Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-20 20:07:36 +00:00
Code Issues Projects Releases Packages Wiki Activity

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-57

Browse source 
Merge from emacs--cvs-trunk--0

Patches applied:

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-594
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-598
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-599
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-600
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-602
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-603
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-604
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-609
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-610
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-611
 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-614
   Update from CVS

 * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-615
   Merge from gnus--rel--5.10

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-42
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-43
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-44
 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-46
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-47
   Merge from emacs--cvs-trunk--0

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-48
   Update from CVS

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-49
   Add {arch}/=commit-merge-make-log

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-50
   {arch}/=commit-merge-make-log: Don't die if there are no ChangeLog changes
This commit is contained in:
Miles Bader 2004-10-14 08:50:09 +00:00
commit 91900dd736
134 changed files with 7873 additions and 1442 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
ChangeLog
View file

@ -1,3 +1,18 @@
2004-10-08 Steven Tamm <steventamm@mac.com>
* configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h
* configure: Rebuild
2004-10-06 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in (HAVE_RANDOM_HEAPSTART): Change AC_MSG_ERROR to
AC_MSG_WARN. Move output of warning message to end of configure run.
2004-10-05 Jan Dj,Ad(Brv. <jan.h.d@swipnet.se>
* configure.in (HAVE_RANDOM_HEAPSTART): Renamed HAVE_EXECSHIELD.
Run test to see if heap start address is random.
2004-09-29 Miles Bader <miles@gnu.org>
* configure.in (HAVE_EXECSHIELD): Test correct env variable to see

4
admin/FOR-RELEASE
View file

@ -28,8 +28,6 @@ isearch faces.
** Finish updating the Emacs Lisp manual.
*** New display properties (KFS to provide input).
** Update the Emacs manual.
*** Update man/info.texi.
@ -88,7 +86,7 @@ man/rmail.texi
man/screen.texi "Luc Teirlinck"
man/search.texi "Luc Teirlinck"
man/sending.texi
man/text.texi
man/text.texi "Luc Teirlinck"
man/trouble.texi
man/windows.texi "Luc Teirlinck"
man/xresources.texi

914
configure vendored
View file

File diff suppressed because it is too large Load diff

82
configure.in
View file

@ -1286,25 +1286,6 @@ AC_LINK_IFELSE([main(){return 0;}],
dnl checks for Unix variants
AC_AIX
dnl check if exec-shield is present.
AC_CHECK_FILE(/proc/sys/kernel/exec-shield, emacs_cv_execshield=1,
emacs_cv_execshield=0)
if test "$emacs_cv_execshield" = 1; then
AC_PATH_PROG(SETARCH, setarch, no)
AC_SUBST(SETARCH)
if test "$SETARCH" != no && test "$machine" = "intel386"; then
AC_DEFINE(HAVE_EXECSHIELD, 1,
[Define to 1 if this OS has exec shield and we can handle it.])
else
case "`cat /proc/sys/kernel/exec-shield`" in
0) ;;
*)
AC_MSG_ERROR([Exec-shield is turned on.
Emacs can not dump itself if exec-shield is turned on.
See `etc/PROBLEMS' for further information.])
esac
fi
fi
#### Extract some information from the operating system and machine files.
@ -1591,6 +1572,53 @@ AH_TEMPLATE(POINTER_TYPE,
[Define as `void' if your compiler accepts `void *'; otherwise
define as `char'.])dnl
dnl Test if heap start address is randomized (exec-shield does this).
dnl The test program requires unistd.h and stdlib.h. They are present
dnl on the systems that currently have exec-shield.
AC_MSG_CHECKING(whether heap start address is randomized)
if test x"$ac_cv_header_unistd_h" != x && test x"$ac_cv_header_stdlib_h" != x
then
AC_TRY_RUN([#include <stdio.h>
#include <unistd.h>
#include <stdlib.h>
int main (int argc, char *argv[])
{
unsigned long old_sbrk = 0;
unsigned long this_sbrk = (unsigned long) sbrk(0);
int nr = 1;
if (argc != 1) {
old_sbrk = strtoul (argv[1], 0, 0);
nr = atoi (argv[2])+1;
}
if (argc == 1 || (old_sbrk == this_sbrk && nr < 3))
{
char buf1[32], buf2[32];
sprintf (buf1, "%lu", this_sbrk);
sprintf (buf2, "%d", nr);
execl (argv[0], argv[0], buf1, buf2, 0);
exit (-1);
}
exit (this_sbrk == old_sbrk);
}], emacs_cv_randomheap=yes, emacs_cv_randomheap=no,
emacs_cv_randomheap='assuming no')
else
emacs_cv_randomheap='assuming no'
fi
AC_MSG_RESULT($emacs_cv_randomheap)
if test "$emacs_cv_randomheap" = yes; then
AC_PATH_PROG(SETARCH, setarch, no)
AC_SUBST(SETARCH)
if test "$SETARCH" != no && test "$machine" = "intel386"; then
AC_DEFINE(HAVE_RANDOM_HEAPSTART, 1,
[Define to 1 if this OS randomizes the start address of the heap.])
else
dnl We do the warning at the end of the configure run so it is seen.
emacs_cv_randomheap=warn
fi
fi
dnl This could be used for targets which can have both byte sexes.
dnl We could presumably replace the hardwired WORDS_BIG_ENDIAN generally.
dnl AC_C_BIGENDIAN
@ -2285,6 +2313,9 @@ if test "${with_carbon}" != "no"; then
AC_CHECK_HEADER(Carbon/Carbon.h, HAVE_CARBON=yes)
fi
dnl Check for malloc/malloc.h on darwin
AC_CHECK_HEADER(malloc/malloc.h, AC_DEFINE(HAVE_MALLOC_MALLOC_H, 1, [Define to 1 if you have the <malloc/malloc.h> header file.]))
if test "${HAVE_CARBON}" = "yes"; then
AC_DEFINE(HAVE_CARBON, 1, [Define to 1 if you are using the Carbon API on Mac OS X.])
window_system=mac
@ -3058,6 +3089,19 @@ echo " Does Emacs use -lpng? ${HAVE_PNG}"
echo " Does Emacs use X toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}"
echo
if test "$emacs_cv_randomheap" = warn; then
AC_MSG_WARN([
**********************************************************************
Heap start address is randomized and no workaround is known.
Emacs will probably dump core when temacs is run in the build phase.
Maybe exec-shield is turned on. Read about exec-shield in `etc/PROBLEMS'
for further information.
**********************************************************************
])
fi
# Remove any trailing slashes in these variables.
[test "${prefix}" != NONE &&
prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'`

2
etc/CENSORSHIP
View file

@ -54,7 +54,7 @@ rules.
Of course, I'm making an assumption about just what "indecent" means.
I have to do this, because nobody knows for sure. The most obvious
possibile meaning is the meaning it has for television, so I'm using
possible meaning is the meaning it has for television, so I'm using
that as a tentative assumption. However, there is a good chance that
our courts will reject that interpretation of the law as
unconstitutional.

13
etc/ChangeLog
View file

@ -1,3 +1,16 @@
2004-10-08 Fr,Ai(Bd,Ai(Bric Bothamy <frederic.bothamy@free.fr> (tiny change)
* TUTORIAL.fr: Minor wording fix.
2004-10-04 Luc Teirlinck <teirllm@auburn.edu>
* enriched.doc: Update for new bindings of `set-left-margin' and
`set-right-margin'.
2004-10-04 Kim F. Storm <storm@cua.dk>
* DEBUG: Mention pp and ff commands.
2004-09-26 Luc Teirlinck <teirllm@auburn.edu>
* enriched.doc: `enriched-annotation-alist' is now called

11
etc/DEBUG
View file

@ -69,9 +69,11 @@ fatal error, you can use the GDB command `pr'. First print the value
in the ordinary way, with the `p' command. Then type `pr' with no
arguments. This calls a subroutine which uses the Lisp printer.
Note: It is not a good idea to try `pr' if you know that Emacs is in
deep trouble: its stack smashed (e.g., if it encountered SIGSEGV due
to stack overflow), or crucial data structures, such as `obarray',
You can also use `pp value' to print the emacs value directly.
Note: It is not a good idea to try `pr' or `pp' if you know that Emacs
is in deep trouble: its stack smashed (e.g., if it encountered SIGSEGV
due to stack overflow), or crucial data structures, such as `obarray',
corrupted, etc. In such cases, the Emacs subroutine called by `pr'
might make more damage, like overwrite some data that is important for
debugging the original problem.
@ -442,6 +444,9 @@ Several more functions for debugging display code are available in
Emacs compiled with GLYPH_DEBUG defined; type "C-h f dump- TAB" and
"C-h f trace- TAB" to see the full list.
When you debug display problems running emacs under X, you can use
the `ff' command to flush all pending display updates to the screen.
** Debugging LessTif

42
etc/NEWS
View file

@ -173,6 +173,21 @@ types any more. Add -DUSE_LISP_UNION_TYPE if you want union types.
* Changes in Emacs 21.4
+++
** New function `looking-back' checks whether a regular expression matches
the text before point. Specifying the LIMIT argument bounds how far
back the match can start; this is a way to keep it from taking too long.
+++
** New functions `make-progress-reporter', `progress-reporter-update',
`progress-reporter-force-update' and `progress-reporter-done' provide
a simple and efficient way of printing progress messages to the user.
+++
** In Enriched mode, `set-left-margin' and `set-right-margin' are now
by default bound to `C-c [' and `C-c ]' instead of the former `C-c C-l'
and `C-c C-r'.
+++
** In processing a local variables list, Emacs strips the prefix and
suffix are from every line before processing all the lines.
@ -1236,12 +1251,23 @@ to new-kill-line, these commands now report:
- C-h w and C-h f new-kill-line reports:
new-kill-line is on C-k
+++
** Vertical scrolling is now possible within incremental search.
To enable this feature, customize the new user option
`isearch-allow-scroll'. User written commands which satisfy stringent
constraints can be marked as "scrolling commands". See the Emacs manual
for details.
+++
** C-w in incremental search now grabs either a character or a word,
making the decision in a heuristic way. This new job is done by the
command `isearch-yank-word-or-char'. To restore the old behavior,
bind C-w to `isearch-yank-word' in `isearch-mode-map'.
+++
** C-y in incremental search now grabs the next line if point is already
at the end of a line.
+++
** C-M-w deletes and C-M-y grabs a character in isearch mode.
Another method to grab a character is to enter the minibuffer by `M-e'
@ -1465,6 +1491,10 @@ of the recognized cursor types.
controls whether or not the function `make-auto-save-file-name' will
attempt to construct a unique auto-save name (e.g. for remote files).
+++
** There is a new calendar package, icalendar.el, that can be used to
convert Emacs diary entries to/from the iCalendar format.
+++
** Diary sexp entries can have custom marking in the calendar.
Diary sexp functions which only apply to certain days (such as
@ -1481,6 +1511,11 @@ appointments, paydays or anything else using a sexp.
year and day number, and moves to that date. Negative day numbers
count backward from the end of the year.
+++
** The new Calendar function `calendar-goto-iso-week' (g w)
prompts for a year and a week number, and moves to the first
day of that ISO week.
---
** The functions `holiday-easter-etc' and `holiday-advent' now take
arguments, and only report on the specified holiday rather than all.
@ -2558,9 +2593,8 @@ symbol identifying a fringe bitmap, either built-in or defined with
`define-fringe-bitmap', and FACE is an optional face name to be used
for displaying the bitmap.
*** New function `fringe-bitmaps-at-pos' returns a cons (LEFT . RIGHT)
identifying the current fringe bitmaps in the display line at a given
buffer position. A nil value means no bitmap.
*** New function `fringe-bitmaps-at-pos' returns the current fringe
bitmaps in the display line at a given buffer position.
** Multiple overlay arrows can now be defined and managed via the new
variable `overlay-arrow-variable-list'. It contains a list of
@ -2579,10 +2613,12 @@ If either property is not set, the default `overlay-arrow-string' or
line in current buffer, or if optional buffer position is given, line
number of corresponding line in current buffer.
+++
** The default value of `sentence-end' is now defined using the new
variable `sentence-end-without-space' which contains such characters
that end a sentence without following spaces.
+++
** The function `sentence-end' should be used to obtain the value of
the variable `sentence-end'. If the variable `sentence-end' is nil,
then this function returns the regexp constructed from the variables

3
etc/TODO
View file

@ -34,6 +34,9 @@ to the FSF.
** Implement a smoother vertical scroll facility, one that allows
C-v to scroll through a tall image.
** Implement intelligent search/replace, going beyond query-replace
(see http://graphics.csail.mit.edu/~rcm/chi04.pdf).
** Implement other text formatting properties.
*** Footnotes that can appear either in place or at the end of the page.
*** text property that says "don't break line in middle of this".

30
etc/TUTORIAL.fr
View file

@ -17,7 +17,7 @@ Tapez C-x C-c (deux caract
Dans ce didacticiel, les caractères ">>" en marge gauche indiquent les
directions à suivre pour essayer une commande. Ainsi :
<<Lignes blanches insérées après cette ligne par help-with-tutorial>>
[Centre de page deliberéement vide. Le texte continue ci-dessous.]
[Centre de page delibérément vide. Le texte continue ci-dessous.]
>> Tapez C-v (Voir l'écran suivant) pour passer à l'écran suivant
(faites-le, pressez la touche CTRL tout en pressant la touche v).
À partir de maintenant, vous devrez le faire à chaque fois que
@ -36,7 +36,7 @@ touche META, EDIT ou ALT).
>> Faites M-v, puis C-v plusieurs fois.
Si votre terminal en dispose, vous pouvez également utiliser les
touches PgUp et PgDn pour monter ou descendre d'un écran, bien les
touches PgUp et PgDn pour monter ou descendre d'un écran, bien que les
combinaisons C-v et M-v soient plus efficaces.
* RÉSUMÉ
@ -347,7 +347,7 @@ avant la position courante du curseur.
Lorsqu'une ligne de texte devient trop longue pour tenir sur une seule
ligne de l'écran, elle se « continue » sur une deuxième ligne
d'écran. Une barre de fraction inverse (« \ ») ou, si vous utilisez un
environnement grapgique, une petite flèche recourbée, sur la marge
environnement graphique, une petite flèche recourbée, sur la marge
droite indique une ligne qui se poursuit sur la ligne suivante.
>> Insérez du texte jusqu'à atteindre la marge droite et continuez
@ -423,7 +423,7 @@ espaces, les effacent (vous ne pouvez donc pas r
Notez qu'un simple C-k supprime le contenu de la ligne et qu'un second
détruit la ligne elle-même, ce qui fait remonter toutes les lignes
suivantes. C-k traite son paramètre numérique d'une façon spéciale :
il détruit ce nombre de lignes ET leurs contenus. Ce n'est pas une
il détruit ce nombre de lignes ET leur contenu. Ce n'est pas une
simple répétition : C-u 2 C-k détruit deux lignes et leurs Newlines
alors que taper deux fois C-k n'aurait pas le même effet.
@ -523,7 +523,7 @@ sauvegardez, Emacs garde le fichier original sous un nom modifi
cas où vous décideriez ensuite d'annuler vos modifications.
Si vous examinez le bas de l'écran, vous verrez une ligne qui commence
et finit par des tirets et débute par « --:-- TUTORIAL.fr » ou quelque
et finit par des tirets et débute par « -1:-- TUTORIAL.fr » ou quelque
chose comme ça. Cette partie de l'écran montre normalement le nom du
fichier que vous êtes en train de visiter. Pour l'instant, vous
visitez un fichier appelé « TUTORIAL.fr », qui est votre copie
@ -584,7 +584,7 @@ l'
encore. C'est ainsi que l'on crée un fichier avec Emacs : on trouve le
fichier, qui démarre vide, puis on insère du texte. Lorsque l'on
demande à « sauvegarder » le fichier, Emacs crée alors vraiment le
fichier avec le texte que l'on a inséré. À partir de ce moment là,
fichier avec le texte que l'on a inséré. À partir de ce moment-là,
vous pouvez considérer que vous éditez un fichier déjà existant.
@ -666,10 +666,10 @@ non.
* EXTENSION DU JEU DE COMMANDES
-------------------------------
Il y bien plus de commandes Emacs qu'il ne serait possible d'en créer
avec tous les caractères de contrôle et les caractères Meta. Emacs
contourne ce problème à l'aide de la commande X (eXtension). Celle-ci
se présente sous deux déclinaisons :
Il y a bien plus de commandes Emacs qu'il ne serait possible d'en
créer avec tous les caractères de contrôle et Meta. Emacs contourne ce
problème à l'aide de la commande X (eXtension). Celle-ci se présente
sous deux déclinaisons :
C-x eXtension caractère, suivie d'un seul caractère.
M-x eXtension d'une commande nommée, suivie d'un nom long.
@ -742,7 +742,7 @@ param
Lorsque vous avez modifié un fichier, mais que vous ne l'avez pas
encore sauvegardé, ces modifications pourraient être perdues si votre
système se plantait. Pour vous protéger ce de problème, Emacs écrit
système se plantait. Pour vous protéger de ce problème, Emacs écrit
périodiquement un fichier de « sauvegarde automatique » pour chaque
fichier en cours d'édition. Le nom de ce fichier commence et se
termine par un # : si, par exemple, votre fichier s'appelle
@ -772,14 +772,14 @@ zone d'
La ligne placée immédiatement au dessus de la zone d'écho s'appelle la
« ligne de mode ». Elle affiche quelque chose comme ça :
--:** TUTORIAL.fr (Fundamental)--L752--67%----------------
-1:** TUTORIAL.fr (Fundamental)--L752--67%----------------
Cette ligne donne des informations sur l'état d'Emacs et sur le texte
que vous êtes en train d'éditer.
Vous savez déjà ce que signifie le nom de fichier -- c'est celui que
vous avez chargé. -NN%-- indique votre position actuelle dans le
texte ; cela signifie que NN pourcent du texte se trouve au dessus du
texte ; cela signifie que NN pour cent du texte se trouve au dessus du
sommet de l'écran. Si le début du fichier est sur l'écran, il
s'affichera --Top-- et non --00%--. Si le bas du texte est sur
l'écran, il s'affichera --Bot--. Si tout le texte tient dans l'écran,
@ -802,7 +802,7 @@ Emacs poss
prévus pour éditer différents langages et/ou types de texte (mode
Lisp, mode Text, etc). À tout instant, il n'y a qu'un seul mode majeur
actif et son nom se trouve toujours dans la ligne de mode, à l'endroit
ou « Fundamental » se trouve actuellement.
où « Fundamental » se trouve actuellement.
Chaque mode majeur modifie le comportement de quelques commandes. Il
existe, par exemple, des commandes pour créer des commentaires dans un
@ -940,7 +940,7 @@ haut dans le texte, faites plut
C-s s'applique également à C-r, sauf que la direction de la recherche
est inversée.
* FENETRES MULTIPLES
* FENÊTRES MULTIPLES
--------------------
L'une des caractéristiques les plus agréables d'Emacs est que vous

4
etc/enriched.doc
View file

@ -98,8 +98,8 @@ direct request, such as using the return key or the <fixed>C-o
<indent>The fill functions also understand margins, which can be set for
any region of a document. In addition to the menu items, which
increase or decrease the margins, there are two commands for
setting the margins absolutely: <fixed>C-c C-l (set-left-margin)</fixed> and <fixed>C-c
C-r (set-right-margin)</fixed>.
setting the margins absolutely: <fixed>C-c [ (set-left-margin)</fixed> and <fixed>C-c
] (set-right-margin)</fixed>.
You <indent>can change indentation at any point in a paragraph, which

239
lisp/ChangeLog
View file

@ -1,4 +1,233 @@
2004-10-03 Stefan <monnier@iro.umontreal.ca>
2004-10-13 Daniel Pfeiffer <occitan@esperanto.org>
* button.el (button-activate): Allow a marker to display as an
action.
* help-fns.el (describe-variable): Use it to make "below" a
hyperlink.
* help.el (describe-mode): Use it to make minor mode list into
hyperlinks.
2004-10-14 Masatake YAMATO <jet@gyve.org>
* progmodes/gud.el (gdb-script-beginning-of-defun): New function.
(gdb-script-end-of-defun): New function.
(gdb-script-mode): Use `gdb-script-beginning-of-defun' and
`gdb-script-end-of-defun' as *-of-defun-function.
2004-10-13 Stefan Monnier <monnier@iro.umontreal.ca>
* vc.el (vc-annotate-display-select): Fix typo.
* subr.el (substitute-key-definition-key): New function.
(substitute-key-definition): Use it with map-keymap.
(event-modifiers): Use push.
(mouse-movement-p, with-temp-buffer): Simplify.
2004-10-12 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.45.
* net/tramp.el (top): Apply `def-edebug-spec' only if function is
defined. This is not the case for XEmacs without package "edebug".
(tramp-set-auto-save-file-modes): Set permissions of autosaved
remote files to the permissions of the original file. This is not
the case for Emacs < 21.3.50 and XEmacs < 21.5. Add function to
`auto-save-hook'. Reported by Thomas Prokosch <thomas@nadev.net>.
(tramp-perl-decode): Fix an error in Perl implementation.
$pending must be cleared every loop. Reported by Benjamin Place
<benjaminplace@sprintmail.com>
* net/tramp-smb.el (tramp-smb-advice-PC-do-completion):
Don't activate advice during definition. This is done later on,
depending on test result of `substitute-in-file-name'.
Suggested by Stefan Monnier <monnier@iro.umontreal.ca>.
2004-10-12 Stefan Monnier <monnier@iro.umontreal.ca>
* pcvs-parse.el (cvs-parse-commit): Fix parsing for new commit message.
* emacs-lisp/lisp.el (mark-sexp): Preserve direction when repeating.
2004-10-12 David Ponce <david@dponce.com>
* recentf.el (recentf-edit-list): Update the menu when the recentf
list has been modified.
2004-10-12 Simon Josefsson <jas@extundo.com>
* net/tls.el (tls-certtool-program): New variable.
(tls-certificate-information): New function, based on
ssl-certificate-information.
2004-10-12 Kenichi Handa <handa@m17n.org>
* international/mule.el (coding-system-equal): Move from mule-util.el.
* international/mule-util.el (coding-system-equal): Move to mule.el.
2004-10-12 Kim F. Storm <storm@cua.dk>
* kmacro.el (kmacro-insert-counter, kmacro-add-counter): Use and
reset kmacro-initial-counter-value if set.
(kmacro-set-counter): Only set kmacro-counter if defining or executing
macro. Set kmacro-initial-counter-value otherwise. Never set both.
(kmacro-display): Show macro counter if non-zero.
* subr.el (substitute-key-definition): Mention command remapping
in doc string.
2004-10-11 Stefan Monnier <monnier@iro.umontreal.ca>
* pcvs-defs.el (pcl-cvs-load-hook): Remove unused var.
* font-lock.el (font-lock-apply-highlight): Fix last change.
2004-10-11 Simon Josefsson <jas@extundo.com>
* mail/smtpmail.el (smtpmail-open-stream): Look for
starttls-gnutls-program instead of starttls-program iff
starttls-use-gnutls is non-nil.
(smtpmail-open-stream): Don't overwrite user settings of
starttls-extra-arguments and starttls-extra-args.
2004-10-10 Stefan Monnier <monnier@iro.umontreal.ca>
* comint.el (comint-mouse-insert-input): Remove.
(comint-insert-input): Make it work for mouse bindings.
(comint-mode-map): Move defs into the declaration.
(comint-output-filter): Typo.
* diff-mode.el (diff-current-defun): Fix 2004-06-13's change.
2004-10-10 Kai Grossjohann <kai.grossjohann@gmx.net>
* net/ange-ftp.el (ange-ftp-remote-shell): Remove variable.
(ange-ftp-call-chmod): Reference remote-shell-program instead of
ange-ftp-remote-shell.
2004-10-10 Andreas Schwab <schwab@suse.de>
* emacs-lisp/byte-opt.el (byte-optimize-backward-word): Optimize
`(backward-word)' to `(forward-word -1)', not `(forward-char -1)'.
Reported by <sri@asu.edu>.
2004-10-10 Benjamin Rutt <brutt@bloomington.in.us>
* vc.el (vc-annotate-mode): Remove variable.
(vc-annotate-display-select): Only call vc-annotate-mode
if we're not in that mode already.
2004-10-09 Stefan Monnier <monnier@iro.umontreal.ca>
* imenu.el (imenu--completion-buffer): Don't return t for rescan.
(imenu-choose-buffer-index): Check here for rescan instead.
* font-lock.el (font-lock-apply-highlight): Explicitly check the case
where the face expression evals to nil.
* textmodes/tex-mode.el (tex-font-lock-append-prop): New fun.
(tex-font-lock-keywords-2): Use it.
(tex-font-lock-syntactic-keywords): Fix the `verbatim' treatment.
* emacs-lisp/lisp-mode.el (lisp-fill-paragraph): Fix backslashes.
2004-10-09 Kim F. Storm <storm@cua.dk>
* subr.el (progress-reporter-update): Define before first usage.
(make-progress-reporter): Doc fix.
2004-10-09 Luc Teirlinck <teirllm@auburn.edu>
* textmodes/paragraphs.el (sentence-end-double-space)
(sentence-end-without-period, sentence-end-without-space)
(sentence-end): Doc fixes.
2004-10-08 Peter Seibel <peter@javamonkey.com> (tiny change)
* emacs-lisp/lisp-mode.el (lisp-fill-paragraph):
Change paragraph-start regexp so we don't fill code starting with #'(.
2004-10-08 Sebastien Kirche <seki@seki.fr> (tiny change)
* mail/mail-extr.el (mail-extr-ignore-realname-equals-mailbox-name):
New defcustom.
(extract-address-components): Use it.
2004-10-08 Paul Pogonyshev <pogonyshev@gmx.net>
* subr.el (make-progress-reporter, progress-reporter-update)
(progress-reporter-force-update, progress-reporter-do-update)
(progress-reporter-done): New functions.
* tar-mode.el (tar-summarize-buffer): Use progress reporter.
* progmodes/etags.el (etags-tags-completion-table): Use progress
reporter.
(etags-tags-apropos): Likewise.
2004-10-08 Alan Mackenzie <acm@muc.de>
* isearch.el (isearch-yank-line): C-y yanks to next EOL, not end
of current line.
2004-10-08 Masatake YAMATO <jet@gyve.org>
* server.el (server-process-filter): Wrap `process-send-region'
by `condition-case' to guard the case when the pipe to PROC is closed.
2004-10-07 Mark A. Hershberger <mah@everybody.org>
* xml.el (xml-substitute-special): Limit handling of external entities.
2004-10-06 Nick Roberts <nickrob@snap.net.nz>
* progmodes/gdb-ui.el (gdb-ann3): (Re-)initialise gdb-input-queue.
2004-10-06 John Paul Wallington <jpw@gnu.org>
* xml.el (xml-parse-dtd): Fix `error' call.
2004-10-05 Mark A. Hershberger <mah@everybody.org>
* xml.el (xml-substitute-special): Return a single string instead
of a list of strings if an entity substitution is made.
2004-10-05 Ulf Jasper <ulf.jasper@web.de>
* calendar/icalendar.el: New file.
2004-10-05 Juri Linkov <juri@jurta.org>
* isearch.el (isearch-done): Set mark after running hook.
Suggested by Drew Adams <drew.adams@oracle.com>.
* info.el (Info-history, Info-toc): Fix Info headers.
(Info-toc): Narrow buffer before Info-fontify-node.
(Info-build-toc): Don't check for special Info file names.
Set main-file to nil if Info-find-file returns a symbol.
2004-10-05 Emilio C. Lopes <eclig@gmx.net>:
* calendar/calendar.el (calendar-goto-iso-week): Add autoload.
(calendar-mode-map): Add binding for `calendar-goto-iso-week'.
* calendar/cal-menu.el (calendar-mode-map): Ditto.
2004-10-05 Glenn Morris <gmorris@ast.cam.ac.uk>
* calendar/cal-iso.el (calendar-iso-read-args): New function,
for old interactive spec from calendar-goto-iso-date.
(calendar-goto-iso-date): Use it.
(calendar-goto-iso-week): New function. Suggested by Emilio
C. Lopes <eclig@gmx.net>.
2004-10-04 Luc Teirlinck <teirllm@auburn.edu>
* textmodes/enriched.el (enriched-mode-map): Give `set-left-margin' and
`set-right-margin' bindings that follow the minor mode conventions.
2004-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* textmodes/tex-mode.el (tex-dvi-view-command): Use `yap' on w32.
(tex-font-lock-keywords-1): Add url and nolinkurl for args with `_'.
@ -62,7 +291,7 @@
* diff-mode.el (diff-file-header-re): Tighten up regexp a tiny bit.
(diff-fixup-modifs): Catch unified-diff file-headers.
2004-09-28 Stefan <monnier@iro.umontreal.ca>
2004-09-28 Stefan Monnier <monnier@iro.umontreal.ca>
* dired.el (dired-view-command-alist): Use more efficient regexps.
Remove dubious arguments.
@ -102,7 +331,7 @@
(pr-delete-file): Check if file exists before deleting it.
Reported by Lennart Borgman <lennart.borgman.073@student.lu.se>.
2004-09-26 Stefan <monnier@iro.umontreal.ca>
2004-09-26 Stefan Monnier <monnier@iro.umontreal.ca>
* term.el (term-display-table): New variable.
(term-mode): Use it.
@ -126,7 +355,7 @@
(term-stop-output-log): Rename from `term-stop-photo'.
(term-switch-to-alternate-sub-buffer): Comment out, unused.
2004-09-25 Stefan <monnier@iro.umontreal.ca>
2004-09-25 Stefan Monnier <monnier@iro.umontreal.ca>
* dired.el (dired-move-to-filename): Don't output a message if
raise-error is non-nil. Fix return position and value.
@ -270,7 +499,7 @@
* progmodes/sh-script.el (sh-mode-default-syntax-table): Set syntax
of = to "." (punctuation).
2004-09-19 Stefan <monnier@iro.umontreal.ca>
2004-09-19 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (event-basic-type): Fix mask (extend to 22bits).

19
lisp/button.el
View file

@ -78,6 +78,7 @@ Mode-specific keymaps may want to use this as their parent keymap.")
(put 'default-button 'mouse-face 'highlight)
(put 'default-button 'keymap button-map)
(put 'default-button 'type 'button)
;; action may be either a function to call, or a marker to go to
(put 'default-button 'action 'ignore)
(put 'default-button 'help-echo "mouse-2, RET: Push this button")
;; Make overlay buttons go away if their underlying text is deleted.
@ -217,9 +218,14 @@ changes to a supertype are not reflected in its subtypes)."
If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
instead of its normal action; if the button has no mouse-action,
the normal action is used instead."
(funcall (or (and use-mouse-action (button-get button 'mouse-action))
(button-get button 'action))
button))
(let ((action (or (and use-mouse-action (button-get button 'mouse-action))
(button-get button 'action))))
(if (markerp action)
(save-selected-window
(select-window (display-buffer (marker-buffer action)))
(goto-char action)
(recenter 0))
(funcall action button))))
(defun button-label (button)
"Return BUTTON's text label."
@ -373,10 +379,11 @@ instead of starting at the next button."
(defun push-button (&optional pos use-mouse-action)
"Perform the action specified by a button at location POS.
POS may be either a buffer position or a mouse-event.
If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
POS may be either a buffer position or a mouse-event. If
USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
instead of its normal action; if the button has no mouse-action,
the normal action is used instead.
the normal action is used instead. The action may be either a
function to call or a marker to display.
POS defaults to point, except when `push-button' is invoked
interactively as the result of a mouse-event, in which case, the
mouse event is used.

77
lisp/calc/calc-help.el
View file

@ -93,18 +93,15 @@ C-w Describe how there is no warranty for Calc."
(defun calc-describe-copying ()
(interactive)
(calc-info)
(Info-goto-node "Copying"))
(calc-info-goto-node "Copying"))
(defun calc-describe-distribution ()
(interactive)
(calc-info)
(Info-goto-node "Reporting Bugs"))
(calc-info-goto-node "Reporting Bugs"))
(defun calc-describe-no-warranty ()
(interactive)
(calc-info)
(Info-goto-node "Copying")
(calc-info-goto-node "Copying")
(let ((case-fold-search nil))
(search-forward " NO WARRANTY"))
(beginning-of-line)
@ -190,13 +187,13 @@ C-w Describe how there is no warranty for Calc."
(message "Reading Calc summary from manual...")
(save-window-excursion
(save-excursion
(calc-info)
(Info-goto-node "Summary")
(calc-info-goto-node "Summary")
(goto-char (point-min))
(forward-line 1)
(copy-to-buffer "*Calc Summary*"
(point) (point-max))
(Info-last)))
(if Info-history
(Info-last))))
(setq case-fold-search nil)
(re-search-forward "^\\(.*\\)\\[\\.\\. a b")
(setq calc-summary-indentation
@ -299,35 +296,62 @@ C-w Describe how there is no warranty for Calc."
(calc-describe-thing desc "Key Index" nil
(string-match "[A-Z][A-Z][A-Z]" desc))))))
(defvar calc-help-function-list nil
"List of functions provided by Calc.")
(defvar calc-help-variable-list nil
"List of variables provided by Calc.")
(defun calc-help-index-entries (&rest indices)
"Create a list of entries from the INDICES in the Calc info manual."
(let ((entrylist '())
entry)
(require 'info nil t)
(while indices
(condition-case nil
(with-temp-buffer
(Info-mode)
(Info-goto-node (concat "(Calc)" (car indices) " Index"))
(goto-char (point-min))
(while (re-search-forward "\n\\* \\(.*\\): " nil t)
(setq entry (match-string 1))
(if (and (not (string-match "<[1-9]+>" entry))
(not (string-match "(.*)" entry))
(not (string= entry "Menu")))
(unless (assoc entry entrylist)
(setq entrylist (cons entry entrylist))))))
(error nil))
(setq indices (cdr indices)))
entrylist))
(defun calc-describe-function (&optional func)
(interactive)
(unless calc-help-function-list
(setq calc-help-function-list
(calc-help-index-entries "Function" "Command")))
(or func
(setq func (intern (completing-read "Describe function: "
obarray nil t "calcFunc-"))))
(setq func (symbol-name func))
(setq func (completing-read "Describe function: "
calc-help-function-list
nil t)))
(if (string-match "\\`calc-." func)
(calc-describe-thing func "Command Index")
(calc-describe-thing (if (string-match "\\`calcFunc-." func)
(substring func 9)
func)
"Function Index")))
(calc-describe-thing func "Function Index")))
(defun calc-describe-variable (&optional var)
(interactive)
(unless calc-help-variable-list
(setq calc-help-variable-list
(calc-help-index-entries "Variable")))
(or var
(setq var (intern (completing-read "Describe variable: "
obarray nil t "var-"))))
(setq var (symbol-name var))
(calc-describe-thing var "Variable Index"
(if (string-match "\\`var-." var)
(substring var 4)
var)))
(setq var (completing-read "Describe variable: "
calc-help-variable-list
nil t)))
(calc-describe-thing var "Variable Index"))
(defun calc-describe-thing (thing where &optional target not-quoted)
(message "Looking for `%s' in %s..." thing where)
(let ((savewin (current-window-configuration)))
(calc-info)
(Info-goto-node where)
(calc-info-goto-node where)
(or (let ((case-fold-search nil))
(re-search-forward (format "\n\\* +%s: \\(.*\\)\\."
(regexp-quote thing))
@ -338,7 +362,8 @@ C-w Describe how there is no warranty for Calc."
nil t)
(setq thing (format "%s9" (substring thing 0 -1))))
(progn
(Info-last)
(if Info-history
(Info-last))
(set-window-configuration savewin)
(error "Can't find `%s' in %s" thing where)))
(let (Info-history)

12
lisp/calc/calc-misc.el
View file

@ -160,21 +160,25 @@ Calc user interface as before (either M-# C or M-# K; initially M-# C)."
(select-window (get-largest-window))
(info "Calc"))
(defun calc-info-goto-node (node)
"Go to a node in the Calculator info documentation."
(interactive)
(select-window (get-largest-window))
(Info-goto-node (concat "(Calc)" node)))
(defun calc-tutorial ()
"Run the Emacs Info system on the Calculator Tutorial."
(interactive)
(if (get-buffer-window "*Calculator*")
(calc-quit))
(calc-info)
(Info-goto-node "Interactive Tutorial")
(calc-info-goto-node "Interactive Tutorial")
(calc-other-window)
(message "Welcome to the Calc Tutorial!"))
(defun calc-info-summary ()
"Run the Emacs Info system on the Calculator Summary."
(interactive)
(calc-info)
(Info-goto-node "Summary"))
(calc-info-goto-node "Summary"))
(defun calc-help ()
(interactive)

3
lisp/calc/calc.el
View file

@ -942,7 +942,8 @@ If nil, selections displayed but ignored.")
calcDigit-algebraic calcDigit-edit)
("calc-misc" another-calc calc-big-or-small calc-dispatch-help
calc-help calc-info calc-info-summary calc-inv calc-last-args-stub
calc-help calc-info calc-info-goto-node calc-info-summary calc-inv
calc-last-args-stub
calc-missing-key calc-mod calc-other-window calc-over calc-percent
calc-pop-above calc-power calc-roll-down calc-roll-up
calc-shift-Y-prefix-help calc-tutorial calcDigit-letter

53
lisp/calendar/cal-iso.el
View file

@ -1,8 +1,9 @@
;;; cal-iso.el --- calendar functions for the ISO calendar
;; Copyright (C) 1995, 1997 Free Software Foundation, Inc.
;; Copyright (C) 1995, 1997, 2004 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
;; Keywords: calendar
;; Human-Keywords: ISO calendar, calendar, diary
@ -96,27 +97,39 @@ Defaults to today's date if DATE is not given."
(message "ISO date: %s"
(calendar-iso-date-string (calendar-cursor-to-date t))))
(defun calendar-iso-read-args (&optional dayflag)
"Interactively read the arguments for an iso date command."
(let* ((today (calendar-current-date))
(year (calendar-read
"ISO calendar year (>0): "
'(lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(no-weeks (extract-calendar-month
(calendar-iso-from-absolute
(1-
(calendar-dayname-on-or-before
1 (calendar-absolute-from-gregorian
(list 1 4 (1+ year))))))))
(week (calendar-read
(format "ISO calendar week (1-%d): " no-weeks)
'(lambda (x) (and (> x 0) (<= x no-weeks)))))
(day (if dayflag (calendar-read
"ISO day (1-7): "
'(lambda (x) (and (<= 1 x) (<= x 7))))
1)))
(list (list week day year))))
(defun calendar-goto-iso-date (date &optional noecho)
"Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
(interactive
(let* ((today (calendar-current-date))
(year (calendar-read
"ISO calendar year (>0): "
'(lambda (x) (> x 0))
(int-to-string (extract-calendar-year today))))
(no-weeks (extract-calendar-month
(calendar-iso-from-absolute
(1-
(calendar-dayname-on-or-before
1 (calendar-absolute-from-gregorian
(list 1 4 (1+ year))))))))
(week (calendar-read
(format "ISO calendar week (1-%d): " no-weeks)
'(lambda (x) (and (> x 0) (<= x no-weeks)))))
(day (calendar-read
"ISO day (1-7): "
'(lambda (x) (and (<= 1 x) (<= x 7))))))
(list (list week day year))))
(interactive (calendar-iso-read-args t))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))
(defun calendar-goto-iso-week (date &optional noecho)
"Move cursor to ISO DATE; echo ISO date unless NOECHO is t.
Interactively, goes to the first day of the specified week."
(interactive (calendar-iso-read-args))
(calendar-goto-date (calendar-gregorian-from-absolute
(calendar-absolute-from-iso date)))
(or noecho (calendar-print-iso-date)))

5
lisp/calendar/cal-menu.el
View file

@ -1,9 +1,10 @@
;;; cal-menu.el --- calendar functions for menu bar and popup menu support
;; Copyright (C) 1994, 1995, 2001, 2003 Free Software Foundation, Inc.
;; Copyright (C) 1994, 1995, 2001, 2003, 2004 Free Software Foundation, Inc.
;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
;; Lara Rios <lrios@coewl.cen.uiuc.edu>
;; Maintainer: Glenn Morris <gmorris@ast.cam.ac.uk>
;; Keywords: calendar
;; Human-Keywords: calendar, popup menus, menu bar
@ -121,6 +122,8 @@
'("Astronomical Date" . calendar-goto-astro-day-number))
(define-key calendar-mode-map [menu-bar goto iso]
'("ISO Date" . calendar-goto-iso-date))
(define-key calendar-mode-map [menu-bar goto iso-week]
'("ISO Week" . calendar-goto-iso-week))
(define-key calendar-mode-map [menu-bar goto day-of-year]
'("Day of Year" . calendar-goto-day-of-year))
(define-key calendar-mode-map [menu-bar goto gregorian]

5
lisp/calendar/calendar.el
View file

@ -1769,6 +1769,10 @@ Driven by the variable `calendar-date-display-form'.")
"Move cursor to ISO date."
t)
(autoload 'calendar-goto-iso-week "cal-iso"
"Move cursor to start of ISO week."
t)
(autoload 'calendar-print-iso-date "cal-iso"
"Show the ISO date equivalents of date."
t)
@ -2204,6 +2208,7 @@ the inserted text. Value is always t."
(define-key calendar-mode-map "ge" 'calendar-goto-ethiopic-date)
(define-key calendar-mode-map "gp" 'calendar-goto-persian-date)
(define-key calendar-mode-map "gc" 'calendar-goto-iso-date)
(define-key calendar-mode-map "gw" 'calendar-goto-iso-week)
(define-key calendar-mode-map "gf" 'calendar-goto-french-date)
(define-key calendar-mode-map "gml" 'calendar-goto-mayan-long-count-date)
(define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)

1299
lisp/calendar/icalendar.el Normal file
View file

File diff suppressed because it is too large Load diff

257
lisp/comint.el
View file

@ -1,7 +1,7 @@
;;; comint.el --- general command interpreter in a window stuff
;; Copyright (C) 1988,90,92,93,94,95,96,97,98,99,2000,01,02,03,2004
;; Free Software Foundation, Inc.
;; Copyright (C) 1988, 1990, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Olin Shivers <shivers@cs.cmu.edu>
;; Simon Marshall <simon@gnu.org>
@ -185,10 +185,10 @@ the remaining prompts will be accidentally messed up. You may
wish to put something like the following in your `.emacs' file:
\(add-hook 'comint-mode-hook
'(lambda ()
(define-key comint-mode-map \"\C-w\" 'comint-kill-region)
(define-key comint-mode-map [C-S-backspace]
'comint-kill-whole-line)))
(lambda ()
(define-key comint-mode-map \"\C-w\" 'comint-kill-region)
(define-key comint-mode-map [C-S-backspace]
'comint-kill-whole-line)))
If you sometimes use comint-mode on text-only terminals or with `emacs-nw',
you might wish to use another binding for `comint-kill-whole-line'."
@ -369,11 +369,8 @@ Takes one argument, the input. If non-nil, the input may be saved on the input
history list. Default is to save anything that isn't all whitespace.")
(defvar comint-input-filter-functions '()
"Functions to call before input is sent to the process.
These functions get one argument, a string containing the text to send.
You can use `add-hook' to add functions to this list
either globally or locally.")
"Special hook run before input is sent to the process.
These functions get one argument, a string containing the text to send.")
(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom)
"Functions to call after output is inserted into the buffer.
@ -411,7 +408,7 @@ See `comint-send-input'."
(defcustom comint-use-prompt-regexp-instead-of-fields nil
"*If non-nil, use `comint-prompt-regexp' to distinguish prompts from user-input.
If nil, then program output and user-input are given different `field'
properties, which emacs commands can use to distinguish them (in
properties, which Emacs commands can use to distinguish them (in
particular, common movement commands such as begining-of-line respect
field boundaries in a natural way)."
:type 'boolean
@ -432,7 +429,106 @@ executed once when the buffer is created."
:type 'hook
:group 'comint)
(defvar comint-mode-map nil)
(defvar comint-mode-map
(let ((map (make-sparse-keymap)))
;; Keys:
(define-key map "\ep" 'comint-previous-input)
(define-key map "\en" 'comint-next-input)
(define-key map [C-up] 'comint-previous-input)
(define-key map [C-down] 'comint-next-input)
(define-key map "\er" 'comint-previous-matching-input)
(define-key map "\es" 'comint-next-matching-input)
(define-key map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
(define-key map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
(define-key map "\e\C-l" 'comint-show-output)
(define-key map "\C-m" 'comint-send-input)
(define-key map "\C-d" 'comint-delchar-or-maybe-eof)
(define-key map "\C-c " 'comint-accumulate)
(define-key map "\C-c\C-x" 'comint-get-next-from-history)
(define-key map "\C-c\C-a" 'comint-bol-or-process-mark)
(define-key map "\C-c\C-u" 'comint-kill-input)
(define-key map "\C-c\C-w" 'backward-kill-word)
(define-key map "\C-c\C-c" 'comint-interrupt-subjob)
(define-key map "\C-c\C-z" 'comint-stop-subjob)
(define-key map "\C-c\C-\\" 'comint-quit-subjob)
(define-key map "\C-c\C-m" 'comint-insert-input)
(define-key map "\C-c\C-o" 'comint-delete-output)
(define-key map "\C-c\C-r" 'comint-show-output)
(define-key map "\C-c\C-e" 'comint-show-maximum-output)
(define-key map "\C-c\C-l" 'comint-dynamic-list-input-ring)
(define-key map "\C-c\C-n" 'comint-next-prompt)
(define-key map "\C-c\C-p" 'comint-previous-prompt)
(define-key map "\C-c\C-d" 'comint-send-eof)
(define-key map "\C-c\C-s" 'comint-write-output)
(define-key map "\C-c." 'comint-insert-previous-argument)
;; Mouse Buttons:
(define-key map [mouse-2] 'comint-insert-input)
;; Menu bars:
;; completion:
(define-key map [menu-bar completion]
(cons "Complete" (make-sparse-keymap "Complete")))
(define-key map [menu-bar completion complete-expand]
'("Expand File Name" . comint-replace-by-expanded-filename))
(define-key map [menu-bar completion complete-listing]
'("File Completion Listing" . comint-dynamic-list-filename-completions))
(define-key map [menu-bar completion complete-file]
'("Complete File Name" . comint-dynamic-complete-filename))
(define-key map [menu-bar completion complete]
'("Complete Before Point" . comint-dynamic-complete))
;; Input history:
(define-key map [menu-bar inout]
(cons "In/Out" (make-sparse-keymap "In/Out")))
(define-key map [menu-bar inout delete-output]
'("Delete Current Output Group" . comint-delete-output))
(define-key map [menu-bar inout append-output-to-file]
'("Append Current Output Group to File" . comint-append-output-to-file))
(define-key map [menu-bar inout write-output]
'("Write Current Output Group to File" . comint-write-output))
(define-key map [menu-bar inout next-prompt]
'("Forward Output Group" . comint-next-prompt))
(define-key map [menu-bar inout previous-prompt]
'("Backward Output Group" . comint-previous-prompt))
(define-key map [menu-bar inout show-maximum-output]
'("Show Maximum Output" . comint-show-maximum-output))
(define-key map [menu-bar inout show-output]
'("Show Current Output Group" . comint-show-output))
(define-key map [menu-bar inout kill-input]
'("Kill Current Input" . comint-kill-input))
(define-key map [menu-bar inout copy-input]
'("Copy Old Input" . comint-insert-input))
(define-key map [menu-bar inout forward-matching-history]
'("Forward Matching Input..." . comint-forward-matching-input))
(define-key map [menu-bar inout backward-matching-history]
'("Backward Matching Input..." . comint-backward-matching-input))
(define-key map [menu-bar inout next-matching-history]
'("Next Matching Input..." . comint-next-matching-input))
(define-key map [menu-bar inout previous-matching-history]
'("Previous Matching Input..." . comint-previous-matching-input))
(define-key map [menu-bar inout next-matching-history-from-input]
'("Next Matching Current Input" . comint-next-matching-input-from-input))
(define-key map [menu-bar inout previous-matching-history-from-input]
'("Previous Matching Current Input" . comint-previous-matching-input-from-input))
(define-key map [menu-bar inout next-history]
'("Next Input" . comint-next-input))
(define-key map [menu-bar inout previous-history]
'("Previous Input" . comint-previous-input))
(define-key map [menu-bar inout list-history]
'("List Input History" . comint-dynamic-list-input-ring))
(define-key map [menu-bar inout expand-history]
'("Expand History Before Point" . comint-replace-by-expanded-history))
;; Signals
(let ((signals-map (make-sparse-keymap "Signals")))
(define-key map [menu-bar signals] (cons "Signals" signals-map))
(define-key signals-map [eof] '("EOF" . comint-send-eof))
(define-key signals-map [kill] '("KILL" . comint-kill-subjob))
(define-key signals-map [quit] '("QUIT" . comint-quit-subjob))
(define-key signals-map [cont] '("CONT" . comint-continue-subjob))
(define-key signals-map [stop] '("STOP" . comint-stop-subjob))
(define-key signals-map [break] '("BREAK" . comint-interrupt-subjob)))
;; Put them in the menu bar:
(setq menu-bar-final-items (append '(completion inout signals)
menu-bar-final-items))
map))
;; Fixme: Is this still relevant?
(defvar comint-ptyp t
@ -548,114 +644,6 @@ Entry to this mode runs the hooks on `comint-mode-hook'."
;; This behavior is not useful in comint buffers, and is annoying
(set (make-local-variable 'next-line-add-newlines) nil))
(if comint-mode-map
nil
;; Keys:
(setq comint-mode-map (make-sparse-keymap))
(define-key comint-mode-map "\ep" 'comint-previous-input)
(define-key comint-mode-map "\en" 'comint-next-input)
(define-key comint-mode-map [C-up] 'comint-previous-input)
(define-key comint-mode-map [C-down] 'comint-next-input)
(define-key comint-mode-map "\er" 'comint-previous-matching-input)
(define-key comint-mode-map "\es" 'comint-next-matching-input)
(define-key comint-mode-map [?\C-c ?\M-r] 'comint-previous-matching-input-from-input)
(define-key comint-mode-map [?\C-c ?\M-s] 'comint-next-matching-input-from-input)
(define-key comint-mode-map "\e\C-l" 'comint-show-output)
(define-key comint-mode-map "\C-m" 'comint-send-input)
(define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
(define-key comint-mode-map "\C-c " 'comint-accumulate)
(define-key comint-mode-map "\C-c\C-x" 'comint-get-next-from-history)
(define-key comint-mode-map "\C-c\C-a" 'comint-bol-or-process-mark)
(define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
(define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
(define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
(define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
(define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
(define-key comint-mode-map "\C-c\C-m" 'comint-insert-input)
(define-key comint-mode-map "\C-c\C-o" 'comint-delete-output)
(define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
(define-key comint-mode-map "\C-c\C-e" 'comint-show-maximum-output)
(define-key comint-mode-map "\C-c\C-l" 'comint-dynamic-list-input-ring)
(define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt)
(define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt)
(define-key comint-mode-map "\C-c\C-d" 'comint-send-eof)
(define-key comint-mode-map "\C-c\C-s" 'comint-write-output)
(define-key comint-mode-map "\C-c." 'comint-insert-previous-argument)
;; Mouse Buttons:
(define-key comint-mode-map [mouse-2] 'comint-mouse-insert-input)
;; Menu bars:
;; completion:
(define-key comint-mode-map [menu-bar completion]
(cons "Complete" (make-sparse-keymap "Complete")))
(define-key comint-mode-map [menu-bar completion complete-expand]
'("Expand File Name" . comint-replace-by-expanded-filename))
(define-key comint-mode-map [menu-bar completion complete-listing]
'("File Completion Listing" . comint-dynamic-list-filename-completions))
(define-key comint-mode-map [menu-bar completion complete-file]
'("Complete File Name" . comint-dynamic-complete-filename))
(define-key comint-mode-map [menu-bar completion complete]
'("Complete Before Point" . comint-dynamic-complete))
;; Input history:
(define-key comint-mode-map [menu-bar inout]
(cons "In/Out" (make-sparse-keymap "In/Out")))
(define-key comint-mode-map [menu-bar inout delete-output]
'("Delete Current Output Group" . comint-delete-output))
(define-key comint-mode-map [menu-bar inout append-output-to-file]
'("Append Current Output Group to File" . comint-append-output-to-file))
(define-key comint-mode-map [menu-bar inout write-output]
'("Write Current Output Group to File" . comint-write-output))
(define-key comint-mode-map [menu-bar inout next-prompt]
'("Forward Output Group" . comint-next-prompt))
(define-key comint-mode-map [menu-bar inout previous-prompt]
'("Backward Output Group" . comint-previous-prompt))
(define-key comint-mode-map [menu-bar inout show-maximum-output]
'("Show Maximum Output" . comint-show-maximum-output))
(define-key comint-mode-map [menu-bar inout show-output]
'("Show Current Output Group" . comint-show-output))
(define-key comint-mode-map [menu-bar inout kill-input]
'("Kill Current Input" . comint-kill-input))
(define-key comint-mode-map [menu-bar inout copy-input]
'("Copy Old Input" . comint-insert-input))
(define-key comint-mode-map [menu-bar inout forward-matching-history]
'("Forward Matching Input..." . comint-forward-matching-input))
(define-key comint-mode-map [menu-bar inout backward-matching-history]
'("Backward Matching Input..." . comint-backward-matching-input))
(define-key comint-mode-map [menu-bar inout next-matching-history]
'("Next Matching Input..." . comint-next-matching-input))
(define-key comint-mode-map [menu-bar inout previous-matching-history]
'("Previous Matching Input..." . comint-previous-matching-input))
(define-key comint-mode-map [menu-bar inout next-matching-history-from-input]
'("Next Matching Current Input" . comint-next-matching-input-from-input))
(define-key comint-mode-map [menu-bar inout previous-matching-history-from-input]
'("Previous Matching Current Input" . comint-previous-matching-input-from-input))
(define-key comint-mode-map [menu-bar inout next-history]
'("Next Input" . comint-next-input))
(define-key comint-mode-map [menu-bar inout previous-history]
'("Previous Input" . comint-previous-input))
(define-key comint-mode-map [menu-bar inout list-history]
'("List Input History" . comint-dynamic-list-input-ring))
(define-key comint-mode-map [menu-bar inout expand-history]
'("Expand History Before Point" . comint-replace-by-expanded-history))
;; Signals
(define-key comint-mode-map [menu-bar signals]
(cons "Signals" (make-sparse-keymap "Signals")))
(define-key comint-mode-map [menu-bar signals eof]
'("EOF" . comint-send-eof))
(define-key comint-mode-map [menu-bar signals kill]
'("KILL" . comint-kill-subjob))
(define-key comint-mode-map [menu-bar signals quit]
'("QUIT" . comint-quit-subjob))
(define-key comint-mode-map [menu-bar signals cont]
'("CONT" . comint-continue-subjob))
(define-key comint-mode-map [menu-bar signals stop]
'("STOP" . comint-stop-subjob))
(define-key comint-mode-map [menu-bar signals break]
'("BREAK" . comint-interrupt-subjob))
;; Put them in the menu bar:
(setq menu-bar-final-items (append '(completion inout signals)
menu-bar-final-items))
)
(defun comint-check-proc (buffer)
"Return t if there is a living process associated w/buffer BUFFER.
Living means the status is `open', `run', or `stop'.
@ -798,9 +786,10 @@ buffer. The hook `comint-exec-hook' is run after each exec."
(set-process-coding-system proc decoding encoding))
proc))
(defun comint-insert-input ()
(defun comint-insert-input (&optional event)
"In a Comint buffer, set the current input to the previous input at point."
(interactive)
(interactive (list last-input-event))
(if event (mouse-set-point event))
(let ((pos (point)))
(if (not (eq (get-char-property pos 'field) 'input))
;; No input at POS, fall back to the global definition.
@ -818,13 +807,7 @@ buffer. The hook `comint-exec-hook' is run after each exec."
;; Insert the input at point
(insert (buffer-substring-no-properties
(previous-single-char-property-change (1+ pos) 'field)
(next-single-char-property-change pos 'field))))))
(defun comint-mouse-insert-input (event)
"In a Comint buffer, set the current input to the previous input you click on."
(interactive "e")
(mouse-set-point event)
(comint-insert-input))
(next-single-char-property-change pos 'field))))))
;; Input history processing in a buffer
@ -1734,7 +1717,7 @@ Make backspaces delete the previous character."
(1- prompt-start) prompt-start 'read-only 'fence))
(add-text-properties
prompt-start (point)
'(read-only t rear-non-sticky t front-sticky (read-only))))
'(read-only t rear-nonsticky t front-sticky (read-only))))
(unless (and (bolp) (null comint-last-prompt-overlay))
;; Need to create or move the prompt overlay (in the case
;; where there is no prompt ((bolp) == t), we still do
@ -2136,8 +2119,8 @@ This command also kills the pending input
between the process mark and point.
WARNING: if there is no current subjob, you can end up suspending
the top-level process running in the buffer. If you accidentally do
this, use \\[comint-continue-subjob] to resume the process. (This
the top-level process running in the buffer. If you accidentally do
this, use \\[comint-continue-subjob] to resume the process. (This
is not a problem with most shells, since they ignore this signal.)"
(interactive)
(comint-skip-input)
@ -2357,9 +2340,9 @@ preceding newline is removed."
(defun comint-kill-whole-line (&optional arg)
"Kill current line, ignoring read-only and field properties.
With prefix arg, kill that many lines starting from the current line.
With prefix ARG, kill that many lines starting from the current line.
If arg is negative, kill backward. Also kill the preceding newline,
instead of the trailing one. \(This is meant to make C-x z work well
instead of the trailing one. \(This is meant to make \\[repeat] work well
with negative arguments.)
If arg is zero, kill current line but exclude the trailing newline.
The read-only status of newlines is updated with `comint-update-fence',
@ -2505,7 +2488,7 @@ Provides a default, if there is one, and returns the result filename.
See `comint-source-default' for more on determining defaults.
PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
from the last source processing command. SOURCE-MODES is a list of major
modes used to determine what file buffers contain source files. (These
two arguments are used for determining defaults). If MUSTMATCH-P is true,
@ -3503,5 +3486,5 @@ REGEXP-GROUP is the regular expression group in REGEXP to use."
(provide 'comint)
;;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164
;; arch-tag: 1793314c-09db-40be-9549-9aeae3e75164
;;; comint.el ends here

49
lisp/diff-mode.el
View file

@ -1,6 +1,7 @@
;;; diff-mode.el --- a mode for viewing/editing context diffs
;; Copyright (C) 1998,1999,2000,01,02,03,2004 Free Software Foundation, Inc.
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: convenience patch diff
@ -171,75 +172,73 @@ when editing big diffs)."
(defface diff-header-face
'((((class color) (min-colors 88) (background light))
(:background "grey85"))
:background "grey85")
(((class color) (min-colors 88) (background dark))
(:background "grey45"))
:background "grey45")
(((class color) (background light))
(:foreground "blue1" :weight bold))
:foreground "blue1" :weight bold)
(((class color) (background dark))
(:foreground "green" :weight bold))
(t (:weight bold)))
:foreground "green" :weight bold)
(t :weight bold))
"`diff-mode' face inherited by hunk and index header faces.")
(defvar diff-header-face 'diff-header-face)
(defface diff-file-header-face
'((((class color) (min-colors 88) (background light))
(:background "grey70" :weight bold))
:background "grey70" :weight bold)
(((class color) (min-colors 88) (background dark))
(:background "grey60" :weight bold))
:background "grey60" :weight bold)
(((class color) (background light))
(:foreground "yellow" :weight bold))
:foreground "yellow" :weight bold)
(((class color) (background dark))
(:foreground "cyan" :weight bold))
(t (:weight bold))) ; :height 1.3
:foreground "cyan" :weight bold)
(t :weight bold)) ; :height 1.3
"`diff-mode' face used to highlight file header lines.")
(defvar diff-file-header-face 'diff-file-header-face)
(defface diff-index-face
'((t (:inherit diff-file-header-face)))
'((t :inherit diff-file-header-face))
"`diff-mode' face used to highlight index header lines.")
(defvar diff-index-face 'diff-index-face)
(defface diff-hunk-header-face
'((t (:inherit diff-header-face)))
'((t :inherit diff-header-face))
"`diff-mode' face used to highlight hunk header lines.")
(defvar diff-hunk-header-face 'diff-hunk-header-face)
(defface diff-removed-face
'((t (:inherit diff-changed-face)))
'((t :inherit diff-changed-face))
"`diff-mode' face used to highlight removed lines.")
(defvar diff-removed-face 'diff-removed-face)
(defface diff-added-face
'((t (:inherit diff-changed-face)))
'((t :inherit diff-changed-face))
"`diff-mode' face used to highlight added lines.")
(defvar diff-added-face 'diff-added-face)
(defface diff-changed-face
'((((type tty pc) (class color) (background light))
(:foreground "magenta" :weight bold :slant italic))
:foreground "magenta" :weight bold :slant italic)
(((type tty pc) (class color) (background dark))
(:foreground "yellow" :weight bold :slant italic))
(t ()))
:foreground "yellow" :weight bold :slant italic))
"`diff-mode' face used to highlight changed lines.")
(defvar diff-changed-face 'diff-changed-face)
(defface diff-function-face
'((t (:inherit diff-context-face)))
'((t :inherit diff-context-face))
"`diff-mode' face used to highlight function names produced by \"diff -p\".")
(defvar diff-function-face 'diff-function-face)
(defface diff-context-face
'((((class color) (background light))
(:foreground "grey50"))
:foreground "grey50")
(((class color) (background dark))
(:foreground "grey70"))
(t ))
:foreground "grey70"))
"`diff-mode' face used to highlight context and other side-information.")
(defvar diff-context-face 'diff-context-face)
(defface diff-nonexistent-face
'((t (:inherit diff-file-header-face)))
'((t :inherit diff-file-header-face))
"`diff-mode' face used to highlight nonexistent files in recursive diffs.")
(defvar diff-nonexistent-face 'diff-nonexistent-face)
@ -1255,7 +1254,7 @@ For use in `add-log-current-defun-function'."
(save-excursion
(when (looking-at diff-hunk-header-re)
(forward-line 1)
(while (and (looking-at " ") (not (zerop (forward-line 1))))))
(re-search-forward "^[^ ]" nil t))
(destructuring-bind (buf line-offset pos src dst &optional switched)
(diff-find-source-location)
(beginning-of-line)
@ -1355,5 +1354,5 @@ For use in `add-log-current-defun-function'."
;; use `combine-after-change-calls' to minimize the slowdown of font-lock.
;;
;;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66
;; arch-tag: 2571d7ff-bc28-4cf9-8585-42e21890be66
;;; diff-mode.el ends here

2
lisp/emacs-lisp/byte-opt.el
View file

@ -1152,7 +1152,7 @@ of FORM by signalling the error at compile-time."
(numberp (nth 1 form)))
(list 'forward-word (eval (- (nth 1 form)))))
((= 1 (safe-length form))
'(forward-char -1))
'(forward-word -1))
(t form)))
(put 'char-before 'byte-optimizer 'byte-optimize-char-before)

10
lisp/emacs-lisp/lisp-mode.el
View file

@ -1,6 +1,7 @@
;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
;; Copyright (C) 1985,86,1999,2000,01,03,2004 Free Software Foundation, Inc.
;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2003, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: lisp, languages
@ -1153,7 +1154,8 @@ paragraph of it that point is in, preserving the comment's indentation
and initial semicolons."
(interactive "P")
(or (fill-comment-paragraph justify)
;; Point is on a program line (a line no comment); we are interested
;; Since fill-comment-paragraph returned nil, that means we're not in
;; a comment: Point is on a program line; we are interested
;; particularly in docstring lines.
;;
;; We bind `paragraph-start' and `paragraph-separate' temporarily. They
@ -1182,7 +1184,7 @@ and initial semicolons."
;; The `fill-column' is temporarily bound to
;; `emacs-lisp-docstring-fill-column' if that value is an integer.
(let ((paragraph-start (concat paragraph-start
"\\|\\s-*\\([\(;:\"]\\|`\(\\)"))
"\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
(paragraph-separate
(concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
(fill-column (if (integerp emacs-lisp-docstring-fill-column)
@ -1227,5 +1229,5 @@ means don't indent that line."
(provide 'lisp-mode)
;;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
;;; lisp-mode.el ends here

8
lisp/emacs-lisp/lisp.el
View file

@ -75,17 +75,19 @@ The place mark goes is the same place \\[forward-sexp] would
move to with the same argument.
If this command is repeated, it marks the next ARG sexps after the ones
already marked."
(interactive "p")
(interactive "P")
(cond ((and (eq last-command this-command) (mark t))
(setq arg (if arg (prefix-numeric-value arg)
(if (> (mark) (point)) 1 -1)))
(set-mark
(save-excursion
(goto-char (mark))
(forward-sexp (or arg 1))
(forward-sexp arg)
(point))))
(t
(push-mark
(save-excursion
(forward-sexp (or arg 1))
(forward-sexp (prefix-numeric-value arg))
(point))
nil t))))

6
lisp/font-lock.el
View file

@ -1324,6 +1324,12 @@ HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
(add-text-properties start end (cddr val))
(setq val (cadr val)))
(cond
((not (or val (eq override t)))
;; If `val' is nil, don't do anything. It is important to do it
;; explicitly, because when adding nil via things like
;; font-lock-append-text-property, the property is actually
;; changed from <face> to (<face>) which is undesirable. --Stef
nil)
((not override)
;; Cannot override existing fontification.
(or (text-property-not-all start end 'face nil)

52
lisp/gnus/ChangeLog
View file

@ -1,3 +1,55 @@
2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org>
* message.el (message-tokenize-header): Fix 2004-09-06 change
which used point-min in the wrong place.
2004-10-12 Simon Josefsson <jas@extundo.com>
* net/tls.el (tls-certtool-program): New variable.
(tls-certificate-information): New function, based on
ssl-certificate-information.
2004-10-10 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-sum.el: Mention that multibyte characters don't work as marks.
* gnus.el (message-y-or-n-p): Autoload.
* pop3.el (pop3-maildrop, pop3-mailhost, pop3-port)
(pop3-password-required, pop3-authentication-scheme)
(pop3-leave-mail-on-server): Made customizable.
(pop3): New custom group.
(pop3-retr): Remove `sleep-for' statements.
Suggested by Dave Love <fx@gnu.org>.
* nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for
Windows/DOS.
* imap.el (imap-parse-flag-list, imap-parse-body-extension)
(imap-parse-body): Fix incorrect use of `assert'. Suggested by
Dave Love <fx@gnu.org>.
* mml.el (mml-minibuffer-read-disposition): Require match.
Suggested by Dave Love <fx@gnu.org>.
2004-10-06 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-group.el (gnus-update-group-mark-positions):
* gnus-sum.el (gnus-update-summary-mark-positions):
* message.el (message-check-news-body-syntax):
* gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead
of string-as-multibyte.
* gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq.
2004-10-05 Juri Linkov <juri@jurta.org>
* gnus-group.el (gnus-update-group-mark-positions):
* gnus-sum.el (gnus-update-summary-mark-positions):
* message.el (message-check-news-body-syntax):
* gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert
8-bit unibyte values to a multibyte string for search functions.
2004-10-01 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-sum.el (gnus-summary-toggle-header): Make it work even if

3
lisp/gnus/gnus-group.el
View file

@ -1046,7 +1046,8 @@ The following commands are available:
(gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
(goto-char (point-min))
(setq gnus-group-mark-positions
(list (cons 'process (and (search-forward "\200" nil t)
(list (cons 'process (and (search-forward
(mm-string-as-multibyte "\200") nil t)
(- (point) 2))))))))
(defun gnus-mouse-pick-group (e)

3
lisp/gnus/gnus-msg.el
View file

@ -1534,7 +1534,8 @@ The source file has to be in the Emacs load path."
;; Remove any control chars - they seem to cause trouble for some
;; mailers. (Byte-compiled output from the stuff above.)
(goto-char point)
(while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
(while (re-search-forward (mm-string-as-multibyte
"[\000-\010\013-\037\200-\237]") nil t)
(replace-match (format "\\%03o" (string-to-char (match-string 0)))
t t))))

24
lisp/gnus/gnus-sum.el
View file

@ -428,6 +428,9 @@ this variable specifies group names."
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
;; FIXME: Although the custom type is `character' for the following variables,
;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
@ -3231,20 +3234,24 @@ buffer that was in action when the last article was fetched."
[0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil]
0 nil t 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) (point-min) 1)))))
(setq pos (list (cons 'unread
(and (search-forward
(mm-string-as-multibyte "\200") nil t)
(- (point) (point-min) 1)))))
(goto-char (point-min))
(push (cons 'replied (and (search-forward "\201" nil t)
(push (cons 'replied (and (search-forward
(mm-string-as-multibyte "\201") nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'score (and (search-forward "\202" nil t)
(push (cons 'score (and (search-forward
(mm-string-as-multibyte "\202") nil t)
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'download
(and (search-forward "\203" nil t)
(- (point) (point-min) 1)))
(push (cons 'download (and (search-forward
(mm-string-as-multibyte "\203") nil t)
(- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
@ -6009,8 +6016,7 @@ the subject line on."
;; Remove list identifiers from subject.
(when gnus-list-identifiers
(let ((gnus-newsgroup-headers (list header)))
(gnus-summary-remove-list-identifiers)
(setq header (car gnus-newsgroup-headers))))
(gnus-summary-remove-list-identifiers)))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse

1
lisp/gnus/gnus.el
View file

@ -34,6 +34,7 @@
(require 'wid-edit)
(require 'mm-util)
(require 'nnheader)
(autoload 'message-y-or-n-p "message" nil nil 'macro)
(defgroup gnus nil
"The coffee-brewing, all singing, all dancing, kitchen sink newsreader."

10
lisp/gnus/imap.el
View file

@ -2421,7 +2421,7 @@ Return nil if no complete line has arrived."
(defun imap-parse-flag-list ()
(let (flag-list start)
(assert (eq (char-after) ?\() t "In imap-parse-flag-list")
(assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
(while (and (not (eq (char-after) ?\)))
(setq start (progn
(imap-forward)
@ -2430,7 +2430,7 @@ Return nil if no complete line has arrived."
(point)))
(> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
(push (buffer-substring start (point)) flag-list))
(assert (eq (char-after) ?\)) t "In imap-parse-flag-list")
(assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
(imap-forward)
(nreverse flag-list)))
@ -2515,7 +2515,7 @@ Return nil if no complete line has arrived."
(while (eq (char-after) ?\ )
(imap-forward)
(push (imap-parse-body-extension) b-e))
(assert (eq (char-after) ?\)) t "In imap-parse-body-extension")
(assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
(imap-forward)
(nreverse b-e))
(or (imap-parse-number)
@ -2641,7 +2641,7 @@ Return nil if no complete line has arrived."
(push (and (imap-parse-nil) nil) body))
(setq body
(append (imap-parse-body-ext) body))) ;; body-ext-...
(assert (eq (char-after) ?\)) t "In imap-parse-body")
(assert (eq (char-after) ?\)) nil "In imap-parse-body")
(imap-forward)
(nreverse body))
@ -2701,7 +2701,7 @@ Return nil if no complete line has arrived."
(push (imap-parse-nstring) body) ;; body-fld-md5
(setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
(assert (eq (char-after) ?\)) t "In imap-parse-body 2")
(assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
(imap-forward)
(nreverse body)))))

8
lisp/gnus/message.el
View file

@ -1615,11 +1615,11 @@ is used by default."
(if (not header)
nil
(let ((regexp (format "[%s]+" (or separator ",")))
(beg (point-min))
(first t)
quoted elems paren)
beg quoted elems paren)
(with-temp-buffer
(mm-enable-multibyte)
(setq beg (point-min))
(insert header)
(goto-char (point-min))
(while (not (eobp))
@ -4399,7 +4399,9 @@ Otherwise, generate and save a value for `canlock-password' first."
nil))))
;; Check for control characters.
(message-check 'control-chars
(if (re-search-forward "[\000-\007\013\015-\032\034-\037\200-\237]" nil t)
(if (re-search-forward
(mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
nil t)
(y-or-n-p
"The article contains control characters. Really post? ")
t))

3
lisp/gnus/mml.el
View file

@ -945,8 +945,7 @@ See Info node `(emacs-mime)Composing'.
"attachment")))
(disposition (completing-read "Disposition: "
'(("attachment") ("inline") (""))
nil
nil)))
nil t)))
(if (not (equal disposition ""))
disposition
default)))

10
lisp/gnus/nnheader.el
View file

@ -74,7 +74,15 @@ Integer values will in effect be rounded up to the nearest multiple of
(defvar nnheader-read-timeout
(if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
(symbol-name system-type))
1.0 ; why?
;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
;;
;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
;;
;; There should probably be a runtime test to determine the timing
;; resolution, or a primitive to report it. I don't know off-hand
;; what's possible. Perhaps better, maybe the Windows/DOS primitive
;; could round up non-zero timeouts to a minimum of 1.0?
1.0
0.1)
"How long nntp should wait between checking for the end of output.
Shorter values mean quicker response, but are more CPU intensive.")

104
lisp/gnus/pop3.el
View file

@ -37,25 +37,56 @@
(require 'mail-utils)
(defvar pop3-maildrop (or (user-login-name) (getenv "LOGNAME") (getenv "USER") nil)
"*POP3 maildrop.")
(defvar pop3-mailhost (or (getenv "MAILHOST") nil)
"*POP3 mailhost.")
(defvar pop3-port 110
"*POP3 port.")
(defgroup pop3 nil
"Post Office Protocol"
:group 'mail
:group 'mail-source)
(defvar pop3-password-required t
"*Non-nil if a password is required when connecting to POP server.")
(defcustom pop3-maildrop (or (user-login-name)
(getenv "LOGNAME")
(getenv "USER"))
"*POP3 maildrop."
:version "21.4" ;; Oort Gnus
:type 'string
:group 'pop3)
(defcustom pop3-mailhost (or (getenv "MAILHOST") ;; nil -> mismatch
"pop3")
"*POP3 mailhost."
:version "21.4" ;; Oort Gnus
:type 'string
:group 'pop3)
(defcustom pop3-port 110
"*POP3 port."
:version "21.4" ;; Oort Gnus
:type 'number
:group 'pop3)
(defcustom pop3-password-required t
"*Non-nil if a password is required when connecting to POP server."
:version "21.4" ;; Oort Gnus
:type 'boolean
:group 'pop3)
;; Should this be customizable?
(defvar pop3-password nil
"*Password to use when connecting to POP server.")
(defvar pop3-authentication-scheme 'pass
(defcustom pop3-authentication-scheme 'pass
"*POP3 authentication scheme.
Defaults to 'pass, for the standard USER/PASS authentication. Other valid
values are 'apop.")
values are 'apop."
:version "21.4" ;; Oort Gnus
:type '(choice (const :tag "USER/PASS" pass)
(const :tag "APOP" apop))
:group 'pop3)
(defvar pop3-leave-mail-on-server nil
"*Non-nil if the mail is to be left on the POP server after fetching.")
(defcustom pop3-leave-mail-on-server nil
"*Non-nil if the mail is to be left on the POP server after fetching."
:version "21.4" ;; Oort Gnus
:type 'boolean
:group 'pop3)
(defvar pop3-timestamp nil
"Timestamp returned when initially connected to the POP server.
@ -71,8 +102,7 @@ Used for APOP authentication.")
(crashbuf (get-buffer-create " *pop3-retr*"))
(n 1)
message-count
(pop3-password pop3-password)
)
(pop3-password pop3-password))
;; for debugging only
(if pop3-debug (switch-to-buffer (process-buffer process)))
;; query for password
@ -114,8 +144,7 @@ Used for APOP authentication.")
"Return the number of messages in the maildrop."
(let* ((process (pop3-open-server pop3-mailhost pop3-port))
message-count
(pop3-password pop3-password)
)
(pop3-password pop3-password))
;; for debugging only
(if pop3-debug (switch-to-buffer (process-buffer process)))
;; query for password
@ -159,15 +188,14 @@ Returns the process associated with the connection."
(insert output)))
(defun pop3-send-command (process command)
(set-buffer (process-buffer process))
(goto-char (point-max))
;; (if (= (aref command 0) ?P)
;; (insert "PASS <omitted>\r\n")
;; (insert command "\r\n"))
(setq pop3-read-point (point))
(goto-char (point-max))
(process-send-string process (concat command "\r\n"))
)
(set-buffer (process-buffer process))
(goto-char (point-max))
;; (if (= (aref command 0) ?P)
;; (insert "PASS <omitted>\r\n")
;; (insert command "\r\n"))
(setq pop3-read-point (point))
(goto-char (point-max))
(process-send-string process (concat command "\r\n")))
(defun pop3-read-response (process &optional return)
"Read the response from the server.
@ -355,27 +383,15 @@ This function currently does nothing.")
(while (not (re-search-forward "^\\.\r\n" nil t))
;; Fixme: Shouldn't depend on nnheader.
(nnheader-accept-process-output process)
;; bill@att.com ... to save wear and tear on the heap
;; uncommented because the condensed version below is a problem for
;; some.
(if (> (buffer-size) 20000) (sleep-for 1))
(if (> (buffer-size) 50000) (sleep-for 1))
(if (> (buffer-size) 100000) (sleep-for 1))
(if (> (buffer-size) 200000) (sleep-for 1))
(if (> (buffer-size) 500000) (sleep-for 1))
;; bill@att.com
;; condensed into:
;; (sometimes causes problems for really large messages.)
; (if (> (buffer-size) 20000) (sleep-for (/ (buffer-size) 20000)))
(goto-char start))
(setq pop3-read-point (point-marker))
;; this code does not seem to work for some POP servers...
;; and I cannot figure out why not.
; (goto-char (match-beginning 0))
; (backward-char 2)
; (if (not (looking-at "\r\n"))
; (insert "\r\n"))
; (re-search-forward "\\.\r\n")
;; this code does not seem to work for some POP servers...
;; and I cannot figure out why not.
;; (goto-char (match-beginning 0))
;; (backward-char 2)
;; (if (not (looking-at "\r\n"))
;; (insert "\r\n"))
;; (re-search-forward "\\.\r\n")
(goto-char (match-beginning 0))
(setq end (point-marker))
(pop3-clean-region start end)

10
lisp/help-fns.el
View file

@ -552,9 +552,15 @@ it is displayed along with the global value."
(forward-line 1)
(forward-sexp 1)
(delete-region (point) (progn (end-of-line) (point)))
(insert " value is shown below.\n\n")
(save-excursion
(insert "\n\nValue:"))))
(insert "\n\nValue:")
(set (make-local-variable 'help-button-cache)
(point-marker)))
(insert " value is shown ")
(insert-button "below"
'action help-button-cache
'help-echo "mouse-2, RET: show value")
(insert ".\n\n")))
;; Add a note for variables that have been make-var-buffer-local.
(when (and (local-variable-if-set-p variable)
(or (not (local-variable-p variable))

57
lisp/help.el
View file

@ -111,6 +111,9 @@
(define-key help-map "q" 'help-quit)
;; insert-button makes the action nil if it is not store somewhere
(defvar help-button-cache nil)
(defun help-quit ()
"Just exit from the Help command's command loop."
@ -655,32 +658,42 @@ whose documentation describes the minor mode."
(lambda (a b) (string-lessp (car a) (car b)))))
(when minor-modes
(princ "Summary of minor modes:\n")
(dolist (mode minor-modes)
(let ((pretty-minor-mode (nth 0 mode))
(indicator (nth 2 mode)))
(princ (format " %s minor mode (%s):\n"
pretty-minor-mode
(if indicator
(format "indicator%s" indicator)
"no indicator")))))
(make-local-variable 'help-button-cache)
(with-current-buffer standard-output
(dolist (mode minor-modes)
(let ((pretty-minor-mode (nth 0 mode))
(mode-function (nth 1 mode))
(indicator (nth 2 mode)))
(add-text-properties 0 (length pretty-minor-mode)
'(face bold) pretty-minor-mode)
(save-excursion
(goto-char (point-max))
(princ "\n\f\n")
(push (point-marker) help-button-cache)
;; Document the minor modes fully.
(insert pretty-minor-mode)
(princ (format " minor mode (%s):\n"
(if indicator
(format "indicator%s" indicator)
"no indicator")))
(princ (documentation mode-function)))
(princ " ")
(insert-button pretty-minor-mode
'action (car help-button-cache)
'help-echo "mouse-2, RET: show full information")
(princ (format " minor mode (%s):\n"
(if indicator
(format "indicator%s" indicator)
"no indicator"))))))
(princ "\n(Full information about these minor modes
follows the description of the major mode.)\n\n"))
;; Document the major mode.
(princ mode-name)
(let ((mode mode-name))
(with-current-buffer standard-output
(insert mode)
(add-text-properties (- (point) (length mode)) (point) '(face bold))))
(princ " mode:\n")
(princ (documentation major-mode))
;; Document the minor modes fully.
(dolist (mode minor-modes)
(let ((pretty-minor-mode (nth 0 mode))
(mode-function (nth 1 mode))
(indicator (nth 2 mode)))
(princ "\n\f\n")
(princ (format "%s minor mode (%s):\n"
pretty-minor-mode
(if indicator
(format "indicator%s" indicator)
"no indicator")))
(princ (documentation mode-function)))))
(princ (documentation major-mode)))
(print-help-return-message))))

39
lisp/imenu.el
View file

@ -317,9 +317,12 @@ The function in this variable is called when selecting a normal index-item.")
;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Return the current/previous sexp and the location of the sexp (its
;; beginning) without moving the point.
;; FIXME: This is the only imenu-example-* definition that's actually used,
;; and it seems to only be used by cperl-mode.el. We should just move it to
;; cperl-mode.el and remove the rest.
(defun imenu-example--name-and-position ()
"Return the current/previous sexp and its (beginning) location.
Don't move point."
(save-excursion
(forward-sexp -1)
;; [ydi] modified for imenu-use-markers
@ -549,12 +552,10 @@ A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).")
(cond
((consp (cdr item))
(imenu--truncate-items (cdr item)))
(t
;; truncate if necessary
(if (and (numberp imenu-max-item-length)
(> (length (car item)) imenu-max-item-length))
(setcar item (substring (car item) 0
imenu-max-item-length)))))))
;; truncate if necessary
((and (numberp imenu-max-item-length)
(> (length (car item)) imenu-max-item-length))
(setcar item (substring (car item) 0 imenu-max-item-length))))))
menulist))
@ -854,7 +855,7 @@ depending on PATTERNS."
(defun imenu--completion-buffer (index-alist &optional prompt)
"Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
Returns t for rescan and otherwise a position number."
Return one of the entries in index-alist or nil."
;; Create a list for this buffer only when needed.
(let ((name (thing-at-point 'symbol))
choice
@ -880,13 +881,11 @@ Returns t for rescan and otherwise a position number."
prepared-index-alist
nil t nil 'imenu--history-list name)))
(cond ((not (stringp name)) nil)
((string= name (car imenu--rescan-item)) t)
(t
(setq choice (assoc name prepared-index-alist))
(if (imenu--subalist-p choice)
(imenu--completion-buffer (cdr choice) prompt)
choice)))))
(when (stringp name)
(setq choice (assoc name prepared-index-alist))
(if (imenu--subalist-p choice)
(imenu--completion-buffer (cdr choice) prompt)
choice))))
(defun imenu--mouse-menu (index-alist event &optional title)
"Let the user select from a buffer index from a mouse menu.
@ -937,9 +936,9 @@ The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
(or (eq imenu-use-popup-menu t) mouse-triggered))
(imenu--mouse-menu index-alist last-nonmenu-event)
(imenu--completion-buffer index-alist prompt)))
(and (eq result t)
(and (equal result imenu--rescan-item)
(imenu--cleanup)
(setq imenu--index-alist nil)))
(setq result t imenu--index-alist nil)))
result))
;;;###autoload
@ -1014,7 +1013,7 @@ A trivial interface to `imenu-add-to-menubar' suitable for use in a hook."
nil))
(defun imenu-default-goto-function (name position &optional rest)
"Move the point to the given position.
"Move to the given position.
NAME is ignored. POSITION is where to move. REST is also ignored.
The ignored args just make this function have the same interface as a
@ -1054,5 +1053,5 @@ for more information."
(provide 'imenu)
;;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7
;; arch-tag: 98a2f5f5-4b91-4704-b18c-3aacf77d77a7
;;; imenu.el ends here

2
lisp/info-look.el
View file

@ -245,6 +245,7 @@ system."
(interactive)
(setq info-lookup-cache nil))
;;;###autoload (put 'info-lookup-symbol 'info-file "emacs")
;;;###autoload
(defun info-lookup-symbol (symbol &optional mode)
"Display the definition of SYMBOL, as found in the relevant manual.
@ -258,6 +259,7 @@ With prefix arg a query for the symbol help mode is offered."
(info-lookup-interactive-arguments 'symbol current-prefix-arg))
(info-lookup 'symbol symbol mode))
;;;###autoload (put 'info-lookup-file 'info-file "emacs")
;;;###autoload
(defun info-lookup-file (file &optional mode)
"Display the documentation of a file.

35
lisp/info.el
View file

@ -79,8 +79,8 @@ The Lisp code is executed when the node is selected.")
:group 'info)
(defface info-xref
'((((class color) (background light)) :foreground "blue")
(((class color) (background dark)) :foreground "cyan")
'((((class color) (background light)) :foreground "blue" :underline t)
(((class color) (background dark)) :foreground "cyan" :underline t)
(t :underline t))
"Face for Info cross-references."
:group 'info)
@ -455,6 +455,7 @@ Do the right thing if the file has been compressed or zipped."
;;;###autoload (add-hook 'same-window-regexps "\\*info\\*\\(\\|<[0-9]+>\\)")
;;;###autoload (put 'info 'info-file "emacs")
;;;###autoload
(defun info (&optional file buffer)
"Enter Info, the documentation browser.
@ -1729,7 +1730,7 @@ If SAME-FILE is non-nil, do not move to a different Info file."
(let ((inhibit-read-only t))
(erase-buffer)
(goto-char (point-min))
(insert "\n\^_\nFile: history Node: Top, Up: (dir)\n\n")
(insert "\n\^_\nFile: history, Node: Top, Up: (dir)\n\n")
(insert "Recently Visited Nodes\n**********************\n\n")
(insert "* Menu:\n\n")
(let ((hl (delete '("history" "Top") Info-history-list)))
@ -1749,26 +1750,31 @@ If SAME-FILE is non-nil, do not move to a different Info file."
"Go to a node with table of contents of the current Info file.
Table of contents is created from the tree structure of menus."
(interactive)
(let ((curr-file Info-current-file)
(curr-node Info-current-node)
(let ((curr-file (substring-no-properties Info-current-file))
(curr-node (substring-no-properties Info-current-node))
p)
(with-current-buffer (get-buffer-create " *info-toc*")
(let ((inhibit-read-only t)
(node-list (Info-build-toc curr-file)))
(erase-buffer)
(goto-char (point-min))
(insert "\n\^_\nFile: toc Node: Top, Up: (dir)\n\n")
(insert "\n\^_\nFile: toc, Node: Top, Up: (dir)\n\n")
(insert "Table of Contents\n*****************\n\n")
(insert "*Note Top::\n")
(insert "*Note Top: (" curr-file ")Top.\n")
(Info-insert-toc
(nth 2 (assoc "Top" node-list)) ; get Top nodes
node-list 0 (substring-no-properties curr-file)))
node-list 0 curr-file))
(if (not (bobp))
(let ((Info-hide-note-references 'hide)
(Info-fontify-visited-nodes nil))
(Info-mode)
(setq Info-current-file "toc" Info-current-node "Top")
(Info-fontify-node)))
(goto-char (point-min))
(narrow-to-region (or (re-search-forward "\n[\^_\f]\n" nil t)
(point-min))
(point-max))
(Info-fontify-node)
(widen)))
(goto-char (point-min))
(if (setq p (search-forward (concat "*Note " curr-node ":") nil t))
(setq p (- p (length curr-node) 2))))
@ -1789,14 +1795,12 @@ Table of contents is created from the tree structure of menus."
(defun Info-build-toc (file)
"Build table of contents from menus of Info FILE and its subfiles."
(if (equal file "dir")
(error "Table of contents for Info directory is not supported yet"))
(with-temp-buffer
(let* ((default-directory (or (and (stringp file)
(file-name-directory
(setq file (Info-find-file file))))
(let* ((file (and (stringp file) (Info-find-file file)))
(default-directory (or (and (stringp file)
(file-name-directory file))
default-directory))
(main-file file)
(main-file (and (stringp file) file))
(sections '(("Top" "Top")))
nodes subfiles)
(while (or main-file subfiles)
@ -3258,6 +3262,7 @@ The locations are of the format used in `Info-history', i.e.
(car elt)
elt))
(file (if (consp elt) (cdr elt) elt))
(case-fold-search nil)
(regexp (concat "\\`" (regexp-quote name)
"\\(\\'\\|-\\)")))
(if (string-match regexp (symbol-name command))

12
lisp/international/mule.el
View file

@ -870,6 +870,18 @@ like `mime-charset' as well as the current style like `:mime-charset'."
(and (not (> (downcase c1) (downcase c2)))
(< c1 c2)))))))
(defun coding-system-equal (coding-system-1 coding-system-2)
"Return t if and only if CODING-SYSTEM-1 and CODING-SYSTEM-2 are identical.
Two coding systems are identical if two symbols are equal
or one is an alias of the other."
(or (eq coding-system-1 coding-system-2)
(and (equal (coding-system-spec coding-system-1)
(coding-system-spec coding-system-2))
(let ((eol-type-1 (coding-system-eol-type coding-system-1))
(eol-type-2 (coding-system-eol-type coding-system-2)))
(or (eq eol-type-1 eol-type-2)
(and (vectorp eol-type-1) (vectorp eol-type-2)))))))
(defun add-to-coding-system-list (coding-system)
"Add CODING-SYSTEM to `coding-system-list' while keeping it sorted."
(if (or (null coding-system-list)

25
lisp/isearch.el
View file

@ -676,16 +676,7 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(if isearch-small-window
(goto-char found-point)
;; Exiting the save-window-excursion clobbers window-start; restore it.
(set-window-start (selected-window) found-start t))
;; If there was movement, mark the starting position.
;; Maybe should test difference between and set mark iff > threshold.
(if (/= (point) isearch-opoint)
(or (and transient-mark-mode mark-active)
(progn
(push-mark isearch-opoint t)
(or executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark saved where search started"))))))
(set-window-start (selected-window) found-start t)))
(setq isearch-mode nil)
(if isearch-input-method-local-p
@ -710,6 +701,16 @@ is treated as a regexp. See \\[isearch-forward] for more info."
(isearch-update-ring isearch-string isearch-regexp))
(run-hooks 'isearch-mode-end-hook)
;; If there was movement, mark the starting position.
;; Maybe should test difference between and set mark iff > threshold.
(if (/= (point) isearch-opoint)
(or (and transient-mark-mode mark-active)
(progn
(push-mark isearch-opoint t)
(or executing-kbd-macro (> (minibuffer-depth) 0)
(message "Mark saved where search started")))))
(and (not edit) isearch-recursive-edit (exit-recursive-edit)))
(defun isearch-update-ring (string &optional regexp)
@ -1249,8 +1250,8 @@ might return the position of the end of the line."
(defun isearch-yank-line ()
"Pull rest of line from buffer into search string."
(interactive)
(isearch-yank-internal 'line-end-position))
(isearch-yank-internal
(lambda () (line-end-position (if (eolp) 2 1)))))
(defun isearch-search-and-update ()
;; Do the search and update the display.

31
lisp/kmacro.el
View file

@ -248,7 +248,9 @@ macro to be executed before appending to it."
"Insert macro counter and increment with ARG or 1 if missing.
With \\[universal-argument], insert previous kmacro-counter (but do not modify counter)."
(interactive "P")
(setq kmacro-initial-counter-value nil)
(if kmacro-initial-counter-value
(setq kmacro-counter kmacro-initial-counter-value
kmacro-initial-counter-value nil))
(if (and arg (listp arg))
(insert (format kmacro-counter-format kmacro-last-counter))
(insert (format kmacro-counter-format kmacro-counter))
@ -275,23 +277,23 @@ With \\[universal-argument], insert previous kmacro-counter (but do not modify c
"Set kmacro-counter to ARG or prompt if missing.
With \\[universal-argument] prefix, reset counter to its value prior to this iteration of the macro."
(interactive "NMacro counter value: ")
(setq kmacro-last-counter kmacro-counter
kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
kmacro-counter-value-start
arg))
;; setup initial macro counter value if we are not executing a macro.
(setq kmacro-initial-counter-value
(and (not (or defining-kbd-macro executing-kbd-macro))
kmacro-counter))
(unless executing-kbd-macro
(kmacro-display-counter)))
(if (not (or defining-kbd-macro executing-kbd-macro))
(kmacro-display-counter (setq kmacro-initial-counter-value arg))
(setq kmacro-last-counter kmacro-counter
kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
kmacro-counter-value-start
arg))
(unless executing-kbd-macro
(kmacro-display-counter))))
(defun kmacro-add-counter (arg)
"Add numeric prefix arg (prompt if missing) to macro counter.
With \\[universal-argument], restore previous counter value."
(interactive "NAdd to macro counter: ")
(setq kmacro-initial-counter-value nil)
(if kmacro-initial-counter-value
(setq kmacro-counter kmacro-initial-counter-value
kmacro-initial-counter-value nil))
(let ((last kmacro-last-counter))
(setq kmacro-last-counter kmacro-counter
kmacro-counter (if (and current-prefix-arg (listp current-prefix-arg))
@ -394,7 +396,10 @@ Optional arg EMPTY is message to print if no macros are defined."
(m (format-kbd-macro macro))
(l (length m))
(z (and nil trunc (> l x))))
(message (format "%s: %s%s" (or descr "Macro")
(message (format "%s%s: %s%s" (or descr "Macro")
(if (= kmacro-counter 0) ""
(format " [%s]"
(format kmacro-counter-format-start kmacro-counter)))
(if z (substring m 0 (1- x)) m) (if z "..." ""))))
(message (or empty "No keyboard macros defined"))))

14
lisp/mail/mail-extr.el
View file

@ -234,6 +234,13 @@ we will act as though we couldn't find a full name in the address."
:version "21.4"
:group 'mail-extr)
(defcustom mail-extr-ignore-realname-equals-mailbox-name t
"*Whether to ignore a name that is equal to the mailbox name.
If true, then when the address is like \"Single <single@address.com>\"
we will act as though we couldn't find a full name in the address."
:type 'boolean
:group 'mail-extr)
;; Matches a leading title that is not part of the name (does not
;; contribute to uniquely identifying the person).
(defcustom mail-extr-full-name-prefixes
@ -694,7 +701,7 @@ Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
"Given an RFC-822 address ADDRESS, extract full name and canonical address.
Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
If no name can be extracted, FULL-NAME will be nil. Also see
`mail-extr-ignore-single-names'.
`mail-extr-ignore-single-names' and `mail-extr-ignore-realname-equals-mailbox-name'.
If the optional argument ALL is non-nil, then ADDRESS can contain zero
or more recipients, separated by commas, and we return a list of
@ -1404,8 +1411,9 @@ consing a string.)"
(setq names-match-flag nil))
(setq i (1+ i)))
(delete-region (+ (point-min) buffer-length) (point-max))
(if names-match-flag
(narrow-to-region (point) (point)))))
(and names-match-flag
mail-extr-ignore-realname-equals-mailbox-name
(narrow-to-region (point) (point)))))
;; Nuke name if it's just one word.
(goto-char (point-min))

32
lisp/mail/smtpmail.el
View file

@ -471,26 +471,32 @@ This is relative to `smtpmail-queue-dir'.")
(if (null (and cred (condition-case ()
(progn
(require 'starttls)
(call-process starttls-program))
(call-process (if starttls-use-gnutls
starttls-gnutls-program
starttls-program)))
(error nil))))
;; The normal case.
(open-network-stream "SMTP" process-buffer host port)
(let* ((cred-key (smtpmail-cred-key cred))
(cred-cert (smtpmail-cred-cert cred))
(starttls-extra-args
(when (and (stringp cred-key) (stringp cred-cert)
(file-regular-p
(setq cred-key (expand-file-name cred-key)))
(file-regular-p
(setq cred-cert (expand-file-name cred-cert))))
(list "--key-file" cred-key "--cert-file" cred-cert)))
(append
starttls-extra-args
(when (and (stringp cred-key) (stringp cred-cert)
(file-regular-p
(setq cred-key (expand-file-name cred-key)))
(file-regular-p
(setq cred-cert (expand-file-name cred-cert))))
(list "--key-file" cred-key "--cert-file" cred-cert))))
(starttls-extra-arguments
(when (and (stringp cred-key) (stringp cred-cert)
(file-regular-p
(setq cred-key (expand-file-name cred-key)))
(file-regular-p
(setq cred-cert (expand-file-name cred-cert))))
(list "--x509keyfile" cred-key "--x509certfile" cred-cert))))
(append
starttls-extra-arguments
(when (and (stringp cred-key) (stringp cred-cert)
(file-regular-p
(setq cred-key (expand-file-name cred-key)))
(file-regular-p
(setq cred-cert (expand-file-name cred-cert))))
(list "--x509keyfile" cred-key "--x509certfile" cred-cert)))))
(starttls-open-stream "SMTP" process-buffer host port)))))
(defun smtpmail-try-auth-methods (process supported-extensions host port)

5
lisp/net/ange-ftp.el
View file

@ -4514,9 +4514,6 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
1))
(apply 'call-process program nil (not discard) nil arguments)))
(defvar ange-ftp-remote-shell "rsh"
"Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
;; Handle an attempt to run chmod on a remote file
;; by using the ftp chmod command.
(defun ange-ftp-call-chmod (args)
@ -4541,7 +4538,7 @@ NEWNAME should be the name to give the new compressed or uncompressed file.")
abbr))))
(or (car result)
(call-process
ange-ftp-remote-shell
remote-shell-program
nil t nil host dired-chmod-program mode name))))))
rest))
(setq ange-ftp-ls-cache-file nil) ;Stop confusing Dired.

31
lisp/net/tls.el
View file

@ -1,6 +1,6 @@
;;; tls.el --- TLS/SSL support via wrapper around GnuTLS
;; Copyright (C) 2003 Free Software Foundation, Inc.
;; Copyright (C) 1996-1999, 2003, 2004 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Keywords: comm, tls, gnutls, ssl
@ -76,6 +76,35 @@ The default is what GNUTLS's \"gnutls-cli\" outputs."
:type 'regexp
:group 'tls)
(defcustom tls-certtool-program (executable-find "certtool")
"Name of GnuTLS certtool.
Used by `tls-certificate-information'."
:type '(repeat string)
:group 'tls)
(defun tls-certificate-information (der)
"Parse X.509 certificate in DER format into an assoc list."
(let ((certificate (concat "-----BEGIN CERTIFICATE-----\n"
(base64-encode-string der)
"\n-----END CERTIFICATE-----\n"))
(exit-code 0))
(with-current-buffer (get-buffer-create " *certtool*")
(erase-buffer)
(insert certificate)
(setq exit-code (condition-case ()
(call-process-region (point-min) (point-max)
tls-certtool-program
t (list (current-buffer) nil) t
"--certificate-info")
(error -1)))
(if (/= exit-code 0)
nil
(let ((vals nil))
(goto-char (point-min))
(while (re-search-forward "^\\([^:]+\\): \\(.*\\)" nil t)
(push (cons (match-string 1) (match-string 2)) vals))
(nreverse vals))))))
(defun open-tls-stream (name buffer host service)
"Open a TLS connection for a service to a host.
Returns a subprocess-object to represent the connection.

9
lisp/net/tramp-smb.el
View file

@ -1087,7 +1087,7 @@ Return the difference in the format of a time value."
;; `PC-do-completion' touches the returning "$$" by `substitute-in-file-name'.
;; Must be corrected.
(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion activate)
(defadvice PC-do-completion (around tramp-smb-advice-PC-do-completion)
"Changes \"$\" back to \"$$\" in minibuffer."
(if (funcall PC-completion-as-file-name-predicate)
@ -1123,6 +1123,13 @@ Return the difference in the format of a time value."
;; No file names. Behave unchanged.
ad-do-it))
;; Activate advice. Recent Emacsen don't need that.
(when (functionp 'PC-do-completion)
(condition-case nil
(substitute-in-file-name "C$/")
(error
(ad-activate 'PC-do-completion))))
(provide 'tramp-smb)
;;; TODO:

32
lisp/net/tramp.el
View file

@ -1668,6 +1668,7 @@ while (my $data = <STDIN>) {
my $len = length($pending);
my $chunk = substr($pending, 0, $len & ~3);
$pending = substr($pending, $len & ~3 + 1);
# Easy method: translate from chars to (pregenerated) six-bit packets, join,
# split in 8-bit chunks and convert back to char.
@ -1883,7 +1884,11 @@ If VAR is nil, then we bind `v' to the structure and `multi-method',
(put 'with-parsed-tramp-file-name 'lisp-indent-function 2)
;; To be activated for debugging containing this macro
(def-edebug-spec with-parsed-tramp-file-name t)
;; It works only when VAR is nil. Otherwise, it can be deactivated by
;; (def-edebug-spec with-parsed-tramp-file-name 0)
;; I'm too stupid to write a precise SPEC for it.
(if (functionp 'def-edebug-spec)
(def-edebug-spec with-parsed-tramp-file-name t))
(defmacro tramp-let-maybe (variable value &rest body)
"Let-bind VARIABLE to VALUE in BODY, but only if VARIABLE is not obsolete.
@ -6731,6 +6736,31 @@ as default."
(tramp-make-auto-save-file-name (buffer-file-name)))
ad-do-it))
;; In Emacs < 21.4 and XEmacs < 21.5 autosaved remote files have
;; permission 666 minus umask. This is a security threat.
(defun tramp-set-auto-save-file-modes ()
"Set permissions of autosaved remote files to the original permissions."
(let ((bfn (buffer-file-name)))
(when (and (stringp bfn)
(tramp-tramp-file-p bfn)
(stringp buffer-auto-save-file-name)
(not (equal bfn buffer-auto-save-file-name))
(not (file-exists-p buffer-auto-save-file-name)))
(write-region "" nil buffer-auto-save-file-name)
(set-file-modes buffer-auto-save-file-name (file-modes bfn)))))
(unless (or (> emacs-major-version 21)
(and (featurep 'xemacs)
(= emacs-major-version 21)
(> emacs-minor-version 4))
(and (not (featurep 'xemacs))
(= emacs-major-version 21)
(or (> emacs-minor-version 3)
(and (string-match "^21\\.3\\.\\([0-9]+\\)" emacs-version)
(>= (string-to-int (match-string 1 emacs-version)) 50)))))
(add-hook 'auto-save-hook 'tramp-set-auto-save-file-modes))
(defun tramp-subst-strs-in-string (alist string)
"Replace all occurrences of the string FROM with TO in STRING.
ALIST is of the form ((FROM . TO) ...)."

2
lisp/net/trampver.el
View file

@ -30,7 +30,7 @@
;; are auto-frobbed from configure.ac, so you should edit that file and run
;; "autoconf && ./configure" to change them.
(defconst tramp-version "2.0.44"
(defconst tramp-version "2.0.45"
"This version of Tramp.")
(defconst tramp-bug-report-address "tramp-devel@mail.freesoftware.fsf.org"

9
lisp/pcvs-defs.el
View file

@ -1,7 +1,7 @@
;;; pcvs-defs.el --- variable definitions for PCL-CVS
;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000, 03, 2004
;; Free Software Foundation, Inc.
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
;; 2000, 2003, 2004 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@cs.yale.edu>
;; Keywords: pcl-cvs
@ -249,9 +249,6 @@ Output from cvs is placed here for asynchronous commands.")
:type '(choice (const :tag "Ediff" (cvs-ediff-diff . cvs-ediff-merge))
(const :tag "Emerge" (cvs-emerge-diff . cvs-emerge-merge))))
(defvar pcl-cvs-load-hook nil
"Run after loading pcl-cvs.")
(defvar cvs-mode-hook nil
"Run after `cvs-mode' was setup.")
@ -510,5 +507,5 @@ message and replace it with a message tell you to change this variable.")
;;
(provide 'pcvs-defs)
;;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e
;; arch-tag: c7c701d0-d1d4-4aa9-a302-007bb03aca5e
;;; pcvs-defs.el ends here

8
lisp/pcvs-parse.el
View file

@ -511,15 +511,19 @@ The remaining KEYS are passed directly to `cvs-create-fileinfo'."
(cvs-match "new revision: \\([0-9.]*\\); previous revision: .*$"
(subtype 'COMMITTED) (base-rev 1)))
(cvs-or (cvs-match "done$") t)
;; In cvs-1.12.9 commit messages have been changed and became
;; ambiguous. More specifically, the `path' above is not given.
;; We assume here that in future releases the corresponding info will
;; be put into `file'.
(progn
;; Try to remove the temp files used by VC.
(vc-delete-automatic-version-backups (expand-file-name path))
(vc-delete-automatic-version-backups (expand-file-name (or path file)))
;; it's important here not to rely on the default directory management
;; because `cvs commit' might begin by a series of Examining messages
;; so the processing of the actual checkin messages might begin with
;; a `current-dir' set to something different from ""
(cvs-parsed-fileinfo (cons 'UP-TO-DATE subtype)
(or path file) (if path 'trust)
(or path file) 'trust
:base-rev base-rev)))
;; useless message added before the actual addition: ignored

19
lisp/progmodes/etags.el
View file

@ -1229,10 +1229,10 @@ where they were found."
(defun etags-tags-completion-table ()
(let ((table (make-vector 511 0))
(point-max (/ (float (point-max)) 100.0))
(msg-fmt (format
"Making tags completion table for %s...%%d%%%%"
buffer-file-name)))
(progress-reporter
(make-progress-reporter
(format "Making tags completion table for %s..." buffer-file-name)
(point-min) (point-max))))
(save-excursion
(goto-char (point-min))
;; This monster regexp matches an etags tag line.
@ -1253,7 +1253,7 @@ where they were found."
(buffer-substring (match-beginning 5) (match-end 5))
;; No explicit tag name. Best guess.
(buffer-substring (match-beginning 3) (match-end 3)))
(message msg-fmt (/ (point) point-max)))
(progress-reporter-update progress-reporter (point)))
table)))
table))
@ -1433,11 +1433,12 @@ where they were found."
(tags-with-face 'highlight (princ buffer-file-name))
(princ "':\n\n"))
(goto-char (point-min))
(let ((point-max (/ (float (point-max)) 100.0)))
(let ((progress-reporter (make-progress-reporter
(format "Making tags apropos buffer for `%s'..."
string)
(point-min) (point-max))))
(while (re-search-forward string nil t)
(message "Making tags apropos buffer for `%s'...%d%%"
string
(/ (point) point-max))
(progress-reporter-update progress-reporter (point))
(beginning-of-line)
(let* ( ;; Get the local value in the tags table

1
lisp/progmodes/gdb-ui.el
View file

@ -188,6 +188,7 @@ detailed description of this mode.
(setq gdb-var-changed nil)
(setq gdb-first-prompt nil)
(setq gdb-prompting nil)
(setq gdb-input-queue nil)
(setq gdb-current-item nil)
(setq gdb-pending-triggers nil)
(setq gdb-output-sink 'user)

25
lisp/progmodes/gud.el
View file

@ -3027,6 +3027,27 @@ class of the file (using s to separate nested class ids)."
(save-excursion (indent-line-to indent))
(indent-line-to indent)))))
;; Derived from cfengine.el.
(defun gdb-script-beginning-of-defun ()
"`beginning-of-defun' function for Gdb script mode.
Treats actions as defuns."
(unless (<= (current-column) (current-indentation))
(end-of-line))
(if (re-search-backward "^define \\|^document " nil t)
(beginning-of-line)
(goto-char (point-min)))
t)
;; Derived from cfengine.el.
(defun gdb-script-end-of-defun ()
"`end-of-defun' function for Gdb script mode.
Treats actions as defuns."
(end-of-line)
(if (re-search-forward "^end" nil t)
(beginning-of-line)
(goto-char (point-max)))
t)
;;;###autoload
(add-to-list 'auto-mode-alist '("/\\.gdbinit" . gdb-script-mode))
@ -3039,6 +3060,10 @@ class of the file (using s to separate nested class ids)."
(set (make-local-variable 'imenu-generic-expression)
'((nil "^define[ \t]+\\(\\w+\\)" 1)))
(set (make-local-variable 'indent-line-function) 'gdb-script-indent-line)
(set (make-local-variable 'beginning-of-defun-function)
#'gdb-script-beginning-of-defun)
(set (make-local-variable 'end-of-defun-function)
#'gdb-script-end-of-defun)
(set (make-local-variable 'font-lock-defaults)
'(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil
(font-lock-syntactic-keywords

3
lisp/recentf.el
View file

@ -1032,7 +1032,8 @@ Click on Cancel or type \"q\" to quit.\n")
(dolist (e recentf-edit-selected-items)
(setq recentf-list (delq e recentf-list)
i (1+ i)))
(message "%S file(s) removed from the list" i))
(message "%S file(s) removed from the list" i)
(recentf-clear-data))
(message "No file selected")))
"Ok")
(widget-insert " ")

6
lisp/server.el
View file

@ -343,7 +343,11 @@ PROC is the server process. Format of STRING is \"PATH PATH PATH... \\n\"."
(with-temp-buffer
(let ((standard-output (current-buffer)))
(pp v)
(process-send-region proc (point-min) (point-max))))))
;; Suppress the error rose when the pipe to PROC is closed.
(condition-case err
(process-send-region proc (point-min) (point-max))
(file-error nil))
))))
;; ARG is a file name.
;; Collapse multiple slashes to single slashes.
(setq arg (command-line-normalize-file-name arg))

319
lisp/subr.el
View file

@ -367,15 +367,6 @@ but optional second arg NODIGITS non-nil treats them like other chars."
(define-key map (char-to-string loop) 'digit-argument)
(setq loop (1+ loop))))))
;Moved to keymap.c
;(defun copy-keymap (keymap)
; "Return a copy of KEYMAP"
; (while (not (keymapp keymap))
; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
; (if (vectorp keymap)
; (copy-sequence keymap)
; (copy-alist keymap)))
(defvar key-substitution-in-progress nil
"Used internally by substitute-key-definition.")
@ -383,7 +374,10 @@ but optional second arg NODIGITS non-nil treats them like other chars."
"Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
In other words, OLDDEF is replaced with NEWDEF where ever it appears.
Alternatively, if optional fourth argument OLDMAP is specified, we redefine
in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP."
in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
For most uses, it is simpler and safer to use command remappping like this:
\(define-key KEYMAP [remap OLDDEF] NEWDEF)"
;; Don't document PREFIX in the doc string because we don't want to
;; advertise it. It's meant for recursive calls only. Here's its
;; meaning
@ -393,126 +387,54 @@ in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP."
;; original key, with PREFIX added at the front.
(or prefix (setq prefix ""))
(let* ((scan (or oldmap keymap))
(vec1 (vector nil))
(prefix1 (vconcat prefix vec1))
(prefix1 (vconcat prefix [nil]))
(key-substitution-in-progress
(cons scan key-substitution-in-progress)))
;; Scan OLDMAP, finding each char or event-symbol that
;; has any definition, and act on it with hack-key.
(while (consp scan)
(if (consp (car scan))
(let ((char (car (car scan)))
(defn (cdr (car scan))))
;; The inside of this let duplicates exactly
;; the inside of the following let that handles array elements.
(aset vec1 0 char)
(aset prefix1 (length prefix) char)
(let (inner-def skipped)
;; Skip past menu-prompt.
(while (stringp (car-safe defn))
(setq skipped (cons (car defn) skipped))
(setq defn (cdr defn)))
;; Skip past cached key-equivalence data for menu items.
(and (consp defn) (consp (car defn))
(setq defn (cdr defn)))
(setq inner-def defn)
;; Look past a symbol that names a keymap.
(while (and (symbolp inner-def)
(fboundp inner-def))
(setq inner-def (symbol-function inner-def)))
(if (or (eq defn olddef)
;; Compare with equal if definition is a key sequence.
;; That is useful for operating on function-key-map.
(and (or (stringp defn) (vectorp defn))
(equal defn olddef)))
(define-key keymap prefix1 (nconc (nreverse skipped) newdef))
(if (and (keymapp defn)
;; Avoid recursively scanning
;; where KEYMAP does not have a submap.
(let ((elt (lookup-key keymap prefix1)))
(or (null elt)
(keymapp elt)))
;; Avoid recursively rescanning keymap being scanned.
(not (memq inner-def
key-substitution-in-progress)))
;; If this one isn't being scanned already,
;; scan it now.
(substitute-key-definition olddef newdef keymap
inner-def
prefix1)))))
(if (vectorp (car scan))
(let* ((array (car scan))
(len (length array))
(i 0))
(while (< i len)
(let ((char i) (defn (aref array i)))
;; The inside of this let duplicates exactly
;; the inside of the previous let.
(aset vec1 0 char)
(aset prefix1 (length prefix) char)
(let (inner-def skipped)
;; Skip past menu-prompt.
(while (stringp (car-safe defn))
(setq skipped (cons (car defn) skipped))
(setq defn (cdr defn)))
(and (consp defn) (consp (car defn))
(setq defn (cdr defn)))
(setq inner-def defn)
(while (and (symbolp inner-def)
(fboundp inner-def))
(setq inner-def (symbol-function inner-def)))
(if (or (eq defn olddef)
(and (or (stringp defn) (vectorp defn))
(equal defn olddef)))
(define-key keymap prefix1
(nconc (nreverse skipped) newdef))
(if (and (keymapp defn)
(let ((elt (lookup-key keymap prefix1)))
(or (null elt)
(keymapp elt)))
(not (memq inner-def
key-substitution-in-progress)))
(substitute-key-definition olddef newdef keymap
inner-def
prefix1)))))
(setq i (1+ i))))
(if (char-table-p (car scan))
(map-char-table
(function (lambda (char defn)
(let ()
;; The inside of this let duplicates exactly
;; the inside of the previous let,
;; except that it uses set-char-table-range
;; instead of define-key.
(aset vec1 0 char)
(aset prefix1 (length prefix) char)
(let (inner-def skipped)
;; Skip past menu-prompt.
(while (stringp (car-safe defn))
(setq skipped (cons (car defn) skipped))
(setq defn (cdr defn)))
(and (consp defn) (consp (car defn))
(setq defn (cdr defn)))
(setq inner-def defn)
(while (and (symbolp inner-def)
(fboundp inner-def))
(setq inner-def (symbol-function inner-def)))
(if (or (eq defn olddef)
(and (or (stringp defn) (vectorp defn))
(equal defn olddef)))
(define-key keymap prefix1
(nconc (nreverse skipped) newdef))
(if (and (keymapp defn)
(let ((elt (lookup-key keymap prefix1)))
(or (null elt)
(keymapp elt)))
(not (memq inner-def
key-substitution-in-progress)))
(substitute-key-definition olddef newdef keymap
inner-def
prefix1)))))))
(car scan)))))
(setq scan (cdr scan)))))
(map-keymap
(lambda (char defn)
(aset prefix1 (length prefix) char)
(substitute-key-definition-key defn olddef newdef prefix1 keymap))
scan)))
(defun substitute-key-definition-key (defn olddef newdef prefix keymap)
(let (inner-def skipped menu-item)
;; Find the actual command name within the binding.
(if (eq (car-safe defn) 'menu-item)
(setq menu-item defn defn (nth 2 defn))
;; Skip past menu-prompt.
(while (stringp (car-safe defn))
(push (pop defn) skipped))
;; Skip past cached key-equivalence data for menu items.
(if (consp (car-safe defn))
(setq defn (cdr defn))))
(if (or (eq defn olddef)
;; Compare with equal if definition is a key sequence.
;; That is useful for operating on function-key-map.
(and (or (stringp defn) (vectorp defn))
(equal defn olddef)))
(define-key keymap prefix
(if menu-item
(let ((copy (copy-sequence menu-item)))
(setcar (nthcdr 2 copy) newdef)
copy)
(nconc (nreverse skipped) newdef)))
;; Look past a symbol that names a keymap.
(setq inner-def
(condition-case nil (indirect-function defn) (error defn)))
;; For nested keymaps, we use `inner-def' rather than `defn' so as to
;; avoid autoloading a keymap. This is mostly done to preserve the
;; original non-autoloading behavior of pre-map-keymap times.
(if (and (keymapp inner-def)
;; Avoid recursively scanning
;; where KEYMAP does not have a submap.
(let ((elt (lookup-key keymap prefix)))
(or (null elt) (natnump elt) (keymapp elt)))
;; Avoid recursively rescanning keymap being scanned.
(not (memq inner-def key-substitution-in-progress)))
;; If this one isn't being scanned already, scan it now.
(substitute-key-definition olddef newdef keymap inner-def prefix)))))
(defun define-key-after (keymap key definition &optional after)
"Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
@ -658,19 +580,19 @@ even when EVENT actually has modifiers."
(char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
?\H-\^@ ?\s-\^@ ?\A-\^@)))))
(if (not (zerop (logand type ?\M-\^@)))
(setq list (cons 'meta list)))
(push 'meta list))
(if (or (not (zerop (logand type ?\C-\^@)))
(< char 32))
(setq list (cons 'control list)))
(push 'control list))
(if (or (not (zerop (logand type ?\S-\^@)))
(/= char (downcase char)))
(setq list (cons 'shift list)))
(push 'shift list))
(or (zerop (logand type ?\H-\^@))
(setq list (cons 'hyper list)))
(push 'hyper list))
(or (zerop (logand type ?\s-\^@))
(setq list (cons 'super list)))
(push 'super list))
(or (zerop (logand type ?\A-\^@))
(setq list (cons 'alt list)))
(push 'alt list))
list))))
(defun event-basic-type (event)
@ -688,8 +610,7 @@ in the current Emacs session, then this function may return nil."
(defsubst mouse-movement-p (object)
"Return non-nil if OBJECT is a mouse movement event."
(and (consp object)
(eq (car object) 'mouse-movement)))
(eq (car-safe object) 'mouse-movement))
(defsubst event-start (event)
"Return the starting position of EVENT.
@ -1880,8 +1801,7 @@ Use a MESSAGE of \"\" to temporarily clear the echo area."
See also `with-temp-file' and `with-output-to-string'."
(declare (indent 0) (debug t))
(let ((temp-buffer (make-symbol "temp-buffer")))
`(let ((,temp-buffer
(get-buffer-create (generate-new-buffer-name " *temp*"))))
`(let ((,temp-buffer (generate-new-buffer " *temp*")))
(unwind-protect
(with-current-buffer ,temp-buffer
,@body)
@ -2652,5 +2572,132 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
(put symbol 'abortfunc (or abortfunc 'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
;; Standardized progress reporting
;; Progress reporter has the following structure:
;;
;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
;; MIN-VALUE
;; MAX-VALUE
;; MESSAGE
;; MIN-CHANGE
;; MIN-TIME])
;;
;; This weirdeness is for optimization reasons: we want
;; `progress-reporter-update' to be as fast as possible, so
;; `(car reporter)' is better than `(aref reporter 0)'.
;;
;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple
;; digits of precision, it doesn't really matter here. On the other
;; hand, it greatly simplifies the code.
(defsubst progress-reporter-update (reporter value)
"Report progress of an operation in the echo area.
However, if the change since last echo area update is too small
or not enough time has passed, then do nothing (see
`make-progress-reporter' for details).
First parameter, REPORTER, should be the result of a call to
`make-progress-reporter'. Second, VALUE, determines the actual
progress of operation; it must be between MIN-VALUE and MAX-VALUE
as passed to `make-progress-reporter'.
This function is very inexpensive, you may not bother how often
you call it."
(when (>= value (car reporter))
(progress-reporter-do-update reporter value)))
(defun make-progress-reporter (message min-value max-value
&optional current-value
min-change min-time)
"Return progress reporter object usage with `progress-reporter-update'.
MESSAGE is shown in the echo area. When at least 1% of operation
is complete, the exact percentage will be appended to the
MESSAGE. When you call `progress-reporter-done', word \"done\"
is printed after the MESSAGE. You can change MESSAGE of an
existing progress reporter with `progress-reporter-force-update'.
MIN-VALUE and MAX-VALUE designate starting (0% complete) and
final (100% complete) states of operation. The latter should be
larger; if this is not the case, then simply negate all values.
Optional CURRENT-VALUE specifies the progress by the moment you
call this function. You should omit it or set it to nil in most
cases since it defaults to MIN-VALUE.
Optional MIN-CHANGE determines the minimal change in percents to
report (default is 1%.) Optional MIN-TIME specifies the minimal
time before echo area updates (default is 0.2 seconds.) If
`float-time' function is not present, then time is not tracked
at all. If OS is not capable of measuring fractions of seconds,
then this parameter is effectively rounded up."
(unless min-time
(setq min-time 0.2))
(let ((reporter
(cons min-value ;; Force a call to `message' now
(vector (if (and (fboundp 'float-time)
(>= min-time 0.02))
(float-time) nil)
min-value
max-value
message
(if min-change (max (min min-change 50) 1) 1)
min-time))))
(progress-reporter-update reporter (or current-value min-value))
reporter))
(defun progress-reporter-force-update (reporter value &optional new-message)
"Report progress of an operation in the echo area unconditionally.
First two parameters are the same as for
`progress-reporter-update'. Optional NEW-MESSAGE allows you to
change the displayed message."
(let ((parameters (cdr reporter)))
(when new-message
(aset parameters 3 new-message))
(when (aref parameters 0)
(aset parameters 0 (float-time)))
(progress-reporter-do-update reporter value)))
(defun progress-reporter-do-update (reporter value)
(let* ((parameters (cdr reporter))
(min-value (aref parameters 1))
(max-value (aref parameters 2))
(one-percent (/ (- max-value min-value) 100.0))
(percentage (truncate (/ (- value min-value) one-percent)))
(update-time (aref parameters 0))
(current-time (float-time))
(enough-time-passed
;; See if enough time has passed since the last update.
(or (not update-time)
(when (>= current-time update-time)
;; Calculate time for the next update
(aset parameters 0 (+ update-time (aref parameters 5)))))))
;;
;; Calculate NEXT-UPDATE-VALUE. If we are not going to print
;; message this time because not enough time has passed, then use
;; 1 instead of MIN-CHANGE. This makes delays between echo area
;; updates closer to MIN-TIME.
(setcar reporter
(min (+ min-value (* (+ percentage
(if enough-time-passed
(aref parameters 4) ;; MIN-CHANGE
1))
one-percent))
max-value))
(when (integerp value)
(setcar reporter (ceiling (car reporter))))
;;
;; Only print message if enough time has passed
(when enough-time-passed
(if (> percentage 0)
(message "%s%d%%" (aref parameters 3) percentage)
(message "%s" (aref parameters 3))))))
(defun progress-reporter-done (reporter)
"Print reporter's message followed by word \"done\" in echo area."
(message "%sdone" (aref (cdr reporter) 3)))
;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
;;; subr.el ends here

14
lisp/tar-mode.el
View file

@ -405,11 +405,12 @@ MODE should be an integer which is a file mode value."
Place a dired-like listing on the front;
then narrow to it, so that only that listing
is visible (and the real data of the buffer is hidden)."
(message "Parsing tar file...")
(set-buffer-multibyte nil)
(let* ((result '())
(pos (point-min))
(bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
(bs100 (max 1 (/ bs 100)))
(progress-reporter
(make-progress-reporter "Parsing tar file..."
(point-min) (max 1 (- (buffer-size) 1024))))
tokens)
(while (and (<= (+ pos 512) (point-max))
(not (eq 'empty-tar-block
@ -417,10 +418,7 @@ is visible (and the real data of the buffer is hidden)."
(tar-header-block-tokenize
(buffer-substring pos (+ pos 512)))))))
(setq pos (+ pos 512))
(message "Parsing tar file...%d%%"
;(/ (* pos 100) bs) ; this gets round-off lossage
(/ pos bs100) ; this doesn't
)
(progress-reporter-update progress-reporter pos)
(if (eq (tar-header-link-type tokens) 20)
;; Foo. There's an extra empty block after these.
(setq pos (+ pos 512)))
@ -447,7 +445,7 @@ is visible (and the real data of the buffer is hidden)."
;; A tar file should end with a block or two of nulls,
;; but let's not get a fatal error if it doesn't.
(if (eq tokens 'empty-tar-block)
(message "Parsing tar file...done")
(progress-reporter-done progress-reporter)
(message "Warning: premature EOF parsing tar file")))
(save-excursion
(goto-char (point-min))

4
lisp/textmodes/enriched.el
View file

@ -258,8 +258,8 @@ Commands:
(define-key enriched-mode-map "\M-j" 'facemenu-justification-menu)
(define-key enriched-mode-map "\M-S" 'set-justification-center)
(define-key enriched-mode-map "\C-x\t" 'increase-left-margin)
(define-key enriched-mode-map "\C-c\C-l" 'set-left-margin)
(define-key enriched-mode-map "\C-c\C-r" 'set-right-margin)
(define-key enriched-mode-map "\C-c[" 'set-left-margin)
(define-key enriched-mode-map "\C-c]" 'set-right-margin)
;;;
;;; Some functions dealing with text-properties, especially indentation

18
lisp/textmodes/paragraphs.el
View file

@ -1,6 +1,6 @@
;;; paragraphs.el --- paragraph and sentence parsing
;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001
;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96, 1997, 1999, 2000, 2001, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@ -122,8 +122,8 @@ This is relevant for filling. See also `sentence-end-without-period'
and `colon-double-space'.
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, in case when the value of
the variable `sentence-end' is nil. See Info node `Sentences'."
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:type 'boolean
:group 'fill)
@ -133,18 +133,18 @@ For example, a sentence in Thai text ends with double space but
without a period.
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, in case when the value of
the variable `sentence-end' is nil. See Info node `Sentences'."
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:type 'boolean
:group 'fill)
(defcustom sentence-end-without-space
"$B!#!%!)!*$A!##.#?#!$(0!$!%!)!*$(G!$!%!)!*(B"
"*String containing characters that end sentence without following spaces.
"*String of characters that end sentence without following spaces.
This value is used by the function `sentence-end' to construct the
regexp describing the end of a sentence, in case when the value of
the variable `sentence-end' is nil. See Info node `Sentences'."
regexp describing the end of a sentence, when the value of the variable
`sentence-end' is nil. See Info node `(elisp)Standard Regexps'."
:group 'paragraphs
:type 'string)
@ -169,7 +169,7 @@ and `sentence-end-without-space'. The default value specifies
that in order to be recognized as the end of a sentence, the
ending period, question mark, or exclamation point must be
followed by two spaces, unless it's inside some sort of quotes or
parenthesis. See Info node `Sentences'."
parenthesis. See Info node `(elisp)Standard Regexps'."
(or sentence-end
(concat (if sentence-end-without-period "\\w \\|")
"\\([.?!][]\"'\xd0c9\x5397d)}]*"

29
lisp/textmodes/tex-mode.el
View file

@ -500,6 +500,11 @@ An alternative value is \" . \", if you use a font with a narrow period."
1 font-lock-function-name-face))))
"Subdued expressions to highlight in TeX modes.")
(defun tex-font-lock-append-prop (prop)
(unless (memq (get-text-property (match-end 1) 'face)
'(font-lock-comment-face tex-verbatim-face))
prop))
(defconst tex-font-lock-keywords-2
(append tex-font-lock-keywords-1
(eval-when-compile
@ -553,16 +558,19 @@ An alternative value is \" . \", if you use a font with a narrow period."
;;
;; Font environments. It seems a bit dubious to use `bold' etc. faces
;; since we might not be able to display those fonts.
(list (concat slash bold " *" arg) 2 '(quote bold) 'append)
(list (concat slash italic " *" arg) 2 '(quote italic) 'append)
(list (concat slash bold " *" arg) 2
'(tex-font-lock-append-prop 'bold) 'append)
(list (concat slash italic " *" arg) 2
'(tex-font-lock-append-prop 'italic) 'append)
;; (list (concat slash type arg) 2 '(quote bold-italic) 'append)
;;
;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for tables.
(list (concat "\\\\\\(em\\|it\\|sl\\)\\>" args)
2 '(quote italic) 'append)
2 '(tex-font-lock-append-prop 'italic) 'append)
;; This is separate from the previous one because of cases like
;; {\em foo {\bf bar} bla} where both match.
(list (concat "\\\\bf\\>" args) 1 '(quote bold) 'append)))))
(list (concat "\\\\\\(bf\\)\\>" args)
2 '(tex-font-lock-append-prop 'bold) 'append)))))
"Gaudy expressions to highlight in TeX modes.")
(defun tex-font-lock-suscript (pos)
@ -604,11 +612,14 @@ An alternative value is \" . \", if you use a font with a narrow period."
(defvar tex-font-lock-syntactic-keywords
(let ((verbs (regexp-opt tex-verbatim-environments t)))
`((,(concat "^\\\\begin *{" verbs "}.*\\(\n\\)") 2 "|")
(,(concat "^\\\\end *{" verbs "}\\(.?\\)") 2
(unless (<= (match-beginning 0) (point-min))
(put-text-property (1- (match-beginning 0)) (match-beginning 0)
'syntax-table (string-to-syntax "|"))
"<"))
;; Technically, we'd like to put the "|" property on the \n preceding
;; the \end, but this would have 2 disadvantages:
;; 1 - it's wrong if the verbatim env is empty (the same \n is used to
;; start and end the fenced-string).
;; 2 - font-lock considers the preceding \n as being part of the
;; preceding line, so things gets screwed every time the previous
;; line is re-font-locked on its own.
(,(concat "^\\(\\\\\\)end *{" verbs "}\\(.?\\)") (1 "|") (3 "<"))
;; ("^\\(\\\\\\)begin *{comment}" 1 "< b")
;; ("^\\\\end *{comment}.*\\(\n\\)" 1 "> b")
("\\\\verb\\**\\([^a-z@*]\\)" 1 "\""))))

61
lisp/url/ChangeLog
View file

@ -1,3 +1,64 @@
2004-10-12 Simon Josefsson <jas@extundo.com>
* url-vars.el (url-gateway-method): Add new method `tls'.
* url-news.el (url-snews): Use nntp-open-tls-stream if
url-gateway-method is tls.
* url-ldap.el (url-ldap-certificate-formatter): Use
tls-certificate-information if ssl.el is not available.
* url-https.el (url-https-create-secure-wrapper): Use tls if ssl
is not available.
* url-gw.el (url-open-stream): Support tls url-gateway-method.
(url-open-stream): Likewise.
2004-10-10 Lars Hansen <larsh@math.ku.dk>
* url-auth.el: Fix copyright notice.
* url-cache.el: Fix copyright notice.
* url-cookie.el: Fix copyright notice.
* url-dired.el: Fix copyright notice.
* url-file.el: Fix copyright notice.
* url-ftp.el: Fix copyright notice.
* url-handlers.el: Fix copyright notice.
* url-history.el: Fix copyright notice.
* url-irc.el: Fix copyright notice.
* url-mailto.el: Fix copyright notice.
* url-methods.el: Fix copyright notice.
* url-misc.el: Fix copyright notice.
* url-news.el: Fix copyright notice.
* url-nfs.el: Fix copyright notice.
* url-parse.el: Fix copyright notice.
* url-privacy.el: Fix copyright notice.
* url-vars.el: Fix copyright notice.
* url.el: Fix copyright notice.
* url-util.el: Fix copyright notice.
2004-10-06 Stefan Monnier <monnier@iro.umontreal.ca>
* url-handlers.el (url-insert-file-contents): Use the URL to decide the
encoding, not the buffer-file-name (which might not even exist).
2004-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
* url-handlers.el (url-insert-file-contents): Decode contents.

316
lisp/url/url-auth.el Normal file
View file

@ -0,0 +1,316 @@
;;; url-auth.el --- Uniform Resource Locator authorization modules
;; Keywords: comm, data, processes, hypermedia
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'url-vars)
(require 'url-parse)
(autoload 'url-warn "url")
(defsubst url-auth-user-prompt (url realm)
"String to usefully prompt for a username."
(concat "Username [for "
(or realm (url-truncate-url-for-viewing
(url-recreate-url url)
(- (window-width) 10 20)))
"]: "))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Basic authorization code
;;; ------------------------
;;; This implements the BASIC authorization type. See the online
;;; documentation at
;;; http://www.w3.org/hypertext/WWW/AccessAuthorization/Basic.html
;;; for the complete documentation on this type.
;;;
;;; This is very insecure, but it works as a proof-of-concept
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar url-basic-auth-storage 'url-http-real-basic-auth-storage
"Where usernames and passwords are stored.
Must be a symbol pointing to another variable that will actually store
the information. The value of this variable is an assoc list of assoc
lists. The first assoc list is keyed by the server name. The cdr of
this is an assoc list based on the 'directory' specified by the url we
are looking up.")
(defun url-basic-auth (url &optional prompt overwrite realm args)
"Get the username/password for the specified URL.
If optional argument PROMPT is non-nil, ask for the username/password
to use for the url and its descendants. If optional third argument
OVERWRITE is non-nil, overwrite the old username/password pair if it
is found in the assoc list. If REALM is specified, use that as the realm
instead of the pathname inheritance method."
(let* ((href (if (stringp url)
(url-generic-parse-url url)
url))
(server (url-host href))
(port (url-port href))
(path (url-filename href))
user pass byserv retval data)
(setq server (format "%s:%d" server port)
path (cond
(realm realm)
((string-match "/$" path) path)
(t (url-basepath path)))
byserv (cdr-safe (assoc server
(symbol-value url-basic-auth-storage))))
(cond
((and prompt (not byserv))
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (funcall url-passwd-entry-func "Password: "))
(set url-basic-auth-storage
(cons (list server
(cons path
(setq retval
(base64-encode-string
(format "%s:%s" user pass)))))
(symbol-value url-basic-auth-storage))))
(byserv
(setq retval (cdr-safe (assoc path byserv)))
(if (and (not retval)
(string-match "/" path))
(while (and byserv (not retval))
(setq data (car (car byserv)))
(if (or (not (string-match "/" data)) ; Its a realm - take it!
(and
(>= (length path) (length data))
(string= data (substring path 0 (length data)))))
(setq retval (cdr (car byserv))))
(setq byserv (cdr byserv))))
(if (or (and (not retval) prompt) overwrite)
(progn
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (funcall url-passwd-entry-func "Password: ")
retval (base64-encode-string (format "%s:%s" user pass))
byserv (assoc server (symbol-value url-basic-auth-storage)))
(setcdr byserv
(cons (cons path retval) (cdr byserv))))))
(t (setq retval nil)))
(if retval (setq retval (concat "Basic " retval)))
retval))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Digest authorization code
;;; ------------------------
;;; This implements the DIGEST authorization type. See the internet draft
;;; ftp://ds.internic.net/internet-drafts/draft-ietf-http-digest-aa-01.txt
;;; for the complete documentation on this type.
;;;
;;; This is very secure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar url-digest-auth-storage nil
"Where usernames and passwords are stored. Its value is an assoc list of
assoc lists. The first assoc list is keyed by the server name. The cdr of
this is an assoc list based on the 'directory' specified by the url we are
looking up.")
(defun url-digest-auth-create-key (username password realm method uri)
"Create a key for digest authentication method"
(let* ((info (if (stringp uri)
(url-generic-parse-url uri)
uri))
(a1 (md5 (concat username ":" realm ":" password)))
(a2 (md5 (concat method ":" (url-filename info)))))
(list a1 a2)))
(defun url-digest-auth (url &optional prompt overwrite realm args)
"Get the username/password for the specified URL.
If optional argument PROMPT is non-nil, ask for the username/password
to use for the url and its descendants. If optional third argument
OVERWRITE is non-nil, overwrite the old username/password pair if it
is found in the assoc list. If REALM is specified, use that as the realm
instead of hostname:portnum."
(if args
(let* ((href (if (stringp url)
(url-generic-parse-url url)
url))
(server (url-host href))
(port (url-port href))
(path (url-filename href))
user pass byserv retval data)
(setq path (cond
(realm realm)
((string-match "/$" path) path)
(t (url-basepath path)))
server (format "%s:%d" server port)
byserv (cdr-safe (assoc server url-digest-auth-storage)))
(cond
((and prompt (not byserv))
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (funcall url-passwd-entry-func "Password: ")
url-digest-auth-storage
(cons (list server
(cons path
(setq retval
(cons user
(url-digest-auth-create-key
user pass realm
(or url-request-method "GET")
url)))))
url-digest-auth-storage)))
(byserv
(setq retval (cdr-safe (assoc path byserv)))
(if (and (not retval) ; no exact match, check directories
(string-match "/" path)) ; not looking for a realm
(while (and byserv (not retval))
(setq data (car (car byserv)))
(if (or (not (string-match "/" data))
(and
(>= (length path) (length data))
(string= data (substring path 0 (length data)))))
(setq retval (cdr (car byserv))))
(setq byserv (cdr byserv))))
(if (or (and (not retval) prompt) overwrite)
(progn
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (funcall url-passwd-entry-func "Password: ")
retval (setq retval
(cons user
(url-digest-auth-create-key
user pass realm
(or url-request-method "GET")
url)))
byserv (assoc server url-digest-auth-storage))
(setcdr byserv
(cons (cons path retval) (cdr byserv))))))
(t (setq retval nil)))
(if retval
(let ((nonce (or (cdr-safe (assoc "nonce" args)) "nonegiven"))
(opaque (or (cdr-safe (assoc "opaque" args)) "nonegiven")))
(format
(concat "Digest username=\"%s\", realm=\"%s\","
"nonce=\"%s\", uri=\"%s\","
"response=\"%s\", opaque=\"%s\"")
(nth 0 retval) realm nonce (url-filename href)
(md5 (concat (nth 1 retval) ":" nonce ":"
(nth 2 retval))) opaque))))))
(defvar url-registered-auth-schemes nil
"A list of the registered authorization schemes and various and sundry
information associated with them.")
;;;###autoload
(defun url-get-authentication (url realm type prompt &optional args)
"Return an authorization string suitable for use in the WWW-Authenticate
header in an HTTP/1.0 request.
URL is the url you are requesting authorization to. This can be either a
string representing the URL, or the parsed representation returned by
`url-generic-parse-url'
REALM is the realm at a specific site we are looking for. This should be a
string specifying the exact realm, or nil or the symbol 'any' to
specify that the filename portion of the URL should be used as the
realm
TYPE is the type of authentication to be returned. This is either a string
representing the type (basic, digest, etc), or nil or the symbol 'any'
to specify that any authentication is acceptable. If requesting 'any'
the strongest matching authentication will be returned. If this is
wrong, its no big deal, the error from the server will specify exactly
what type of auth to use
PROMPT is boolean - specifies whether to ask the user for a username/password
if one cannot be found in the cache"
(if (not realm)
(setq realm (cdr-safe (assoc "realm" args))))
(if (stringp url)
(setq url (url-generic-parse-url url)))
(if (or (null type) (eq type 'any))
;; Whooo doogies!
;; Go through and get _all_ the authorization strings that could apply
;; to this URL, store them along with the 'rating' we have in the list
;; of schemes, then sort them so that the 'best' is at the front of the
;; list, then get the car, then get the cdr.
;; Zooom zooom zoooooom
(cdr-safe
(car-safe
(sort
(mapcar
(function
(lambda (scheme)
(if (fboundp (car (cdr scheme)))
(cons (cdr (cdr scheme))
(funcall (car (cdr scheme)) url nil nil realm))
(cons 0 nil))))
url-registered-auth-schemes)
(function
(lambda (x y)
(cond
((null (cdr x)) nil)
((and (cdr x) (null (cdr y))) t)
((and (cdr x) (cdr y))
(>= (car x) (car y)))
(t nil)))))))
(if (symbolp type) (setq type (symbol-name type)))
(let* ((scheme (car-safe
(cdr-safe (assoc (downcase type)
url-registered-auth-schemes)))))
(if (and scheme (fboundp scheme))
(funcall scheme url prompt
(and prompt
(funcall scheme url nil nil realm args))
realm args)))))
;;;###autoload
(defun url-register-auth-scheme (type &optional function rating)
"Register an HTTP authentication method.
TYPE is a string or symbol specifying the name of the method. This
should be the same thing you expect to get returned in an Authenticate
header in HTTP/1.0 - it will be downcased.
FUNCTION is the function to call to get the authorization information. This
defaults to `url-?-auth', where ? is TYPE
RATING a rating between 1 and 10 of the strength of the authentication.
This is used when asking for the best authentication for a specific
URL. The item with the highest rating is returned."
(let* ((type (cond
((stringp type) (downcase type))
((symbolp type) (downcase (symbol-name type)))
(t (error "Bad call to `url-register-auth-scheme'"))))
(function (or function (intern (concat "url-" type "-auth"))))
(rating (cond
((null rating) 2)
((stringp rating) (string-to-int rating))
(t rating)))
(node (assoc type url-registered-auth-schemes)))
(if (not (fboundp function))
(url-warn 'security
(format (concat
"Tried to register `%s' as an auth scheme"
", but it is not a function!") function)))
(if node
(setcdr node (cons function rating))
(setq url-registered-auth-schemes
(cons (cons type (cons function rating))
url-registered-auth-schemes)))))
(defun url-auth-registered (scheme)
;; Return non-nil iff SCHEME is registered as an auth type
(assoc scheme url-registered-auth-schemes))
(provide 'url-auth)
;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91

202
lisp/url/url-cache.el Normal file
View file

@ -0,0 +1,202 @@
;;; url-cache.el --- Uniform Resource Locator retrieval tool
;; Keywords: comm, data, processes, hypermedia
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'url-parse)
(require 'url-util)
(defcustom url-cache-directory
(expand-file-name "cache" url-configuration-directory)
"*The directory where cache files should be stored."
:type 'directory
:group 'url-file)
;; Cache manager
(defun url-cache-file-writable-p (file)
"Follows the documentation of `file-writable-p', unlike `file-writable-p'."
(and (file-writable-p file)
(if (file-exists-p file)
(not (file-directory-p file))
(file-directory-p (file-name-directory file)))))
(defun url-cache-prepare (file)
"Makes it possible to cache data in FILE.
Creates any necessary parent directories, deleting any non-directory files
that would stop this. Returns nil if parent directories can not be
created. If FILE already exists as a non-directory, it changes
permissions of FILE or deletes FILE to make it possible to write a new
version of FILE. Returns nil if this can not be done. Returns nil if
FILE already exists as a directory. Otherwise, returns t, indicating that
FILE can be created or overwritten."
(cond
((url-cache-file-writable-p file)
t)
((file-directory-p file)
nil)
(t
(condition-case ()
(or (make-directory (file-name-directory file) t) t)
(error nil)))))
;;;###autoload
(defun url-store-in-cache (&optional buff)
"Store buffer BUFF in the cache."
(if (not (and buff (get-buffer buff)))
nil
(save-excursion
(and buff (set-buffer buff))
(let* ((fname (url-cache-create-filename (url-view-url t))))
(if (url-cache-prepare fname)
(let ((coding-system-for-write 'binary))
(write-region (point-min) (point-max) fname nil 5)))))))
;;;###autoload
(defun url-is-cached (url)
"Return non-nil if the URL is cached."
(let* ((fname (url-cache-create-filename url))
(attribs (file-attributes fname)))
(and fname ; got a filename
(file-exists-p fname) ; file exists
(not (eq (nth 0 attribs) t)) ; Its not a directory
(nth 5 attribs)))) ; Can get last mod-time
(defun url-cache-create-filename-human-readable (url)
"Return a filename in the local cache for URL"
(if url
(let* ((url (if (vectorp url) (url-recreate-url url) url))
(urlobj (url-generic-parse-url url))
(protocol (url-type urlobj))
(hostname (url-host urlobj))
(host-components
(cons
(user-real-login-name)
(cons (or protocol "file")
(reverse (split-string (or hostname "localhost")
(eval-when-compile
(regexp-quote ".")))))))
(fname (url-filename urlobj)))
(if (and fname (/= (length fname) 0) (= (aref fname 0) ?/))
(setq fname (substring fname 1 nil)))
(if fname
(let ((slash nil))
(setq fname
(mapconcat
(function
(lambda (x)
(cond
((and (= ?/ x) slash)
(setq slash nil)
"%2F")
((= ?/ x)
(setq slash t)
"/")
(t
(setq slash nil)
(char-to-string x))))) fname ""))))
(setq fname (and fname
(mapconcat
(function (lambda (x)
(if (= x ?~) "" (char-to-string x))))
fname ""))
fname (cond
((null fname) nil)
((or (string= "" fname) (string= "/" fname))
url-directory-index-file)
((= (string-to-char fname) ?/)
(if (string= (substring fname -1 nil) "/")
(concat fname url-directory-index-file)
(substring fname 1 nil)))
(t
(if (string= (substring fname -1 nil) "/")
(concat fname url-directory-index-file)
fname))))
(and fname
(expand-file-name fname
(expand-file-name
(mapconcat 'identity host-components "/")
url-cache-directory))))))
(defun url-cache-create-filename-using-md5 (url)
"Create a cached filename using MD5.
Very fast if you have an `md5' primitive function, suitably fast otherwise."
(require 'md5)
(if url
(let* ((url (if (vectorp url) (url-recreate-url url) url))
(checksum (md5 url))
(urlobj (url-generic-parse-url url))
(protocol (url-type urlobj))
(hostname (url-host urlobj))
(host-components
(cons
(user-real-login-name)
(cons (or protocol "file")
(nreverse
(delq nil
(split-string (or hostname "localhost")
(eval-when-compile
(regexp-quote "."))))))))
(fname (url-filename urlobj)))
(and fname
(expand-file-name checksum
(expand-file-name
(mapconcat 'identity host-components "/")
url-cache-directory))))))
(defcustom url-cache-creation-function 'url-cache-create-filename-using-md5
"*What function to use to create a cached filename."
:type '(choice (const :tag "MD5 of filename (low collision rate)"
:value url-cache-create-filename-using-md5)
(const :tag "Human readable filenames (higher collision rate)"
:value url-cache-create-filename-human-readable)
(function :tag "Other"))
:group 'url-cache)
(defun url-cache-create-filename (url)
(funcall url-cache-creation-function url))
;;;###autoload
(defun url-cache-extract (fnam)
"Extract FNAM from the local disk cache"
(erase-buffer)
(insert-file-contents-literally fnam))
;;;###autoload
(defun url-cache-expired (url mod)
"Return t iff a cached file has expired."
(let* ((urlobj (if (vectorp url) url (url-generic-parse-url url)))
(type (url-type urlobj)))
(cond
(url-standalone-mode
(not (file-exists-p (url-cache-create-filename url))))
((string= type "http")
t)
((member type '("file" "ftp"))
(if (or (equal mod '(0 0)) (not mod))
t
(or (> (nth 0 mod) (nth 0 (current-time)))
(> (nth 1 mod) (nth 1 (current-time))))))
(t nil))))
(provide 'url-cache)
;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c

466
lisp/url/url-cookie.el Normal file
View file

@ -0,0 +1,466 @@
;;; url-cookie.el --- Netscape Cookie support
;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(require 'timezone)
(require 'url-util)
(require 'url-parse)
(eval-when-compile (require 'cl))
;; See http://home.netscape.com/newsref/std/cookie_spec.html for the
;; 'open standard' defining this crap.
;;
;; A cookie is stored internally as a vector of 7 slots
;; [ 'cookie name value expires path domain secure ]
(defsubst url-cookie-name (cookie) (aref cookie 1))
(defsubst url-cookie-value (cookie) (aref cookie 2))
(defsubst url-cookie-expires (cookie) (aref cookie 3))
(defsubst url-cookie-path (cookie) (aref cookie 4))
(defsubst url-cookie-domain (cookie) (aref cookie 5))
(defsubst url-cookie-secure (cookie) (aref cookie 6))
(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val))
(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val))
(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val))
(defsubst url-cookie-set-path (cookie val) (aset cookie 4 val))
(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val))
(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val))
(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args)))
(defsubst url-cookie-create (&rest args)
(let ((retval (make-vector 7 nil)))
(aset retval 0 'cookie)
(url-cookie-set-name retval (url-cookie-retrieve-arg :name args))
(url-cookie-set-value retval (url-cookie-retrieve-arg :value args))
(url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args))
(url-cookie-set-path retval (url-cookie-retrieve-arg :path args))
(url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args))
(url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args))
retval))
(defun url-cookie-p (obj)
(and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
(defgroup url-cookie nil
"URL cookies"
:prefix "url-"
:prefix "url-cookie-"
:group 'url)
(defvar url-cookie-storage nil "Where cookies are stored.")
(defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
(defcustom url-cookie-file nil "*Where cookies are stored on disk."
:type '(choice (const :tag "Default" :value nil) file)
:group 'url-file
:group 'url-cookie)
(defcustom url-cookie-confirmation nil
"*If non-nil, confirmation by the user is required to accept HTTP cookies."
:type 'boolean
:group 'url-cookie)
(defcustom url-cookie-multiple-line nil
"*If nil, HTTP requests put all cookies for the server on one line.
Some web servers, such as http://www.hotmail.com/, only accept cookies
when they are on one line. This is broken behaviour, but just try
telling Microsoft that.")
(defvar url-cookies-changed-since-last-save nil
"Whether the cookies list has changed since the last save operation.")
;;;###autoload
(defun url-cookie-parse-file (&optional fname)
(setq fname (or fname url-cookie-file))
(condition-case ()
(load fname nil t)
(error (message "Could not load cookie file %s" fname))))
(defun url-cookie-clean-up (&optional secure)
(let* (
(var (if secure 'url-cookie-secure-storage 'url-cookie-storage))
(val (symbol-value var))
(cur nil)
(new nil)
(cookies nil)
(cur-cookie nil)
(new-cookies nil)
)
(while val
(setq cur (car val)
val (cdr val)
new-cookies nil
cookies (cdr cur))
(while cookies
(setq cur-cookie (car cookies)
cookies (cdr cookies))
(if (or (not (url-cookie-p cur-cookie))
(url-cookie-expired-p cur-cookie)
(null (url-cookie-expires cur-cookie)))
nil
(setq new-cookies (cons cur-cookie new-cookies))))
(if (not new-cookies)
nil
(setcdr cur new-cookies)
(setq new (cons cur new))))
(set var new)))
;;;###autoload
(defun url-cookie-write-file (&optional fname)
(setq fname (or fname url-cookie-file))
(cond
((not url-cookies-changed-since-last-save) nil)
((not (file-writable-p fname))
(message "Cookies file %s (see variable `url-cookie-file') is unwritable." fname))
(t
(url-cookie-clean-up)
(url-cookie-clean-up t)
(save-excursion
(set-buffer (get-buffer-create " *cookies*"))
(erase-buffer)
(fundamental-mode)
(insert ";; Emacs-W3 HTTP cookies file\n"
";; Automatically generated file!!! DO NOT EDIT!!!\n\n"
"(setq url-cookie-storage\n '")
(pp url-cookie-storage (current-buffer))
(insert ")\n(setq url-cookie-secure-storage\n '")
(pp url-cookie-secure-storage (current-buffer))
(insert ")\n")
(write-file fname)
(kill-buffer (current-buffer))))))
(defun url-cookie-store (name value &optional expires domain path secure)
"Store a netscape-style cookie."
(let* ((storage (if secure url-cookie-secure-storage url-cookie-storage))
(tmp storage)
(cur nil)
(found-domain nil))
;; First, look for a matching domain
(setq found-domain (assoc domain storage))
(if found-domain
;; Need to either stick the new cookie in existing domain storage
;; or possibly replace an existing cookie if the names match.
(progn
(setq storage (cdr found-domain)
tmp nil)
(while storage
(setq cur (car storage)
storage (cdr storage))
(if (and (equal path (url-cookie-path cur))
(equal name (url-cookie-name cur)))
(progn
(url-cookie-set-expires cur expires)
(url-cookie-set-value cur value)
(setq tmp t))))
(if (not tmp)
;; New cookie
(setcdr found-domain (cons
(url-cookie-create :name name
:value value
:expires expires
:domain domain
:path path
:secure secure)
(cdr found-domain)))))
;; Need to add a new top-level domain
(setq tmp (url-cookie-create :name name
:value value
:expires expires
:domain domain
:path path
:secure secure))
(cond
(storage
(setcdr storage (cons (list domain tmp) (cdr storage))))
(secure
(setq url-cookie-secure-storage (list (list domain tmp))))
(t
(setq url-cookie-storage (list (list domain tmp))))))))
(defun url-cookie-expired-p (cookie)
(let* (
(exp (url-cookie-expires cookie))
(cur-date (and exp (timezone-parse-date (current-time-string))))
(exp-date (and exp (timezone-parse-date exp)))
(cur-greg (and cur-date (timezone-absolute-from-gregorian
(string-to-int (aref cur-date 1))
(string-to-int (aref cur-date 2))
(string-to-int (aref cur-date 0)))))
(exp-greg (and exp (timezone-absolute-from-gregorian
(string-to-int (aref exp-date 1))
(string-to-int (aref exp-date 2))
(string-to-int (aref exp-date 0)))))
(diff-in-days (and exp (- cur-greg exp-greg)))
)
(cond
((not exp) nil) ; No expiry == expires at browser quit
((< diff-in-days 0) nil) ; Expires sometime after today
((> diff-in-days 0) t) ; Expired before today
(t ; Expires sometime today, check times
(let* ((cur-time (timezone-parse-time (aref cur-date 3)))
(exp-time (timezone-parse-time (aref exp-date 3)))
(cur-norm (+ (* 360 (string-to-int (aref cur-time 2)))
(* 60 (string-to-int (aref cur-time 1)))
(* 1 (string-to-int (aref cur-time 0)))))
(exp-norm (+ (* 360 (string-to-int (aref exp-time 2)))
(* 60 (string-to-int (aref exp-time 1)))
(* 1 (string-to-int (aref exp-time 0))))))
(> (- cur-norm exp-norm) 1))))))
;;;###autoload
(defun url-cookie-retrieve (host path &optional secure)
"Retrieve all the netscape-style cookies for a specified HOST and PATH."
(let ((storage (if secure
(append url-cookie-secure-storage url-cookie-storage)
url-cookie-storage))
(case-fold-search t)
(cookies nil)
(cur nil)
(retval nil)
(path-regexp nil))
(while storage
(setq cur (car storage)
storage (cdr storage)
cookies (cdr cur))
(if (and (car cur)
(string-match (concat "^.*" (regexp-quote (car cur)) "$") host))
;; The domains match - a possible hit!
(while cookies
(setq cur (car cookies)
cookies (cdr cookies)
path-regexp (concat "^" (regexp-quote
(url-cookie-path cur))))
(if (and (string-match path-regexp path)
(not (url-cookie-expired-p cur)))
(setq retval (cons cur retval))))))
retval))
;;;###autolaod
(defun url-cookie-generate-header-lines (host path secure)
(let* ((cookies (url-cookie-retrieve host path secure))
(retval nil)
(cur nil)
(chunk nil))
;; Have to sort this for sending most specific cookies first
(setq cookies (and cookies
(sort cookies
(function
(lambda (x y)
(> (length (url-cookie-path x))
(length (url-cookie-path y))))))))
(while cookies
(setq cur (car cookies)
cookies (cdr cookies)
chunk (format "%s=%s" (url-cookie-name cur) (url-cookie-value cur))
retval (if (and url-cookie-multiple-line
(< 80 (+ (length retval) (length chunk) 4)))
(concat retval "\r\nCookie: " chunk)
(if retval
(concat retval "; " chunk)
(concat "Cookie: " chunk)))))
(if retval
(concat retval "\r\n")
"")))
(defvar url-cookie-two-dot-domains
(concat "\\.\\("
(mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int")
"\\|")
"\\)$")
"A regexp of top level domains that only require two matching
'.'s in the domain name in order to set a cookie.")
(defcustom url-cookie-trusted-urls nil
"*A list of regular expressions matching URLs to always accept cookies from."
:type '(repeat regexp)
:group 'url-cookie)
(defcustom url-cookie-untrusted-urls nil
"*A list of regular expressions matching URLs to never accept cookies from."
:type '(repeat regexp)
:group 'url-cookie)
(defun url-cookie-host-can-set-p (host domain)
(let ((numdots 0)
(tmp domain)
(last nil)
(case-fold-search t)
(mindots 3))
(while (setq last (string-match "\\." domain last))
(setq numdots (1+ numdots)
last (1+ last)))
(if (string-match url-cookie-two-dot-domains domain)
(setq mindots 2))
(cond
((string= host domain) ; Apparently netscape lets you do this
t)
((>= numdots mindots) ; We have enough dots in domain name
;; Need to check and make sure the host is actually _in_ the
;; domain it wants to set a cookie for though.
(string-match (concat (regexp-quote domain) "$") host))
(t
nil))))
;;;###autoload
(defun url-cookie-handle-set-cookie (str)
(setq url-cookies-changed-since-last-save t)
(let* ((args (url-parse-args str t))
(case-fold-search t)
(secure (and (assoc-string "secure" args t) t))
(domain (or (cdr-safe (assoc-string "domain" args t))
(url-host url-current-object)))
(current-url (url-view-url t))
(trusted url-cookie-trusted-urls)
(untrusted url-cookie-untrusted-urls)
(expires (cdr-safe (assoc-string "expires" args t)))
(path (or (cdr-safe (assoc-string "path" args t))
(file-name-directory
(url-filename url-current-object))))
(rest nil))
(while args
(if (not (member (downcase (car (car args)))
'("secure" "domain" "expires" "path")))
(setq rest (cons (car args) rest)))
(setq args (cdr args)))
;; Sometimes we get dates that the timezone package cannot handle very
;; gracefully - take care of this here, instead of in url-cookie-expired-p
;; to speed things up.
(if (and expires
(string-match
(concat "^[^,]+, +\\(..\\)-\\(...\\)-\\(..\\) +"
"\\(..:..:..\\) +\\[*\\([^\]]+\\)\\]*$")
expires))
(setq expires (concat (match-string 1 expires) " "
(match-string 2 expires) " "
(match-string 3 expires) " "
(match-string 4 expires) " ["
(match-string 5 expires) "]")))
;; This one is for older Emacs/XEmacs variants that don't
;; understand this format without tenths of a second in it.
;; Wednesday, 30-Dec-2037 16:00:00 GMT
;; - vs -
;; Wednesday, 30-Dec-2037 16:00:00.00 GMT
(if (and expires
(string-match
"\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\(\\.[0-9]+\\)*[ \t]+\\([-+a-zA-Z0-9]+\\)"
expires))
(setq expires (concat (match-string 1 expires) "-" ; day
(match-string 2 expires) "-" ; month
(match-string 3 expires) " " ; year
(match-string 4 expires) ".00 " ; hour:minutes:seconds
(match-string 6 expires)))) ":" ; timezone
(while (consp trusted)
(if (string-match (car trusted) current-url)
(setq trusted (- (match-end 0) (match-beginning 0)))
(pop trusted)))
(while (consp untrusted)
(if (string-match (car untrusted) current-url)
(setq untrusted (- (match-end 0) (match-beginning 0)))
(pop untrusted)))
(if (and trusted untrusted)
;; Choose the more specific match
(if (> trusted untrusted)
(setq untrusted nil)
(setq trusted nil)))
(cond
(untrusted
;; The site was explicity marked as untrusted by the user
nil)
((or (eq url-privacy-level 'paranoid)
(and (listp url-privacy-level) (memq 'cookies url-privacy-level)))
;; user never wants cookies
nil)
((and url-cookie-confirmation
(not trusted)
(save-window-excursion
(with-output-to-temp-buffer "*Cookie Warning*"
(mapcar
(function
(lambda (x)
(princ (format "%s - %s" (car x) (cdr x))))) rest))
(prog1
(not (funcall url-confirmation-func
(format "Allow %s to set these cookies? "
(url-host url-current-object))))
(if (get-buffer "*Cookie Warning*")
(kill-buffer "*Cookie Warning*")))))
;; user wants to be asked, and declined.
nil)
((url-cookie-host-can-set-p (url-host url-current-object) domain)
;; Cookie is accepted by the user, and passes our security checks
(let ((cur nil))
(while rest
(setq cur (pop rest))
(url-cookie-store (car cur) (cdr cur)
expires domain path secure))))
(t
(message "%s tried to set a cookie for domain %s - rejected."
(url-host url-current-object) domain)))))
(defvar url-cookie-timer nil)
(defcustom url-cookie-save-interval 3600
"*The number of seconds between automatic saves of cookies.
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-cookie-setup-save-timer' function manually."
:set (function (lambda (var val)
(set-default var val)
(and (featurep 'url)
(fboundp 'url-cookie-setup-save-timer)
(url-cookie-setup-save-timer))))
:type 'integer
:group 'url)
;;;###autoload
(defun url-cookie-setup-save-timer ()
"Reset the cookie saver timer."
(interactive)
(ignore-errors
(cond ((fboundp 'cancel-timer) (cancel-timer url-cookie-timer))
((fboundp 'delete-itimer) (delete-itimer url-cookie-timer))))
(setq url-cookie-timer nil)
(if url-cookie-save-interval
(setq url-cookie-timer
(cond
((fboundp 'run-at-time)
(run-at-time url-cookie-save-interval
url-cookie-save-interval
'url-cookie-write-file))
((fboundp 'start-itimer)
(start-itimer "url-cookie-saver" 'url-cookie-write-file
url-cookie-save-interval
url-cookie-save-interval))))))
(provide 'url-cookie)
;; arch-tag: 2568751b-6452-4398-aa2d-303edadb54d7
;;; url-cookie.el ends here

100
lisp/url/url-dired.el Normal file
View file

@ -0,0 +1,100 @@
;;; url-dired.el --- URL Dired minor mode
;; Keywords: comm, files
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(autoload 'w3-fetch "w3")
(autoload 'w3-open-local "w3")
(autoload 'dired-get-filename "dired")
(defvar url-dired-minor-mode-map
(let ((map (make-sparse-keymap)))
(define-key map "\C-m" 'url-dired-find-file)
(if (featurep 'xemacs)
(define-key map [button2] 'url-dired-find-file-mouse)
(define-key map [mouse-2] 'url-dired-find-file-mouse))
map)
"Keymap used when browsing directories.")
(defvar url-dired-minor-mode nil
"Whether we are in url-dired-minor-mode")
(make-variable-buffer-local 'url-dired-minor-mode)
(defun url-dired-find-file ()
"In dired, visit the file or directory named on this line, using Emacs-W3."
(interactive)
(let ((filename (dired-get-filename)))
(cond ((string-match "/\\(.*@.*\\):\\(/.*\\)" filename)
(w3-fetch (concat "file://" (match-string 1 filename) (match-string 2 filename))))
(t
(w3-open-local filename)))))
(defun url-dired-find-file-mouse (event)
"In dired, visit the file or directory name you click on, using Emacs-W3."
(interactive "@e")
(mouse-set-point event)
(url-dired-find-file))
(defun url-dired-minor-mode (&optional arg)
"Minor mode for directory browsing with Emacs-W3."
(interactive "P")
(cond
((null arg)
(setq url-dired-minor-mode (not url-dired-minor-mode)))
((equal 0 arg)
(setq url-dired-minor-mode nil))
(t
(setq url-dired-minor-mode t))))
(if (not (fboundp 'add-minor-mode))
(defun add-minor-mode (toggle name &optional keymap after toggle-fun)
"Add a minor mode to `minor-mode-alist' and `minor-mode-map-alist'.
TOGGLE is a symbol which is used as the variable which toggle the minor mode,
NAME is the name that should appear in the modeline (it should be a string
beginning with a space), KEYMAP is a keymap to make active when the minor
mode is active, and AFTER is the toggling symbol used for another minor
mode. If AFTER is non-nil, then it is used to position the new mode in the
minor-mode alists. TOGGLE-FUN specifies an interactive function that
is called to toggle the mode on and off; this affects what appens when
button2 is pressed on the mode, and when button3 is pressed somewhere
in the list of modes. If TOGGLE-FUN is nil and TOGGLE names an
interactive function, TOGGLE is used as the toggle function.
Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
(if (not (assq toggle minor-mode-alist))
(setq minor-mode-alist (cons (list toggle name) minor-mode-alist)))
(if (and keymap (not (assq toggle minor-mode-map-alist)))
(setq minor-mode-map-alist (cons (cons toggle keymap)
minor-mode-map-alist)))))
(add-minor-mode 'url-dired-minor-mode " URL" url-dired-minor-mode-map)
(defun url-find-file-dired (dir)
"\"Edit\" directory DIR, but with additional URL-friendly bindings."
(interactive "DURL Dired (directory): ")
(find-file dir)
(url-dired-minor-mode t))
(provide 'url-dired)
;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f

1
lisp/url/url-file.el
View file

@ -1,7 +1,6 @@
;;; url-file.el --- File retrieval code
;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc.
;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
;; Keywords: comm, data, processes

42
lisp/url/url-ftp.el Normal file
View file

@ -0,0 +1,42 @@
;;; url-ftp.el --- FTP wrapper
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; We knew not what we did when we overloaded 'file' to mean 'file'
;; and 'ftp' back in the dark ages of the web.
;;
;; This stub file is just here to please the auto-scheme-loading code
;; in url-methods.el and just maps everything onto the code in
;; url-file.
(require 'url-parse)
(require 'url-file)
(defconst url-ftp-default-port 21 "Default FTP port.")
(defconst url-ftp-asynchronous-p t "FTP transfers are asynchronous.")
(defalias 'url-ftp-expand-file-name 'url-default-expander)
(defalias 'url-ftp 'url-file)
(provide 'url-ftp)
;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc

268
lisp/url/url-gw.el Normal file
View file

@ -0,0 +1,268 @@
;;; url-gw.el --- Gateway munging for URL loading
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(eval-when-compile (require 'cl))
(require 'url-vars)
;; Fixme: support SSH explicitly or via a url-gateway-rlogin-program?
(autoload 'socks-open-network-stream "socks")
(autoload 'open-ssl-stream "ssl")
(autoload 'open-tls-stream "tls")
(defgroup url-gateway nil
"URL gateway variables"
:group 'url)
(defcustom url-gateway-local-host-regexp nil
"*A regular expression specifying local hostnames/machines."
:type '(choice (const nil) regexp)
:group 'url-gateway)
(defcustom url-gateway-prompt-pattern
"^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?"
"*A regular expression matching a shell prompt."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-rlogin-host nil
"*What hostname to actually rlog into before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-rlogin-user-name nil
"*Username to log into the remote machine with when using rlogin."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-rlogin-parameters '("telnet" "-8")
"*Parameters to `url-open-rlogin'.
This list will be used as the parameter list given to rsh."
:type '(repeat string)
:group 'url-gateway)
(defcustom url-gateway-telnet-host nil
"*What hostname to actually login to before doing a telnet."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8")
"*Parameters to `url-open-telnet'.
This list will be executed as a command after logging in via telnet."
:type '(repeat string)
:group 'url-gateway)
(defcustom url-gateway-telnet-login-prompt "^\r*.?login:"
"*Prompt that tells us we should send our username when loggin in w/telnet."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-telnet-password-prompt "^\r*.?password:"
"*Prompt that tells us we should send our password when loggin in w/telnet."
:type 'regexp
:group 'url-gateway)
(defcustom url-gateway-telnet-user-name nil
"User name to log in via telnet with."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-telnet-password nil
"Password to use to log in via telnet with."
:type '(choice (const nil) string)
:group 'url-gateway)
(defcustom url-gateway-broken-resolution nil
"*Whether to use nslookup to resolve hostnames.
This should be used when your version of Emacs cannot correctly use DNS,
but your machine can. This usually happens if you are running a statically
linked Emacs under SunOS 4.x"
:type 'boolean
:group 'url-gateway)
(defcustom url-gateway-nslookup-program "nslookup"
"*If non-NIL then a string naming nslookup program."
:type '(choice (const :tag "None" :value nil) string)
:group 'url-gateway)
;; Stolen from ange-ftp
;;;###autoload
(defun url-gateway-nslookup-host (host)
"Attempt to resolve the given HOST using nslookup if possible."
(interactive "sHost: ")
(if url-gateway-nslookup-program
(let ((proc (start-process " *nslookup*" " *nslookup*"
url-gateway-nslookup-program host))
(res host))
(process-kill-without-query proc)
(save-excursion
(set-buffer (process-buffer proc))
(while (memq (process-status proc) '(run open))
(accept-process-output proc))
(goto-char (point-min))
(if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
(setq res (buffer-substring (match-beginning 1)
(match-end 1))))
(kill-buffer (current-buffer)))
res)
host))
;; Stolen from red gnus nntp.el
(defun url-wait-for-string (regexp proc)
"Wait until string matching REGEXP arrives in process PROC's buffer."
(let ((buf (current-buffer)))
(goto-char (point-min))
(while (not (re-search-forward regexp nil t))
(accept-process-output proc)
(set-buffer buf)
(goto-char (point-min)))))
;; Stolen from red gnus nntp.el
(defun url-open-rlogin (name buffer host service)
"Open a connection using rsh."
(if (not (stringp service))
(setq service (int-to-string service)))
(let ((proc (if url-gateway-rlogin-user-name
(start-process
name buffer "rsh"
url-gateway-rlogin-host "-l" url-gateway-rlogin-user-name
(mapconcat 'identity
(append url-gateway-rlogin-parameters
(list host service)) " "))
(start-process
name buffer "rsh" url-gateway-rlogin-host
(mapconcat 'identity
(append url-gateway-rlogin-parameters
(list host service))
" ")))))
(set-buffer buffer)
(url-wait-for-string "^\r*200" proc)
(beginning-of-line)
(delete-region (point-min) (point))
proc))
;; Stolen from red gnus nntp.el
(defun url-open-telnet (name buffer host service)
(if (not (stringp service))
(setq service (int-to-string service)))
(save-excursion
(set-buffer (get-buffer-create buffer))
(erase-buffer)
(let ((proc (start-process name buffer "telnet" "-8"))
(case-fold-search t))
(when (memq (process-status proc) '(open run))
(process-send-string proc "set escape \^X\n")
(process-send-string proc (concat
"open " url-gateway-telnet-host "\n"))
(url-wait-for-string url-gateway-telnet-login-prompt proc)
(process-send-string
proc (concat
(or url-gateway-telnet-user-name
(setq url-gateway-telnet-user-name (read-string "login: ")))
"\n"))
(url-wait-for-string url-gateway-telnet-password-prompt proc)
(process-send-string
proc (concat
(or url-gateway-telnet-password
(setq url-gateway-telnet-password
(funcall url-passwd-entry-func "Password: ")))
"\n"))
(erase-buffer)
(url-wait-for-string url-gateway-prompt-pattern proc)
(process-send-string
proc (concat (mapconcat 'identity
(append url-gateway-telnet-parameters
(list host service)) " ") "\n"))
(url-wait-for-string "^\r*Escape character.*\r*\n+" proc)
(delete-region (point-min) (match-end 0))
(process-send-string proc "\^]\n")
(url-wait-for-string "^telnet" proc)
(process-send-string proc "mode character\n")
(accept-process-output proc 1)
(sit-for 1)
(goto-char (point-min))
(forward-line 1)
(delete-region (point) (point-max)))
proc)))
;;;###autoload
(defun url-open-stream (name buffer host service)
"Open a stream to HOST, possibly via a gateway.
Args per `open-network-stream'.
Will not make a connexion if `url-gateway-unplugged' is non-nil."
(unless url-gateway-unplugged
(let ((gw-method (if (and url-gateway-local-host-regexp
(not (eq 'tls url-gateway-method))
(not (eq 'ssl url-gateway-method))
(string-match
url-gateway-local-host-regexp
host))
'native
url-gateway-method))
;;; ;; This hack is for OS/2 Emacs so that it will not do bogus CRLF
;;; ;; conversions while trying to be 'helpful'
;;; (tcp-binary-process-output-services (if (stringp service)
;;; (list service)
;;; (list service
;;; (int-to-string service))))
;; An attempt to deal with denied connections, and attempt
;; to reconnect
(cur-retries 0)
(retry t)
(errobj nil)
(conn nil))
;; If the user told us to do DNS for them, do it.
(if url-gateway-broken-resolution
(setq host (url-gateway-nslookup-host host)))
(condition-case errobj
;; This is a clean way to ensure the new process inherits the
;; right coding systems in both Emacs and XEmacs.
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(setq conn (case gw-method
(tls
(open-tls-stream name buffer host service))
(ssl
(open-ssl-stream name buffer host service))
((native)
(open-network-stream name buffer host service))
(socks
(socks-open-network-stream name buffer host service))
(telnet
(url-open-telnet name buffer host service))
(rlogin
(url-open-rlogin name buffer host service))
(otherwise
(error "Bad setting of url-gateway-method: %s"
url-gateway-method)))))
(error
(setq conn nil)))
conn)))
(provide 'url-gw)
;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838

3
lisp/url/url-handlers.el
View file

@ -1,7 +1,6 @@
;;; url-handlers.el --- file-name-handler stuff for URL loading
;; Copyright (c) 1996, 1997, 1998, 1999, 2004 Free Software Foundation, Inc.
;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
;; Keywords: comm, data, processes, hypermedia
@ -208,7 +207,7 @@ accessible."
;; annotation which we could use as a hint of the locale in use
;; at the remote site. Not sure how/if that should be done. --Stef
(decode-coding-inserted-region
start (point) buffer-file-name visit beg end replace)))
start (point) url visit beg end replace)))
(list url (length data))))
(defun url-file-name-completion (url directory)

199
lisp/url/url-history.el Normal file
View file

@ -0,0 +1,199 @@
;;; url-history.el --- Global history tracking for URL package
;; Copyright (c) 1996 - 1999,2004 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
;; This can get a recursive require.
;;(require 'url)
(eval-when-compile (require 'cl))
(require 'url-parse)
(autoload 'url-do-setup "url")
(defgroup url-history nil
"History variables in the URL package"
:prefix "url-history"
:group 'url)
(defcustom url-history-track nil
"*Controls whether to keep a list of all the URLS being visited.
If non-nil, url will keep track of all the URLS visited.
If eq to `t', then the list is saved to disk at the end of each emacs
session."
:type 'boolean
:group 'url-history)
(defcustom url-history-file nil
"*The global history file for the URL package.
This file contains a list of all the URLs you have visited. This file
is parsed at startup and used to provide URL completion."
:type '(choice (const :tag "Default" :value nil) file)
:group 'url-history)
(defcustom url-history-save-interval 3600
"*The number of seconds between automatic saves of the history list.
Default is 1 hour. Note that if you change this variable outside of
the `customize' interface after `url-do-setup' has been run, you need
to run the `url-history-setup-save-timer' function manually."
:set (function (lambda (var val)
(set-default var val)
(and (featurep 'url)
(fboundp 'url-history-setup-save-timer)
(let ((def (symbol-function
'url-history-setup-save-timer)))
(not (and (listp def) (eq 'autoload (car def)))))
(url-history-setup-save-timer))))
:type 'integer
:group 'url-history)
(defvar url-history-timer nil)
(defvar url-history-list nil
"List of urls visited this session.")
(defvar url-history-changed-since-last-save nil
"Whether the history list has changed since the last save operation.")
(defvar url-history-hash-table nil
"Hash table for global history completion.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;###autoload
(defun url-history-setup-save-timer ()
"Reset the history list timer."
(interactive)
(ignore-errors
(cond ((fboundp 'cancel-timer) (cancel-timer url-history-timer))
((fboundp 'delete-itimer) (delete-itimer url-history-timer))))
(setq url-history-timer nil)
(if url-history-save-interval
(setq url-history-timer
(cond
((fboundp 'run-at-time)
(run-at-time url-history-save-interval
url-history-save-interval
'url-history-save-history))
((fboundp 'start-itimer)
(start-itimer "url-history-saver" 'url-history-save-history
url-history-save-interval
url-history-save-interval))))))
;;;###autoload
(defun url-history-parse-history (&optional fname)
"Parse a history file stored in FNAME."
;; Parse out the mosaic global history file for completions, etc.
(or fname (setq fname (expand-file-name url-history-file)))
(cond
((not (file-exists-p fname))
(message "%s does not exist." fname))
((not (file-readable-p fname))
(message "%s is unreadable." fname))
(t
(condition-case nil
(load fname nil t)
(error (message "Could not load %s" fname)))))
(if (not url-history-hash-table)
(setq url-history-hash-table (make-hash-table :size 31 :test 'equal))))
(defun url-history-update-url (url time)
(setq url-history-changed-since-last-save t)
(puthash (if (vectorp url) (url-recreate-url url) url) time url-history-hash-table))
;;;###autoload
(defun url-history-save-history (&optional fname)
"Write the global history file into `url-history-file'.
The type of data written is determined by what is in the file to begin
with. If the type of storage cannot be determined, then prompt the
user for what type to save as."
(interactive)
(or fname (setq fname (expand-file-name url-history-file)))
(cond
((not url-history-changed-since-last-save) nil)
((not (file-writable-p fname))
(message "%s is unwritable." fname))
(t
(let ((make-backup-files nil)
(version-control nil)
(require-final-newline t))
(save-excursion
(set-buffer (get-buffer-create " *url-tmp*"))
(erase-buffer)
(let ((count 0))
(maphash (function
(lambda (key value)
(while (string-match "[\r\n]+" key)
(setq key (concat (substring key 0 (match-beginning 0))
(substring key (match-end 0) nil))))
(setq count (1+ count))
(insert "(puthash \"" key "\""
(if (not (stringp value)) " '" "")
(prin1-to-string value)
" url-history-hash-table)\n")))
url-history-hash-table)
(goto-char (point-min))
(insert (format
"(setq url-history-hash-table (make-hash-table :size %d :test 'equal))\n"
(/ count 4)))
(goto-char (point-max))
(insert "\n")
(write-file fname))
(kill-buffer (current-buffer))))))
(setq url-history-changed-since-last-save nil))
(defun url-have-visited-url (url)
(url-do-setup)
(gethash url url-history-hash-table nil))
(defun url-completion-function (string predicate function)
(url-do-setup)
(cond
((eq function nil)
(let ((list nil))
(maphash (function (lambda (key val)
(setq list (cons (cons key val)
list))))
url-history-hash-table)
(try-completion string (nreverse list) predicate)))
((eq function t)
(let ((stub (concat "^" (regexp-quote string)))
(retval nil))
(maphash
(function
(lambda (url time)
(if (string-match stub url)
(setq retval (cons url retval)))))
url-history-hash-table)
retval))
((eq function 'lambda)
(and url-history-hash-table
(gethash string url-history-hash-table)
t))
(t
(error "url-completion-function very confused."))))
(provide 'url-history)
;; arch-tag: fbbbaf63-db36-4e88-bc9f-2939aa93afb2
;;; url-history.el ends here

14
lisp/url/url-https.el
View file

@ -1,4 +1,4 @@
;;; url-https.el --- HTTP over SSL routines
;;; url-https.el --- HTTP over SSL/TLS routines
;; Copyright (c) 1999, 2004 Free Software Foundation, Inc.
@ -30,6 +30,7 @@
(require 'url-parse)
(require 'url-cookie)
(require 'url-http)
(require 'tls)
(defconst url-https-default-port 443 "Default HTTPS port.")
(defconst url-https-asynchronous-p t "HTTPS retrievals are asynchronous.")
@ -38,12 +39,11 @@
(defmacro url-https-create-secure-wrapper (method args)
`(defun ,(intern (format (if method "url-https-%s" "url-https") method)) ,args
,(format "HTTPS wrapper around `%s' call." (or method "url-http"))
(condition-case ()
(require 'ssl)
(error
(error "HTTPS support could not find `ssl' library")))
(let ((url-gateway-method 'ssl))
( ,(intern (format (if method "url-http-%s" "url-http") method)) ,@(remove '&rest (remove '&optional args))))))
(let ((url-gateway-method (condition-case ()
(require 'ssl)
(error 'tls))))
(,(intern (format (if method "url-http-%s" "url-http") method))
,@(remove '&rest (remove '&optional args))))))
(url-https-create-secure-wrapper nil (url callback cbargs))
(url-https-create-secure-wrapper file-exists-p (url))

76
lisp/url/url-irc.el Normal file
View file

@ -0,0 +1,76 @@
;;; url-irc.el --- IRC URL interface
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
(require 'url-vars)
(require 'url-parse)
(defconst url-irc-default-port 6667 "Default port for IRC connections")
(defcustom url-irc-function 'url-irc-zenirc
"*Function to actually open an IRC connection.
Should be a function that takes several argument:
HOST - the hostname of the IRC server to contact
PORT - the port number of the IRC server to contact
CHANNEL - What channel on the server to visit right away (can be nil)
USER - What username to use
PASSWORD - What password to use"
:type '(choice (const :tag "ZEN IRC" :value 'url-irc-zenirc)
(function :tag "Other"))
:group 'url)
(defun url-irc-zenirc (host port channel user password)
(let ((zenirc-buffer-name (if (and user host port)
(format "%s@%s:%d" user host port)
(format "%s:%d" host port)))
(zenirc-server-alist
(list
(list host port password nil user))))
(zenirc)
(goto-char (point-max))
(if (not channel)
nil
(insert "/join " channel)
(zenirc-send-line))))
;;;###autoload
(defun url-irc (url)
(let* ((host (url-host url))
(port (string-to-int (url-port url)))
(pass (url-password url))
(user (url-user url))
(chan (url-filename url)))
(if (url-target url)
(setq chan (concat chan "#" (url-target url))))
(if (string-match "^/" chan)
(setq chan (substring chan 1 nil)))
(if (= (length chan) 0)
(setq chan nil))
(funcall url-irc-function host port chan user pass)
nil))
(provide 'url-irc)
;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e

240
lisp/url/url-ldap.el Normal file
View file

@ -0,0 +1,240 @@
;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(require 'url-vars)
(require 'url-parse)
(require 'url-util)
(require 'ldap)
(autoload 'tls-certificate-information "tls")
;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997)
;;
;; basic format is: ldap://host:port/dn?attributes?scope?filter?extensions
;;
;; Test URLs:
;; ldap://ldap.itd.umich.edu/cn%3Dumbflabmanager%2C%20ou%3DUser%20Groups%2C%20ou%3DGroups%2C%20o%3DUniversity%20of%20Michigan%2C%20c%3DUS
;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US
;;
;; For simple queries, I have verified compatibility with Netscape
;; Communicator v4.5 under GNU/Linux.
;;
;; For anything _useful_ though, like specifying the attributes,
;; scope, filter, or extensions, netscape claims the URL format is
;; unrecognized. So I don't think it supports anything other than the
;; defaults (scope=base,attributes=*,filter=(objectClass=*)
(defconst url-ldap-default-port 389 "Default LDAP port.")
(defalias 'url-ldap-expand-file-name 'url-default-expander)
(defvar url-ldap-pretty-names
'(("l" . "City")
("objectclass" . "Object Class")
("o" . "Organization")
("ou" . "Organizational Unit")
("cn" . "Name")
("sn" . "Last Name")
("givenname" . "First Name")
("mail" . "Email")
("title" . "Title")
("c" . "Country")
("postalcode" . "ZIP Code")
("telephonenumber" . "Phone Number")
("facsimiletelephonenumber" . "Fax")
("postaladdress" . "Mailing Address")
("description" . "Notes"))
"*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
(defvar url-ldap-attribute-formatters
'(("mail" . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
("owner" . url-ldap-dn-formatter)
("creatorsname" . url-ldap-dn-formatter)
("jpegphoto" . url-ldap-image-formatter)
("usercertificate" . url-ldap-certificate-formatter)
("modifiersname" . url-ldap-dn-formatter)
("namingcontexts" . url-ldap-dn-formatter)
("defaultnamingcontext" . url-ldap-dn-formatter)
("member" . url-ldap-dn-formatter))
"*An assoc list mapping LDAP attribute names to pretty formatters for them.")
(defsubst url-ldap-attribute-pretty-name (n)
(or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
(defsubst url-ldap-attribute-pretty-desc (n v)
(if (string-match "^\\([^;]+\\);" n)
(setq n (match-string 1 n)))
(funcall (or (cdr-safe (assoc (downcase n) url-ldap-attribute-formatters)) 'identity) v))
(defun url-ldap-dn-formatter (dn)
(concat "<a href='/"
(url-hexify-string dn)
"'>" dn "</a>"))
(defun url-ldap-certificate-formatter (data)
(condition-case ()
(require 'ssl)
(error nil))
(let ((vals (if (fboundp 'ssl-certificate-information)
(ssl-certificate-information data)
(tls-certificate-information data))))
(if (not vals)
"<b>Unable to parse certificate</b>"
(concat "<table border=0>\n"
(mapconcat
(lambda (ava)
(format "<tr><td>%s</td><td>%s</td></tr>\n" (car ava) (cdr ava)))
vals "\n")
"</table>\n"))))
(defun url-ldap-image-formatter (data)
(format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
(url-hexify-string (base64-encode-string data))))
;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically
;; calls of ldap-open, ldap-close, ldap-search-internal
;;;###autoload
(defun url-ldap (url)
(save-excursion
(set-buffer (generate-new-buffer " *url-ldap*"))
(setq url-current-object url)
(insert "Content-type: text/html\r\n\r\n")
(if (not (fboundp 'ldap-search-internal))
(insert "<html>\n"
" <head>\n"
" <title>LDAP Not Supported</title>\n"
" <base href='" (url-recreate-url url) "'>\n"
" </head>\n"
" <body>\n"
" <h1>LDAP Not Supported</h1>\n"
" <p>\n"
" This version of Emacs does not support LDAP.\n"
" </p>\n"
" </body>\n"
"</html>\n")
(let* ((binddn nil)
(data (url-filename url))
(host (url-host url))
(port (url-port url))
(base-object nil)
(attributes nil)
(scope nil)
(filter nil)
(extensions nil)
(connection nil)
(results nil)
(extract-dn (and (fboundp 'function-max-args)
(= (function-max-args 'ldap-search-internal) 7))))
;; Get rid of leading /
(if (string-match "^/" data)
(setq data (substring data 1)))
(setq data (mapcar (lambda (x) (if (/= (length x) 0) x nil)) (split-string data "\\?"))
base-object (nth 0 data)
attributes (nth 1 data)
scope (nth 2 data)
filter (nth 3 data)
extensions (nth 4 data))
;; fill in the defaults
(setq base-object (url-unhex-string (or base-object ""))
scope (intern (url-unhex-string (or scope "base")))
filter (url-unhex-string (or filter "(objectClass=*)")))
(if (not (memq scope '(base one tree)))
(error "Malformed LDAP URL: Unknown scope: %S" scope))
;; Convert to the internal LDAP support scoping names.
(setq scope (cdr (assq scope '((base . base) (one . onelevel) (sub . subtree)))))
(if attributes
(setq attributes (mapcar 'url-unhex-string (split-string attributes ","))))
;; Parse out the exentions
(if extensions
(setq extensions (mapcar (lambda (ext)
(if (string-match "\\([^=]*\\)=\\(.*\\)" ext)
(cons (match-string 1 ext) (match-string 2 ext))
(cons ext ext)))
(split-string extensions ","))
extensions (mapcar (lambda (ext)
(cons (url-unhex-string (car ext))
(url-unhex-string (cdr ext))))
extensions)))
(setq binddn (cdr-safe (or (assoc "bindname" extensions)
(assoc "!bindname" extensions))))
;; Now, let's actually do something with it.
(setq connection (ldap-open host (if binddn (list 'binddn binddn)))
results (if extract-dn
(ldap-search-internal connection filter base-object scope attributes nil t)
(ldap-search-internal connection filter base-object scope attributes nil)))
(ldap-close connection)
(insert "<html>\n"
" <head>\n"
" <title>LDAP Search Results</title>\n"
" <base href='" (url-recreate-url url) "'>\n"
" </head>\n"
" <body>\n"
" <h1>" (int-to-string (length results)) " matches</h1>\n")
(mapc (lambda (obj)
(insert " <hr>\n"
" <table border=1>\n")
(if extract-dn
(insert " <tr><th colspan=2>" (car obj) "</th></tr>\n"))
(mapc (lambda (attr)
(if (= (length (cdr attr)) 1)
;; single match, easy
(insert " <tr><td>"
(url-ldap-attribute-pretty-name (car attr))
"</td><td>"
(url-ldap-attribute-pretty-desc (car attr) (car (cdr attr)))
"</td></tr>\n")
;; Multiple matches, slightly uglier
(insert " <tr>\n"
(format " <td valign=top>")
(url-ldap-attribute-pretty-name (car attr)) "</td><td>"
(mapconcat (lambda (x)
(url-ldap-attribute-pretty-desc (car attr) x))
(cdr attr)
"<br>\n")
"</td>"
" </tr>\n")))
(if extract-dn (cdr obj) obj))
(insert " </table>\n"))
results)
(insert " <hr>\n"
" </body>\n"
"</html>\n")))
(current-buffer)))
(provide 'url-ldap)
;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8
;;; url-ldap.el ends here

131
lisp/url/url-mailto.el Normal file
View file

@ -0,0 +1,131 @@
;;; url-mail.el --- Mail Uniform Resource Locator retrieval code
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(eval-when-compile (require 'cl))
(require 'url-vars)
(require 'url-parse)
(require 'url-util)
;;;###autoload
(defun url-mail (&rest args)
(interactive "P")
(if (fboundp 'message-mail)
(apply 'message-mail args)
(or (apply 'mail args)
(error "Mail aborted"))))
(defun url-mail-goto-field (field)
(if (not field)
(goto-char (point-max))
(let ((dest nil)
(lim nil)
(case-fold-search t))
(save-excursion
(goto-char (point-min))
(if (re-search-forward (regexp-quote mail-header-separator) nil t)
(setq lim (match-beginning 0)))
(goto-char (point-min))
(if (re-search-forward (concat "^" (regexp-quote field) ":") lim t)
(setq dest (match-beginning 0))))
(if dest
(progn
(goto-char dest)
(end-of-line))
(goto-char lim)
(insert (capitalize field) ": ")
(save-excursion
(insert "\n"))))))
;;;###autoload
(defun url-mailto (url)
"Handle the mailto: URL syntax."
(if (url-user url)
;; malformed mailto URL (mailto://wmperry@gnu.org instead of
;; mailto:wmperry@gnu.org
(url-set-filename url (concat (url-user url) "@" (url-filename url))))
(setq url (url-filename url))
(let (to args source-url subject func headers-start)
(if (string-match (regexp-quote "?") url)
(setq headers-start (match-end 0)
to (url-unhex-string (substring url 0 (match-beginning 0)))
args (url-parse-query-string
(substring url headers-start nil) t))
(setq to (url-unhex-string url)))
(setq source-url (url-view-url t))
(if (and url-request-data (not (assoc "subject" args)))
(setq args (cons (list "subject"
(concat "Automatic submission from "
url-package-name "/"
url-package-version)) args)))
(if (and source-url (not (assoc "x-url-from" args)))
(setq args (cons (list "x-url-from" source-url) args)))
(if (assoc "to" args)
(push to (cdr (assoc "to" args)))
(setq args (cons (list "to" to) args)))
(setq subject (cdr-safe (assoc "subject" args)))
(if (fboundp url-mail-command) (funcall url-mail-command) (mail))
(while args
(if (string= (caar args) "body")
(progn
(goto-char (point-max))
(insert (mapconcat 'identity (cdar args) "\n")))
(url-mail-goto-field (caar args))
(setq func (intern-soft (concat "mail-" (caar args))))
(insert (mapconcat 'identity (cdar args) ", ")))
(setq args (cdr args)))
;; (url-mail-goto-field "User-Agent")
;; (insert url-package-name "/" url-package-version " URL/" url-version)
(if (not url-request-data)
(progn
(set-buffer-modified-p nil)
(if subject
(url-mail-goto-field nil)
(url-mail-goto-field "subject")))
(if url-request-extra-headers
(mapconcat
(lambda (x)
(url-mail-goto-field (car x))
(insert (cdr x)))
url-request-extra-headers ""))
(goto-char (point-max))
(insert url-request-data)
;; It seems Microsoft-ish to send without warning.
;; Fixme: presumably this should depend on a privacy setting.
(if (y-or-n-p "Send this auto-generated mail? ")
(cond ((eq url-mail-command 'compose-mail)
(funcall (get mail-user-agent 'sendfunc) nil))
;; otherwise, we can't be sure
((fboundp 'message-send-and-exit)
(message-send-and-exit))
(t (mail-send-and-exit nil)))))
nil))
(provide 'url-mailto)
;; arch-tag: 7b7ad52e-8760-497b-9444-75fae14e34c5
;;; url-mailto.el ends here

150
lisp/url/url-methods.el Normal file
View file

@ -0,0 +1,150 @@
;;; url-methods.el --- Load URL schemes as needed
;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc.
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(eval-when-compile
(require 'cl))
;; This loads up some of the small, silly URLs that I really don't
;; want to bother putting in their own separate files.
(require 'url-parse)
(defvar url-scheme-registry (make-hash-table :size 7 :test 'equal))
(defconst url-scheme-methods
'((default-port . variable)
(asynchronous-p . variable)
(expand-file-name . function)
(file-exists-p . function)
(file-attributes . function)
(parse-url . function)
(file-symlink-p . function)
(file-writable-p . function)
(file-directory-p . function)
(file-executable-p . function)
(directory-files . function)
(file-truename . function))
"Assoc-list of methods that each URL loader can provide.")
(defconst url-scheme-default-properties
(list 'name "unknown"
'loader 'url-scheme-default-loader
'default-port 0
'expand-file-name 'url-identity-expander
'parse-url 'url-generic-parse-url
'asynchronous-p nil
'file-directory-p 'ignore
'file-truename (lambda (&rest args)
(url-recreate-url (car args)))
'file-exists-p 'ignore
'file-attributes 'ignore))
(defun url-scheme-default-loader (url &optional callback cbargs)
"Signal an error for an unknown URL scheme."
(error "Unkown URL scheme: %s" (url-type url)))
(defun url-scheme-register-proxy (scheme)
"Automatically find a proxy for SCHEME and put it in `url-proxy-services'."
(let* ((env-var (concat scheme "_proxy"))
(env-proxy (or (getenv (upcase env-var))
(getenv (downcase env-var))))
(cur-proxy (assoc scheme url-proxy-services))
(urlobj nil))
;; Store any proxying information - this will not overwrite an old
;; entry, so that people can still set this information in their
;; .emacs file
(cond
(cur-proxy nil) ; Keep their old settings
((null env-proxy) nil) ; No proxy setup
;; First check if its something like hostname:port
((string-match "^\\([^:]+\\):\\([0-9]+\\)$" env-proxy)
(setq urlobj (url-generic-parse-url nil)) ; Get a blank object
(url-set-type urlobj "http")
(url-set-host urlobj (match-string 1 env-proxy))
(url-set-port urlobj (string-to-number (match-string 2 env-proxy))))
;; Then check if its a fully specified URL
((string-match url-nonrelative-link env-proxy)
(setq urlobj (url-generic-parse-url env-proxy))
(url-set-type urlobj "http")
(url-set-target urlobj nil))
;; Finally, fall back on the assumption that its just a hostname
(t
(setq urlobj (url-generic-parse-url nil)) ; Get a blank object
(url-set-type urlobj "http")
(url-set-host urlobj env-proxy)))
(if (and (not cur-proxy) urlobj)
(progn
(setq url-proxy-services
(cons (cons scheme (format "%s:%d" (url-host urlobj)
(url-port urlobj)))
url-proxy-services))
(message "Using a proxy for %s..." scheme)))))
(defun url-scheme-get-property (scheme property)
"Get property of a URL SCHEME.
Will automatically try to load a backend from url-SCHEME.el if
it has not already been loaded."
(setq scheme (downcase scheme))
(let ((desc (gethash scheme url-scheme-registry)))
(if (not desc)
(let* ((stub (concat "url-" scheme))
(loader (intern stub)))
(condition-case ()
(require loader)
(error nil))
(if (fboundp loader)
(progn
;; Found the module to handle <scheme> URLs
(url-scheme-register-proxy scheme)
(setq desc (list 'name scheme
'loader loader))
(dolist (cell url-scheme-methods)
(let ((symbol (intern-soft (format "%s-%s" stub (car cell))))
(type (cdr cell)))
(if symbol
(case type
(function
;; Store the symbol name of a function
(if (fboundp symbol)
(setq desc (plist-put desc (car cell) symbol))))
(variable
;; Store the VALUE of a variable
(if (boundp symbol)
(setq desc (plist-put desc (car cell)
(symbol-value symbol)))))
(otherwise
(error "Malformed url-scheme-methods entry: %S"
cell))))))
(puthash scheme desc url-scheme-registry)))))
(or (plist-get desc property)
(plist-get url-scheme-default-properties property))))
(provide 'url-methods)
;; arch-tag: 336863f8-5a07-4906-9be5-b3c6bcebbe67
;;; url-methods.el ends here

117
lisp/url/url-misc.el Normal file
View file

@ -0,0 +1,117 @@
;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'url-vars)
(require 'url-parse)
(autoload 'Info-goto-node "info" "" t)
(autoload 'man "man" nil t)
;;;###autoload
(defun url-man (url)
"Fetch a Unix manual page URL."
(man (url-filename url))
nil)
;;;###autoload
(defun url-info (url)
"Fetch a GNU Info URL."
;; Fetch an info node
(let* ((fname (url-filename url))
(node (url-unhex-string (or (url-target url) "Top"))))
(if (and fname node)
(Info-goto-node (concat "(" fname ")" node))
(error "Malformed url: %s" (url-recreate-url url)))
nil))
(defun url-do-terminal-emulator (type server port user)
(terminal-emulator
(generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
(case type
(rlogin "rlogin")
(telnet "telnet")
(tn3270 "tn3270")
(otherwise
(error "Unknown terminal emulator required: %s" type)))
(case type
(rlogin
(if user
(list server "-l" user)
(list server)))
(telnet
(if user (message "Please log in as user: %s" user))
(if port
(list server port)
(list server)))
(tn3270
(if user (message "Please log in as user: %s" user))
(list server)))))
;;;###autoload
(defun url-generic-emulator-loader (url)
(let* ((type (intern (downcase (url-type url))))
(server (url-host url))
(name (url-user url))
(port (url-port url)))
(url-do-terminal-emulator type server port name))
nil)
;;;###autoload
(defalias 'url-rlogin 'url-generic-emulator-loader)
;;;###autoload
(defalias 'url-telnet 'url-generic-emulator-loader)
;;;###autoload
(defalias 'url-tn3270 'url-generic-emulator-loader)
;; RFC 2397
;;;###autoload
(defun url-data (url)
"Fetch a data URL (RFC 2397)."
(let ((mediatype nil)
;; The mediatype may need to be hex-encoded too -- see the RFC.
(desc (url-unhex-string (url-filename url)))
(encoding "8bit")
(data nil))
(save-excursion
(if (not (string-match "\\([^,]*\\)?," desc))
(error "Malformed data URL: %s" desc)
(setq mediatype (match-string 1 desc))
(if (and mediatype (string-match ";base64\\'" mediatype))
(setq mediatype (substring mediatype 0 (match-beginning 0))
encoding "base64"))
(if (or (null mediatype)
(eq ?\; (aref mediatype 0)))
(setq mediatype (concat "text/plain" mediatype)))
(setq data (url-unhex-string (substring desc (match-end 0)))))
(set-buffer (generate-new-buffer " *url-data*"))
(mm-disable-multibyte)
(insert (format "Content-Length: %d\n" (length data))
"Content-Type: " mediatype "\n"
"Content-Encoding: " encoding "\n"
"\n")
(if data (insert data))
(current-buffer))))
(provide 'url-misc)
;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0

135
lisp/url/url-news.el Normal file
View file

@ -0,0 +1,135 @@
;;; url-news.el --- News Uniform Resource Locator retrieval code
;; Keywords: comm, data, processes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'url-vars)
(require 'url-util)
(require 'url-parse)
(require 'nntp)
(autoload 'url-warn "url")
(autoload 'gnus-group-read-ephemeral-group "gnus-group")
(eval-when-compile (require 'cl))
(defgroup url-news nil
"News related options"
:group 'url)
(defun url-news-open-host (host port user pass)
(if (fboundp 'nnheader-init-server-buffer)
(nnheader-init-server-buffer))
(nntp-open-server host (list (string-to-int port)))
(if (and user pass)
(progn
(nntp-send-command "^.*\r?\n" "AUTHINFO USER" user)
(nntp-send-command "^.*\r?\n" "AUTHINFO PASS" pass)
(if (not (nntp-server-opened host))
(url-warn 'url (format "NNTP authentication to `%s' as `%s' failed"
host user))))))
(defun url-news-fetch-message-id (host message-id)
(let ((buf (generate-new-buffer " *url-news*")))
(if (eq ?> (aref message-id (1- (length message-id))))
nil
(setq message-id (concat "<" message-id ">")))
(if (cdr-safe (nntp-request-article message-id nil host buf))
;; Successfully retrieved the article
nil
(save-excursion
(set-buffer buf)
(insert "Content-type: text/html\n\n"
"<html>\n"
" <head>\n"
" <title>Error</title>\n"
" </head>\n"
" <body>\n"
" <div>\n"
" <h1>Error requesting article...</h1>\n"
" <p>\n"
" The status message returned by the NNTP server was:"
"<br><hr>\n"
" <xmp>\n"
(nntp-status-message)
" </xmp>\n"
" </p>\n"
" <p>\n"
" If you If you feel this is an error, <a href=\""
"mailto:" url-bug-address "\">send mail</a>\n"
" </p>\n"
" </div>\n"
" </body>\n"
"</html>\n"
"<!-- Automatically generated by URL v" url-version " -->\n"
)))
buf))
(defun url-news-fetch-newsgroup (newsgroup host)
(declare (special gnus-group-buffer))
(if (string-match "^/+" newsgroup)
(setq newsgroup (substring newsgroup (match-end 0))))
(if (string-match "/+$" newsgroup)
(setq newsgroup (substring newsgroup 0 (match-beginning 0))))
;; This saves us from checking new news if Gnus is already running
;; FIXME - is it relatively safe to use gnus-alive-p here? FIXME
(if (or (not (get-buffer gnus-group-buffer))
(save-excursion
(set-buffer gnus-group-buffer)
(not (eq major-mode 'gnus-group-mode))))
(gnus))
(set-buffer gnus-group-buffer)
(goto-char (point-min))
(gnus-group-read-ephemeral-group newsgroup
(list 'nntp host
'nntp-open-connection-function
nntp-open-connection-function)
nil
(cons (current-buffer) 'browse)))
;;;###autoload
(defun url-news (url)
;; Find a news reference
(let* ((host (or (url-host url) url-news-server))
(port (url-port url))
(article-brackets nil)
(buf nil)
(article (url-filename url)))
(url-news-open-host host port (url-user url) (url-password url))
(setq article (url-unhex-string article))
(cond
((string-match "@" article) ; Its a specific article
(setq buf (url-news-fetch-message-id host article)))
((string= article "") ; List all newsgroups
(gnus))
(t ; Whole newsgroup
(url-news-fetch-newsgroup article host)))
buf))
;;;###autoload
(defun url-snews (url)
(let ((nntp-open-connection-function (if (eq 'tls url-gateway-method)
nntp-open-tls-stream
nntp-open-ssl-stream)))
(url-news url)))
(provide 'url-news)
;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311

3
lisp/url/url-nfs.el
View file

@ -1,7 +1,6 @@
;;; url-nfs.el --- NFS URL interface
;; Copyright (c) 1996,97,98,1999,2004 Free Software Foundation, Inc.
;; Copyright (c) 1996 by William M. Perry <wmperry@cs.indiana.edu>
;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc.
;; Keywords: comm, data, processes

210
lisp/url/url-parse.el Normal file
View file

@ -0,0 +1,210 @@
;;; url-parse.el --- Uniform Resource Locator parser
;; Copyright (c) 1996,1997,1998,1999,2004 Free Software Foundation, Inc.
;; Keywords: comm, data, processes
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;;; Code:
(require 'url-vars)
(autoload 'url-scheme-get-property "url-methods")
(defmacro url-type (urlobj)
`(aref ,urlobj 0))
(defmacro url-user (urlobj)
`(aref ,urlobj 1))
(defmacro url-password (urlobj)
`(aref ,urlobj 2))
(defmacro url-host (urlobj)
`(aref ,urlobj 3))
(defmacro url-port (urlobj)
`(or (aref ,urlobj 4)
(if (url-fullness ,urlobj)
(url-scheme-get-property (url-type ,urlobj) 'default-port))))
(defmacro url-filename (urlobj)
`(aref ,urlobj 5))
(defmacro url-target (urlobj)
`(aref ,urlobj 6))
(defmacro url-attributes (urlobj)
`(aref ,urlobj 7))
(defmacro url-fullness (urlobj)
`(aref ,urlobj 8))
(defmacro url-set-type (urlobj type)
`(aset ,urlobj 0 ,type))
(defmacro url-set-user (urlobj user)
`(aset ,urlobj 1 ,user))
(defmacro url-set-password (urlobj pass)
`(aset ,urlobj 2 ,pass))
(defmacro url-set-host (urlobj host)
`(aset ,urlobj 3 ,host))
(defmacro url-set-port (urlobj port)
`(aset ,urlobj 4 ,port))
(defmacro url-set-filename (urlobj file)
`(aset ,urlobj 5 ,file))
(defmacro url-set-target (urlobj targ)
`(aset ,urlobj 6 ,targ))
(defmacro url-set-attributes (urlobj targ)
`(aset ,urlobj 7 ,targ))
(defmacro url-set-full (urlobj val)
`(aset ,urlobj 8 ,val))
;;;###autoload
(defun url-recreate-url (urlobj)
"Recreate a URL string from the parsed URLOBJ."
(concat (url-type urlobj) ":" (if (url-host urlobj) "//" "")
(if (url-user urlobj)
(concat (url-user urlobj)
(if (url-password urlobj)
(concat ":" (url-password urlobj)))
"@"))
(url-host urlobj)
(if (and (url-port urlobj)
(not (equal (url-port urlobj)
(url-scheme-get-property (url-type urlobj) 'default-port))))
(format ":%d" (url-port urlobj)))
(or (url-filename urlobj) "/")
(if (url-target urlobj)
(concat "#" (url-target urlobj)))
(if (url-attributes urlobj)
(concat ";"
(mapconcat
(function
(lambda (x)
(if (cdr x)
(concat (car x) "=" (cdr x))
(car x)))) (url-attributes urlobj) ";")))))
;;;###autoload
(defun url-generic-parse-url (url)
"Return a vector of the parts of URL.
Format is:
\[TYPE USER PASSWORD HOST PORT FILE TARGET ATTRIBUTES FULL\]"
(cond
((null url)
(make-vector 9 nil))
((or (not (string-match url-nonrelative-link url))
(= ?/ (string-to-char url)))
(let ((retval (make-vector 9 nil)))
(url-set-filename retval url)
(url-set-full retval nil)
retval))
(t
(save-excursion
(set-buffer (get-buffer-create " *urlparse*"))
(set-syntax-table url-parse-syntax-table)
(let ((save-pos nil)
(prot nil)
(user nil)
(pass nil)
(host nil)
(port nil)
(file nil)
(refs nil)
(attr nil)
(full nil)
(inhibit-read-only t))
(erase-buffer)
(insert url)
(goto-char (point-min))
(setq save-pos (point))
(if (not (looking-at "//"))
(progn
(skip-chars-forward "a-zA-Z+.\\-")
(downcase-region save-pos (point))
(setq prot (buffer-substring save-pos (point)))
(skip-chars-forward ":")
(setq save-pos (point))))
;; We are doing a fully specified URL, with hostname and all
(if (looking-at "//")
(progn
(setq full t)
(forward-char 2)
(setq save-pos (point))
(skip-chars-forward "^/")
(setq host (buffer-substring save-pos (point)))
(if (string-match "^\\([^@]+\\)@" host)
(setq user (match-string 1 host)
host (substring host (match-end 0) nil)))
(if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
(setq pass (match-string 2 user)
user (match-string 1 user)))
(if (string-match ":\\([0-9+]+\\)" host)
(setq port (string-to-int (match-string 1 host))
host (substring host 0 (match-beginning 0))))
(if (string-match ":$" host)
(setq host (substring host 0 (match-beginning 0))))
(setq host (downcase host)
save-pos (point))))
(if (not port)
(setq port (url-scheme-get-property prot 'default-port)))
;; Gross hack to preserve ';' in data URLs
(setq save-pos (point))
(if (string= "data" prot)
(goto-char (point-max))
;; Now check for references
(skip-chars-forward "^#")
(if (eobp)
nil
(delete-region
(point)
(progn
(skip-chars-forward "#")
(setq refs (buffer-substring (point) (point-max)))
(point-max))))
(goto-char save-pos)
(skip-chars-forward "^;")
(if (not (eobp))
(setq attr (url-parse-args (buffer-substring (point) (point-max)) t)
attr (nreverse attr))))
(setq file (buffer-substring save-pos (point)))
(if (and host (string-match "%[0-9][0-9]" host))
(setq host (url-unhex-string host)))
(vector prot user pass host port file refs attr full))))))
(provide 'url-parse)
;; arch-tag: f338325f-71ab-4bee-93cc-78fb9a03d403
;;; url-parse.el ends here

81
lisp/url/url-privacy.el Normal file
View file

@ -0,0 +1,81 @@
;;; url-privacy.el --- Global history tracking for URL package
;; Keywords: comm, data, processes, hypermedia
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(eval-when-compile (require 'cl))
(require 'url-vars)
(if (fboundp 'device-type)
(defalias 'url-device-type 'device-type)
(defun url-device-type (&optional device) (or window-system 'tty)))
;;;###autoload
(defun url-setup-privacy-info ()
(interactive)
(setq url-system-type
(cond
((or (eq url-privacy-level 'paranoid)
(and (listp url-privacy-level)
(memq 'os url-privacy-level)))
nil)
;; First, we handle the inseparable OS/Windowing system
;; combinations
((eq system-type 'Apple-Macintosh) "Macintosh")
((eq system-type 'next-mach) "NeXT")
((eq system-type 'windows-nt) "Windows-NT; 32bit")
((eq system-type 'ms-windows) "Windows; 16bit")
((eq system-type 'ms-dos) "MS-DOS; 32bit")
((memq (url-device-type) '(win32 w32)) "Windows; 32bit")
((eq (url-device-type) 'pm) "OS/2; 32bit")
(t
(case (url-device-type)
(x "X11")
(ns "OpenStep")
(tty "TTY")
(otherwise nil)))))
(setq url-personal-mail-address (or url-personal-mail-address
user-mail-address
(format "%s@%s" (user-real-login-name)
(system-name))))
(if (or (memq url-privacy-level '(paranoid high))
(and (listp url-privacy-level)
(memq 'email url-privacy-level)))
(setq url-personal-mail-address nil))
(setq url-os-type
(cond
((or (eq url-privacy-level 'paranoid)
(and (listp url-privacy-level)
(memq 'os url-privacy-level)))
nil)
((boundp 'system-configuration)
system-configuration)
((boundp 'system-type)
(symbol-name system-type))
(t nil))))
(provide 'url-privacy)
;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d

3
lisp/url/url-util.el
View file

@ -1,7 +1,6 @@
;;; url-util.el --- Miscellaneous helper routines for URL library
;; Copyright (c) 1996,97,98,99,2001,2004 Free Software Foundation, Inc.
;; Copyright (c) 1993 - 1996 by William M. Perry <wmperry@cs.indiana.edu>
;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes

431
lisp/url/url-vars.el Normal file
View file

@ -0,0 +1,431 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool
;; Keywords: comm, data, processes, hypermedia
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
;;;
;;; This file is part of GNU Emacs.
;;;
;;; GNU Emacs is free software; you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 2, or (at your option)
;;; any later version.
;;;
;;; GNU Emacs is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Emacs; see the file COPYING. If not, write to the
;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;;; Boston, MA 02111-1307, USA.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'mm-util)
(defconst url-version "Emacs"
"Version number of URL package.")
(defgroup url nil
"Uniform Resource Locator tool"
:version "21.4"
:group 'hypermedia)
(defgroup url-file nil
"URL storage"
:prefix "url-"
:group 'url)
(defgroup url-cache nil
"URL cache"
:prefix "url-"
:prefix "url-cache-"
:group 'url)
(defgroup url-mime nil
"MIME options of URL"
:prefix "url-"
:group 'url)
(defgroup url-hairy nil
"Hairy options of URL"
:prefix "url-"
:group 'url)
(defvar url-current-object nil
"A parsed representation of the current url.")
(defvar url-current-mime-headers nil
"A parsed representation of the MIME headers for the current url.")
(mapcar 'make-variable-buffer-local
'(
url-current-object
url-current-referer
url-current-mime-headers
))
(defcustom url-honor-refresh-requests t
"*Whether to do automatic page reloads.
These are done at the request of the document author or the server via
the `Refresh' header in an HTTP response. If nil, no refresh
requests will be honored. If t, all refresh requests will be honored.
If non-nil and not t, the user will be asked for each refresh
request."
:type '(choice (const :tag "off" nil)
(const :tag "on" t)
(const :tag "ask" 'ask))
:group 'url-hairy)
(defcustom url-automatic-caching nil
"*If non-nil, all documents will be automatically cached to the local disk."
:type 'boolean
:group 'url-cache)
;; Fixme: sanitize this.
(defcustom url-cache-expired
(lambda (t1 t2) (>= (- (car t2) (car t1)) 5))
"*A function determining if a cached item has expired.
It takes two times (numbers) as its arguments, and returns non-nil if
the second time is 'too old' when compared to the first time."
:type 'function
:group 'url-cache)
(defconst url-bug-address "bug-gnu-emacs@gnu.org"
"Where to send bug reports.")
(defcustom url-personal-mail-address nil
"*Your full email address.
This is what is sent to HTTP servers as the FROM field in an HTTP
request."
:type '(choice (const :tag "Unspecified" nil) string)
:group 'url)
(defcustom url-directory-index-file "index.html"
"*The filename to look for when indexing a directory.
If this file exists, and is readable, then it will be viewed instead of
using `dired' to view the directory."
:type 'string
:group 'url-file)
;; Fixme: this should have a setter which calls url-setup-privacy-info.
(defcustom url-privacy-level '(email)
"*How private you want your requests to be.
HTTP has header fields for various information about the user, including
operating system information, email addresses, the last page you visited, etc.
This variable controls how much of this information is sent.
This should a symbol or a list.
Valid values if a symbol are:
none -- Send all information
low -- Don't send the last location
high -- Don't send the email address or last location
paranoid -- Don't send anything
If a list, this should be a list of symbols of what NOT to send.
Valid symbols are:
email -- the email address
os -- the operating system info
lastloc -- the last location
agent -- Do not send the User-Agent string
cookie -- never accept HTTP cookies
Samples:
(setq url-privacy-level 'high)
(setq url-privacy-level '(email lastloc)) ;; equivalent to 'high
(setq url-privacy-level '(os))
::NOTE::
This variable controls several other variables and is _NOT_ automatically
updated. Call the function `url-setup-privacy-info' after modifying this
variable."
:type '(radio (const :tag "None (you believe in the basic goodness of humanity)"
:value none)
(const :tag "Low (do not reveal last location)"
:value low)
(const :tag "High (no email address or last location)"
:value high)
(const :tag "Paranoid (reveal nothing!)"
:value paranoid)
(checklist :tag "Custom"
(const :tag "Email address" :value email)
(const :tag "Operating system" :value os)
(const :tag "Last location" :value lastloc)
(const :tag "Browser identification" :value agent)
(const :tag "No cookies" :value cookie)))
:group 'url)
(defvar url-inhibit-uncompression nil "Do not do decompression if non-nil.")
(defcustom url-uncompressor-alist '((".z" . "x-gzip")
(".gz" . "x-gzip")
(".uue" . "x-uuencoded")
(".hqx" . "x-hqx")
(".Z" . "x-compress")
(".bz2" . "x-bzip2"))
"*An alist of file extensions and appropriate content-transfer-encodings."
:type '(repeat (cons :format "%v"
(string :tag "Extension")
(string :tag "Encoding")))
:group 'url-mime)
(defcustom url-mail-command (if (fboundp 'compose-mail)
'compose-mail
'url-mail)
"*This function will be called whenever url needs to send mail.
It should enter a mail-mode-like buffer in the current window.
The commands `mail-to' and `mail-subject' should still work in this
buffer, and it should use `mail-header-separator' if possible."
:type 'function
:group 'url)
(defcustom url-proxy-services nil
"*An alist of schemes and proxy servers that gateway them.
Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up
from the ACCESS_proxy environment variables."
:type '(repeat (cons :format "%v"
(string :tag "Protocol")
(string :tag "Proxy")))
:group 'url)
(defcustom url-passwd-entry-func nil
"*Symbol indicating which function to call to read in a password.
It will be set up depending on whether you are running EFS or ange-ftp
at startup if it is nil. This function should accept the prompt
string as its first argument, and the default value as its second
argument."
:type '(choice (const :tag "Guess" :value nil)
(const :tag "Use Ange-FTP" :value ange-ftp-read-passwd)
(const :tag "Use EFS" :value efs-read-passwd)
(const :tag "Use Password Package" :value read-passwd)
(function :tag "Other"))
:group 'url-hairy)
(defcustom url-standalone-mode nil
"*Rely solely on the cache?"
:type 'boolean
:group 'url-cache)
(defvar url-mime-separator-chars (mapcar 'identity
(concat "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
"abcdefghijklmnopqrstuvwxyz"
"0123456789'()+_,-./=?"))
"Characters allowable in a MIME multipart separator.")
(defcustom url-bad-port-list
'("25" "119" "19")
"*List of ports to warn the user about connecting to.
Defaults to just the mail, chargen, and NNTP ports so you cannot be
tricked into sending fake mail or forging messages by a malicious HTML
document."
:type '(repeat (string :tag "Port"))
:group 'url-hairy)
(defvar url-mime-content-type-charset-regexp
";[ \t]*charset=\"?\\([^\"]+\\)\"?"
"Regexp used in parsing `Content-Type' for a charset indication.")
(defvar url-request-data nil "Any data to send with the next request.")
(defvar url-request-extra-headers nil
"A list of extra headers to send with the next request.
Should be an assoc list of headers/contents.")
(defvar url-request-method nil "The method to use for the next request.")
;; FIXME!! (RFC 2616 gives examples like `compress, gzip'.)
(defvar url-mime-encoding-string nil
"*String to send in the Accept-encoding: field in HTTP requests.")
;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose
;; cars aren't valid MIME charsets/coding systems, at least in Emacs.
;; This gets it correct by construction in Emacs. Fixme: DTRT for
;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg.
(when (and (not (featurep 'xemacs))
(fboundp 'coding-system-list))
(setq mm-mime-mule-charset-alist
(apply
'nconc
(mapcar
(lambda (cs)
(when (and (coding-system-get cs 'mime-charset)
(not (eq t (coding-system-get cs 'safe-charsets))))
(list (cons (coding-system-get cs 'mime-charset)
(delq 'ascii
(coding-system-get cs 'safe-charsets))))))
(coding-system-list 'base-only)))))
;; Perhaps the first few should actually be given decreasing `q's and
;; the list should be trimmed significantly.
;; Fixme: do something sane if we don't have `sort-coding-systems'
;; (Emacs 20, XEmacs).
(defun url-mime-charset-string ()
"Generate a list of preferred MIME charsets for HTTP requests.
Generated according to current coding system priorities."
(if (fboundp 'sort-coding-systems)
(let ((ordered (sort-coding-systems
(let (accum)
(dolist (elt mm-mime-mule-charset-alist)
(if (mm-coding-system-p (car elt))
(push (car elt) accum)))
(nreverse accum)))))
(concat (format "%s;q=1, " (pop ordered))
(mapconcat 'symbol-name ordered ";q=0.5, ")
";q=0.5"))))
(defvar url-mime-charset-string (url-mime-charset-string)
"*String to send in the Accept-charset: field in HTTP requests.
The MIME charset corresponding to the most preferred coding system is
given priority 1 and the rest are given priority 0.5.")
(defun url-set-mime-charset-string ()
(setq url-mime-charset-string (url-mime-charset-string)))
;; Regenerate if the language environment changes.
(add-hook 'set-language-environment-hook 'url-set-mime-charset-string)
;; Fixme: set from the locale.
(defcustom url-mime-language-string nil
"*String to send in the Accept-language: field in HTTP requests.
Specifies the preferred language when servers can serve documents in
several languages. Use RFC 1766 abbreviations, e.g.@: `en' for
English, `de' for German. A comma-separated specifies descending
order of preference. The ordering can be made explicit using `q'
factors defined by HTTP, e.g. `de,en-gb;q=0.8,en;q=0.7'. `*' means
get the first available language (as opposed to the default)."
:type '(radio
(const :tag "None (get default language version)" :value nil)
(const :tag "Any (get first available language version)" :value "*")
(string :tag "Other"))
:group 'url-mime
:group 'i18n)
(defvar url-mime-accept-string nil
"String to send to the server in the Accept: field in HTTP requests.")
(defvar url-package-version nil
"Version number of package using URL.")
(defvar url-package-name nil "Version number of package using URL.")
(defvar url-system-type nil
"What type of system we are on.")
(defvar url-os-type nil
"What OS we are on.")
(defcustom url-max-password-attempts 5
"*Maximum number of times a password will be prompted for.
Applies when a protected document is denied by the server."
:type 'integer
:group 'url)
(defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp")
"*Where temporary files go."
:type 'directory
:group 'url-file)
(defcustom url-show-status t
"*Whether to show a running total of bytes transferred.
Can cause a large hit if using a remote X display over a slow link, or
a terminal with a slow modem."
:type 'boolean
:group 'url)
(defvar url-using-proxy nil
"Either nil or the fully qualified proxy URL in use, e.g.
http://www.domain.com/")
(defcustom url-news-server nil
"*The default news server from which to get newsgroups/articles.
Applies if no server is specified in the URL. Defaults to the
environment variable NNTPSERVER or \"news\" if NNTPSERVER is
undefined."
:type '(choice (const :tag "None" :value nil) string)
:group 'url)
(defvar url-nonrelative-link
"\\`\\([-a-zA-Z0-9+.]+:\\)"
"A regular expression that will match an absolute URL.")
(defcustom url-confirmation-func 'y-or-n-p
"*What function to use for asking yes or no functions.
Possible values are `yes-or-no-p' or `y-or-n-p', or any function that
takes a single argument (the prompt), and returns t only if a positive
answer is given."
:type '(choice (const :tag "Short (y or n)" :value y-or-n-p)
(const :tag "Long (yes or no)" :value yes-or-no-p)
(function :tag "Other"))
:group 'url-hairy)
(defcustom url-gateway-method 'native
"*The type of gateway support to use.
Should be a symbol specifying how to get a connection from the local machine.
Currently supported methods:
`telnet': Run telnet in a subprocess to connect;
`rlogin': Rlogin to another machine to connect;
`socks': Connect through a socks server;
`tls': Connect with TLS;
`ssl': Connect with SSL (deprecated, use `tls' instead);
`native': Connect directy."
:type '(radio (const :tag "Telnet to gateway host" :value telnet)
(const :tag "Rlogin to gateway host" :value rlogin)
(const :tag "Use SOCKS proxy" :value socks)
(const :tag "Use SSL/TLS for all connections" :value tls)
(const :tag "Use SSL for all connections (obsolete)" :value ssl)
(const :tag "Direct connection" :value native))
:group 'url-hairy)
(defvar url-setup-done nil "Has setup configuration been done?")
(defconst weekday-alist
'(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3)
("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6)
("Tues" . 2) ("Thurs" . 4)
("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3)
("Thu" . 4) ("Fri" . 5) ("Sat" . 6)))
(defconst monthabbrev-alist
'(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6)
("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11)
("Dec" . 12)))
(defvar url-lazy-message-time 0)
;; Fixme: We may not be able to run SSL.
(defvar url-extensions-header "Security/Digest Security/SSL")
(defvar url-parse-syntax-table
(copy-syntax-table emacs-lisp-mode-syntax-table)
"*A syntax table for parsing URLs.")
(modify-syntax-entry ?' "\"" url-parse-syntax-table)
(modify-syntax-entry ?` "\"" url-parse-syntax-table)
(modify-syntax-entry ?< "(>" url-parse-syntax-table)
(modify-syntax-entry ?> ")<" url-parse-syntax-table)
(modify-syntax-entry ?/ " " url-parse-syntax-table)
(defvar url-load-hook nil
"*Hooks to be run after initalizing the URL library.")
;;; Make OS/2 happy - yeeks
;; (defvar tcp-binary-process-input-services nil
;; "*Make OS/2 happy with our CRLF pairs...")
(defconst url-working-buffer " *url-work")
(defvar url-gateway-unplugged nil
"Non-nil means don't open new network connexions.
This should be set, e.g. by mail user agents rendering HTML to avoid
`bugs' which call home.")
(defun url-vars-unload-hook ()
(remove-hook 'set-language-environment-hook 'url-set-mime-charset-string))
(provide 'url-vars)
;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49
;;; url-vars.el ends here

269
lisp/url/url.el Normal file
View file

@ -0,0 +1,269 @@
;;; url.el --- Uniform Resource Locator retrieval tool
;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
;; Author: Bill Perry <wmperry@gnu.org>
;; Keywords: comm, data, processes, hypermedia
;; This file is part of GNU Emacs.
;;
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;;
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
;;; Commentary:
;; Registered URI schemes: http://www.iana.org/assignments/uri-schemes
;;; Code:
(eval-when-compile (require 'cl))
;; Don't require CL at runtime if we can avoid it (Emacs 21).
;; Otherwise we need it for hashing functions. `puthash' was never
;; defined in the Emacs 20 cl.el for some reason.
(if (fboundp 'puthash)
nil ; internal or CL is loaded
(defalias 'puthash 'cl-puthash)
(autoload 'cl-puthash "cl")
(autoload 'gethash "cl")
(autoload 'maphash "cl")
(autoload 'make-hash-table "cl"))
(eval-when-compile
(require 'mm-decode)
(require 'mm-view))
(require 'mailcap)
(require 'url-vars)
(require 'url-cookie)
(require 'url-history)
(require 'url-expand)
(require 'url-privacy)
(require 'url-methods)
(require 'url-proxy)
(require 'url-parse)
(require 'url-util)
;; Fixme: customize? convert-standard-filename?
;;;###autoload
(defvar url-configuration-directory "~/.url")
(defun url-do-setup ()
"Setup the url package.
This is to avoid conflict with user settings if URL is dumped with
Emacs."
(unless url-setup-done
;; Make OS/2 happy
;;(push '("http" "80") tcp-binary-process-input-services)
(mailcap-parse-mailcaps)
(mailcap-parse-mimetypes)
;; Register all the authentication schemes we can handle
(url-register-auth-scheme "basic" nil 4)
(url-register-auth-scheme "digest" nil 7)
(setq url-cookie-file
(or url-cookie-file
(expand-file-name "cookies" url-configuration-directory)))
(setq url-history-file
(or url-history-file
(expand-file-name "history" url-configuration-directory)))
;; Parse the global history file if it exists, so that it can be used
;; for URL completion, etc.
(url-history-parse-history)
(url-history-setup-save-timer)
;; Ditto for cookies
(url-cookie-setup-save-timer)
(url-cookie-parse-file url-cookie-file)
;; Read in proxy gateways
(let ((noproxy (and (not (assoc "no_proxy" url-proxy-services))
(or (getenv "NO_PROXY")
(getenv "no_PROXY")
(getenv "no_proxy")))))
(if noproxy
(setq url-proxy-services
(cons (cons "no_proxy"
(concat "\\("
(mapconcat
(lambda (x)
(cond
((= x ?,) "\\|")
((= x ? ) "")
((= x ?.) (regexp-quote "."))
((= x ?*) ".*")
((= x ??) ".")
(t (char-to-string x))))
noproxy "") "\\)"))
url-proxy-services))))
;; Set the password entry funtion based on user defaults or guess
;; based on which remote-file-access package they are using.
(cond
(url-passwd-entry-func nil) ; Already been set
((fboundp 'read-passwd) ; Use secure password if available
(setq url-passwd-entry-func 'read-passwd))
((or (featurep 'efs) ; Using EFS
(featurep 'efs-auto)) ; or autoloading efs
(if (not (fboundp 'read-passwd))
(autoload 'read-passwd "passwd" "Read in a password" nil))
(setq url-passwd-entry-func 'read-passwd))
((or (featurep 'ange-ftp) ; Using ange-ftp
(and (boundp 'file-name-handler-alist)
(not (featurep 'xemacs)))) ; ??
(setq url-passwd-entry-func 'ange-ftp-read-passwd))
(t
(url-warn
'security
"(url-setup): Can't determine how to read passwords, winging it.")))
(url-setup-privacy-info)
(run-hooks 'url-load-hook)
(setq url-setup-done t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Retrieval functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun url-retrieve (url callback &optional cbargs)
"Retrieve URL asynchronously and call CALLBACK with CBARGS when finished.
The callback is called when the object has been completely retrieved, with
the current buffer containing the object, and any MIME headers associated
with it. URL is either a string or a parsed URL.
Return the buffer URL will load into, or nil if the process has
already completed."
(url-do-setup)
(url-gc-dead-buffers)
(if (stringp url)
(set-text-properties 0 (length url) nil url))
(if (not (vectorp url))
(setq url (url-generic-parse-url url)))
(if (not (functionp callback))
(error "Must provide a callback function to url-retrieve"))
(unless (url-type url)
(error "Bad url: %s" (url-recreate-url url)))
(let ((loader (url-scheme-get-property (url-type url) 'loader))
(url-using-proxy (if (url-host url)
(url-find-proxy-for-url url (url-host url))))
(buffer nil)
(asynch (url-scheme-get-property (url-type url) 'asynchronous-p)))
(if url-using-proxy
(setq asynch t
loader 'url-proxy))
(if asynch
(setq buffer (funcall loader url callback cbargs))
(setq buffer (funcall loader url))
(if buffer
(with-current-buffer buffer
(apply callback cbargs))))
(url-history-update-url url (current-time))
buffer))
(defun url-retrieve-synchronously (url)
"Retrieve URL synchronously.
Return the buffer containing the data, or nil if there are no data
associated with it (the case for dired, info, or mailto URLs that need
no further processing). URL is either a string or a parsed URL."
(url-do-setup)
(lexical-let ((retrieval-done nil)
(asynch-buffer nil))
(setq asynch-buffer
(url-retrieve url (lambda (&rest ignored)
(url-debug 'retrieval "Synchronous fetching done (%S)" (current-buffer))
(setq retrieval-done t
asynch-buffer (current-buffer)))))
(if (not asynch-buffer)
;; We do not need to do anything, it was a mailto or something
;; similar that takes processing completely outside of the URL
;; package.
nil
(while (not retrieval-done)
(url-debug 'retrieval "Spinning in url-retrieve-synchronously: %S (%S)"
retrieval-done asynch-buffer)
;; Quoth Stef:
;; It turns out that the problem seems to be that the (sit-for
;; 0.1) below doesn't actually process the data: instead it
;; returns immediately because there is keyboard input
;; waiting, so we end up spinning endlessly waiting for the
;; process to finish while not letting it finish.
;; However, raman claims that it blocks Emacs with Emacspeak
;; for unexplained reasons. Put back for his benefit until
;; someone can understand it.
;; (sleep-for 0.1)
(sit-for 0.1))
asynch-buffer)))
(defun url-mm-callback (&rest ignored)
(let ((handle (mm-dissect-buffer t)))
(save-excursion
(url-mark-buffer-as-dead (current-buffer))
(set-buffer (generate-new-buffer (url-recreate-url url-current-object)))
(if (eq (mm-display-part handle) 'external)
(progn
(set-process-sentinel
;; Fixme: this shouldn't have to know the form of the
;; undisplayer produced by `mm-display-part'.
(get-buffer-process (cdr (mm-handle-undisplayer handle)))
`(lambda (proc event)
(mm-destroy-parts (quote ,handle))))
(message "Viewing externally")
(kill-buffer (current-buffer)))
(display-buffer (current-buffer))
(mm-destroy-parts handle)))))
(defun url-mm-url (url)
"Retrieve URL and pass to the appropriate viewing application."
(require 'mm-decode)
(require 'mm-view)
(url-retrieve url 'url-mm-callback nil))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Miscellaneous
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar url-dead-buffer-list nil)
(defun url-mark-buffer-as-dead (buff)
(push buff url-dead-buffer-list))
(defun url-gc-dead-buffers ()
(let ((buff))
(while (setq buff (pop url-dead-buffer-list))
(if (buffer-live-p buff)
(kill-buffer buff)))))
(cond
((fboundp 'display-warning)
(defalias 'url-warn 'display-warning))
((fboundp 'warn)
(defun url-warn (class message &optional level)
(warn "(%s/%s) %s" class (or level 'warning) message)))
(t
(defun url-warn (class message &optional level)
(with-current-buffer (get-buffer-create "*URL-WARNINGS*")
(goto-char (point-max))
(save-excursion
(insert (format "(%s/%s) %s\n" class (or level 'warning) message)))
(display-buffer (current-buffer))))))
(provide 'url)
;; arch-tag: bc182f1f-d187-4f10-b961-47af2066579a
;;; url.el ends here

5
lisp/vc.el
View file

@ -646,9 +646,6 @@ List of factors, used to expand/compress the time scale. See `vc-annotate'."
:group 'vc)
;; vc-annotate functionality (CVS only).
(defvar vc-annotate-mode nil
"Variable indicating if VC-Annotate mode is active.")
(defvar vc-annotate-mode-map
(let ((m (make-sparse-keymap)))
(define-key m [menu-bar] (make-sparse-keymap "VC-Annotate"))
@ -3004,7 +3001,7 @@ use; you may override this using the second optional arg MODE."
(when buffer
(set-buffer buffer)
(display-buffer buffer))
(if (not vc-annotate-mode) ; Turn on vc-annotate-mode if not done
(if (not vc-annotate-parent-rev)
(vc-annotate-mode))
(cond ((null vc-annotate-display-mode)
(vc-annotate-display-default vc-annotate-ratio))

23
lisp/xml.el
View file

@ -598,8 +598,8 @@ This follows the rule [28] in the XML specifications."
nil)
(t
(if xml-validating-parser
error "XML: (Validity) Invalid element type in the DTD")))
(error "XML: (Validity) Invalid element type in the DTD"))))
;; rule [45]: the element declaration must be unique
(if (and (assoc element dtd)
xml-validating-parser)
@ -727,14 +727,9 @@ This follows the rule [28] in the XML specifications."
(match-string 1 this-part)))))))
(cond ((null children)
(if (stringp expansion)
(setq children (concat prev-part expansion))
(if (stringp (car (last expansion)))
(progn
(setq children
(list (concat prev-part (car expansion))
(cdr expansion))))
(setq children (append expansion prev-part)))))
;; FIXME: If we have an entity that expands into XML, this won't work.
(setq children
(concat prev-part expansion)))
((stringp children)
(if (stringp expansion)
(setq children (concat children prev-part expansion))
@ -756,11 +751,15 @@ This follows the rule [28] in the XML specifications."
(cond ((stringp children)
(concat children (substring string point)))
((stringp (car (last children)))
(concat (car children) (substring string point)))
(concat (car (last children)) (substring string point)))
((null children)
string)
(t
(nreverse children)))))
(concat (mapconcat 'identity
(nreverse children)
"")
(substring string point))))))
;;*******************************************************************
;;**
;;** Printing a tree.

47
lispintro/emacs-lisp-intro.texi
View file

@ -1,6 +1,7 @@
@c \input texinfo @c -*-texinfo-*-
\input texinfo @c -*-texinfo-*-
@comment %**start of header
@setfilename ../info/eintr
@c setfilename emacs-lisp-intro.info
@c sethtmlfilename emacs-lisp-intro.html
@settitle Programming in Emacs Lisp
@syncodeindex vr cp
@ -21,8 +22,8 @@
@comment %**end of header
@set edition-number 2.12
@set update-date 2003 Nov 19
@set edition-number 2.14
@set update-date 2004 Oct 12
@ignore
## Summary of shell commands to create various output formats:
@ -61,6 +62,8 @@
## View Info output with standalone reader
info emacs-lisp-intro.info
## popd
@end ignore
@c ================ Included Figures ================
@ -180,7 +183,7 @@ people who are not programmers.
Edition @value{edition-number}, @value{update-date}
@sp 1
Copyright @copyright{} 1990, 1991, 1992, 1993, 1994, 1995, 1997, 2001,
2002, 2003 Free Software Foundation, Inc.
2002, 2003, 2004 Free Software Foundation, Inc.
@sp 1
@iftex
@ -1050,13 +1053,16 @@ Robert J. Chassell
@chapter List Processing
To the untutored eye, Lisp is a strange programming language. In Lisp
code there are parentheses everywhere. Some people even claim that the
name stands for `Lots of Isolated Silly Parentheses'. But the claim is
unwarranted. Lisp stands for LISt Processing, and the programming
language handles @emph{lists} (and lists of lists) by putting them
between parentheses. The parentheses mark the boundaries of the list.
Sometimes a list is preceded by a single apostrophe or quotation mark,
@samp{'}. Lists are the basis of Lisp.
code there are parentheses everywhere. Some people even claim that
the name stands for `Lots of Isolated Silly Parentheses'. But the
claim is unwarranted. Lisp stands for LISt Processing, and the
programming language handles @emph{lists} (and lists of lists) by
putting them between parentheses. The parentheses mark the boundaries
of the list. Sometimes a list is preceded by a single apostrophe or
quotation mark, @samp{'}@footnote{The single apostrophe or quotation
mark is an abbreviation for the function @code{quote}; you need not
think about functions now; functions are defined in @ref{Making
Errors, , Generate an Error Message}.} Lists are the basis of Lisp.
@menu
* Lisp Lists:: What are lists?
@ -2135,7 +2141,8 @@ Debugger entered--Lisp error:
@need 1250
As usual, the error message tries to be helpful and makes sense after you
learn how to read it.
learn how to read it.@footnote{@code{(quote hello)} is an expansion of
the abbreviation @code{'hello}.}
The first part of the error message is straightforward; it says
@samp{wrong type argument}. Next comes the mysterious jargon word
@ -4002,7 +4009,7 @@ the @dfn{else-part}, for the case when the true-or-false-test returns
false. When this happens, the second argument or then-part of the
overall @code{if} expression is @emph{not} evaluated, but the third or
else-part @emph{is} evaluated. You might think of this as the cloudy
day alternative for the decision `if it is warm and sunny, then go to
day alternative for the decision ``if it is warm and sunny, then go to
the beach, else read a book!''.
The word ``else'' is not written in the Lisp code; the else-part of an
@ -14924,10 +14931,10 @@ Here is the function:
((eq t (car (cdr (car current-directory-list))))
;; decide whether to skip or recurse
(if
(equal (or "." "..")
(equal "."
(substring (car (car current-directory-list)) -1))
;; then do nothing if filename is that of
;; current directory or parent
;; then do nothing since filename is that of
;; current directory or parent, "." or ".."
()
@end group
@group
@ -17118,7 +17125,7 @@ problem recently.)
@item Ignore case when using `grep'@*
@samp{-n}@w{ } Prefix each line of output with line number@*
@samp{-i}@w{ } Ignore case distinctions@*
@samp{-e}@w{ } Protect patterns beginning with a hyphen character, @samp{-}
@samp{-e}@w{ } Protect patterns beginning with a hyphen character, @samp{-}
@smallexample
(setq grep-command "grep -n -i -e ")
@ -17159,7 +17166,7 @@ If you want to write with Chinese `GB' characters, set this instead:
@end itemize
@subsubheading Fixing Unpleasant Key Bindings
@cindex Key bindings, fixing
@cindex Key bindings, fixing
@cindex Bindings, key, fixing unpleasant
Some systems bind keys unpleasantly. Sometimes, for example, the
@ -18018,7 +18025,7 @@ beginning.
Sometimes when you you write text, you duplicate words---as with ``you
you'' near the beginning of this sentence. I find that most
frequently, I duplicate ``the'; hence, I call the function for
frequently, I duplicate ``the''; hence, I call the function for
detecting duplicated words, @code{the-the}.
@need 1250
@ -20638,6 +20645,7 @@ each column."
@end smallexample
@end ifnottex
@c qqq
@ignore
Graphing Definitions Re-listed
@ -21137,6 +21145,7 @@ each column."
(print-X-axis numbers-list horizontal-step)))
@end group
@end smallexample
@c qqq
@end ignore
@page

18
lispref/ChangeLog
View file

@ -1,3 +1,21 @@
2004-10-09 Luc Teirlinck <teirllm@auburn.edu>
* text.texi (Filling): Add anchor for definition of
`sentence-end-double-space'.
* searching.texi (Regexp Example): Update description of how
Emacs currently recognizes the end of a sentence.
(Standard Regexps): Update definition of the variable
`sentence-end'. Add definition of the function `sentence-end'.
2004-10-08 Paul Pogonyshev <pogonyshev@gmx.net>
* display.texi (Progress): New node.
2004-10-05 Kim F. Storm <storm@cua.dk>
* display.texi (Fringe Bitmaps): Update fringe-bitmaps-at-pos.
2004-09-29 Kim F. Storm <storm@cua.dk>
* display.texi (Fringe Bitmaps): Use symbols rather than numbers

104
lispref/display.texi
View file

@ -16,6 +16,7 @@ that Emacs presents to the user.
* Truncation:: Folding or wrapping long text lines.
* The Echo Area:: Where messages are displayed.
* Warnings:: Displaying warning messages for the user.
* Progress:: Informing user about progress of a long operation.
* Invisible Text:: Hiding part of the buffer text.
* Selective Display:: Hiding part of the buffer text (the old way).
* Overlay Arrow:: Display of an arrow to indicate position.
@ -533,6 +534,104 @@ symbols. If it matches the first few elements in a warning type, then
that warning is not logged.
@end defopt
@node Progress
@section Reporting Operation Progress
@cindex progress reporting
When an operation can take a while to finish, you should inform the
user about the progress it makes. This way the user can estimate
remaining time and clearly see that Emacs is busy working, not hung.
Functions listed in this section provide simple and efficient way of
reporting operation progress. Here is a working example that does
nothing useful:
@example
(let ((progress-reporter
(make-progress-reporter "Collecting some mana for Emacs..."
0 500)))
(dotimes (k 500)
(sit-for 0.01)
(progress-reporter-update progress-reporter k))
(progress-reporter-done progress-reporter))
@end example
@defun make-progress-reporter message min-value max-value &optional current-value min-change min-time
This function creates a progress reporter---the object you will use as
an argument for all other functions listed here. The idea is to
precompute as much data as possible to make progress reporting very
fast.
The @var{message} will be displayed in the echo area, followed by
progress percentage. @var{message} is treated as a simple string. If
you need it to depend on a filename, for instance, use @code{format}
before calling this function.
@var{min-value} and @var{max-value} arguments stand for starting and
final states of your operation. For instance, if you scan a buffer,
they should be the results of @code{point-min} and @code{point-max}
correspondingly. It is required that @var{max-value} is greater than
@var{min-value}. If you create progress reporter when some part of
the operation has already been completed, then specify
@var{current-value} argument. But normally you should omit it or set
it to @code{nil}---it will default to @var{min-value} then.
Remaining arguments control the rate of echo area updates. Progress
reporter will wait for at least @var{min-change} more percents of the
operation to be completed before printing next message.
@var{min-time} specifies the minimum time in seconds to pass between
successive prints. It can be fractional. Depending on Emacs and
system capabilities, progress reporter may or may not respect this
last argument or do it with varying precision. Default value for
@var{min-change} is 1 (one percent), for @var{min-time}---0.2
(seconds.)
This function calls @code{progress-reporter-update}, so the first
message is printed immediately.
@end defun
@defun progress-reporter-update reporter value
This function does the main work of reporting progress of your
operation. It print the message of @var{reporter} followed by
progress percentage determined by @var{value}. If percentage is zero,
then it is not printed at all.
@var{reporter} must be the result of a call to
@code{make-progress-reporter}. @var{value} specifies the current
state of your operation and must be between @var{min-value} and
@var{max-value} (inclusive) as passed to
@code{make-progress-reporter}. For instance, if you scan a buffer,
then @var{value} should be the result of a call to @code{point}.
This function respects @var{min-change} and @var{min-time} as passed
to @code{make-progress-reporter} and so does not output new messages
on every invocation. It is thus very fast and normally you should not
try to reduce the number of calls to it: resulting overhead will most
likely negate your effort.
@end defun
@defun progress-reporter-force-update reporter value &optional new-message
This function is similar to @code{progress-reporter-update} except
that it prints a message in the echo area unconditionally.
The first two arguments have the same meaning as for
@code{progress-reporter-update}. Optional @var{new-message} allows
you to change the message of the @var{reporter}. Since this functions
always updates the echo area, such a change will be immediately
presented to the user.
@end defun
@defun progress-reporter-done reporter
This function should be called when the operation is finished. It
prints the message of @var{reporter} followed by word ``done'' in the
echo area.
You should always call this function and not hope for
@code{progress-reporter-update} to print ``100%.'' Firstly, it may
never print it, there are many good reasons for this not to happen.
Secondly, ``done'' is more explicit.
@end defun
@node Invisible Text
@section Invisible Text
@ -2655,9 +2754,10 @@ symbols have their own name space.
@defun fringe-bitmaps-at-pos &optional pos window
This function returns the fringe bitmaps of the display line
containing position @var{pos} in window @var{window}. The return
value has the form @code{(@var{left} . @var{right})}, where @var{left}
value has the form @code{(@var{left} @var{right} @var{ov})}, where @var{left}
is the symbol for the fringe bitmap in the left fringe (or @code{nil}
if no bitmap), and @var{right} is similar for the right fringe.
if no bitmap), @var{right} is similar for the right fringe, and @var{ov}
is non-@code{nil} if there is an overlay arrow in the left fringe.
The value is @code{nil} if @var{pos} is not visible in @var{window}.
If @var{window} is @code{nil}, that stands for the selected window.

44
lispref/searching.texi
View file

@ -1,6 +1,6 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999
@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2004
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/searching
@ -694,9 +694,9 @@ an @code{invalid-regexp} error is signaled.
Here is a complicated regexp which was formerly used by Emacs to
recognize the end of a sentence together with any whitespace that
follows. It was used as the variable @code{sentence-end}. (Its value
nowadays contains alternatives for @samp{.}, @samp{?} and @samp{!} in
other character sets.)
follows. (Nowadays Emacs uses a similar but more complex default
regexp constructed by the function @code{sentence-end}.
@xref{Standard Regexps}.)
First, we show the regexp as a string in Lisp syntax to distinguish
spaces from tab characters. The string constant begins and ends with a
@ -730,9 +730,9 @@ deciphered as follows:
The first part of the pattern is a character alternative that matches
any one of three characters: period, question mark, and exclamation
mark. The match must begin with one of these three characters. (This
is the one point where the new value of @code{sentence-end} differs
from the old. The new value also lists sentence ending
non-@acronym{ASCII} characters.)
is one point where the new default regexp used by Emacs differs from
the old. The new value also allows some non-@acronym{ASCII}
characters that end a sentence without any following whitespace.)
@item []\"')@}]*
The second part of the pattern matches any closing braces and quotation
@ -1698,23 +1698,25 @@ whitespace or starting with a form feed (after its left margin).
@end defvar
@defvar sentence-end
This is the regular expression describing the end of a sentence. (All
paragraph boundaries also end sentences, regardless.) The (slightly
simplified) default value is:
If non-@code{nil}, the value should be a regular expression describing
the end of a sentence, including the whitespace following the
sentence. (All paragraph boundaries also end sentences, regardless.)
@example
"[.?!][]\"')@}]*\\($\\| $\\|\t\\|@ @ \\)[ \t\n]*"
@end example
This means a period, question mark or exclamation mark (the actual
default value also lists their alternatives in other character sets),
followed optionally by closing parenthetical characters, followed by
tabs, spaces or new lines.
For a detailed explanation of this regular expression, see @ref{Regexp
Example}.
If the value is @code{nil}, the default, then the function
@code{sentence-end} has to construct the regexp. That is why you
should always call the function @code{sentence-end} to obtain the
regexp to be used to recognize the end of a sentence.
@end defvar
@defun sentence-end
This function returns the value of the variable @code{sentence-end},
if non-@code{nil}. Otherwise it returns a default value based on the
values of the variables @code{sentence-end-double-space}
(@pxref{Definition of sentence-end-double-space}),
@code{sentence-end-without-period} and
@code{sentence-end-without-space}.
@end defun
@ignore
arch-tag: c2573ca2-18aa-4839-93b8-924043ef831f
@end ignore

4
lispref/text.texi
View file

@ -1,6 +1,7 @@
@c -*-texinfo-*-
@c This is part of the GNU Emacs Lisp Reference Manual.
@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2000, 2001
@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999,
@c 2000, 2001, 2004
@c Free Software Foundation, Inc.
@c See the file elisp.texi for copying conditions.
@setfilename ../info/text
@ -1448,6 +1449,7 @@ the text around point.
@end defun
@defopt sentence-end-double-space
@anchor{Definition of sentence-end-double-space}
If this variable is non-@code{nil}, a period followed by just one space
does not count as the end of a sentence, and the filling functions
avoid breaking the line at such a place.

89
man/ChangeLog
View file

@ -1,3 +1,90 @@
2004-10-12 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-faq.texi ([5.9]): Improve code for reply-in-news.
2004-10-12 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.45.
* tramp.texi (Frequently Asked Questions): Comment paragraph about
plink link. The URL is outdated. Originator contacted for
clarification.
2004-10-10 Juri Linkov <juri@jurta.org>
* gnus.texi (Top, Marking Articles): Join two menus in one node
because a node can have only one menu.
2004-10-09 Luc Teirlinck <teirllm@auburn.edu>
* files.texi (Misc File Ops): View mode is a minor mode.
2004-10-09 Juri Linkov <juri@jurta.org>
* gnus.texi (Fancy Mail Splitting): Remove backslash in the
example of nnmail-split-fancy.
2004-10-08 Glenn Morris <gmorris@ast.cam.ac.uk>
* calendar.texi (iCalendar): Style changes.
2004-10-07 Luc Teirlinck <teirllm@auburn.edu>
* search.texi (Regexps): The regexp described in the example is no
longer stored in the variable `sentence-end'.
2004-10-06 Karl Berry <karl@gnu.org>
* info.texi (@kbd{1}--@kbd{9}): no space around --, for
consistency with other uses of dashes.
2004-10-06 Nick Roberts <nickrob@snap.net.nz>
* building.texi (Starting GUD): Note that multiple debugging
sessions requires `gdb --fullname'.
2004-10-05 Ulf Jasper <ulf.jasper@web.de>
* calendar.texi (iCalendar): New section for a new package.
2004-10-05 Karl Berry <karl@gnu.org>
* info.texi: consistently use --- throughout, periods at end of
menu descriptions, and a couple typos.
2004-10-05 Luc Teirlinck <teirllm@auburn.edu>
* text.texi: Various small changes in addition to the following.
(Text): Replace xref for autotype with inforef.
(Sentences): Explain nil value for `sentence-end'.
(Paragraphs): Update default values for `paragraph-start' and
`paragraph-separate'.
(Text Mode): Correct description of Text mode's effect on the
syntax table.
(Outline Visibility): `hide-other' does not hide top level headings.
`selective-display-ellipses' no longer has an effect on Outline mode.
(TeX Misc): Add missing @cindex.
Replace xref for RefTeX with inforef.
(Requesting Formatted Text): the variable
`enriched-fill-after-visiting' no longer exists.
(Editing Format Info): Update names of menu items and commands.
(Format Faces): Mention special effect of specifying the default face.
Describe inheritance of text properties.
Correct description of `fixed' face.
(Format Indentation): Correct description of effect of setting
margins. Mention `set-left-margin' and `set-right-margin'.
(Format Justification): Update names of menu items.
`set-justification-full' is now bound to `M-j b'.
Mention that `default-justification' is a per buffer variable.
(Format Properties): Update name of menu item.
(Forcing Enriched Mode): `format-decode-buffer' automatically
turns on Enriched mode if the buffer is in text/enriched format.
2004-10-05 Emilio C. Lopes <eclig@gmx.net>
* calendar.texi (From Other Calendar): Add calendar-goto-iso-week.
2004-09-28 Kim F. Storm <storm@cua.dk>
* display.texi (Display Custom) <indicate-buffer-boundaries>:
@ -893,7 +980,7 @@
* misc.texi: Section "Saving Emacs Sessions" rewritten.
2003-09-29 Jan D. <jhd@gaffa.gaia.swipnet.se>
2003-09-29 Jan Dj,Ad(Brv. <jan.h.d@swipnet.se>
* xresources.texi (GTK names in Emacs): Correct typo.

12
man/building.texi
View file

@ -336,11 +336,13 @@ to a particular debugger program.
@findex gdb
Run GDB as a subprocess of Emacs. If the variable
@code{gud-gdb-command-name} is ``gdb --annotate=3'' (the default
value) then GDB starts as for @kbd{M-x gdba} below. If you want to
GDB to start as in Emacs 21.3 and earlier then set
@code{gud-gdb-command-name} to ``gdb --fullname''. In this case, the
command creates a buffer for input and output to GDB, and switches to
it. If a GDB buffer already exists, it just switches to that buffer.
value) then GDB starts as for @kbd{M-x gdba} below. If you want GDB
to start as in Emacs 21.3 and earlier then edit the string in the
minibuffer or set @code{gud-gdb-command-name} to ``gdb --fullname''.
You need to do this if you want to run multiple debugging sessions
within one Emacs session. In this case, the command creates a buffer
for input and output to GDB, and switches to it. If a GDB buffer
already exists, it just switches to that buffer.
@item M-x gdba @key{RET} @var{file} @key{RET}
Run GDB as a subprocess of Emacs, providing a graphical interface

16
man/calc.texi
View file

@ -10026,19 +10026,17 @@ additional notes from the summary that apply to this command.
@kindex h f
@pindex calc-describe-function
The @kbd{h f} (@code{calc-describe-function}) command looks up an
algebraic function or a command name in the Calc manual. The
prompt initially contains @samp{calcFunc-}; follow this with an
algebraic function or a command name in the Calc manual. Enter an
algebraic function name to look up that function in the Function
Index. Or, backspace and enter a command name beginning with
@samp{calc-} to look it up in the Command Index. This command
will also look up operator symbols that can appear in algebraic
formulas, like @samp{%} and @samp{=>}.
Index or enter a command name beginning with @samp{calc-} to look it
up in the Command Index. This command will also look up operator
symbols that can appear in algebraic formulas, like @samp{%} and
@samp{=>}.
@kindex h v
@pindex calc-describe-variable
The @kbd{h v} (@code{calc-describe-variable}) command looks up a
variable in the Calc manual. The prompt initially contains the
@samp{var-} prefix; just add a variable name like @code{pi} or
variable in the Calc manual. Enter a variable name like @code{pi} or
@code{PlotRejects}.
@kindex h b
@ -21981,7 +21979,7 @@ back on.
The most basic default simplification is the evaluation of functions.
For example, @cite{2 + 3} is evaluated to @cite{5}, and @cite{@t{sqrt}(9)}
is evaluated to @cite{3}. Evaluation does not occur if the arguments
to a function are somehow of the wrong type (@cite{@t{tan}([2,3,4])},
to a function are somehow of the wrong type (@cite{@t{tan}([2,3,4])}),
range (@cite{@t{tan}(90)}), or number (@cite{@t{tan}(3,5)}), or if the
function name is not recognized (@cite{@t{f}(5)}), or if ``symbolic''
mode (@pxref{Symbolic Mode}) prevents evaluation (@cite{@t{sqrt}(2)}).

54
man/calendar.texi
View file

@ -37,6 +37,7 @@ information about the calendar and diary.
* Other Calendars:: Converting dates to other calendar systems.
* Diary:: Displaying events from your diary.
* Appointments:: Reminders when it's time to do something.
* iCalendar:: Converting diary events to/from iCalendar format.
* Daylight Savings:: How to specify when daylight savings time is active.
* Time Intervals:: Keeping track of time intervals.
@end menu
@ -754,6 +755,7 @@ other than Mayan; for the Mayan calendar, see the following section.
@kindex g @var{char} @r{(Calendar mode)}
@findex calendar-goto-iso-date
@findex calendar-goto-iso-week
@findex calendar-goto-julian-date
@findex calendar-goto-astro-day-number
@findex calendar-goto-hebrew-date
@ -767,6 +769,9 @@ other than Mayan; for the Mayan calendar, see the following section.
@item g c
Move to a date specified in the ISO commercial calendar
(@code{calendar-goto-iso-date}).
@item g w
Move to a week specified in the ISO commercial calendar
(@code{calendar-goto-iso-week}).
@item g j
Move to a date specified in the Julian calendar
(@code{calendar-goto-julian-date}).
@ -1379,6 +1384,55 @@ clock. The command @kbd{M-x appt-add} adds entries to the appointment
list without affecting your diary file. You delete entries from the
appointment list with @kbd{M-x appt-delete}.
@node iCalendar
@section iCalendar
@cindex iCalendar support
The icalendar package aims at providing an implementation of the
iCalendar standard, as defined in ``RFC 2445 -- Internet Calendaring and
Scheduling Core Object Specification (iCalendar)''. It provides a means
for importing iCalendar (and the earlier vCalendar format) data into
Emacs diary files and vice versa.
Importing works for ``ordinary'' (i.e. non-recurring) events, but (at
present) may not work correctly (if at all) for recurring events.
Exporting of diary files into iCalendar files should work correctly for
most diary entries. Please note that @file{icalendar.el} is work in
progress, so usage may evolve in future.
To activate the package, use @code{(require 'icalendar)}.
@findex icalendar-extract-ical-from-buffer
The command @code{icalendar-extract-ical-from-buffer} extracts
iCalendar data from the current buffer and adds it to your (default)
diary file. This function is also suitable for automatic extraction of
iCalendar data; for example with the Rmail mail client one could use:
@example
(add-hook 'rmail-show-message-hook 'icalendar-extract-ical-from-buffer)
@end example
@findex icalendar-import-file
The command @code{icalendar-import-file} imports an iCalendar file.
@strong{Caution:} the contents of the target diary file are
@emph{deleted} by default! It is highly recommended to use a dedicated
diary file for importing. For example:
@example
(icalendar-import-file "/here/is/calendar.ics" "/there/goes/ical-diary")
@end example
@noindent
You can use an @code{#include} directive to add the import file contents
to the diary. @xref{Fancy Diary Display,,, elisp, The Emacs Lisp
Reference Manual}.
@findex icalendar-convert-diary-to-ical
The command @code{icalendar-convert-diary-to-ical} exports an Emacs
diary file to iCalendar format. @strong{Caution:} the contents of the
target file are @emph{deleted} by default!
@node Daylight Savings
@section Daylight Savings Time
@cindex daylight savings time

2
man/files.texi
View file

@ -2858,7 +2858,7 @@ or @key{DEL} to scroll backward. Various other commands are provided
for moving around in the file, but none for changing it; type @kbd{?}
while viewing for a list of them. They are mostly the same as normal
Emacs cursor motion commands. To exit from viewing, type @kbd{q}.
The commands for viewing are defined by a special major mode called View
The commands for viewing are defined by a special minor mode called View
mode.
A related command, @kbd{M-x view-buffer}, views a buffer already present

11
man/gnus-faq.texi
View file

@ -1776,11 +1776,14 @@ Answer:
@example
(defadvice gnus-summary-reply (around reply-in-news activate)
(eval-after-load "gnus-msg"
'(unless (boundp 'gnus-confirm-mail-reply-to-news)
(defadvice gnus-summary-reply (around reply-in-news activate)
"Request confirmation when replying to news."
(interactive)
(when (or (not (gnus-news-group-p gnus-newsgroup-name))
(y-or-n-p "Really reply? "))
ad-do-it))
(when (or (not (gnus-news-group-p gnus-newsgroup-name))
(y-or-n-p "Really reply by mail to article author? "))
ad-do-it))))
@end example
@ifnottex

28
man/gnus.texi
View file

@ -535,12 +535,9 @@ Marking Articles
* Unread Articles:: Marks for unread articles.
* Read Articles:: Marks for read articles.
* Other Marks:: Marks that do not affect readedness.
Marking Articles
* Setting Marks:: How to set and remove marks.
* Generic Marking Commands:: How to customize the marking.
* Setting Process Marks:: How to mark articles for later processing.
* Setting Marks:: How to set and remove marks.
* Generic Marking Commands:: How to customize the marking.
* Setting Process Marks:: How to mark articles for later processing.
Threading
@ -5686,20 +5683,17 @@ neologism ohoy!) of the article. Alphabetic marks generally mean
In addition, you also have marks that do not affect readedness.
@ifinfo
There's a plethora of commands for manipulating these marks.
@end ifinfo
@menu
* Unread Articles:: Marks for unread articles.
* Read Articles:: Marks for read articles.
* Other Marks:: Marks that do not affect readedness.
@end menu
@ifinfo
There's a plethora of commands for manipulating these marks:
@end ifinfo
@menu
* Setting Marks:: How to set and remove marks.
* Generic Marking Commands:: How to customize the marking.
* Setting Process Marks:: How to mark articles for later processing.
* Setting Marks:: How to set and remove marks.
* Generic Marking Commands:: How to customize the marking.
* Setting Process Marks:: How to mark articles for later processing.
@end menu
@ -14002,7 +13996,7 @@ Let's look at an example value of this variable first:
;; @r{the bugs- list, but allow cross-posting when the}
;; @r{message was really cross-posted.}
(any "bugs-mypackage@@somewhere" "mypkg.bugs")
(any "mypackage@@somewhere\" - "bugs-mypackage" "mypkg.list")
(any "mypackage@@somewhere" - "bugs-mypackage" "mypkg.list")
;; @r{People@dots{}}
(any "larsi@@ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen"))
;; @r{Unmatched mail goes to the catch all group.}

Some files were not shown because too many files have changed in this diff Show more