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

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

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

Patches applied:

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

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

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

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

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

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

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

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

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

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

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

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

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

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-56
   Update from CVS: Add lisp/legacy-gnus-agent.el

 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-57
 - miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-58
   Update from CVS
This commit is contained in:
Miles Bader 2004-10-22 10:13:52 +00:00
commit 5ea24f9468
124 changed files with 4670 additions and 3489 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
ChangeLog
View file

@ -1,3 +1,9 @@
2004-10-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in (HAVE_PERSONALITY_LINUX32): New test if PER_LINUX32
can be set. Remove SETARCH test.
* configure: Rebuild
2004-10-08 Steven Tamm <steventamm@mac.com>
* configure.in (HAVE_MALLOC_MALLOC_H): Test for malloc/malloc.h

178
configure vendored
View file

@ -310,7 +310,7 @@ ac_includes_default="\
# include <unistd.h>
#endif"
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT LN_S CPP INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA RANLIB ac_ct_RANLIB INSTALL_INFO EGREP LIBSOUND SETARCH SET_MAKE PKG_CONFIG GTK_CFLAGS GTK_LIBS ALLOCA liblockfile LIBOBJS NEED_SETGID KMEM_GROUP GETLOADAVG_LIBS version configuration canonical srcdir lispdir locallisppath lisppath x_default_search_path etcdir archlibdir docdir bitmapdir gamedir gameuser c_switch_system c_switch_machine LD_SWITCH_X_SITE LD_SWITCH_X_SITE_AUX C_SWITCH_X_SITE X_TOOLKIT_TYPE machfile opsysfile carbon_appdir LTLIBOBJS'
ac_subst_vars='SHELL PATH_SEPARATOR PACKAGE_NAME PACKAGE_TARNAME PACKAGE_VERSION PACKAGE_STRING PACKAGE_BUGREPORT exec_prefix prefix program_transform_name bindir sbindir libexecdir datadir sysconfdir sharedstatedir localstatedir libdir includedir oldincludedir infodir mandir build_alias host_alias target_alias DEFS ECHO_C ECHO_N ECHO_T LIBS MAINT build build_cpu build_vendor build_os host host_cpu host_vendor host_os CC CFLAGS LDFLAGS CPPFLAGS ac_ct_CC EXEEXT OBJEXT LN_S CPP INSTALL_PROGRAM INSTALL_SCRIPT INSTALL_DATA RANLIB ac_ct_RANLIB INSTALL_INFO EGREP LIBSOUND SET_MAKE PKG_CONFIG GTK_CFLAGS GTK_LIBS ALLOCA liblockfile LIBOBJS NEED_SETGID KMEM_GROUP GETLOADAVG_LIBS version configuration canonical srcdir lispdir locallisppath lisppath x_default_search_path etcdir archlibdir docdir bitmapdir gamedir gameuser c_switch_system c_switch_machine LD_SWITCH_X_SITE LD_SWITCH_X_SITE_AUX C_SWITCH_X_SITE X_TOOLKIT_TYPE machfile opsysfile carbon_appdir LTLIBOBJS'
ac_subst_files=''
# Initialize some variables set by options.
@ -5440,6 +5440,65 @@ fi
done
echo "$as_me:$LINENO: checking if personality LINUX32 can be set" >&5
echo $ECHO_N "checking if personality LINUX32 can be set... $ECHO_C" >&6
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <sys/personality.h>
int
main ()
{
personality (PER_LINUX32)
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
(eval $ac_compile) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest.$ac_objext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
emacs_cv_personality_linux32=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
emacs_cv_personality_linux32=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
echo "$as_me:$LINENO: result: $emacs_cv_personality_linux32" >&5
echo "${ECHO_T}$emacs_cv_personality_linux32" >&6
if test $emacs_cv_personality_linux32 = yes; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_PERSONALITY_LINUX32 1
_ACEOF
fi
for ac_header in term.h
do
as_ac_Header=`echo "ac_cv_header_$ac_header" | $as_tr_sh`
@ -7741,122 +7800,6 @@ _ACEOF
fi
echo "$as_me:$LINENO: checking whether heap start address is randomized" >&5
echo $ECHO_N "checking whether heap start address is randomized... $ECHO_C" >&6
if test x"$ac_cv_header_unistd_h" != x && test x"$ac_cv_header_stdlib_h" != x
then
if test "$cross_compiling" = yes; then
emacs_cv_randomheap='assuming no'
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#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);
}
_ACEOF
rm -f conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && { ac_try='./conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
emacs_cv_randomheap=yes
else
echo "$as_me: program exited with status $ac_status" >&5
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
( exit $ac_status )
emacs_cv_randomheap=no
fi
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi
else
emacs_cv_randomheap='assuming no'
fi
echo "$as_me:$LINENO: result: $emacs_cv_randomheap" >&5
echo "${ECHO_T}$emacs_cv_randomheap" >&6
if test "$emacs_cv_randomheap" = yes; then
# Extract the first word of "setarch", so it can be a program name with args.
set dummy setarch; ac_word=$2
echo "$as_me:$LINENO: checking for $ac_word" >&5
echo $ECHO_N "checking for $ac_word... $ECHO_C" >&6
if test "${ac_cv_path_SETARCH+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
case $SETARCH in
[\\/]* | ?:[\\/]*)
ac_cv_path_SETARCH="$SETARCH" # Let the user override the test with a path.
;;
*)
as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
for as_dir in $PATH
do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if $as_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_SETARCH="$as_dir/$ac_word$ac_exec_ext"
echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
fi
done
done
test -z "$ac_cv_path_SETARCH" && ac_cv_path_SETARCH="no"
;;
esac
fi
SETARCH=$ac_cv_path_SETARCH
if test -n "$SETARCH"; then
echo "$as_me:$LINENO: result: $SETARCH" >&5
echo "${ECHO_T}$SETARCH" >&6
else
echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
fi
if test "$SETARCH" != no && test "$machine" = "intel386"; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_RANDOM_HEAPSTART 1
_ACEOF
else
emacs_cv_randomheap=warn
fi
fi
@ -22291,7 +22234,6 @@ s,@ac_ct_RANLIB@,$ac_ct_RANLIB,;t t
s,@INSTALL_INFO@,$INSTALL_INFO,;t t
s,@EGREP@,$EGREP,;t t
s,@LIBSOUND@,$LIBSOUND,;t t
s,@SETARCH@,$SETARCH,;t t
s,@SET_MAKE@,$SET_MAKE,;t t
s,@PKG_CONFIG@,$PKG_CONFIG,;t t
s,@GTK_CFLAGS@,$GTK_CFLAGS,;t t

57
configure.in
View file

@ -1450,6 +1450,18 @@ AC_CHECK_HEADERS(sys/select.h sys/timeb.h sys/time.h unistd.h utime.h \
linux/version.h sys/systeminfo.h termios.h limits.h string.h stdlib.h \
termcap.h stdio_ext.h fcntl.h strings.h coff.h pty.h sys/mman.h \
sys/param.h sys/vlimit.h sys/resource.h locale.h sys/_mbstate_t.h)
AC_MSG_CHECKING(if personality LINUX32 can be set)
AC_TRY_COMPILE([#include <sys/personality.h>], [personality (PER_LINUX32)],
emacs_cv_personality_linux32=yes,
emacs_cv_personality_linux32=no)
AC_MSG_RESULT($emacs_cv_personality_linux32)
if test $emacs_cv_personality_linux32 = yes; then
AC_DEFINE(HAVE_PERSONALITY_LINUX32, 1,
[Define to 1 if personality LINUX32 can be set.])
fi
dnl On Solaris 8 there's a compilation warning for term.h because
dnl it doesn't define `bool'.
AC_CHECK_HEADERS(term.h, , , -)
@ -1572,51 +1584,6 @@ 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.

1305
etc/MAILINGLISTS
View file

File diff suppressed because it is too large Load diff

27
etc/refcard.tex
View file

@ -1,12 +1,19 @@
% Reference Card for GNU Emacs version 21 on Unix systems
%**start of header
\newcount\columnsperpage
\newcount\letterpaper
% This file can be printed with 1, 2, or 3 columns per page (see below).
% Specify how many you want here. Nothing else needs to be changed.
% Specify how many you want here.
\columnsperpage=1
\columnsperpage=3
% Set letterpapaer to 0 for A4 paper, 1 for letter (US) paper. Useful
% only when columnsperpage is 2 or 3.
\letterpaper=1
% Nothing else needs to be changed below this line.
% Copyright (c) 1987, 1993, 1996, 1997 Free Software Foundation, Inc.
% This file is part of GNU Emacs.
@ -42,6 +49,10 @@
% For this you need a dvi device driver that can print sideways.
% Which mode to use is controlled by setting \columnsperpage above.
%
% To compile and print this document:
% tex refcard.tex
% dvips -t landscape refcard.dvi
%
% Author:
% Stephen Gildea
% Internet: gildea@stop.mail-abuse.org
@ -103,7 +114,11 @@
\def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}}
\else %2 or 3 columns uses prereduced size
\hsize 3.2in
\vsize 7.95in
\if 1\the\letterpaper
\vsize 7.95in
\else
\vsize 7.65in
\fi
\hoffset -.75in
\voffset -.745in
\font\titlefont=cmbx10 \scaledmag2
@ -123,7 +138,11 @@
\def\bf{\eightbf}
\def\it{\eightit}
\def\tt{\eighttt}
\normalbaselineskip=.8\normalbaselineskip
\if 1\the\letterpaper
\normalbaselineskip=.8\normalbaselineskip
\else
\normalbaselineskip=.7\normalbaselineskip
\fi
\normallineskip=.8\normallineskip
\normallineskiplimit=.8\normallineskiplimit
\normalbaselines\rm %make definitions take effect

336
lisp/ChangeLog
View file

@ -1,10 +1,255 @@
2004-10-21 Jay Belanger <belanger@truman.edu>
* calc/calc-aent.el (calc-alg-ent-map, calc-alg-ent-esc-map):
Declared these variables with defvar.
* calc/calc-aent.el (calc-do-alg-entry): Since `calc-alg-ent-map'
is bound, only check to see if it is bound.
2004-10-21 Stefan Monnier <monnier@iro.umontreal.ca>
* calc/calc-help.el (calc-describe-bindings): Fix last change.
2004-10-21 John Paul Wallington <jpw@gnu.org>
* calc/calc-graph.el (calc-graph-init):
Use `set-process-query-on-exit-flag'.
2004-10-21 Daniel Pfeiffer <occitan@esperanto.org>
* progmodes/compile.el (compilation-start): Rely on `cd' to get
dir right and also allow argumentless cd.
2004-10-19 Richard M. Stallman <rms@gnu.org>
* textmodes/flyspell.el (flyspell-mode): Doc fix.
* eshell/em-unix.el (eshell-grep):
Don't bind compilation-process-setup-function.
* comint.el (comint-insert-input): Use @ in `interactive'.
(comint-input-filter-functions): Doc fix.
(comint-kill-whole-line, comint-get-source): Doc fix.
* progmodes/compile.el (compilation-setup):
Don't set buffer-read-only if MINOR is non-nil.
2004-10-19 Jay Belanger <belanger@truman.edu>
* calc/calc.el (calc-emacs-type-19, calc-emacs-type-epoch)
(calc-emacs-type-gnu19): Remove.
(calc-digit-map, calc-read-key-sequence, calc-read-key):
Remove check for old emacs versions.
* calc/calc-ext.el (calc-fancy-prefix): Remove emacs version check.
(calc-init-extensions): Define `calc-alg-map' and `calc-alg-esc-map'
for current Emacs.
* calc/calc-aent.el (calcAlg-previous): Check to see if looking at
the end of the minibuffer.
(calc-do-alg-entry): Remove Emacs version check. Use `copy-keymap' to
copy `esc-map'.
* calc/calc-graph.el (calc-graph-plot): Remove emacs version check.
* calc/calc-mode.el (calc-total-algebraic-mode): Remove error
call that would be given when the current emacs was used.
2004-10-19 Ulf Jasper <ulf.jasper@web.de>
* calendar/icalendar.el: Set coding to utf-8.
(icalendar-version): Increase to 0.07.
(icalendar-monthnumber-table): Change March pattern.
(icalendar-get-all-event-properties)
(icalendar-set-event-property): Delete.
(icalendar-all-events): No longer interactive.
(icalendar-convert-diary-to-ical)
(icalendar-extract-ical-from-buffer): Make obsolete, and alias to
their replacements.
(icalendar-export-file, icalendar-export-region): New functions;
essentially old `icalendar-convert-diary-to-ical' but appending to
target rather than overwriting.
(icalendar-import-file): Append to target file rather than
overwriting. Fourth arg deleted.
(icalendar-import-buffer): New name for old
`icalendar-extract-ical-from-buffer'.
(icalendar--convert-string-for-import): New name for
old `icalendar-convert-for-import'.
(include-icalendar-files): Delete.
Prefix for all internal functions changed from `icalendar-'
to `icalendar--'.
2004-10-19 Richard M. Stallman <rms@gnu.org>
* paths.el (news-path): Fix previous change.
2004-10-18 Jay Belanger <belanger@truman.edu>
* calc/calc-help.el (calc-describe-bindings):
Set `buffer-read-only' to nil while working in the keybindings buffer;
remove some extra information from the keybindings buffer.
2004-10-18 David Ponce <david@dponce.com>
* mouse.el (mouse-drag-move-window-top): New function.
(mouse-drag-mode-line-1): Use it.
2004-10-18 Thien-Thi Nguyen <ttn@gnu.org>
* info.el (Info-fontify-node): For multiline refs,
arrange to unfontify newline and surrounding whitespace.
2004-10-17 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-arch.el (vc-arch-workfile-version): Don't burp if the patch-log
directory is missing.
2004-10-17 John Paul Wallington <jpw@gnu.org>
* ibuffer.el (ibuffer-default-display-maybe-show-predicates):
New customizable variable; whether to display buffers that match
`ibuffer-maybe-show-predicates' by default.
(ibuffer-maybe-show-predicates): Mention it in docstring.
(ibuffer-display-maybe-show-predicates): New variable.
(ibuffer-update): Prefix arg now toggles whether buffers that
match `ibuffer-maybe-show-predicates' should be displayed.
(ibuffer-mode): Set `ibuffer-display-maybe-show-predicates'
locally to heed `ibuffer-default-display-maybe-show-predicates'.
(ibuffer-redisplay-engine): Rename optional second arg to `ignore'.
2004-10-17 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el: Redo sync with Tramp 2.0.45. Last commit did not
work correctly.
2004-10-17 Daniel Pfeiffer <occitan@esperanto.org>
* buff-menu.el (Buffer-menu-revert-function): Emulate save-excursion.
(Buffer-menu-beginning): New helper function.
(Buffer-menu-execute): Use it.
(Buffer-menu-select): Use it.
(Buffer-menu-sort): Use it and also keep markers.
2004-10-17 Richard M. Stallman <rms@gnu.org>
* paths.el (news-directory): Rename from news-path. Old name alias.
(rmail-spool-directory): Use defvar.
(sendmail-program): Use defcustom.
(remote-shell-program): Use defcustom.
(term-file-prefix): Use defvar.
(abbrev-file-name): Use defvar.
* term.el: Add maintainer.
* subr.el (with-local-quit): Return nil if there's a quit.
(read-passwd): Use with-local-quit. Doc fix.
* strokes.el (strokes-list-strokes): Don't try to delete char at eob.
(strokes-unload-hook): Set as a variable with add-hook.
* startup.el (fancy-splash-tail, normal-splash-screen):
Update copyright year.
* shadowfile.el (shadowfile-unload-hook): Set as variable w/ add-hook.
* server.el (server-unload-hook): Set as a variable with add-hook.
* help-at-pt.el (help-at-pt-unload-hook): Use add-hook; no defvar.
* frame.el (special-display-popup-frame):
Make the buffer current as its frame is created.
* delsel.el (delsel-unload-hook): Set as a variable.
* comint.el (comint-output-filter-functions):
Add comint-watch-for-password-prompt.
(comint-read-noecho): Function deleted.
(send-invisible): Use read-passwd.
* fringe.el (fringe-mode-initialize): New function.
(fringe-mode): Use fringe-mode-initialize as :initialize.
2004-10-17 Kim F. Storm <storm@cua.dk>
* language/indian.el (indian-script-language-alist): Swap value and doc.
(indian-font-char-index-table): Doc fix.
2004-10-16 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-hooks.el (vc-find-file-hook): Call vc-backend with absolute name.
2004-10-16 Juri Linkov <juri@jurta.org>
* progmodes/compile.el (compilation-start): Move let-binding of
`process-environment' into `with-current-buffer' body.
Reported by Matt Hodges <MPHodges@member.fsf.org>.
2004-10-16 Richard M. Stallman <rms@gnu.org>
* pcvs-util.el (cvs-bury-buffer):
Don't call get-buffer-window for effect.
* outline.el (hide-other): Call outline-up-heading with INVISIBLE-OK=t.
* newcomment.el (comment-auto-fill-only-comments): Add autoload.
* msb.el (msb-unload-hook): Set the variable.
* mouse.el (mouse-yank-at-click, mouse-yank-secondary):
Use * to err if buffer is readonly.
* subr.el (looking-back): Return only t or nil.
* whitespace.el (whitespace-unload-hook): Set the variable.
* view.el (view-mode-enable): Set view-page-size and
view-half-page-size to nil.
(view-set-half-page-size-default): view-half-page-size = nil
means the default.
(View-scroll-page-forward): Use view-page-size-default.
(View-scroll-page-backward): Likewise.
(view-page-size, view-half-page-size): Doc fixes.
* emacs-lisp/elp.el (elp-unload-hook): Set the variable.
* emacs-lisp/cl.el (cl-unload-hook): Don't defvar it, just set it.
* emacs-lisp/bytecomp.el (byte-compile-eval): Don't process
"cl" like other files. Instead, call byte-compile-find-cl-functions.
(byte-compile-log-1): Bind inhibit-read-only.
(byte-compile-warning-prefix, byte-compile-log-file): Likewise.
(byte-compile-log-warning): Likewise.
(byte-compile-file-form-require): Detect "cl" from the arg value.
* progmodes/compile.el (compilation-start): Assume compilation-mode
will make the buffer read-only.
(compilation-mode): Take arg name-of-mode.
(compilation-setup): Make buffer read-only.
(compilation-handle-exit): Bind inhibit-read-only.
* textmodes/ispell.el (ispell-command-loop): Use with-no-warnings.
(ispell-message): Likewise.
(ispell-show-choices): Don't call get-buffer-window uselessly.
(ispell-init-process): Use set-process-query-on-exit-flag.
2004-10-16 Kim F. Storm <storm@cua.dk>
* fringe.el (fringe-bitmaps): Only initialize when defined.
* pcvs.el (cvs-mode-view-file, cvs-mode-view-file-other-window): Add.
(cvs-mode-find-file): Add optional `view' arg to enter view mode.
* pcvs-defs.el (cvs-mode-map): Bind v to cvs-mode-view-file.
2004-10-15 Simon Josefsson <jas@extundo.com>
* net/password.el: Add.
2004-10-13 Daniel Pfeiffer <occitan@esperanto.org>
* button.el (button-activate): Allow a marker to display as an
action.
* 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-fns.el (describe-variable): Use it to make "below" a hyperlink.
* help.el (describe-mode): Use it to make minor mode list into
hyperlinks.
@ -25,6 +270,25 @@
(event-modifiers): Use push.
(mouse-movement-p, with-temp-buffer): Simplify.
2004-10-12 Jay Belanger <belanger@truman.edu>
* calc/calc-help.el (calc-help-function-list, calc-help-variable-list):
New variables.
(calc-help-index-entries): New function.
(calc-describe-function): Use `calc-help-function-list' instead of
obarray for completion.
(calc-describe-variable): Use `calc-help-variable-list' instead
of obarray for completion.
2004-10-12 Richard M. Stallman <rms@gnu.org>
* info-look.el (info-lookup-file): Add info-file property.
(info-lookup-symbol): Likewise.
* info.el (info-xref): Add underlining.
(info): Add info-file property.
(Info-find-emacs-command-nodes): Specify case-sensitive search.
2004-10-12 Michael Albinus <michael.albinus@gmx.de>
Sync with Tramp 2.0.45.
@ -78,6 +342,15 @@
* subr.el (substitute-key-definition): Mention command remapping
in doc string.
2004-10-11 Jay Belanger <belanger@truman.edu>
* calc/calc-misc.el (calc-info-goto-node): New function.
(calc-tutorial, calc-info-summary): Go to appropriate Calc info
node in one step.
(calc-describe-copying, calc-describe-distribution)
(calc-describe-thing, calc-describe-no-warranty, calc-describe-key):
Go to appropriate info node in one step.
2004-10-11 Stefan Monnier <monnier@iro.umontreal.ca>
* pcvs-defs.el (pcl-cvs-load-hook): Remove unused var.
@ -201,7 +474,7 @@
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>.
Reported by Drew Adams <drew.adams@oracle.com>.
* info.el (Info-history, Info-toc): Fix Info headers.
(Info-toc): Narrow buffer before Info-fontify-node.
@ -443,6 +716,12 @@
* progmodes/tcl.el (inferior-tcl): Use pop-to-buffer.
2004-09-21 Jay Belanger <belanger@truman.edu>
* calc/calc-graph.el (calc-graph-add-curve): Moved the call to
`calc-graph-set-styles' so the gnuplot buffer will appear in a
separate window.
2004-09-21 Luc Teirlinck <teirllm@auburn.edu>
* subr.el (after-change-major-mode-hook): Doc fix.
@ -457,6 +736,10 @@
* descr-text.el (describe-char): Checking of quail activation
fixed.
2004-09-21 Jay Belanger <belanger@truman.edu>
* calc/calc.el (calc-mode-var-list): Removed unnecessary quotes.
2004-09-20 Luc Teirlinck <teirllm@auburn.edu>
* subr.el (run-mode-hooks): Run `after-change-major-mode-hook'
@ -542,6 +825,11 @@
* calc/calc-units.el (calc-quick-units): Fix overzealous
s/or/unless/.
2004-09-17 Jay Belanger <belanger@truman.edu>
* calc/calc.el (calc-mode-var-list): Fixed the value of
`calc-matrix-brackets'.
2004-09-17 Romain Francoise <romain@orebokech.com>
* ibuf-ext.el (define-ibuffer-filter filename):
@ -573,6 +861,44 @@
(term-protocol-version): Increment.
(term-current-face): Set to default.
2004-09-15 Jay Belanger <belanger@truman.edu>
* calc/calc.el (calc-mode-var-list): Define this variable.
(calc-always-load-extensions, calc-line-numbering)
(calc-line-breaking, calc-display-just, calc-display-origin)
(calc-number-radix, calc-leading-zeros, calc-group-digits)
(calc-group-char, calc-point-char, calc-frac-format)
(calc-prefer-frac, calc-hms-format, calc-date-format)
(calc-float-format, calc-full-float-format, calc-complex-format)
(calc-complex-mode, calc-infinite-mode, calc-display-strings)
(calc-matrix-just, calc-break-vectors, calc-full-vectors)
(calc-full-trail-vectors, calc-vector-commas, calc-vector-brackets)
(calc-matrix-brackets, calc-language, calc-language-option)
(calc-left-label, calc-right-label, calc-word-size)
(calc-previous-modulo, calc-simplify-mode, calc-auto-recompute)
(calc-display-raw, calc-internal-prec, calc-angle-mode)
(calc-algebraic-mode, calc-incomplete-algebraic-mode)
(calc-symbolic-mode, calc-matrix-mode, calc-shift-prefix)
(calc-window-height, calc-display-trail, calc-show-selections)
(calc-use-selections, calc-assoc-selections)
(calc-display-working-message, calc-auto-why, calc-timing)
(calc-mode-save-mode, calc-standard-date-formats)
(calc-autorange-units, calc-was-keypad-mode, calc-full-mode)
(calc-user-parse-tables, calc-gnuplot-default-device)
(calc-gnuplot-default-output, calc-gnuplot-print-device)
(calc-gnuplot-print-output, calc-gnuplot-geometry)
(calc-graph-default-resolution, calc-graph-default-resolution-3d)
(calc-invocation-macro, calc-show-banner): Give these values as
part of `calc-mode-var-list's initialization after the variables
are declared with defvar.
(calc-bug-address): Changed email address to send bug
reports to. Also changed the maintainer address at the top.
(calc-mode): Compare `calc-settings-file' to `user-init-file' rather
than "\\.emacs" to determine if it is the user-init-file.
* calc/calc-embed.el (calc-embedded-set-modes): Use
`calc-mode-var-list' correctly.
2004-09-15 Thien-Thi Nguyen <ttn@gnu.org>
* vc.el (annotate-time): Document point handling.

3
lisp/autorevert.el
View file

@ -421,6 +421,9 @@ This is an internal function used by Auto-Revert Mode."
'no-mini t))
(if auto-revert-tail-mode
(auto-revert-tail-handler)
;; Bind buffer-read-only in case user has done C-x C-q,
;; so as not to forget that. This gives undesirable results
;; when the file's mode changes, but that is less common.
(let ((buffer-read-only buffer-read-only))
(revert-buffer 'ignore-auto 'dont-ask 'preserve-modes)))
(when buffer-file-name

61
lisp/buff-menu.el
View file

@ -197,9 +197,15 @@ Letters do not insert themselves; instead, they are commands.
(defun Buffer-menu-revert-function (ignore1 ignore2)
;; We can not use save-excursion here. The buffer gets erased.
(let ((old-point (point)))
(let ((ocol (current-column))
(oline (progn (move-to-column 4)
(get-text-property (point) 'buffer)))
(prop (point-min)))
(list-buffers-noselect Buffer-menu-files-only)
(goto-char old-point)))
(while (setq prop (next-single-property-change prop 'buffer))
(when (eq (get-text-property prop 'buffer) oline)
(goto-char prop)
(move-to-column ocol)))))
(defun Buffer-menu-toggle-files-only (arg)
"Toggle whether the current buffer-menu displays only file buffers.
@ -354,13 +360,16 @@ and then move up one line. Prefix arg means move that many lines."
(delete-char 1)
(insert (if arg ?* ? ))))))
(defun Buffer-menu-beginning ()
(goto-char (point-min))
(unless Buffer-menu-use-header-line
(forward-line)))
(defun Buffer-menu-execute ()
"Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
(interactive)
(save-excursion
(goto-char (point-min))
(unless Buffer-menu-use-header-line
(forward-line 1))
(Buffer-menu-beginning)
(while (re-search-forward "^..S" nil t)
(let ((modp nil))
(save-excursion
@ -371,9 +380,7 @@ and then move up one line. Prefix arg means move that many lines."
(delete-char -1)
(insert (if modp ?* ? ))))))
(save-excursion
(goto-char (point-min))
(unless Buffer-menu-use-header-line
(forward-line 1))
(Buffer-menu-beginning)
(let ((buff-menu-buffer (current-buffer))
(buffer-read-only nil))
(while (re-search-forward "^D" nil t)
@ -399,9 +406,7 @@ in the selected frame."
(menu (current-buffer))
(others ())
tem)
(goto-char (point-min))
(unless Buffer-menu-use-header-line
(forward-line 1))
(Buffer-menu-beginning)
(while (re-search-forward "^>" nil t)
(setq tem (Buffer-menu-buffer t))
(let ((buffer-read-only nil))
@ -581,7 +586,35 @@ For more information, see the function `buffer-menu'."
(if (< column 2) (setq column 2))
(if (> column 5) (setq column 5)))
(setq Buffer-menu-sort-column column)
(Buffer-menu-revert))
(let (buffer-read-only l buf m1 m2)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
(when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer)))
(setq m1 (char-after)
m1 (if (memq m1 '(?> ?D)) m1)
m2 (char-after (+ (point) 2))
m2 (if (eq m2 ?S) m2))
(if (or m1 m2)
(push (list buf m1 m2) l)))
(forward-line)))
(Buffer-menu-revert)
(setq buffer-read-only)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
(when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l))
(setq m1 (cadr buf)
m2 (cadr (cdr buf)))
(when m1
(delete-char 1)
(insert m1)
(backward-char 1))
(when m2
(forward-char 2)
(delete-char 1)
(insert m2)))
(forward-line)))))
(defun Buffer-menu-make-sort-button (name column)
(if (equal column Buffer-menu-sort-column) (setq column nil))
@ -592,7 +625,9 @@ For more information, see the function `buffer-menu'."
'mouse-face 'highlight
'keymap (let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-2]
`(lambda () (interactive)
`(lambda (e)
(interactive "e")
(if e (set-buffer (window-buffer (posn-window (event-end e)))))
(Buffer-menu-sort ,column)))
map)))

24
lisp/calc/calc-aent.el
View file

@ -295,24 +295,28 @@
calc-dollar-used 0)))
(calc-handle-whys))))
(defvar calc-alg-ent-map nil
"The keymap used for algebraic entry.")
(defvar calc-alg-ent-esc-map nil
"The keymap used for escapes in algebraic entry.")
(defun calc-do-alg-entry (&optional initial prompt no-normalize)
(let* ((calc-buffer (current-buffer))
(blink-paren-function 'calcAlg-blink-matching-open)
(alg-exp 'error))
(unless (boundp 'calc-alg-ent-map)
(unless calc-alg-ent-map
(setq calc-alg-ent-map (copy-keymap minibuffer-local-map))
(define-key calc-alg-ent-map "'" 'calcAlg-previous)
(define-key calc-alg-ent-map "`" 'calcAlg-edit)
(define-key calc-alg-ent-map "\C-m" 'calcAlg-enter)
(define-key calc-alg-ent-map "\C-j" 'calcAlg-enter)
(or calc-emacs-type-19
(let ((i 33))
(setq calc-alg-ent-esc-map (copy-sequence esc-map))
(while (< i 127)
(aset calc-alg-ent-esc-map i 'calcAlg-escape)
(setq i (1+ i))))))
(unless calc-emacs-type-19
(define-key calc-alg-ent-map "\e" nil))
(let ((i 33))
(setq calc-alg-ent-esc-map (copy-keymap esc-map))
(while (< i 127)
(aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape)
(setq i (1+ i)))))
(define-key calc-alg-ent-map "\e" nil)
(if (eq calc-algebraic-mode 'total)
(define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map)
(define-key calc-alg-ent-map "\ep" 'calcAlg-plus-minus)
@ -350,7 +354,7 @@
(defun calcAlg-previous ()
(interactive)
(if (calc-minibuffer-contains "\\`\\'")
(if (calc-minibuffer-contains "\\'")
(if calc-previous-alg-entry
(insert calc-previous-alg-entry)
(beep))

25
lisp/calc/calc-ext.el
View file

@ -640,29 +640,27 @@
(define-key calc-mode-map (format "u%c" x) 'calc-quick-units)))
"0123456789")
(or calc-emacs-type-19 (progn
(let ((i ?A))
(while (and (<= i ?z) (vectorp calc-mode-map))
(if (eq (car-safe (aref calc-mode-map i)) 'keymap)
(aset calc-mode-map i
(cons 'keymap (cons (cons ?\e (aref calc-mode-map i))
(cdr (aref calc-mode-map i))))))
(while (<= i ?z)
(if (eq (car-safe (aref (nth 1 calc-mode-map) i)) 'keymap)
(aset (nth 1 calc-mode-map) i
(cons 'keymap (cons (cons ?\e (aref (nth 1 calc-mode-map) i))
(cdr (aref (nth 1 calc-mode-map) i))))))
(setq i (1+ i))))
(setq calc-alg-map (copy-sequence calc-mode-map)
calc-alg-esc-map (copy-sequence esc-map))
(setq calc-alg-map (copy-keymap calc-mode-map)
calc-alg-esc-map (copy-keymap esc-map))
(let ((i 32))
(while (< i 127)
(or (memq i '(?' ?` ?= ??))
(aset calc-alg-map i 'calc-auto-algebraic-entry))
(aset (nth 1 calc-alg-map) i 'calc-auto-algebraic-entry))
(or (memq i '(?# ?x ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
(aset calc-alg-esc-map i (aref calc-mode-map i)))
(aset (nth 1 calc-alg-esc-map) i (aref (nth 1 calc-mode-map) i)))
(setq i (1+ i))))
(define-key calc-alg-map "\e" calc-alg-esc-map)
(define-key calc-alg-map "\e\t" 'calc-roll-up)
(define-key calc-alg-map "\e\C-m" 'calc-last-args-stub)
(define-key calc-alg-map "\e\177" 'calc-pop-above)
))
;; The following is a relic for backward compatability only.
;; The calc-define property list is now the recommended method.
@ -1395,8 +1393,7 @@ calc-kill calc-kill-region calc-yank))))
(and (>= last-command-char 0) (< last-command-char ? )
(not (memq last-command-char '(?\e)))))
(calc-wrapper)) ; clear flags if not a Calc command.
(if calc-emacs-type-19
(setq last-command-event (cdr event)))
(setq last-command-event (cdr event))
(if (or (not (integerp last-command-char))
(eq last-command-char ?-))
(calc-unread-command)

10
lisp/calc/calc-graph.el
View file

@ -289,12 +289,8 @@
(tty-output nil)
cache-env is-splot device output resolution precision samples-pos)
(or (boundp 'calc-graph-prev-kill-hook)
(if calc-emacs-type-19
(progn
(setq calc-graph-prev-kill-hook nil)
(add-hook 'kill-emacs-hook 'calc-graph-kill-hook))
(setq calc-graph-prev-kill-hook kill-emacs-hook)
(setq kill-emacs-hook 'calc-graph-kill-hook)))
(setq calc-graph-prev-kill-hook nil)
(add-hook 'kill-emacs-hook 'calc-graph-kill-hook))
(save-excursion
(calc-graph-init)
(set-buffer tempbuf)
@ -1405,7 +1401,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
calc-gnuplot-buffer
calc-gnuplot-name
args))
(process-kill-without-query calc-gnuplot-process))
(set-process-query-on-exit-flag calc-gnuplot-process nil))
(file-error
(error "Sorry, can't find \"%s\" on your system"
calc-gnuplot-name)))

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

@ -1,6 +1,7 @@
;;; calc-help.el --- help display functions for Calc,
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002 Free Software Foundation, Inc.
;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2004
;; Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainers: D. Goel <deego@gnufans.org>
@ -112,34 +113,27 @@ C-w Describe how there is no warranty for Calc."
(describe-bindings)
(save-excursion
(set-buffer "*Help*")
(goto-char (point-min))
(if (search-forward "Global bindings:" nil t)
(delete-region (match-beginning 0) (point-max)))
(goto-char (point-min))
(while (re-search-forward "\n[a-z] ESC" nil t)
(end-of-line)
(delete-region (match-beginning 0) (point)))
(goto-char (point-min))
(while (re-search-forward "\nESC m" nil t)
(end-of-line)
(delete-region (match-beginning 0) (point)))
(goto-char (point-min))
(while (search-forward "\n\n\n" nil t)
(backward-delete-char 1)
(backward-char 2))
(goto-char (point-min))
(while
(re-search-forward
"\n[a-z] [0-9]\\(\t\t.*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1"
nil t)
(let ((dig1 (char-after (1- (match-beginning 1))))
(dig2 (char-after (match-beginning 3))))
(delete-region (match-end 1) (match-end 0))
(goto-char (match-beginning 1))
(delete-backward-char 1)
(delete-char 1)
(insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2)))))
(goto-char (point-min))))
(let ((inhibit-read-only t))
(goto-char (point-min))
(when (search-forward "Major Mode Bindings:" nil t)
(delete-region (point-min) (point))
(insert "Calc Mode Bindings:"))
(when (search-forward "Global bindings:" nil t)
(forward-line -1)
(delete-region (point) (point-max)))
(goto-char (point-min))
(while
(re-search-forward
"\n[a-z] [0-9]\\( .*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1"
nil t)
(let ((dig1 (char-after (1- (match-beginning 1))))
(dig2 (char-after (match-beginning 3))))
(delete-region (match-end 1) (match-end 0))
(goto-char (match-beginning 1))
(delete-backward-char 1)
(delete-char 5)
(insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2)))))
(goto-char (point-min)))))
(defun calc-describe-key-briefly (key)
(interactive "kDescribe key briefly: ")
@ -680,5 +674,5 @@ C-w Describe how there is no warranty for Calc."
"} (matrix brackets); . (abbreviate); / (multi-lines)")
"vec/mat" ?v))
;;; arch-tag: 2d347593-7591-449e-a64a-93dab5f2f686
;; arch-tag: 2d347593-7591-449e-a64a-93dab5f2f686
;;; calc-help.el ends here

2
lisp/calc/calc-mode.el
View file

@ -429,8 +429,6 @@
(defun calc-total-algebraic-mode (flag)
(interactive "P")
(if calc-emacs-type-19
(error "Total algebraic mode not yet supported for Emacs 19"))
(calc-wrapper
(if (eq calc-algebraic-mode 'total)
(calc-algebraic-mode nil)

18
lisp/calc/calc.el
View file

@ -656,12 +656,7 @@ If nil, selections displayed but ignored.")
;; Verify that Calc is running on the right kind of system.
(defconst calc-emacs-type-epoch (and (fboundp 'epoch::version) epoch::version))
(defvar calc-emacs-type-19 (not (or calc-emacs-type-epoch
(string-lessp emacs-version "19"))))
(defvar calc-emacs-type-lucid (not (not (string-match "Lucid" emacs-version))))
(defvar calc-emacs-type-gnu19 (and calc-emacs-type-19
(not calc-emacs-type-lucid)))
;; Set up the standard keystroke (M-#) to run the Calculator, if that key
;; has not yet been bound to anything. For best results, the user should
@ -827,8 +822,8 @@ If nil, selections displayed but ignored.")
(if (eq bind 'undefined)
'undefined 'calcDigit-nondigit))))
calc-mode-map)
(let ((cmap (if calc-emacs-type-19 (nth 1 calc-mode-map) calc-mode-map))
(dmap (if calc-emacs-type-19 (nth 1 map) map))
(let ((cmap (nth 1 calc-mode-map))
(dmap (nth 1 map))
(i 0))
(while (< i 128)
(aset dmap i
@ -998,9 +993,7 @@ If nil, selections displayed but ignored.")
(use-global-map map)
(use-local-map nil)
(read-key-sequence
(if (commandp (key-binding (if calc-emacs-type-19
(vector (cdr key))
(char-to-string (cdr key)))))
(if (commandp (key-binding (vector (cdr key))))
"" prompt2)))
(use-global-map glob)
(use-local-map loc)))))
@ -3425,11 +3418,8 @@ Also looks for the equivalent TeX words, \\gets and \\evalto."
(let ((key (event-to-character event t t)))
(or key optkey (error "Expected a plain keystroke"))
(cons key event))))
(calc-emacs-type-gnu19
(let ((key (read-event)))
(cons key key)))
(t
(let ((key (read-char)))
(let ((key (read-event)))
(cons key key)))))
(defun calc-unread-command (&optional input)

756
lisp/calendar/icalendar.el
View file

File diff suppressed because it is too large Load diff

72
lisp/comint.el
View file

@ -369,10 +369,10 @@ 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 '()
"Special hook run before input is sent to the process.
"Abnormal 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)
(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt)
"Functions to call after output is inserted into the buffer.
One possible function is `comint-postoutput-scroll-to-bottom'.
These functions get one argument, a string containing the text as originally
@ -788,7 +788,7 @@ buffer. The hook `comint-exec-hook' is run after each exec."
(defun comint-insert-input (&optional event)
"In a Comint buffer, set the current input to the previous input at point."
(interactive (list last-input-event))
(interactive "@")
(if event (mouse-set-point event))
(let ((pos (point)))
(if (not (eq (get-char-property pos 'field) 'input))
@ -1901,65 +1901,7 @@ prompt skip is done by skipping text matching the regular expression
;; These three functions are for entering text you don't want echoed or
;; saved -- typically passwords to ftp, telnet, or somesuch.
;; Just enter m-x send-invisible and type in your line, or add
;; `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
(defun comint-read-noecho (prompt &optional stars)
"Read a single line of text from user without echoing, and return it.
Prompt with argument PROMPT, a string. Optional argument STARS causes
input to be echoed with '*' characters on the prompt line. Input ends with
RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if
`inhibit-quit' is set because e.g. this function was called from a process
filter and C-g is pressed, this function returns nil rather than a string).
Note that the keystrokes comprising the text can still be recovered
\(temporarily) with \\[view-lossage]. Some people find this worrisome (see,
however, `clear-this-command-keys').
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
(let ((ans "")
(newans nil)
(c 0)
(echo-keystrokes 0)
(cursor-in-echo-area t)
(message-log-max nil)
(done nil))
(while (not done)
(if stars
(message "%s%s" prompt (make-string (length ans) ?*))
(message "%s" prompt))
;; Use this instead of `read-char' to avoid "Non-character input-event".
(setq c (read-char-exclusive))
(cond ((= c ?\C-g)
;; This function may get called from a process filter, where
;; inhibit-quit is set. In later versions of emacs read-char
;; may clear quit-flag itself and return C-g. That would make
;; it impossible to quit this loop in a simple way, so
;; re-enable it here (for backward-compatibility the check for
;; quit-flag below would still be necessary, so this seems
;; like the simplest way to do things).
(setq quit-flag t
done t))
((or (= c ?\r) (= c ?\n) (= c ?\e))
(setq done t))
((= c ?\C-u)
(clear-string ans)
(setq ans ""))
((and (/= c ?\b) (/= c ?\177))
(setq newans (concat ans (char-to-string c)))
(clear-string ans)
(setq ans newans))
((> (length ans) 0)
(aset ans (1- (length ans)) 0)
(setq ans (substring ans 0 -1)))))
(if quit-flag
;; Emulate a true quit, except that we have to return a value.
(prog1
(setq quit-flag nil)
(message "Quit")
(beep t))
(message "")
ans)))
;; Just enter m-x send-invisible and type in your line.
(defun send-invisible (&optional prompt)
"Read a string without echoing.
@ -1970,7 +1912,7 @@ Security bug: your string can still be temporarily recovered with
(interactive "P") ; Defeat snooping via C-x ESC ESC
(let ((proc (get-buffer-process (current-buffer))))
(if proc
(let ((str (comint-read-noecho (or prompt "Non-echoed text: ") t)))
(let ((str (read-passwd (or prompt "Non-echoed text: "))))
(if (stringp str)
(progn
(comint-snapshot-last-prompt)
@ -2340,7 +2282,7 @@ 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 \\[repeat] work well
with negative arguments.)
@ -2488,7 +2430,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,

2
lisp/delsel.el
View file

@ -147,6 +147,8 @@ then it takes a second \\[keyboard-quit] to abort the minibuffer."
(define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit)
(define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit))
(add-hook 'delsel-unload-hook 'delsel-unload-hook)
(provide 'delsel)
;;; arch-tag: 1e388890-1b50-4ed0-9347-763b1343b6ed

58
lisp/emacs-lisp/bytecomp.el
View file

@ -792,7 +792,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(let ((xs (pop hist-new))
old-autoloads)
;; Make sure the file was not already loaded before.
(unless (assoc (car xs) hist-orig)
(unless (or (assoc (car xs) hist-orig)
(equal (car xs) "cl"))
(dolist (s xs)
(cond
((symbolp s)
@ -809,7 +810,18 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(when (and (symbolp s) (not (memq s old-autoloads)))
(push s byte-compile-noruntime-functions))
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads))))))))))
(push (cdr s) old-autoloads)))))))
(when (memq 'cl-functions byte-compile-warnings)
(let ((hist-new load-history)
(hist-nil-new current-load-list))
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
(while (and hist-new (not (eq hist-new hist-orig)))
(let ((xs (pop hist-new))
old-autoloads)
;; Make sure the file was not already loaded before.
(when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
(byte-compile-find-cl-functions)))))))))
(defun byte-compile-eval-before-compile (form)
"Evaluate FORM for `eval-and-compile'."
@ -848,12 +860,13 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
;; Log something that isn't a warning.
(defun byte-compile-log-1 (string)
(with-current-buffer "*Compile-Log*"
(goto-char (point-max))
(byte-compile-warning-prefix nil nil)
(cond (noninteractive
(message " %s" string))
(t
(insert (format "%s\n" string))))))
(let ((inhibit-read-only t))
(goto-char (point-max))
(byte-compile-warning-prefix nil nil)
(cond (noninteractive
(message " %s" string))
(t
(insert (format "%s\n" string)))))))
(defvar byte-compile-read-position nil
"Character position we began the last `read' from.")
@ -904,7 +917,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
;; This is used as warning-prefix for the compiler.
;; It is always called with the warnings buffer current.
(defun byte-compile-warning-prefix (level entry)
(let* ((dir default-directory)
(let* ((inhibit-read-only t)
(dir default-directory)
(file (cond ((stringp byte-compile-current-file)
(format "%s:" (file-relative-name byte-compile-current-file dir)))
((bufferp byte-compile-current-file)
@ -950,7 +964,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(save-excursion
(set-buffer (get-buffer-create "*Compile-Log*"))
(goto-char (point-max))
(let* ((dir (and byte-compile-current-file
(let* ((inhibit-read-only t)
(dir (and byte-compile-current-file
(file-name-directory byte-compile-current-file)))
(was-same (equal default-directory dir))
pt)
@ -984,7 +999,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(defun byte-compile-log-warning (string &optional fill level)
(let ((warning-prefix-function 'byte-compile-warning-prefix)
(warning-type-format "")
(warning-fill-prefix (if fill " ")))
(warning-fill-prefix (if fill " "))
(inhibit-read-only t))
(display-warning 'bytecomp string level "*Compile-Log*")))
(defun byte-compile-warn (format &rest args)
@ -2140,17 +2156,15 @@ list that represents a doc string reference.
(setq tail (cdr tail))))
form)
(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
(defun byte-compile-file-form-eval-boundary (form)
(let ((old-load-list current-load-list))
(eval form)
;; (require 'cl) turns off warnings for cl functions.
(let ((tem current-load-list))
(while (not (eq tem old-load-list))
(when (equal (car tem) '(require . cl))
(setq byte-compile-warnings
(remq 'cl-functions byte-compile-warnings)))
(setq tem (cdr tem)))))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
(let ((old-load-list current-load-list)
(args (mapcar 'eval (cdr form))))
(apply 'require args)
;; Detech (require 'cl) in a way that works even if cl is already loaded.
(if (member (car args) '("cl" cl))
(setq byte-compile-warnings
(remq 'cl-functions byte-compile-warnings))))
(byte-compile-keep-pending form 'byte-compile-normal-call))
(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)

3
lisp/emacs-lisp/cl.el
View file

@ -108,8 +108,7 @@ printer proceeds to the next function on the list.
This variable is not used at present, but it is defined in hopes that
a future Emacs interpreter will be able to use it.")
(defvar cl-unload-hook '(cl-cannot-unload)
"Prevent unloading the feature `cl', since it does not work.")
(add-hook 'cl-unload-hook 'cl-cannot-unload)
(defun cl-cannot-unload ()
(error "Cannot unload the feature `cl'"))

1
lisp/emacs-lisp/elp.el
View file

@ -626,6 +626,7 @@ displayed."
(defun elp-unload-hook ()
(elp-restore-all))
(add-hook 'elp-unload-hook 'elp-unload-hook)
(provide 'elp)

6
lisp/eshell/em-unix.el
View file

@ -708,11 +708,7 @@ external command."
(eshell-parse-command (concat "*" command)
(eshell-stringify-list
(eshell-flatten-list args))))
(let* ((compilation-process-setup-function
(list 'lambda nil
(list 'setq 'process-environment
(list 'quote (eshell-copy-environment)))))
(args (mapconcat 'identity
(let* ((args (mapconcat 'identity
(mapcar 'shell-quote-argument
(eshell-stringify-list
(eshell-flatten-list args)))

4
lisp/frame.el
View file

@ -135,7 +135,9 @@ Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args."
;; (set-window-dedicated-p window t)
window))
;; If no window yet, make one in a new frame.
(let ((frame (make-frame (append args special-display-frame-alist))))
(let ((frame
(with-current-buffer buffer
(make-frame (append args special-display-frame-alist)))))
(set-window-buffer (frame-selected-window frame) buffer)
(set-window-dedicated-p (frame-selected-window frame) t)
(frame-selected-window frame))))))

23
lisp/fringe.el
View file

@ -43,7 +43,8 @@
(defvar fringe-bitmaps)
(unless (get 'left-truncation 'fringe)
(unless (or (not (boundp 'fringe-bitmaps))
(get 'left-truncation 'fringe))
(let ((bitmaps '(left-truncation right-truncation
up-arrow down-arrow
continued-line continuation-line
@ -112,6 +113,25 @@ See `fringe-mode' for possible values and their effect."
fringe-mode))))
(setq frames (cdr frames)))))
;; For initialization of fringe-mode, take account of changes
;; made explicitly to default-frame-alist.
(defun fringe-mode-initialize (symbol value)
(let* ((left-pair (assq 'left-fringe default-frame-alist))
(right-pair (assq 'right-fringe default-frame-alist))
(left (cdr left-pair))
(right (cdr right-pair)))
(if (or left-pair right-pair)
;; If there's something in default-frame-alist for fringes,
;; don't change it, but reflect that into the value of fringe-mode.
(progn
(setq fringe-mode (cons left right))
(if (equal fringe-mode '(nil . nil))
(setq fringe-mode nil))
(if (equal fringe-mode '(0 . 0))
(setq fringe-mode 0)))
;; Otherwise impose the user-specified value of fringe-mode.
(custom-initialize-reset symbol value))))
;;;###autoload
(defcustom fringe-mode nil
"*Specify appearance of fringes on all frames.
@ -138,6 +158,7 @@ you can use the interactive function `toggle-fringe'"
(integer :tag "Right width")))
:group 'frames
:require 'fringe
:initialize 'fringe-mode-initialize
:set 'set-fringe-mode-1)
(defun fringe-query-style (&optional all-frames)

366
lisp/gnus/ChangeLog
View file

@ -1,3 +1,365 @@
2004-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
* mm-view.el (mm-display-inline-fontify): Inhibit font-lock when
running the major-mode function.
2004-10-21 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-start.el (gnus-convert-old-newsrc): Two of the converters
have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a
boolean check to not apply converters that apply to future
versions of gnus.
2004-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-sum.el (gnus-update-summary-mark-positions): Search for
dummy marks in the right way.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* nnagent.el (nnagent-request-type): Bind gnus-agent to nil to
avoid infinite recursion via gnus-get-function.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-synchronize-group-flags): When
necessary, pass full group name to gnus-request-set-marks.
(gnus-agent-synchronize-group-flags): Added support for sync'ing
tick marks.
(gnus-agent-synchronize-flags-server): Be silent when writing file.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced
gnus-request-update-info with explicit code to sync the in-memory
info read flags with the marks being sync'd to the backend.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore
servers that are offline. Avoids having gnus-agent-toggle-plugged
first ask if you want to open a server and then, even when you
responded with no, asking if you want to synchronize the server's
flags.
(gnus-agent-synchronize-flags-server): Rewrote read loop to handle
multi-line expressions.
(gnus-agent-synchronize-group-flags): New internal function.
Updates marks in memory (in the info structure) AND in the
backend.
(gnus-agent-check-overview-buffer): Fixed range of
deletion to remove entire duplicate line. Fixes merged article
number bug.
* gnus-util.el (gnus-remassoc): Fixed typo in documentation.
* nnagent.el (nnagent-request-set-mark): Use
gnus-agent-synchronize-group-flags, not backend's request-set-mark
method, to ensure that synchronization updates marks in the
backend and in the info (in memory) structure.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing
unless plugged. Disable the agent so that an open failure causes
an error.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de>
* gnus-agent.el (gnus-agent-fetched-hook): Add :version.
(gnus-agent-go-online): Change :version.
(gnus-agent-expire-unagentized-dirs)
(gnus-agent-auto-agentize-methods): Add :version.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt):
New function. Used internally to only display 'gnus converting
files' message when actually necessary.
* gnus-sum.el (): Removed (require 'gnus-agent) as required
methods now autoloaded.
* gnus-int.el (gnus-request-move-article): Use
gnus-agent-unfetch-articles in place of gnus-agent-expire to
improve performance.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf
to avoid run-time CL dependencies.
(gnus-agent-unfetch-articles): New function.
(gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate
article numbers even when local .overview file is missing.
(gnus-agent-read-article-number): New function. Only accepts
27-bit article numbers.
(gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use
gnus-agent-read-article-number.
(gnus-agent-braid-nov): Rewrote to validate article numbers coming
from backend while recognizing that article numbers in .overview
must be valid.
* gnus-start.el (gnus-convert-old-newsrc): Changed message text as
some users confused by references to .newsrc when they only have a
.newsrc.eld file.
(gnus-convert-mark-converter-prompt,
gnus-convert-converter-needs-prompt): Fixed use of property list.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-start.el (gnus-get-unread-articles-in-group): Don't do
stuff for non-living groups.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-agent.el (gnus-agent-synchronize-flags): Default to nil.
(gnus-agent-regenerate-group): Using nil messages aren't valid.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus-agent.el (gnus-agent-read-agentview): Inline
gnus-uncompress-range.
2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
* legacy-gnus-agent.el
(gnus-agent-convert-to-compressed-agentview): Fixed typos with
help from Florian Weimer <fw@deneb.enyo.de>
* gnus-agent.el (gnus-agentize):
gnus-agent-send-mail-real-function no longer set to current value
of message-send-mail-function but rather a lambda that calls
message-send-mail-function. The change makes the agent real-time
responsive to user changes to message-send-mail-function.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de>
* gnus-start.el (gnus-get-unread-articles): Fix last commit.
2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-cache.el (gnus-cache-rename-group): New function.
(gnus-cache-delete-group): New function.
* gnus-agent.el (gnus-agent-rename-group): New function.
(gnus-agent-delete-group): New function.
(gnus-agent-save-group-info): Use gnus-command-method when
`method' parameter is nil. Don't write nil entries into the
active file.
(gnus-agent-get-group-info): New function.
(gnus-agent-get-local): Added optional parameters to avoid calling
gnus-group-real-name and gnus-find-method-for-group.
(gnus-agent-set-local): Delete stored entry if either min, or max,
are nil.
(gnus-agent-fetch-session): Reworded error/quit messages. On
quit, use gnus-agent-regenerate-group to record existance of any
articles fetched to disk before the quit occurred.
* gnus-int.el (gnus-request-delete-group): Use
gnus-cache-delete-group and gnus-agent-delete-group to keep the
local disk in sync with the server.
(gnus-request-rename-group): Use
gnus-cache-rename-group and gnus-agent-rename-group to keep the
local disk in sync with the server.
* gnus-start.el (gnus-get-unread-articles): Cosmetic
simplification to logic.
* gnus-group.el (): (gnus-group-delete-group): No longer update
gnus-cache-active-altered as gnus-request-delete-group now keeps
the cache in sync.
(gnus-group-list-active): Let the agent store a server's active
list if currently plugged.
* gnus-util.el (gnus-rename-file): New function.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-agent.el (gnus-agent-regenerate-group): Activate the group
when the group's active is not available.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to
error.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-start.el (gnus-convert-old-newsrc): Only write the
conversion message to newsrc-dribble when an actual conversion is
performed.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-agent.el (gnus-agent-read-local): Bind
nnheader-file-coding-system to gnus-agent-file-coding-system to
avoid the implicit assumption that they will always be equal.
(gnus-agent-save-local): Bind buffer-file-coding-system, not
coding-system-for-write, as the with-temp-file macro first prints
to a buffer then saves the buffer.
2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
* legacy-gnus-agent.el (): New. Provides converters that are only
loaded when gnus-convert-old-newsrc needs to call them.
* gnus-agent.el (gnus-agent-read-agentview): Removed support for
old file versions.
(gnus-group-prepare-hook): Removed function that converted list
form of gnus-agent-expire-days to group properties.
* gnus-start.el (gnus-convert-old-newsrc): Registered new
converters to handle old agent file formats. Added logic for a
"backup before upgrading warning".
(gnus-convert-mark-converter-prompt): Developers can mark
functions as needing (default), or not needing,
gnus-convert-old-newsrc's "backup before upgrading warning".
(gnus-convert-converter-needs-prompt): Tests whether the user
should be protected from potentially irreversable changes by the
function.
2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
* gnus-int.el (gnus-request-accept-article): Inform the agent that
articles are being added to a group.
(gnus-request-replace-article): Inform the agent that articles
need to be uncached as the cached contents are no longer valid.
* gnus-agent.el (gnus-agent-file-header-cache): Removed.
(gnus-agent-possibly-alter-active): Avoid null in numeric
comparison.
(gnus-agent-set-local): Refuse to save null in local object table.
(gnus-agent-regenerate-group): The REREAD parameter can now be a
list of articles that will be marked as unread.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-range.el (gnus-sorted-range-intersection): Now accepts
single-interval range of the form (min . max). Previously the
range had to look like ((min . max)). Likewise, return
(min . max) rather than ((min . max)).
(gnus-range-map): Use gnus-range-normalize to accept
single-interval range.
* gnus-sum.el (gnus-summary-highlight-line): Articles stored in
the cache, but not the agent, now appear with their usual face.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of
marks consisting of a single range {for example, (3 . 5)} rather
than a list of a single range { ((3 . 5)) }.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the
uncompressed list.
2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
* gnus-draft.el (gnus-group-send-queue): Pass the group name
"nndraft:queue" along to gnus-draft-send. Use
gnus-agent-prompt-send-queue.
(gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group
is "nndraft:queue". Suggested by Gaute Strokkenes
<gs234@srcf.ucam.org>
* gnus-group.el (gnus-group-catchup): Use new
gnus-sequence-of-unread-articles, not
gnus-list-of-unread-articles, to avoid exhausting memory with huge
numbers of articles. Use gnus-range-map to avoid having to
uncompress the unread list.
(gnus-group-archive-directory,
gnus-group-recent-archive-directory): Fixed invalid ange-ftp
reference.
* gnus-range.el (gnus-range-map): Iterate over list or sequence.
(gnus-sorted-range-intersection): Intersection of two ranges
without requiring that they first be uncompressed.
* gnus-start.el (gnus-activate-group): Unless blocked by the
caller, possibly expand the active range to include both cached
and agentized articles.
(gnus-convert-old-newsrc): Rewrote in anticipation of having
multiple version-dependent converters.
(gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with
gnus-agent-save-active.
(gnus-save-newsrc-file): Save dirty agent range limits.
* gnus-sum.el (gnus-select-newgroup): Replaced inline code with
gnus-agent-possibly-alter-active.
(gnus-adjust-marked-articles): Faster handling of simple lists
2004-10-18 David Edmondson <dme@dme.org>
* mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call
excessively.
2004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
* mml.el (mml-preview): Use `pop-to-buffer'.
* message.el (message-goto-mail-followup-to): Insert after "To".
(message-carefully-insert-headers): Add comment.
* gnus-sum.el (gnus-summary-make-menu-bar): Add help texts.
* gnus-art.el (gnus-button-alist): Improve
`gnus-button-handle-library' entry.
* gnus-art.el (gnus-button-alist): Fixed regexp for manual links.
* gnus-group.el (gnus-group-get-new-news-this-group): Added
doc-string.
* gnus-start.el (gnus-activate-group): Added doc-string.
* gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to
handle manual section.
* imap.el (imap-store-password): New variable.
(imap-interactive-login): Use it.
Suggested by Mark Plaksin <happy@mcplaksin.org>.
* gnus-art.el (gnus-button-alist, gnus-header-button-alist): Allow
/ in mailto URLs.
* spam.el (spam-directory): Derive from `gnus-directory'.
* gnus-sum.el (gnus-pick-line-number): Add autoload.
2004-10-17 Richard M. Stallman <rms@gnu.org>
* gnus-registry.el (gnus-registry-unload-hook):
Set as a variable with add-hook.
* nnspool.el (nnspool-spool-directory): Use news-directory instead
of news-path.
* spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook.
* spam.el: Delete duplicate `provide'.
(spam-unload-hook): Set as a variable with add-hook.
2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
* pop3.el (pop3-leave-mail-on-server): Describe possible problems
in the doc string.
* message.el (message-ignored-news-headers)
(message-ignored-supersedes-headers)
(message-ignored-resent-headers)
(message-forward-ignored-headers): Improve custom type.
2004-10-15 Simon Josefsson <jas@extundo.com>
* pop3.el (top-level): Don't require nnheader.
(pop3-read-timeout): Add.
(pop3-accept-process-output): Add.
(pop3-read-response, pop3-retr): Use it.
2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org>
* message.el (message-tokenize-header): Fix 2004-09-06 change
@ -9,6 +371,10 @@
(tls-certificate-information): New function, based on
ssl-certificate-information.
2004-10-11 Reiner Steib <Reiner.Steib@gmx.de>
* message.el (message-bury): Use `window-dedicated-p'.
2004-10-10 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-sum.el: Mention that multibyte characters don't work as marks.

1046
lisp/gnus/gnus-agent.el
View file

File diff suppressed because it is too large Load diff

19
lisp/gnus/gnus-art.el
View file

@ -6122,7 +6122,7 @@ positives are possible."
("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
;; RFC 2368 (The mailto URL scheme)
("mailto:\\([-a-z.@_+0-9%=?&]+\\)"
("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
("\\bmailto:\\([^ \n\t]+\\)"
0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
@ -6170,8 +6170,9 @@ positives are possible."
("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
;; The following entries may lead to many false positives so don't enable
;; them by default (use a high button level):
("/\\([a-z][-a-z0-9]+\\.el\\)\\>"
;; them by default (use a high button level).
("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
;; Exclude [.?] for URLs in gmane.emacs.cvs
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
("`\\([a-z][-a-z0-9]+\\.el\\)'"
1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
@ -6204,16 +6205,16 @@ positives are possible."
(gnus-button-url-regexp
0 (>= gnus-button-browse-level 0) browse-url 0)
;; man pages
("\\b\\([a-z][a-z]+\\)([1-9])\\W"
("\\b\\([a-z][a-z]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
gnus-button-handle-man 1)
;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
("\\b\\([a-z][-_.a-z0-9]+\\)([1-9])\\W"
("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W"
0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
gnus-button-handle-man 1)
;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
("\\b\\([a-z][-+_.:a-z0-9]+\\)([1-9][X1a-z]*)\\W\\|\\b\\(X\\)([1-9])\\W"
("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"
0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
;; MID or mail: To avoid too many false positives we don't try to catch
;; all kind of allowed MIDs or mail addresses. Domain part must contain
@ -6257,7 +6258,7 @@ variable it the real callback function."
0 (>= gnus-button-browse-level 0) browse-url 0)
("^[^:]+:" gnus-button-url-regexp
0 (>= gnus-button-browse-level 0) browse-url 0)
("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&]+\\)"
("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
@ -6602,6 +6603,10 @@ specified by `gnus-button-alist'."
(defun gnus-button-handle-man (url)
"Fetch a man page."
(gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
(when (eq gnus-button-man-handler 'woman)
(setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
(gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
(funcall gnus-button-man-handler url))
(defun gnus-button-handle-info-url (url)

40
lisp/gnus/gnus-cache.el
View file

@ -726,6 +726,46 @@ If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
(or (not gnus-uncacheable-groups)
(not (string-match gnus-uncacheable-groups group)))))))
;;;###autoload
(defun gnus-cache-rename-group (old-group new-group)
"Rename OLD-GROUP as NEW-GROUP. Always updates the cache, even when
disabled, as the old cache files would corrupt gnus when the cache was
next enabled. Depends upon the caller to determine whether group renaming is supported."
(let ((old-dir (gnus-cache-file-name old-group ""))
(new-dir (gnus-cache-file-name new-group "")))
(gnus-rename-file old-dir new-dir t))
(let ((no-save gnus-cache-active-hashtb))
(unless gnus-cache-active-hashtb
(gnus-cache-read-active))
(let* ((old-group-hash-value (gnus-gethash old-group gnus-cache-active-hashtb))
(new-group-hash-value (gnus-gethash new-group gnus-cache-active-hashtb))
(delta (or old-group-hash-value new-group-hash-value)))
(gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
(gnus-sethash old-group nil gnus-cache-active-hashtb)
(if no-save
(setq gnus-cache-active-altered delta)
(gnus-cache-write-active delta)))))
;;;###autoload
(defun gnus-cache-delete-group (group)
"Delete GROUP. Always updates the cache, even when
disabled, as the old cache files would corrupt gnus when the cache was
next enabled. Depends upon the caller to determine whether group deletion is supported."
(let ((dir (gnus-cache-file-name group "")))
(gnus-delete-file dir))
(let ((no-save gnus-cache-active-hashtb))
(unless gnus-cache-active-hashtb
(gnus-cache-read-active))
(let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))
(gnus-sethash group nil gnus-cache-active-hashtb)
(if no-save
(setq gnus-cache-active-altered group-hash-value)
(gnus-cache-write-active group-hash-value)))))
(provide 'gnus-cache)
;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a

74
lisp/gnus/gnus-draft.el
View file

@ -132,17 +132,21 @@
(defun gnus-draft-send (article &optional group interactive)
"Send message ARTICLE."
(let ((message-syntax-checks (if interactive message-syntax-checks
'dont-check-for-anything-just-trust-me))
(message-hidden-headers nil)
(message-inhibit-body-encoding (or (not group)
(equal group "nndraft:queue")
message-inhibit-body-encoding))
(message-send-hook (and group (not (equal group "nndraft:queue"))
message-send-hook))
(message-setup-hook (and group (not (equal group "nndraft:queue"))
message-setup-hook))
type method move-to)
(let* ((is-queue (or (not group)
(equal group "nndraft:queue")))
(message-syntax-checks (if interactive message-syntax-checks
'dont-check-for-anything-just-trust-me))
(message-hidden-headers nil)
(message-inhibit-body-encoding (or is-queue
message-inhibit-body-encoding))
(message-send-hook (and (not is-queue)
message-send-hook))
(message-setup-hook (and (not is-queue)
message-setup-hook))
(gnus-agent-queue-mail (and (not is-queue)
gnus-agent-queue-mail))
(rfc2047-encode-encoded-words nil)
type method move-to)
(gnus-draft-setup article (or group "nndraft:queue"))
;; We read the meta-information that says how and where
;; this message is to be sent.
@ -196,22 +200,25 @@
(defun gnus-group-send-queue ()
"Send all sendable articles from the queue group."
(interactive)
(gnus-activate-group "nndraft:queue")
(save-excursion
(let* ((articles (nndraft-articles))
(unsendable (gnus-uncompress-range
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
(gnus-posting-styles nil)
(total (length articles))
article)
(while (setq article (pop articles))
(unless (memq article unsendable)
(let ((message-sending-message
(format "Sending message %d of %d..."
(- total (length articles)) total)))
(gnus-draft-send article)))))))
(when (or gnus-plugged
(not gnus-agent-prompt-send-queue)
(gnus-y-or-n-p "Gnus is unplugged; really send queue? "))
(gnus-activate-group "nndraft:queue")
(save-excursion
(let* ((articles (nndraft-articles))
(unsendable (gnus-uncompress-range
(cdr (assq 'unsend
(gnus-info-marks
(gnus-get-info "nndraft:queue"))))))
(gnus-posting-styles nil)
(total (length articles))
article)
(while (setq article (pop articles))
(unless (memq article unsendable)
(let ((message-sending-message
(format "Sending message %d of %d..."
(- total (length articles)) total)))
(gnus-draft-send article))))))))
;;;###autoload
(defun gnus-draft-reminder ()
@ -265,12 +272,13 @@
`(lambda (arg)
(gnus-post-method arg ,(car ga))))
(unless (equal (cadr ga) "")
(message-add-action
`(progn
(gnus-add-mark ,(car ga) 'replied ,(cadr ga))
(gnus-request-set-mark ,(car ga) (list (list (list ,(cadr ga))
'add '(reply)))))
'send))))))
(dolist (article (cdr ga))
(message-add-action
`(progn
(gnus-add-mark ,(car ga) 'replied ,article)
(gnus-request-set-mark ,(car ga) (list (list (list ,article)
'add '(reply)))))
'send)))))))
(defun gnus-draft-article-sendable-p (article)
"Say whether ARTICLE is sendable."

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

@ -44,13 +44,13 @@
(eval-when-compile (require 'mm-url))
(defcustom gnus-group-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives."
:group 'gnus-group-foreign
:type 'directory)
(defcustom gnus-group-recent-archive-directory
"*ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
"/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
"*The address of the most recent (ding) articles."
:group 'gnus-group-foreign
:type 'directory)
@ -2283,8 +2283,6 @@ ADDRESS."
(lambda (group)
(gnus-group-delete-group group nil t))))))
(defvar gnus-cache-active-altered)
(defun gnus-group-delete-group (group &optional force no-prompt)
"Delete the current group. Only meaningful with editable groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
@ -2314,10 +2312,6 @@ be removed from the server, even when it's empty."
(gnus-group-goto-group group)
(gnus-group-kill-group 1 t)
(gnus-sethash group nil gnus-active-hashtb)
(if (boundp 'gnus-cache-active-hashtb)
(when gnus-cache-active-hashtb
(gnus-sethash group nil gnus-cache-active-hashtb)
(setq gnus-cache-active-altered t)))
t))
(gnus-group-position-point)))
@ -3133,7 +3127,7 @@ or nil if no action could be taken."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
(num (car entry))
(marks (nth 3 (nth 2 entry)))
(unread (gnus-list-of-unread-articles group)))
(unread (gnus-sequence-of-unread-articles group)))
;; Remove entries for this group.
(nnmail-purge-split-history (gnus-group-real-name group))
;; Do the updating only if the newsgroup isn't killed.
@ -3146,16 +3140,17 @@ or nil if no action could be taken."
'del '(tick))
(list (cdr (assq 'dormant marks))
'del '(dormant))))
(setq unread (gnus-uncompress-range
(gnus-range-add (gnus-range-add
unread (cdr (assq 'dormant marks)))
(cdr (assq 'tick marks)))))
(setq unread (gnus-range-add (gnus-range-add
unread (cdr (assq 'dormant marks)))
(cdr (assq 'tick marks))))
(gnus-add-marked-articles group 'tick nil nil 'force)
(gnus-add-marked-articles group 'dormant nil nil 'force))
;; Do auto-expirable marks if that's required.
(when (gnus-group-auto-expirable-p group)
(gnus-add-marked-articles group 'expire unread)
(gnus-request-set-mark group (list (list unread 'add '(expire)))))
(gnus-range-map (lambda (article)
(gnus-add-marked-articles group 'expire (list article))
(gnus-request-set-mark group (list (list (list article) 'add '(expire)))))
unread))
(let ((gnus-newsgroup-name group))
(gnus-run-hooks 'gnus-group-catchup-group-hook))
num)))
@ -3517,7 +3512,7 @@ entail asking the server for the groups."
;; First we make sure that we have really read the active file.
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t)
(gnus-agent nil)) ; Trick the agent into ignoring the active file.
(gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
(gnus-read-active-file)))
;; Find all groups and sort them.
(let ((groups
@ -3599,7 +3594,8 @@ re-scanning. If ARG is non-nil and not a number, this will force
(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
"Check for newly arrived news in the current group (and the N-1 next groups).
The difference between N and the number of newsgroup checked is returned.
If N is negative, this group and the N-1 previous groups will be checked."
If N is negative, this group and the N-1 previous groups will be checked.
If DONT-SCAN is non-nil, scan non-activated groups as well."
(interactive "P")
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))

58
lisp/gnus/gnus-int.el
View file

@ -33,6 +33,7 @@
(require 'gnus-range)
(autoload 'gnus-agent-expire "gnus-agent")
(autoload 'gnus-agent-regenerate-group "gnus-agent")
(autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
(defcustom gnus-open-server-hook nil
@ -176,7 +177,7 @@ If it is down, start it up (again)."
(setq method (gnus-server-to-method method)))
;; Check cache of constructed names.
(let* ((method-sym (if gnus-agent
(gnus-agent-get-function method)
(inline (gnus-agent-get-function method))
(car method)))
(method-fns (get method-sym 'gnus-method-functions))
(func (let ((method-fnlist-elt (assq function method-fns)))
@ -570,7 +571,7 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(nth 1 gnus-command-method) accept-function last)))
(when (and result gnus-agent
(gnus-agent-method-p gnus-command-method))
(gnus-agent-expire (list article) group 'force))
(gnus-agent-unfetch-articles group (list article)))
result))
(defun gnus-request-accept-article (group &optional gnus-command-method last
@ -580,7 +581,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(setq gnus-command-method (gnus-server-to-method gnus-command-method)))
(when (and (not gnus-command-method)
(stringp group))
(setq gnus-command-method (gnus-group-name-to-method group)))
(setq gnus-command-method (or (gnus-find-method-for-group group)
(gnus-group-name-to-method group))))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
@ -592,12 +594,17 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer)))
(message-encode-message-body)))
(let ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group))))
(funcall (gnus-get-function gnus-command-method 'request-accept-article)
(if (stringp group) (gnus-group-real-name group) group)
(cadr gnus-command-method)
last)))
(let ((gnus-command-method (or gnus-command-method
(gnus-find-method-for-group group)))
(result
(funcall
(gnus-get-function gnus-command-method 'request-accept-article)
(if (stringp group) (gnus-group-real-name group) group)
(cadr gnus-command-method)
last)))
(when (and gnus-agent (gnus-agent-method-p gnus-command-method))
(gnus-agent-regenerate-group group (list (cdr result))))
result))
(defun gnus-request-replace-article (article group buffer &optional no-encode)
(unless no-encode
@ -608,9 +615,12 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(let ((mail-parse-charset message-default-charset))
(mail-encode-encoded-word-buffer)))
(message-encode-message-body)))
(let ((func (car (gnus-group-name-to-method group))))
(funcall (intern (format "%s-request-replace-article" func))
article (gnus-group-real-name group) buffer)))
(let* ((func (car (gnus-group-name-to-method group)))
(result (funcall (intern (format "%s-request-replace-article" func))
article (gnus-group-real-name group) buffer)))
(when (and gnus-agent (gnus-agent-method-p gnus-command-method))
(gnus-agent-regenerate-group group (list article)))
result))
(defun gnus-request-associate-buffer (group)
(let ((gnus-command-method (gnus-find-method-for-group group)))
@ -633,15 +643,25 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
(gnus-group-real-name group) (nth 1 gnus-command-method) args)))
(defun gnus-request-delete-group (group &optional force)
(let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-delete-group)
(gnus-group-real-name group) force (nth 1 gnus-command-method))))
(let* ((gnus-command-method (gnus-find-method-for-group group))
(result
(funcall (gnus-get-function gnus-command-method 'request-delete-group)
(gnus-group-real-name group) force (nth 1 gnus-command-method))))
(when result
(gnus-cache-delete-group group)
(gnus-agent-delete-group group))
result))
(defun gnus-request-rename-group (group new-name)
(let ((gnus-command-method (gnus-find-method-for-group group)))
(funcall (gnus-get-function gnus-command-method 'request-rename-group)
(gnus-group-real-name group)
(gnus-group-real-name new-name) (nth 1 gnus-command-method))))
(let* ((gnus-command-method (gnus-find-method-for-group group))
(result
(funcall (gnus-get-function gnus-command-method 'request-rename-group)
(gnus-group-real-name group)
(gnus-group-real-name new-name) (nth 1 gnus-command-method))))
(when result
(gnus-cache-rename-group group new-name)
(gnus-agent-rename-group group new-name))
result))
(defun gnus-close-backends ()
;; Send a close request to all backends that support such a request.

67
lisp/gnus/gnus-range.el
View file

@ -1,6 +1,6 @@
;;; gnus-range.el --- range and sequence functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -183,6 +183,58 @@ LIST1 and LIST2 have to be sorted over <."
(setq list2 (cdr list2)))))
(nreverse out)))
;;;###autoload
(defun gnus-sorted-range-intersection (range1 range2)
"Return intersection of RANGE1 and RANGE2.
RANGE1 and RANGE2 have to be sorted over <."
(let* (out
(min1 (car range1))
(max1 (if (numberp min1)
(if (numberp (cdr range1))
(prog1 (cdr range1)
(setq range1 nil)) min1)
(prog1 (cdr min1)
(setq min1 (car min1)))))
(min2 (car range2))
(max2 (if (numberp min2)
(if (numberp (cdr range2))
(prog1 (cdr range2)
(setq range2 nil)) min2)
(prog1 (cdr min2)
(setq min2 (car min2))))))
(setq range1 (cdr range1)
range2 (cdr range2))
(while (and min1 min2)
(cond ((< max1 min2) ; range1 preceeds range2
(setq range1 (cdr range1)
min1 nil))
((< max2 min1) ; range2 preceeds range1
(setq range2 (cdr range2)
min2 nil))
(t ; some sort of overlap is occurring
(let ((min (max min1 min2))
(max (min max1 max2)))
(setq out (if (= min max)
(cons min out)
(cons (cons min max) out))))
(if (< max1 max2) ; range1 ends before range2
(setq min1 nil) ; incr range1
(setq min2 nil)))) ; incr range2
(unless min1
(setq min1 (car range1)
max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))
range1 (cdr range1)))
(unless min2
(setq min2 (car range2)
max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
range2 (cdr range2))))
(cond ((cdr out)
(nreverse out))
((numberp (car out))
out)
(t
(car out)))))
;;;###autoload
(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
@ -589,6 +641,19 @@ LIST is a sorted list."
(setcdr prev (cons num list)))
(cdr top)))
(defun gnus-range-map (func range)
"Apply FUNC to each value contained by RANGE."
(setq range (gnus-range-normalize range))
(while range
(let ((span (pop range)))
(if (numberp span)
(funcall func span)
(let ((first (car span))
(last (cdr span)))
(while (<= first last)
(funcall func first)
(setq first (1+ first))))))))
(provide 'gnus-range)
;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad

2
lisp/gnus/gnus-registry.el
View file

@ -693,6 +693,8 @@ Returns the first place where the trail finds a group name."
(remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
(when gnus-registry-install
(gnus-registry-install-hooks)
(gnus-registry-read))

256
lisp/gnus/gnus-start.el
View file

@ -1,5 +1,5 @@
;;; gnus-start.el --- startup functions for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -34,8 +34,15 @@
(require 'gnus-util)
(autoload 'message-make-date "message")
(autoload 'gnus-agent-read-servers-validate "gnus-agent")
(autoload 'gnus-agent-save-local "gnus-agent")
(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
(eval-when-compile (require 'cl))
(eval-when-compile
(require 'cl)
(defvar gnus-agent-covered-methods nil)
(defvar gnus-agent-file-loading-local nil)
(defvar gnus-agent-file-loading-cache nil))
(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
"Your `.newsrc' file.
@ -665,6 +672,8 @@ the first newsgroup."
(setq gnus-list-of-killed-groups nil
gnus-have-read-active-file nil
gnus-agent-covered-methods nil
gnus-agent-file-loading-local nil
gnus-agent-file-loading-cache nil
gnus-server-method-cache nil
gnus-newsrc-alist nil
gnus-newsrc-hashtb nil
@ -1481,8 +1490,8 @@ newsgroup."
(setcdr active (cdr cache-active))))))))
(defun gnus-activate-group (group &optional scan dont-check method)
;; Check whether a group has been activated or not.
;; If SCAN, request a scan of that group as well.
"Check whether a group has been activated or not.
If SCAN, request a scan of that group as well."
(let ((method (or method (inline (gnus-find-method-for-group group))))
active)
(and (inline (gnus-check-server method))
@ -1513,12 +1522,21 @@ newsgroup."
(gnus-active group))
(gnus-active group)
;; If a cache is present, we may have to alter the active info.
(when gnus-use-cache
(inline (gnus-cache-possibly-alter-active
group active)))
;; If the agent is enabled, we may have to alter the active info.
(when gnus-agent
(gnus-agent-possibly-alter-active group active))
(gnus-set-active group active)
;; Return the new active info.
active)))))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when active
(when (and info active)
;; Allow the backend to update the info in the group.
(when (and update
(gnus-request-update-info
@ -1528,6 +1546,10 @@ newsgroup."
(let* ((range (gnus-info-read info))
(num 0))
;; These checks are present in gnus-activate-group but skipped
;; due to setting dont-check in the preceeding call.
;; If a cache is present, we may have to alter the active info.
(when (and gnus-use-cache info)
(inline (gnus-cache-possibly-alter-active
@ -1535,8 +1557,7 @@ newsgroup."
;; If the agent is enabled, we may have to alter the active info.
(when (and gnus-agent info)
(gnus-agent-possibly-alter-active
(gnus-info-group info) active))
(gnus-agent-possibly-alter-active (gnus-info-group info) active info))
;; Modify the list of read articles according to what articles
;; are available; then tally the unread articles and add the
@ -1632,7 +1653,7 @@ newsgroup."
(while newsrc
(setq active (gnus-active (setq group (gnus-info-group
(setq info (pop newsrc))))))
(setq info (pop newsrc))))))
;; Check newsgroups. If the user doesn't want to check them, or
;; they can't be checked (for instance, if the news server can't
@ -1655,61 +1676,60 @@ newsgroup."
(when (and method
(not (setq method-type (cdr (assoc method type-cache)))))
(setq method-type
(cond
((gnus-secondary-method-p method)
'secondary)
((inline (gnus-server-equal gnus-select-method method))
'primary)
(t
'foreign)))
(cond
((gnus-secondary-method-p method)
'secondary)
((inline (gnus-server-equal gnus-select-method method))
'primary)
(t
'foreign)))
(push (cons method method-type) type-cache))
(if (and method
(eq method-type 'foreign))
;; These groups are foreign. Check the level.
(when (and (<= (gnus-info-level info) foreign-level)
(setq active (gnus-activate-group group 'scan)))
;; Let the Gnus agent save the active file.
(when (and gnus-agent active (gnus-online method))
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
(unless (inline (gnus-virtual-group-p group))
(inline (gnus-close-group group)))
(when (fboundp (intern (concat (symbol-name (car method))
"-request-update-info")))
(inline (gnus-request-update-info info method))))
;; These groups are native or secondary.
(cond
;; We don't want these groups.
((> (gnus-info-level info) level)
(setq active 'ignore))
;; Activate groups.
((not gnus-read-active-file)
(if (gnus-check-backend-function 'retrieve-groups group)
;; if server support gnus-retrieve-groups we push
;; the group onto retrievegroups for later checking
(if (assoc method retrieve-groups)
(setcdr (assoc method retrieve-groups)
(cons group (cdr (assoc method retrieve-groups))))
(push (list method group) retrieve-groups))
;; hack: `nnmail-get-new-mail' changes the mail-source depending
;; on the group, so we must perform a scan for every group
;; if the users has any directory mail sources.
;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
;; for it scan all spool files even when the groups are
;; not required.
(if (and
(or nnmail-scan-directory-mail-source-once
(null (assq 'directory
(or mail-sources
(if (listp nnmail-spool-file)
nnmail-spool-file
(list nnmail-spool-file))))))
(member method scanned-methods))
(setq active (gnus-activate-group group))
(setq active (gnus-activate-group group 'scan))
(push method scanned-methods))
(when active
(gnus-close-group group))))))
(cond ((and method (eq method-type 'foreign))
;; These groups are foreign. Check the level.
(when (and (<= (gnus-info-level info) foreign-level)
(setq active (gnus-activate-group group 'scan)))
;; Let the Gnus agent save the active file.
(when (and gnus-agent active (gnus-online method))
(gnus-agent-save-group-info
method (gnus-group-real-name group) active))
(unless (inline (gnus-virtual-group-p group))
(inline (gnus-close-group group)))
(when (fboundp (intern (concat (symbol-name (car method))
"-request-update-info")))
(inline (gnus-request-update-info info method)))))
;; These groups are native or secondary.
((> (gnus-info-level info) level)
;; We don't want these groups.
(setq active 'ignore))
;; Activate groups.
((not gnus-read-active-file)
(if (gnus-check-backend-function 'retrieve-groups group)
;; if server support gnus-retrieve-groups we push
;; the group onto retrievegroups for later checking
(if (assoc method retrieve-groups)
(setcdr (assoc method retrieve-groups)
(cons group (cdr (assoc method retrieve-groups))))
(push (list method group) retrieve-groups))
;; hack: `nnmail-get-new-mail' changes the mail-source depending
;; on the group, so we must perform a scan for every group
;; if the users has any directory mail sources.
;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
;; for it scan all spool files even when the groups are
;; not required.
(if (and
(or nnmail-scan-directory-mail-source-once
(null (assq 'directory
(or mail-sources
(if (listp nnmail-spool-file)
nnmail-spool-file
(list nnmail-spool-file))))))
(member method scanned-methods))
(setq active (gnus-activate-group group))
(setq active (gnus-activate-group group 'scan))
(push method scanned-methods))
(when active
(gnus-close-group group)))))
;; Get the number of unread articles in the group.
(cond
@ -1736,8 +1756,8 @@ newsgroup."
(when (gnus-check-backend-function 'request-scan (car method))
(gnus-request-scan nil method))
(gnus-read-active-file-2
(mapcar (lambda (group) (gnus-group-real-name group)) groups)
method)
(mapcar (lambda (group) (gnus-group-real-name group)) groups)
method)
(dolist (group groups)
(cond
((setq active (gnus-active (gnus-info-group
@ -1982,10 +2002,10 @@ newsgroup."
(while (setq info (pop newsrc))
(when (inline
(gnus-server-equal
(inline
(gnus-find-method-for-group
(gnus-info-group info) info))
gmethod))
(inline
(gnus-find-method-for-group
(gnus-info-group info) info))
gmethod))
(push (gnus-group-real-name (gnus-info-group info))
groups)))
(gnus-read-active-file-2 groups method)))
@ -2129,7 +2149,7 @@ newsgroup."
(gnus-online method)
(gnus-agent-method-p method))
(progn
(gnus-agent-save-groups method)
(gnus-agent-save-active method)
(gnus-active-to-gnus-format method hashtb nil real-active))
(goto-char (point-min))
@ -2205,17 +2225,94 @@ If FORCE is non-nil, the .newsrc file is read."
(gnus-convert-old-newsrc))))
(defun gnus-convert-old-newsrc ()
"Convert old newsrc into the new format, if needed."
"Convert old newsrc formats into the current format, if needed."
(let ((fcv (and gnus-newsrc-file-version
(gnus-continuum-version gnus-newsrc-file-version))))
(cond
;; No .newsrc.eld file was loaded.
((null fcv) nil)
;; Gnus 5 .newsrc.eld was loaded.
((< fcv (gnus-continuum-version "September Gnus v0.1"))
(gnus-convert-old-ticks)))))
(when fcv
;; A newsrc file was loaded.
(let (prompt-displayed
(converters
(sort
(mapcar (lambda (date-func)
(cons (gnus-continuum-version (car date-func))
date-func))
;; This is a list of converters that must be run
;; to bring the newsrc file up to the current
;; version. If you create an incompatibility
;; with older versions, you should create an
;; entry here. The entry should consist of the
;; current gnus version (hardcoded so that it
;; doesn't change with each release) and the
;; function that must be applied to convert the
;; previous version into the current version.
'(("September Gnus v0.1" nil
gnus-convert-old-ticks)
("Oort Gnus v0.08" "legacy-gnus-agent"
gnus-agent-convert-to-compressed-agentview)
("Gnus v5.11" "legacy-gnus-agent"
gnus-agent-unlist-expire-days)
("Gnus v5.11" "legacy-gnus-agent"
gnus-agent-unhook-expire-days)))
#'car-less-than-car)))
;; Skip converters older than the file version
(while (and converters (>= fcv (caar converters)))
(pop converters))
(defun gnus-convert-old-ticks ()
;; Perform converters to bring older version up to date.
(when (and converters (< fcv (caar converters)))
(while (and converters (< fcv (caar converters))
(<= (caar converters) gnus-version))
(let* ((converter-spec (pop converters))
(convert-to (nth 1 converter-spec))
(load-from (nth 2 converter-spec))
(func (nth 3 converter-spec)))
(when (and load-from
(not (fboundp func)))
(load load-from t))
(or prompt-displayed
(not (gnus-convert-converter-needs-prompt func))
(while (let (c
(cursor-in-echo-area t)
(echo-keystrokes 0))
(message "Convert gnus from version '%s' to '%s'? (n/y/?)"
gnus-newsrc-file-version gnus-version)
(setq c (read-char-exclusive))
(cond ((or (eq c ?n) (eq c ?N))
(error "Can not start gnus without converting"))
((or (eq c ?y) (eq c ?Y))
(setq prompt-displayed t)
nil)
((eq c ?\?)
(message "This conversion is irreversible. \
To be safe, you should backup your files before proceeding.")
(sit-for 5)
t)
(t
(gnus-message 3 "Ignoring unexpected input")
(sit-for 3)
t)))))
(funcall func convert-to)))
(gnus-dribble-enter
(format ";Converted gnus from version '%s' to '%s'."
gnus-newsrc-file-version gnus-version)))))))
(defun gnus-convert-mark-converter-prompt (converter no-prompt)
"Indicate whether CONVERTER requires gnus-convert-old-newsrc to
display the conversion prompt. NO-PROMPT may be nil (prompt),
t (no prompt), or any form that can be called as a function.
The form should return either t or nil."
(put converter 'gnus-convert-no-prompt no-prompt))
(defun gnus-convert-converter-needs-prompt (converter)
(let ((no-prompt (get converter 'gnus-convert-no-prompt)))
(not (if (memq no-prompt '(t nil))
no-prompt
(funcall no-prompt)))))
(defun gnus-convert-old-ticks (converting-to)
(let ((newsrc (cdr gnus-newsrc-alist))
marks info dormant ticked)
(while (setq info (pop newsrc))
@ -2594,6 +2691,10 @@ If FORCE is non-nil, the .newsrc file is read."
;; from the variable gnus-newsrc-alist.
(when (and (or gnus-newsrc-alist gnus-killed-list)
gnus-current-startup-file)
;; Save agent range limits for the currently active method.
(when gnus-agent
(gnus-agent-save-local force))
(save-excursion
(if (and (or gnus-use-dribble-file gnus-slave)
(not force)
@ -2611,6 +2712,7 @@ If FORCE is non-nil, the .newsrc file is read."
(gnus-message 8 "Saving %s..." gnus-current-startup-file)
(gnus-gnus-to-newsrc-format)
(gnus-message 8 "Saving %s...done" gnus-current-startup-file))
;; Save .newsrc.eld.
(set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
(make-local-variable 'version-control)

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

@ -44,6 +44,7 @@
(autoload 'gnus-cache-write-active "gnus-cache")
(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
(autoload 'gnus-pick-line-number "gnus-salt" nil t)
(autoload 'mm-uu-dissect "mm-uu")
(autoload 'gnus-article-outlook-deuglify-article "deuglify"
"Deuglify broken Outlook (Express) articles and redisplay."
@ -2238,8 +2239,12 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
["Pipe through a filter..." gnus-summary-pipe-output t]
["Add to SOUP packet" gnus-soup-add-article t]
["Print with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article t])
("Backend"
["Print" gnus-summary-print-article
,@(if (featurep 'xemacs) '(t)
'(:help "Generate and print a PostScript image"))])
("Copy, move,... (Backend)"
,@(if (featurep 'xemacs) '(t)
'(:help "Copying, moving, expiring articles..."))
["Respool article..." gnus-summary-respool-article t]
["Move article..." gnus-summary-move-article
(gnus-check-backend-function
@ -2330,7 +2335,7 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs))))
`("Post"
["Send a message (mail or news)" gnus-summary-post-news
,@(if (featurep 'xemacs) '(t)
'(:help "Post an article"))]
'(:help "Compose a new message (mail or news)"))]
["Followup" gnus-summary-followup
,@(if (featurep 'xemacs) '(t)
'(:help "Post followup to this article"))]
@ -3229,28 +3234,34 @@ buffer that was in action when the last article was fetched."
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '(0)))
(gnus-newsgroup-downloadable '(0))
marks)
(insert ?\200 "\200" ?\201 "\201" ?\202 "\202" ?\203 "\203")
(while (not (bobp))
(push (buffer-substring (1- (point)) (point)) marks)
(backward-char))
(erase-buffer)
(gnus-summary-insert-line
[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
(mm-string-as-multibyte "\200") nil t)
(and (or (search-forward (nth 0 marks) nil t)
(search-forward (nth 1 marks) nil t))
(- (point) (point-min) 1)))))
(goto-char (point-min))
(push (cons 'replied (and (search-forward
(mm-string-as-multibyte "\201") nil t)
(push (cons 'replied (and (or (search-forward (nth 2 marks) nil t)
(search-forward (nth 3 marks) nil t))
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'score (and (search-forward
(mm-string-as-multibyte "\202") nil t)
(push (cons 'score (and (or (search-forward (nth 4 marks) nil t)
(search-forward (nth 5 marks) nil t))
(- (point) (point-min) 1)))
pos)
(goto-char (point-min))
(push (cons 'download (and (search-forward
(mm-string-as-multibyte "\203") nil t)
(push (cons 'download (and (or (search-forward (nth 6 marks) nil t)
(search-forward (nth 7 marks) nil t))
(- (point) (point-min) 1)))
pos)))
(setq gnus-summary-mark-positions pos))))
@ -5065,17 +5076,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
group (gnus-status-message group)))
(when gnus-agent
;; The agent may be storing articles that are no longer in the
;; server's active range. If that is the case, the active range
;; needs to be expanded such that the agent's articles can be
;; included in the summary.
(let* ((gnus-command-method (gnus-find-method-for-group group))
(alist (gnus-agent-load-alist group))
(active (gnus-active group)))
(if (and (car alist)
(< (caar alist) (car active)))
(gnus-set-active group (cons (caar alist) (cdr active)))))
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(setq gnus-summary-use-undownloaded-faces
(gnus-agent-find-parameter
group
@ -5404,7 +5406,8 @@ If SELECT-ARTICLES, only select those articles from GROUP."
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
marks var articles article mark mark-type)
marks var articles article mark mark-type
bgn end)
(dolist (marks marked-lists)
(setq mark (car marks)
@ -5414,13 +5417,30 @@ If SELECT-ARTICLES, only select those articles from GROUP."
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
;; Adjust "simple" lists.
;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
(set var (setq articles (gnus-uncompress-range (cdr marks))))
(when (memq mark '(tick dormant expire reply save))
(while articles
(when (or (< (setq article (pop articles)) min) (> article max))
(set var (delq article (symbol-value var)))))))
;; Simultaneously uncompress and clip to active range
;; See gnus-uncompress-range for a description of possible marks
(let (l lh)
(if (not (cadr marks))
(set var nil)
(setq articles (if (numberp (cddr marks))
(list (cdr marks))
(cdr marks))
lh (cons nil nil)
l lh)
(while (setq article (pop articles))
(cond ((consp article)
(setq bgn (max (car article) min)
end (min (cdr article) max))
(while (<= bgn end)
(setq l (setcdr l (cons bgn nil))
bgn (1+ bgn))))
((and (<= min article)
(>= max article))
(setq l (setcdr l (cons article nil))))))
(set var (cdr lh)))))
;; Adjust assocs.
((eq mark-type 'tuple)
(set var (setq articles (cdr marks)))
@ -6353,15 +6373,15 @@ displayed, no centering will be performed."
(while read
(when first
(while (< first nlast)
(push first unread)
(setq first (1+ first))))
(setq unread (cons first unread)
first (1+ first))))
(setq first (1+ (if (atom (car read)) (car read) (cdar read))))
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(while (<= first last)
(push first unread)
(setq first (1+ first)))
(setq unread (cons first unread)
first (1+ first)))
;; Return the list of unread articles.
(delq 0 (nreverse unread))))
@ -6379,6 +6399,44 @@ displayed, no centering will be performed."
(cdr (assq 'dormant marked)))
(cdr (assq 'tick marked))))))
;; This function returns a sequence of article numbers based on the
;; difference between the ranges of read articles in this group and
;; the range of active articles.
(defun gnus-sequence-of-unread-articles (group)
(let* ((read (gnus-info-read (gnus-get-info group)))
(active (or (gnus-active group) (gnus-activate-group group)))
(last (cdr active))
first nlast unread)
;; If none are read, then all are unread.
(if (not read)
(setq first (car active))
;; If the range of read articles is a single range, then the
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
(if (and (not (listp (cdr read)))
(or (< (car read) (car active))
(progn (setq read (list read))
nil)))
(setq first (max (car active) (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
(setq first (car active)))
(while read
(when first
(push (cons first nlast) unread))
(setq first (1+ (if (atom (car read)) (car read) (cdar read))))
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(cond ((< first last)
(push (cons first last) unread))
((= first last)
(push first unread)))
;; Return the sequence of unread articles.
(delq 0 (nreverse unread))))
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
@ -11305,7 +11363,8 @@ If REVERSE, save parts that do not match TYPE."
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
(uncached (and gnus-summary-use-undownloaded-faces
(memq article gnus-newsgroup-undownloaded))))
(memq article gnus-newsgroup-undownloaded)
(not (memq article gnus-newsgroup-cached)))))
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces

30
lisp/gnus/gnus-util.el
View file

@ -38,7 +38,11 @@
(eval-when-compile
(require 'cl)
;; Fixme: this should be a gnus variable, not nnmail-.
(defvar nnmail-pathname-coding-system))
(defvar nnmail-pathname-coding-system)
;; Inappropriate references to other parts of Gnus.
(defvar gnus-emphasize-whitespace-regexp)
)
(require 'time-date)
(require 'netrc)
@ -1186,7 +1190,7 @@ is run."
"Delete by side effect any elements of LIST whose car is `equal' to KEY.
The modified LIST is returned. If the first member
of LIST has a car that is `equal' to KEY, there is no way to remove it
by side effect; therefore, write `(setq foo (remassoc key foo))' to be
by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be
sure of changing the value of `foo'."
(when alist
(if (equal key (caar alist))
@ -1512,6 +1516,28 @@ predicate on the elements."
"")))
(t emacs-version))))
(defun gnus-rename-file (old-path new-path &optional trim)
"Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete
empty directories from OLD-PATH."
(when (file-exists-p old-path)
(let* ((old-dir (file-name-directory old-path))
(old-name (file-name-nondirectory old-path))
(new-dir (file-name-directory new-path))
(new-name (file-name-nondirectory new-path))
temp)
(gnus-make-directory new-dir)
(rename-file old-path new-path t)
(when trim
(while (progn (setq temp (directory-files old-dir))
(while (member (car temp) '("." ".."))
(setq temp (cdr temp)))
(= (length temp) 0))
(delete-directory old-dir)
(setq old-dir (file-name-as-directory
(file-truename
(concat old-dir "..")))))))))
(provide 'gnus-util)
;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49

12
lisp/gnus/imap.el
View file

@ -270,6 +270,11 @@ Shorter values mean quicker response, but is more CPU intensive."
:type 'number
:group 'imap)
(defcustom imap-store-password nil
"If non-nil, store session password without promting."
:group 'imap
:type 'boolean)
;; Various variables.
(defvar imap-fetch-data-hook nil
@ -827,9 +832,10 @@ Returns t if login was successful, nil otherwise."
(progn
(setq ret t
imap-username user)
(if (and (not imap-password)
(y-or-n-p "Store password for this session? "))
(setq imap-password passwd)))
(when (and (not imap-password)
(or imap-store-password
(y-or-n-p "Store password for this session? ")))
(setq imap-password passwd)))
(message "Login failed...")
(setq passwd nil)
(setq imap-password nil)

227
lisp/gnus/legacy-gnus-agent.el Normal file
View file

@ -0,0 +1,227 @@
(require 'gnus-start)
(require 'gnus-util)
(require 'gnus-range)
(require 'gnus-agent)
; Oort Gnus v0.08 - This release updated agent to no longer use
; history file and to support a compressed alist.
(defvar gnus-agent-compressed-agentview-search-only nil)
(defun gnus-agent-convert-to-compressed-agentview (converting-to)
"Iterates over all agentview files to ensure that they have been
converted to the compressed format."
(let ((search-in (list gnus-agent-directory))
here
members
member
converted-something)
(while (setq here (pop search-in))
(setq members (directory-files here t))
(while (setq member (pop members))
(cond ((string-match "/\\.\\.?$" member)
nil)
((file-directory-p member)
(push member search-in))
((equal (file-name-nondirectory member) ".agentview")
(setq converted-something
(or (gnus-agent-convert-agentview member)
converted-something))))))
(if converted-something
(gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))
(defun gnus-agent-convert-to-compressed-agentview-prompt ()
(catch 'found-file-to-convert
(let ((gnus-agent-compressed-agentview-search-only t))
(gnus-agent-convert-to-compressed-agentview nil))))
(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)
(defun gnus-agent-convert-agentview (file)
"Load FILE and do a `read' there."
(with-temp-buffer
(nnheader-insert-file-contents file)
(goto-char (point-min))
(let ((inhibit-quit t)
(alist (read (current-buffer)))
(version (condition-case nil (read (current-buffer))
(end-of-file 0)))
changed-version
history-file)
(cond
((= version 0)
(let (entry
(gnus-command-method nil))
(mm-disable-multibyte) ;; everything is binary
(erase-buffer)
(insert "\n")
(let ((file (concat (file-name-directory file) "/history")))
(when (file-exists-p file)
(nnheader-insert-file-contents file)
(setq history-file file)))
(goto-char (point-min))
(while (not (eobp))
(if (and (looking-at
"[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
(string= (gnus-agent-article-name ".agentview" (match-string 2))
file)
(setq entry (assoc (string-to-number (match-string 3)) alist)))
(setcdr entry (string-to-number (match-string 1))))
(forward-line 1))
(setq changed-version t)))
((= version 1)
(setq changed-version t)))
(when changed-version
(when gnus-agent-compressed-agentview-search-only
(throw 'found-file-to-convert t))
(erase-buffer)
(let ((compressed nil))
(mapcar (lambda (pair)
(let* ((article-id (car pair))
(day-of-download (cdr pair))
(comp-list (assq day-of-download compressed)))
(if comp-list
(setcdr comp-list
(cons article-id (cdr comp-list)))
(setq compressed
(cons (list day-of-download article-id)
compressed)))
nil)) alist)
(mapcar (lambda (comp-list)
(setcdr comp-list
(gnus-compress-sequence
(nreverse (cdr comp-list)))))
compressed)
(princ compressed (current-buffer)))
(insert "\n2\n")
(write-file file)
(when history-file
(delete-file history-file))
t))))
;; End of Oort Gnus v0.08 updates
;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
;; from previous versions. Therefore, the previous
;; hacks to handle a gnus-agent-expire-days that
;; specifies a list of values can be removed.
(defun gnus-agent-unlist-expire-days (converting-to)
(when (listp gnus-agent-expire-days)
(let (buffer)
(unwind-protect
(save-window-excursion
(setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*"))
(set-buffer buffer)
(erase-buffer)
(insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ")
(gnus-pp gnus-agent-expire-days)
(insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
(insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
(insert "expiration days to individual groups, you must instead set the\n")
(insert "'agent-days-until-old group and/or topic parameter.\n")
(insert "\n")
(insert "If you would like, gnus can iterate over every group comparing its name to the\n")
(insert "regular expressions that you currently have in gnus-agent-expire-days. When\n")
(insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n")
(insert "parameter to the value associated with the regular expression.\n")
(insert "\n")
(insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
(insert "ERROR as soon as this function completes. The reason is that you must\n")
(insert "manually edit your configuration to either not set gnus-agent-expire-days or\n")
(insert "to set it to an integer before gnus can be used.\n")
(insert "\n")
(insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n")
(insert "execute past this function.\n")
(insert "\n")
(insert "Should gnus use gnus-agent-expire-days to assign\n")
(insert "agent-days-until-old parameters to individual groups? (Y/N)")
(switch-to-buffer buffer)
(beep)
(beep)
(let ((echo-keystrokes 0)
c)
(while (progn (setq c (read-char-exclusive))
(cond ((or (eq c ?y) (eq c ?Y))
(save-excursion
(let ((groups (gnus-group-listed-groups)))
(while groups
(let* ((group (pop groups))
(days gnus-agent-expire-days)
(day (catch 'found
(while days
(when (eq 0 (string-match
(caar days)
group))
(throw 'found (cadar days)))
(setq days (cdr days)))
nil)))
(when day
(gnus-group-set-parameter group 'agent-days-until-old
day))))))
nil
)
((or (eq c ?n) (eq c ?N))
nil)
(t
t))))))
(kill-buffer buffer))
(error "Change gnus-agent-expire-days to an integer for gnus to start."))))
;; The gnus-agent-unlist-expire-days has its own conversion prompt.
;; Therefore, hide the default prompt.
(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
(defun gnus-agent-unhook-expire-days (converting-to)
"Remove every lambda from gnus-group-prepare-hook that mention the
symbol gnus-agent-do-once in their definition. This should NOT be
necessary as gnus-agent.el no longer adds them. However, it is
possible that the hook was persistently saved."
(let ((h t)) ; iterate from bgn of hook
(while h
(let ((func (progn (when (eq h t)
;; init h to list of functions
(setq h (cond ((listp gnus-group-prepare-hook)
gnus-group-prepare-hook)
((boundp 'gnus-group-prepare-hook)
(list gnus-group-prepare-hook)))))
(pop h))))
(when (cond ((eq (type-of func) 'compiled-function)
;; Search def. of compiled function for gnus-agent-do-once string
(let* (definition
print-level
print-length
(standard-output
(lambda (char)
(setq definition (cons char definition)))))
(princ func) ; populates definition with reversed list of characters
(let* ((i (length definition))
(s (make-string i 0)))
(while definition
(aset s (setq i (1- i)) (pop definition)))
(string-match "\\bgnus-agent-do-once\\b" s))))
((listp func)
(eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda
))
(remove-hook 'gnus-group-prepare-hook func)
;; I don't what remove-hook is going to actually do to the
;; hook list so start over from the beginning.
(setq h t))))))
;; gnus-agent-unhook-expire-days is safe in that it does not modify
;; the .newsrc.eld file.
(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)
;;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a

2
lisp/gnus/mail-source.el
View file

@ -257,7 +257,7 @@ If non-nil, this maildrop will be checked periodically for new mail."
:type 'file)
(defcustom mail-source-directory message-directory
"Directory where files (if any) will be stored."
"Directory where incoming mail source files (if any) will be stored."
:group 'mail-source
:type 'directory)

30
lisp/gnus/message.el
View file

@ -255,7 +255,12 @@ included. Organization and User-Agent are optional."
:group 'message-news
:group 'message-headers
:link '(custom-manual "(message)Message Headers")
:type 'regexp)
:type '(repeat :value-to-internal (lambda (widget value)
(custom-split-regexp-maybe value))
:match (lambda (widget value)
(or (stringp value)
(widget-editable-list-match widget value)))
regexp))
(defcustom message-ignored-mail-headers
"^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
@ -271,7 +276,12 @@ It's best to delete old Path and Date headers before posting to avoid
any confusion."
:group 'message-interface
:link '(custom-manual "(message)Superseding")
:type 'regexp)
:type '(repeat :value-to-internal (lambda (widget value)
(custom-split-regexp-maybe value))
:match (lambda (widget value)
(or (stringp value)
(widget-editable-list-match widget value)))
regexp))
(defcustom message-subject-re-regexp
"^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
@ -534,13 +544,22 @@ Done before generating the new subject of a forward."
"*All headers that match this regexp will be deleted when resending a message."
:group 'message-interface
:link '(custom-manual "(message)Resending")
:type 'regexp)
:type '(repeat :value-to-internal (lambda (widget value)
(custom-split-regexp-maybe value))
:match (lambda (widget value)
(or (stringp value)
(widget-editable-list-match widget value)))
regexp))
(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
"*All headers that match this regexp will be deleted when forwarding a message."
:version "21.1"
:group 'message-forwarding
:type '(choice (const :tag "None" nil)
:type '(repeat :value-to-internal (lambda (widget value)
(custom-split-regexp-maybe value))
:match (lambda (widget value)
(or (stringp value)
(widget-editable-list-match widget value)))
regexp))
(defcustom message-ignored-cited-headers "."
@ -2610,7 +2629,7 @@ M-RET `message-newline-and-reformat' (break the line and reformat)."
(defun message-goto-mail-followup-to ()
"Move point to the Mail-Followup-To header."
(interactive)
(message-position-on-field "Mail-Followup-To" "From"))
(message-position-on-field "Mail-Followup-To" "To"))
(defun message-goto-keywords ()
"Move point to the Keywords header."
@ -2720,6 +2739,7 @@ or in the synonym headers, defined by `message-header-synonyms'."
;; FIXME: Should compare only the address and not the full name. Comparison
;; should be done case-folded (and with `string=' rather than
;; `string-match').
;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)")
(dolist (header headers)
(let* ((header-name (symbol-name (car header)))
(new-header (cdr header))

21
lisp/gnus/mm-view.el
View file

@ -199,13 +199,14 @@
(setq w3m-display-inline-images mm-inline-text-html-with-images))
(defun mm-w3m-cid-retrieve-1 (url handle)
(if (mm-multiple-handles handle)
(dolist (elem handle)
(mm-w3m-cid-retrieve-1 url elem))
(when (and (listp handle)
(equal url (mm-handle-id handle)))
(mm-insert-part handle)
(throw 'found-handle (mm-handle-media-type handle)))))
(dolist (elem handle)
(when (listp elem)
(if (equal url (mm-handle-id elem))
(progn
(mm-insert-part elem)
(throw 'found-handle (mm-handle-media-type elem))))
(if (equal "multipart" (mm-handle-media-supertype elem))
(mm-w3m-cid-retrieve-1 url elem)))))
(defun mm-w3m-cid-retrieve (url &rest args)
"Insert a content pointed by URL if it has the cid: scheme."
@ -465,8 +466,12 @@
(progn
(buffer-disable-undo)
(mm-insert-part handle)
(funcall mode)
(require 'font-lock)
;; Inhibit font-lock this time (*-mode-hook might run
;; `turn-on-font-lock') so that jit-lock may not turn off
;; font-lock immediately after this.
(let ((font-lock-mode t))
(funcall mode))
(let ((font-lock-verbose nil))
;; I find font-lock a bit too verbose.
(font-lock-fontify-buffer))

6
lisp/gnus/mml.el
View file

@ -1076,9 +1076,9 @@ If RAW, don't highlight the article."
(message-fetch-field "Newsgroups")))
message-posting-charset)))
(message-options-set-recipient)
(switch-to-buffer (generate-new-buffer
(concat (if raw "*Raw MIME preview of "
"*MIME preview of ") (buffer-name))))
(pop-to-buffer (generate-new-buffer
(concat (if raw "*Raw MIME preview of "
"*MIME preview of ") (buffer-name))))
(when (boundp 'gnus-buffers)
(push (current-buffer) gnus-buffers))
(erase-buffer)

13
lisp/gnus/nnagent.el
View file

@ -103,7 +103,7 @@
(defun nnagent-request-type (group article)
(unless (stringp article)
(let ((gnus-plugged t))
(let ((gnus-agent nil))
(if (not (gnus-check-backend-function
'request-type (car gnus-command-method)))
'unknown
@ -122,9 +122,14 @@
(deffoo nnagent-request-set-mark (group action server)
(with-temp-buffer
(insert (format "(%s-request-set-mark \"%s\" '%s \"%s\")\n"
(nth 0 gnus-command-method) group action
(or server (nth 1 gnus-command-method))))
(insert "(gnus-agent-synchronize-group-flags \""
group
"\" '")
(gnus-pp action)
(insert " \""
(gnus-method-to-server gnus-command-method)
"\"")
(insert ")\n")
(append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags")))
nil)

2
lisp/gnus/nnspool.el
View file

@ -44,7 +44,7 @@ This is most commonly `inews' or `injnews'.")
"Switches for nnspool-request-post to pass to `inews' for posting news.
If you are using Cnews, you probably should set this variable to nil.")
(defvoo nnspool-spool-directory (file-name-as-directory news-path)
(defvoo nnspool-spool-directory (file-name-as-directory news-directory)
"Local news spool directory.")
(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")

40
lisp/gnus/pop3.el
View file

@ -83,7 +83,14 @@ values are 'apop."
:group 'pop3)
(defcustom pop3-leave-mail-on-server nil
"*Non-nil if the mail is to be left on the POP server after fetching."
"*Non-nil if the mail is to be left on the POP server after fetching.
If the `pop3-leave-mail-on-server' is non-`nil' the mail is to be
left on the POP server after fetching. Note that POP servers
maintain no state information between sessions, so what the
client believes is there and what is actually there may not match
up. If they do not, then the whole thing can fall apart and
leave you with a corrupt mailbox."
:version "21.4" ;; Oort Gnus
:type 'boolean
:group 'pop3)
@ -95,6 +102,32 @@ Used for APOP authentication.")
(defvar pop3-read-point nil)
(defvar pop3-debug nil)
;; Borrowed from nnheader-accept-process-output in nnheader.el.
(defvar pop3-read-timeout
(if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
(symbol-name system-type))
;; 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 pop3 should wait between checking for the end of output.
Shorter values mean quicker response, but are more CPU intensive.")
;; Borrowed from nnheader-accept-process-output in nnheader.el.
(defun pop3-accept-process-output (process)
(accept-process-output
process
(truncate pop3-read-timeout)
(truncate (* (- pop3-read-timeout
(truncate pop3-read-timeout))
1000))))
(defun pop3-movemail (&optional crashbox)
"Transfer contents of a maildrop to the specified CRASHBOX."
(or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
@ -207,7 +240,7 @@ Return the response string if optional second argument is non-nil."
(goto-char pop3-read-point)
(while (and (memq (process-status process) '(open run))
(not (search-forward "\r\n" nil t)))
(nnheader-accept-process-output process)
(pop3-accept-process-output process)
(goto-char pop3-read-point))
(setq match-end (point))
(goto-char pop3-read-point)
@ -381,8 +414,7 @@ This function currently does nothing.")
(save-excursion
(set-buffer (process-buffer process))
(while (not (re-search-forward "^\\.\r\n" nil t))
;; Fixme: Shouldn't depend on nnheader.
(nnheader-accept-process-output process)
(pop3-accept-process-output process)
(goto-char start))
(setq pop3-read-point (point-marker))
;; this code does not seem to work for some POP servers...

2
lisp/gnus/spam-stat.el
View file

@ -594,6 +594,8 @@ COUNT defaults to 5"
(remove-hook 'gnus-select-article-hook
'spam-stat-store-gnus-article-buffer))
(add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook)
(provide 'spam-stat)
;;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554

8
lisp/gnus/spam.el
View file

@ -78,7 +78,7 @@
(defgroup spam nil
"Spam configuration.")
(defcustom spam-directory "~/News/spam/"
(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
"Directory for spam whitelists and blacklists."
:type 'directory
:group 'spam)
@ -1814,14 +1814,12 @@ REMOVE not nil, remove the ADDRESSES."
(remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
(remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
(add-hook 'spam-unload-hook 'spam-unload-hook)
(when spam-install-hooks
(spam-initialize))
(provide 'spam)
;;; spam.el ends here.
(provide 'spam)
;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
;;; spam.el ends here

3
lisp/help-at-pt.el
View file

@ -348,8 +348,7 @@ different regions. With numeric argument ARG, behaves like
(interactive "p")
(scan-buf-move-to-region 'help-echo (- arg) 'scan-buf-move-hook))
(defvar help-at-pt-unload-hook '(help-at-pt-cancel-timer)
"Normal hook run when `help-at-pt' is unloaded.")
(add-hook 'help-at-pt-unload-hook 'help-at-pt-cancel-timer)
(provide 'help-at-pt)

28
lisp/ibuffer.el
View file

@ -213,12 +213,20 @@ If a regexp, then it will be matched against the buffer's name.
If a function, it will be called with the buffer as an argument, and
should return non-nil if this buffer should be shown.
Viewing of buffers hidden because of these predicates is enabled by
giving a non-nil prefix argument to `ibuffer-update'. Note that this
specialized filtering occurs before real filtering."
Viewing of buffers hidden because of these predicates may be customized
via `ibuffer-default-display-maybe-show-predicates' and is toggled by
giving a non-nil prefix argument to `ibuffer-update'.
Note that this specialized filtering occurs before real filtering."
:type '(repeat (choice regexp function))
:group 'ibuffer)
(defcustom ibuffer-default-display-maybe-show-predicates nil
"Non-nil means show buffers that match `ibuffer-maybe-show-predicates'."
:type 'boolean
:group 'ibuffer)
(defvar ibuffer-display-maybe-show-predicates nil)
(defvar ibuffer-current-format nil)
(defcustom ibuffer-movement-cycle t
@ -2069,11 +2077,15 @@ If optional arg SILENT is non-nil, do not display progress messages."
(defun ibuffer-update (arg &optional silent)
"Regenerate the list of all buffers.
Display buffers whose name matches one of `ibuffer-maybe-show-predicates'
iff arg ARG is non-nil.
Prefix arg non-nil means to toggle whether buffers that match
`ibuffer-maybe-show-predicates' should be displayed.
If optional arg SILENT is non-nil, do not display progress messages."
(interactive "P")
(if arg
(setq ibuffer-display-maybe-show-predicates
(not ibuffer-display-maybe-show-predicates)))
(ibuffer-forward-line 0)
(let* ((bufs (buffer-list))
(blist (ibuffer-filter-buffers
@ -2086,7 +2098,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
(caddr bufs)
(cadr bufs))
(ibuffer-current-buffers-with-marks bufs)
arg)))
ibuffer-display-maybe-show-predicates)))
(when (null blist)
(if (and (featurep 'ibuf-ext)
ibuffer-filtering-qualifiers)
@ -2148,7 +2160,7 @@ If optional arg SILENT is non-nil, do not display progress messages."
'ibuffer-filter-group
name)))
(defun ibuffer-redisplay-engine (bmarklist &optional all)
(defun ibuffer-redisplay-engine (bmarklist &optional ignore)
(assert (eq major-mode 'ibuffer-mode))
(let* ((--ibuffer-insert-buffers-and-marks-format
(ibuffer-current-format))
@ -2475,6 +2487,8 @@ will be inserted before the group at point."
ibuffer-default-sorting-reversep)
(set (make-local-variable 'ibuffer-shrink-to-minimum-size)
ibuffer-default-shrink-to-minimum-size)
(set (make-local-variable 'ibuffer-display-maybe-show-predicates)
ibuffer-default-display-maybe-show-predicates)
(set (make-local-variable 'ibuffer-filtering-qualifiers) nil)
(set (make-local-variable 'ibuffer-filter-groups) nil)
(set (make-local-variable 'ibuffer-filter-group-kill-ring) nil)

78
lisp/info.el
View file

@ -3445,7 +3445,8 @@ Preserve text properties."
(fontify-visited-p ; visited nodes need to be re-fontified
(and Info-fontify-visited-nodes
;; Don't take time to refontify visited nodes in huge nodes
(< (- (point-max) (point-min)) Info-fontify-maximum-menu-size))))
(< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))
rbeg rend)
;; Fontify header line
(goto-char (point-min))
@ -3570,39 +3571,48 @@ Preserve text properties."
"mouse-2: go to this node")
'mouse-face 'highlight)))
(when (or not-fontified-p fontify-visited-p)
(add-text-properties
(match-beginning 2) (match-end 2)
(list
'font-lock-face
;; Display visited nodes in a different face
(if (and Info-fontify-visited-nodes
(save-match-data
(let* ((node (replace-regexp-in-string
"^[ \t]+" ""
(replace-regexp-in-string
"[ \t\n]+" " "
(or (match-string 5)
(and (not (equal (match-string 4) ""))
(match-string 4))
(match-string 2)))))
(file (file-name-nondirectory
Info-current-file))
(hl Info-history-list)
res)
(if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
(setq file (file-name-nondirectory
(match-string 1 node))
node (if (equal (match-string 2 node) "")
"Top"
(match-string 2 node))))
(while hl
(if (and (string-equal node (nth 1 (car hl)))
(string-equal file
(file-name-nondirectory
(nth 0 (car hl)))))
(setq res (car hl) hl nil)
(setq hl (cdr hl))))
res))) 'info-xref-visited 'info-xref))))
(setq rbeg (match-beginning 2)
rend (match-end 2))
(put-text-property
rbeg rend
'font-lock-face
;; Display visited nodes in a different face
(if (and Info-fontify-visited-nodes
(save-match-data
(let* ((node (replace-regexp-in-string
"^[ \t]+" ""
(replace-regexp-in-string
"[ \t\n]+" " "
(or (match-string 5)
(and (not (equal (match-string 4) ""))
(match-string 4))
(match-string 2)))))
(file (file-name-nondirectory
Info-current-file))
(hl Info-history-list)
res)
(if (string-match "(\\([^)]+\\))\\([^)]*\\)" node)
(setq file (file-name-nondirectory
(match-string 1 node))
node (if (equal (match-string 2 node) "")
"Top"
(match-string 2 node))))
(while hl
(if (and (string-equal node (nth 1 (car hl)))
(string-equal file
(file-name-nondirectory
(nth 0 (car hl)))))
(setq res (car hl) hl nil)
(setq hl (cdr hl))))
res))) 'info-xref-visited 'info-xref))
;; For multiline ref, unfontify newline and surrounding whitespace
(save-excursion
(goto-char rbeg)
(save-match-data
(while (re-search-forward "\\s-*\n\\s-*" rend t nil)
(remove-text-properties (match-beginning 0)
(match-end 0)
'(font-lock-face t))))))
(when not-fontified-p
(when (memq Info-hide-note-references '(t hide))
(add-text-properties (match-beginning 3) (match-end 3)

26
lisp/language/indian.el
View file

@ -45,6 +45,15 @@
Currently supported foundries are `cdac' and `akruti'.")
(defvar indian-script-language-alist
'((devanagari (hindi sanskrit) nil)
(bengali (bengali assamese) nil)
(gurmukhi (punjabi) nil)
(gujarati (gujarati) nil)
(oriya (oriya) nil)
(tamil (tamil) nil)
(telugu (telugu) nil)
(kannada (kannada) nil)
(malayalam (malayalam) nil))
"Alist of Indian scripts vs the corresponding language list and font foundry.
Each element has this form:
@ -57,16 +66,7 @@ The list is in the priority order.
FONT-FOUNDRY is a font foundry representing a group of Indian
fonts. If the value is nil, the value of `indian-font-foundry'
is used."
'((devanagari (hindi sanskrit) nil)
(bengali (bengali assamese) nil)
(gurmukhi (punjabi) nil)
(gujarati (gujarati) nil)
(oriya (oriya) nil)
(tamil (tamil) nil)
(telugu (telugu) nil)
(kannada (kannada) nil)
(malayalam (malayalam) nil)))
is used.")
(defconst indian-font-char-index-table
'( ; for which language(s)
@ -94,14 +94,14 @@ is used."
(#x1200 . akruti:knd) ; kannada
(#x1300 . akruti:mal) ; malayalam
)
"Aliat of indices of `indian-glyph' character vs Indian font identifiers.
"Alist of indices of `indian-glyph' character vs Indian font identifiers.
Each element has this form: (INDEX . FONT-IDENTIFIER)
INDEX is an index number of the first character in the charset
`indian-glyph' assigned for glyphs in the font specified by
FONT-IDENTIFIER. Currently FONT-IDENTIFIERs are defined for CDAC
and AKRUTI font groups.")
(defun indian-font-char (index font-identifier)
"Return character of charset `indian-glyph' made from glyph index INDEX.
FONT-IDENTIFIER is an identifier of an Indian font listed in the
@ -122,7 +122,7 @@ font INDEX is for."
(defun indian-font-char-range (font-identifier)
(cons (indian-font-char 0 font-identifier)
(indian-font-char 255 font-identifier)))
(defvar indian-script-table
'[
devanagari

19
lisp/mouse.el
View file

@ -338,6 +338,17 @@ shrink the window or windows above it to make room."
(select-window window)
(enlarge-window growth nil (> growth 0))))
(defsubst mouse-drag-move-window-top (window growth)
"Move the top of WINDOW up or down by GROWTH lines.
Move it down if GROWTH is positive, or up if GROWTH is negative.
If this would make WINDOW too short, shrink the window or windows
above it to make room."
;; Moving the top of WINDOW is actually moving the bottom of the
;; window above.
(let ((window-above (mouse-drag-window-above window)))
(and window-above
(mouse-drag-move-window-bottom window-above (- growth)))))
(defun mouse-drag-mode-line-1 (start-event mode-line-p)
"Change the height of a window by dragging on the mode or header line.
START-EVENT is the starting mouse-event of the drag action.
@ -444,7 +455,9 @@ MODE-LINE-P non-nil means dragging a mode line; nil means a header line."
(select-window start-event-window))
;; no. grow/shrink the selected window
;(message "growth = %d" growth)
(mouse-drag-move-window-bottom start-event-window growth))
(if mode-line-p
(mouse-drag-move-window-bottom start-event-window growth)
(mouse-drag-move-window-top start-event-window growth)))
;; if this window's growth caused another
;; window to be deleted because it was too
@ -1097,7 +1110,7 @@ and set mark at the beginning.
Prefix arguments are interpreted as with \\[yank].
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
(interactive "e\nP")
(interactive "*e\nP")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))
@ -1399,7 +1412,7 @@ The function returns a non-nil value if it creates a secondary selection."
Move point to the end of the inserted text.
If `mouse-yank-at-point' is non-nil, insert at point
regardless of where you click."
(interactive "e")
(interactive "*e")
;; Give temporary modes such as isearch a chance to turn off.
(run-hooks 'mouse-leave-buffer-hook)
(or mouse-yank-at-point (mouse-set-point click))

1
lisp/msb.el
View file

@ -1153,6 +1153,7 @@ different buffer menu using the function `msb'."
(defun msb-unload-hook ()
(msb-mode 0))
(add-hook 'msb-unload-hook 'msb-unload-hook)
(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))

128
lisp/net/password.el Normal file
View file

@ -0,0 +1,128 @@
;;; password.el --- Read passwords from user, possibly using a password cache.
;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc.
;; Author: Simon Josefsson <simon@josefsson.org>
;; Created: 2003-12-21
;; Keywords: password cache passphrase key
;; 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:
;; Greatly influenced by pgg.el written by Daiki Ueno, with timer
;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just
;; a rip-off.
;;
;; (password-read "Password? " "test")
;; ;; Minibuffer prompt for password.
;; => "foo"
;;
;; (password-cache-add "test" "foo")
;; => nil
;; Note the previous two can be replaced with:
;; (password-read-and-add "Password? " "test")
;; ;; Minibuffer prompt for password.
;; => "foo"
;; ;; "foo" is now cached with key "test"
;; (password-read "Password? " "test")
;; ;; No minibuffer prompt
;; => "foo"
;;
;; (password-read "Password? " "test")
;; ;; No minibuffer prompt
;; => "foo"
;;
;; ;; Wait `password-cache-expiry' seconds.
;;
;; (password-read "Password? " "test")
;; ;; Minibuffer prompt for password is back.
;; => "foo"
;;; Code:
(when (featurep 'xemacs)
(require 'run-at-time))
(eval-when-compile
(require 'cl))
(defcustom password-cache t
"Whether to cache passwords."
:group 'password
:type 'boolean)
(defcustom password-cache-expiry 16
"How many seconds passwords are cached, or nil to disable expiring.
Whether passwords are cached at all is controlled by `password-cache'."
:group 'password
:type '(choice (const :tag "Never" nil)
(integer :tag "Seconds")))
(defvar password-data (make-vector 7 0))
(defun password-read (prompt &optional key)
"Read password, for use with KEY, from user, or from cache if wanted.
KEY indicate the purpose of the password, so the cache can
separate passwords. The cache is not used if KEY is nil. It is
typically a string.
The variable `password-cache' control whether the cache is used."
(or (and password-cache
key
(symbol-value (intern-soft key password-data)))
(read-passwd prompt)))
(defun password-read-and-add (prompt &optional key)
"Read password, for use with KEY, from user, or from cache if wanted.
Then store the password in the cache. Uses `password-read' and
`password-cache-add'."
(let ((password (password-read prompt key)))
(when (and password key)
(password-cache-add key password))
password))
(defun password-cache-remove (key)
"Remove password indexed by KEY from password cache.
This is typically run be a timer setup from `password-cache-add',
but can be invoked at any time to forcefully remove passwords
from the cache. This may be useful when it has been detected
that a password is invalid, so that `password-read' query the
user again."
(let ((password (symbol-value (intern-soft key password-data))))
(when password
(fillarray password ?_)
(unintern key password-data))))
(defun password-cache-add (key password)
"Add password to cache.
The password is removed by a timer after `password-cache-expiry'
seconds."
(set (intern key password-data) password)
(when password-cache-expiry
(run-at-time password-cache-expiry nil
#'password-cache-remove
key))
nil)
(provide 'password)
;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5
;;; password.el ends here

77
lisp/net/tramp.el
View file

@ -2337,45 +2337,46 @@ If it doesn't exist, generate a new one."
;; This function makes the same assumption as
;; `tramp-handle-set-visited-file-modtime'.
(defun tramp-handle-verify-visited-file-modtime (buf)
"Like `verify-visited-file-modtime' for tramp files.
At the time `verify-visited-file-modtime' calls this function, we
already know that the buffer is visiting a file and that
`visited-file-modtime' does not return 0. Do not call this
function directly, unless those two cases are already taken care
of."
"Like `verify-visited-file-modtime' for tramp files."
(with-current-buffer buf
(let ((f (buffer-file-name)))
(with-parsed-tramp-file-name f nil
(let* ((attr (file-attributes f))
(modtime (nth 5 attr)))
(cond ((and attr (not (equal modtime '(0 0))))
;; Why does `file-attributes' return a list (HIGH
;; LOW), but `visited-file-modtime' returns a cons
;; (HIGH . LOW)?
(let ((mt (visited-file-modtime)))
(< (abs (tramp-time-diff
modtime
;; For compatibility, deal with both the old
;; (HIGH . LOW) and the new (HIGH LOW)
;; return values of `visited-file-modtime'.
(if (atom (cdr mt))
(list (car mt) (cdr mt))
mt)))
2)))
(attr
(save-excursion
(tramp-send-command
multi-method method user host
(format "%s -ild %s"
(tramp-get-ls-command multi-method method
user host)
(tramp-shell-quote-argument localname)))
(tramp-wait-for-output)
(setq attr (buffer-substring
(point) (progn (end-of-line) (point)))))
(equal tramp-buffer-file-attributes attr))
;; If file does not exist, say it is not modified.
(t nil)))))))
;; There is no file visiting the buffer, or the buffer has no
;; recorded last modification time.
(if (or (not (buffer-file-name))
(eq (visited-file-modtime) 0))
t
(let ((f (buffer-file-name)))
(with-parsed-tramp-file-name f nil
(let* ((attr (file-attributes f))
(modtime (nth 5 attr))
(mt (visited-file-modtime)))
(cond
;; file exists, and has a known modtime.
((and attr (not (equal modtime '(0 0))))
(< (abs (tramp-time-diff
modtime
;; For compatibility, deal with both the old
;; (HIGH . LOW) and the new (HIGH LOW)
;; return values of `visited-file-modtime'.
(if (atom (cdr mt))
(list (car mt) (cdr mt))
mt)))
2))
;; modtime has the don't know value.
(attr
(save-excursion
(tramp-send-command
multi-method method user host
(format "%s -ild %s"
(tramp-get-ls-command multi-method method user host)
(tramp-shell-quote-argument localname)))
(tramp-wait-for-output)
(setq attr (buffer-substring
(point) (progn (end-of-line) (point)))))
(equal tramp-buffer-file-attributes attr))
;; If file does not exist, say it is not modified
;; if and only if that agrees with the buffer's record.
(t (equal mt '(-1 65535))))))))))
(defadvice clear-visited-file-modtime (after tramp activate)
"Set `tramp-buffer-file-attributes' back to nil.

1
lisp/newcomment.el
View file

@ -1087,6 +1087,7 @@ Else, call `comment-indent'."
(insert (comment-padleft comment-end add)))
(indent-according-to-mode))))))
;;;###autoload
(defcustom comment-auto-fill-only-comments nil
"Non-nil means to only auto-fill inside comments.
This has no effect in modes that do not define a comment syntax."

2
lisp/outline.el
View file

@ -808,7 +808,7 @@ Show the heading too, if it is currently invisible."
(save-excursion
(outline-back-to-heading t)
(show-entry)
(while (condition-case nil (progn (outline-up-heading 1) (not (bobp)))
(while (condition-case nil (progn (outline-up-heading 1 t) (not (bobp)))
(error nil))
(outline-flag-region (1- (point))
(save-excursion (forward-line 1) (point))

21
lisp/paths.el
View file

@ -101,11 +101,12 @@ This variable `Info-default-directory-list' is used as the default
for initializing `Info-directory-list' when Info is started, unless
the environment variable INFOPATH is set.")
(defvar news-path
(defvar news-directory
(if (file-exists-p "/usr/spool/news/")
"/usr/spool/news/"
"/var/spool/news/")
"The root directory below which all news files are stored.")
(defvaralias 'news-path 'news-directory)
(defvar news-inews-program
(cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
@ -136,7 +137,7 @@ The `ORGANIZATION' environment variable is used instead if defined.")
:group 'rmail
:version "21.1")
(defconst rmail-spool-directory
(defvar rmail-spool-directory
(cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration)
"/usr/spool/mail/")
;; On The Bull DPX/2 /usr/spool/mail is used although
@ -157,15 +158,17 @@ The `ORGANIZATION' environment variable is used instead if defined.")
"Name of directory used by system mailer for delivering new mail.
Its name should end with a slash.")
(defconst sendmail-program
(defcustom sendmail-program
(cond
((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
(t "fakemail")) ;In ../etc, to interface to /bin/mail.
"Program used to send messages.")
"Program used to send messages."
:group 'mail
:type 'file)
(defconst remote-shell-program
(defcustom remote-shell-program
(cond
;; Some systems use rsh for the remote shell; others use that name for the
;; restricted shell and use remsh for the remote shell. Let's try to guess
@ -186,14 +189,16 @@ Its name should end with a slash.")
((file-exists-p "/bin/rsh") "/bin/rsh")
((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh")
(t "rsh"))
"File name for remote-shell program (often rsh or remsh).")
"File name for remote-shell program (often rsh or remsh)."
:group 'environment
:type 'file)
(defconst term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "\
(defvar term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "\
If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\")))
You may set this variable to nil in your `.emacs' file if you do not wish
the terminal-initialization file to be loaded.")
(defconst abbrev-file-name
(defvar abbrev-file-name
(if (eq system-type 'vax-vms)
"~/abbrev.def"
(convert-standard-filename "~/.abbrev_defs"))

2
lisp/pcvs-defs.el
View file

@ -374,7 +374,7 @@ This variable is buffer local and only used in the *cvs* buffer.")
("r" . cvs-mode-remove)
("s" . cvs-mode-status)
("t" . cvs-mode-tag)
;;("v" . cvs-mode-diff-vendor)
("v" . cvs-mode-view-file)
("x" . cvs-mode-remove-handled)
;; cvstree bindings
("+" . cvs-mode-tree)

11
lisp/pcvs-util.el
View file

@ -104,11 +104,12 @@ BUF is assumed to be a temporary buffer used from the buffer MAINBUF."
(condition-case ()
(delete-window win)
(error (iconify-frame (window-frame win))))
(if (and mainbuf (get-buffer-window mainbuf))
;; FIXME: if the buffer popped into a pre-existing window,
;; we don't want to delete that window.
t ;;(delete-window win)
))))
;;; (if (and mainbuf (get-buffer-window mainbuf))
;;; ;; FIXME: if the buffer popped into a pre-existing window,
;;; ;; we don't want to delete that window.
;;; t ;;(delete-window win)
;;; )
)))
(with-current-buffer buf
(bury-buffer (unless (and (eq buf (window-buffer (selected-window)))
(not (window-dedicated-p (selected-window))))

20
lisp/pcvs.el
View file

@ -1925,6 +1925,18 @@ to hear about anymore."
(cvs-mode-find-file e 'dont-select))
(defun cvs-mode-view-file (e)
"View the file."
(interactive (list last-input-event))
(cvs-mode-find-file e nil t))
(defun cvs-mode-view-file-other-window (e)
"View the file."
(interactive (list last-input-event))
(cvs-mode-find-file e t t))
(defun cvs-find-modif (fi)
(with-temp-buffer
(call-process cvs-program nil (current-buffer) nil
@ -1935,7 +1947,7 @@ to hear about anymore."
1)))
(defun cvs-mode-find-file (e &optional other)
(defun cvs-mode-find-file (e &optional other view)
"Select a buffer containing the file.
With a prefix, opens the buffer in an OTHER window."
(interactive (list last-input-event current-prefix-arg))
@ -1963,8 +1975,10 @@ With a prefix, opens the buffer in an OTHER window."
(let ((buf (if rev (cvs-retrieve-revision fi rev)
(find-file-noselect (cvs-fileinfo->full-path fi)))))
(funcall (cond ((eq other 'dont-select) 'display-buffer)
(other 'switch-to-buffer-other-window)
(t 'switch-to-buffer))
(other
(if view 'view-buffer-other-window
'switch-to-buffer-other-window))
(t (if view 'view-buffer 'switch-to-buffer)))
buf)
(when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base))
(goto-line (cvs-find-modif fi)))

198
lisp/progmodes/compile.el
View file

@ -866,24 +866,7 @@ Returns the compilation buffer created."
(if (eq mode t)
(prog1 "compilation" (require 'comint))
(replace-regexp-in-string "-mode$" "" (symbol-name mode))))
(process-environment
(append
compilation-environment
(if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:"
(window-width))))
;; Set the EMACS variable, but
;; don't override users' setting of $EMACS.
(unless (getenv "EMACS") '("EMACS=t"))
(copy-sequence process-environment)))
cd-path ; in case process-environment contains CDPATH
(thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command)
(substitute-in-file-name (match-string 1 command))
default-directory))
(thisdir default-directory)
outwin outbuf)
(with-current-buffer
(setq outbuf
@ -903,18 +886,26 @@ Returns the compilation buffer created."
(error nil))
(error "Cannot have two processes in `%s' at once"
(buffer-name)))))
;; Clear out the compilation buffer and make it writable.
;; Change its default-directory to the directory where the compilation
;; will happen, and insert a `default-directory' to indicate this.
(setq buffer-read-only nil)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(buffer-enable-undo (current-buffer))
(cd thisdir)
;; output a mode setter, for saving and later reloading this buffer
(insert "-*- mode: " name-of-mode
"; default-directory: " (prin1-to-string default-directory)
" -*-\n" command "\n")
;; first transfer directory from where M-x compile was called
(setq default-directory thisdir)
;; Make compilation buffer read-only. The filter can still write it.
;; Clear out the compilation buffer.
(let ((inhibit-read-only t)
(default-directory thisdir))
;; Then evaluate a cd command if any, but don't perform it yet, else start-command
;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make"
(cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command)
(if (match-end 1)
(match-string 1 command)
"~")
default-directory))
(erase-buffer)
;; output a mode setter, for saving and later reloading this buffer
(insert "-*- mode: " name-of-mode
"; default-directory: " (prin1-to-string default-directory)
" -*-\n" command "\n")
(setq thisdir default-directory))
(set-buffer-modified-p nil))
;; If we're already in the compilation buffer, go to the end
;; of the buffer, so point will track the compilation output.
@ -923,70 +914,85 @@ Returns the compilation buffer created."
;; Pop up the compilation buffer.
(setq outwin (display-buffer outbuf nil t))
(with-current-buffer outbuf
(if (not (eq mode t))
(funcall mode)
(with-no-warnings (comint-mode))
(compilation-shell-minor-mode))
;; In what way is it non-ergonomic ? -stef
;; (toggle-read-only 1) ;;; Non-ergonomic.
(if highlight-regexp
(set (make-local-variable 'compilation-highlight-regexp)
highlight-regexp))
(set (make-local-variable 'compilation-arguments)
(list command mode name-function highlight-regexp))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
(set-window-start outwin (point-min))
(or (eq outwin (selected-window))
(set-window-point outwin (if compilation-scroll-output
(point)
(point-min))))
;; The setup function is called before compilation-set-window-height
;; so it can set the compilation-window-height buffer locally.
(if compilation-process-setup-function
(funcall compilation-process-setup-function))
(compilation-set-window-height outwin)
;; Start the compilation.
(if (fboundp 'start-process)
(let ((proc (if (eq mode t)
(get-buffer-process
(with-no-warnings
(comint-exec outbuf (downcase mode-name)
shell-file-name nil `("-c" ,command))))
(start-process-shell-command (downcase mode-name)
outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process '(":%s"))
(set-process-sentinel proc 'compilation-sentinel)
(set-process-filter proc 'compilation-filter)
(set-marker (process-mark proc) (point) outbuf)
(setq compilation-in-progress
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
;; Fake modeline display as if `start-process' were run.
(setq mode-line-process ":run")
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(let ((status (call-process shell-file-name nil outbuf nil "-c"
command)))
(cond ((numberp status)
(compilation-handle-exit 'exit status
(if (zerop status)
"finished\n"
(format "\
(let ((process-environment
(append
compilation-environment
(if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning
system-uses-terminfo)
(list "TERM=dumb" "TERMCAP="
(format "COLUMNS=%d" (window-width)))
(list "TERM=emacs"
(format "TERMCAP=emacs:co#%d:tc=unknown:"
(window-width))))
;; Set the EMACS variable, but
;; don't override users' setting of $EMACS.
(unless (getenv "EMACS") '("EMACS=t"))
(copy-sequence process-environment))))
(if (not (eq mode t))
(funcall mode)
(setq buffer-read-only nil)
(with-no-warnings (comint-mode))
(compilation-shell-minor-mode))
(if highlight-regexp
(set (make-local-variable 'compilation-highlight-regexp)
highlight-regexp))
(set (make-local-variable 'compilation-arguments)
(list command mode name-function highlight-regexp))
(set (make-local-variable 'revert-buffer-function)
'compilation-revert-buffer)
(set-window-start outwin (point-min))
(or (eq outwin (selected-window))
(set-window-point outwin (if compilation-scroll-output
(point)
(point-min))))
;; The setup function is called before compilation-set-window-height
;; so it can set the compilation-window-height buffer locally.
(if compilation-process-setup-function
(funcall compilation-process-setup-function))
(compilation-set-window-height outwin)
;; Start the compilation.
(if (fboundp 'start-process)
(let ((proc (if (eq mode t)
(get-buffer-process
(with-no-warnings
(comint-exec outbuf (downcase mode-name)
shell-file-name nil `("-c" ,command))))
(start-process-shell-command (downcase mode-name)
outbuf command))))
;; Make the buffer's mode line show process state.
(setq mode-line-process '(":%s"))
(set-process-sentinel proc 'compilation-sentinel)
(set-process-filter proc 'compilation-filter)
(set-marker (process-mark proc) (point) outbuf)
(setq compilation-in-progress
(cons proc compilation-in-progress)))
;; No asynchronous processes available.
(message "Executing `%s'..." command)
;; Fake modeline display as if `start-process' were run.
(setq mode-line-process ":run")
(force-mode-line-update)
(sit-for 0) ; Force redisplay
(let ((status (call-process shell-file-name nil outbuf nil "-c"
command)))
(cond ((numberp status)
(compilation-handle-exit 'exit status
(if (zerop status)
"finished\n"
(format "\
exited abnormally with code %d\n"
status))))
((stringp status)
(compilation-handle-exit 'signal status
(concat status "\n")))
(t
(compilation-handle-exit 'bizarre status status))))
;; Without async subprocesses, the buffer is not yet
;; fontified, so fontify it now.
(let ((font-lock-verbose nil)) ; shut up font-lock messages
(font-lock-fontify-buffer))
(message "Executing `%s'...done" command)))
status))))
((stringp status)
(compilation-handle-exit 'signal status
(concat status "\n")))
(t
(compilation-handle-exit 'bizarre status status))))
;; Without async subprocesses, the buffer is not yet
;; fontified, so fontify it now.
(let ((font-lock-verbose nil)) ; shut up font-lock messages
(font-lock-fontify-buffer))
(message "Executing `%s'...done" command)))
;; Now finally cd to where the shell started make/grep/...
(setq default-directory thisdir))
(if (buffer-local-value 'compilation-scroll-output outbuf)
(save-selected-window
(select-window outwin)
@ -1108,7 +1114,7 @@ from a different message."
:version "21.4")
;;;###autoload
(defun compilation-mode ()
(defun compilation-mode (&optional name-of-mode)
"Major mode for compilation log buffers.
\\<compilation-mode-map>To visit the source for a line-numbered error,
move point to the error message line and type \\[compile-goto-error].
@ -1121,7 +1127,7 @@ Runs `compilation-mode-hook' with `run-hooks' (which see).
(kill-all-local-variables)
(use-local-map compilation-mode-map)
(setq major-mode 'compilation-mode
mode-name "Compilation")
mode-name (or name-of-mode "Compilation"))
(set (make-local-variable 'page-delimiter)
compilation-page-delimiter)
(compilation-setup)
@ -1187,6 +1193,8 @@ If nil, use the beginning of buffer.")
"Prepare the buffer for the compilation parsing commands to work.
Optional argument MINOR indicates this is called from
`compilation-minor-mode'."
(unless minor
(setq buffer-read-only t))
(make-local-variable 'compilation-current-error)
(make-local-variable 'compilation-messages-start)
(make-local-variable 'compilation-error-screen-columns)
@ -1248,7 +1256,7 @@ Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
(defun compilation-handle-exit (process-status exit-status msg)
"Write MSG in the current buffer and hack its mode-line-process."
(let ((buffer-read-only nil)
(let ((inhibit-read-only t)
(status (if compilation-exit-message-function
(funcall compilation-exit-message-function
process-status exit-status msg)

2
lisp/server.el
View file

@ -631,6 +631,8 @@ Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
(remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
(remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
(remove-hook 'kill-buffer-hook 'server-kill-buffer))
(add-hook 'server-unload-hook 'server-unload-hook)
(provide 'server)

2
lisp/shadowfile.el
View file

@ -837,6 +837,8 @@ look for files that have been changed and need to be copied to other systems."
(symbol-function 'shadow-orig-save-buffers-kill-emacs)))
(remove-hook 'write-file-hooks 'shadow-add-to-todo))
(add-hook 'shadowfile-unload-hook 'shadowfile-unload-hook)
(provide 'shadowfile)
;;; arch-tag: e2f4cdd7-2bab-4def-9130-9e69b412b79e

6
lisp/startup.el
View file

@ -1156,7 +1156,7 @@ where FACE is a valid face specification, as it can be used with
(emacs-version)
"\n"
:face '(variable-pitch :height 0.5)
"Copyright (C) 2002 Free Software Foundation, Inc.")
"Copyright (C) 2004 Free Software Foundation, Inc.")
(and auto-save-list-file-prefix
;; Don't signal an error if the
;; directory for auto-save-list files
@ -1322,7 +1322,7 @@ More Manuals / Ordering Manuals How to order printed manuals from the FSF.
")
(insert "\n\n" (emacs-version)
"
Copyright (C) 2002 Free Software Foundation, Inc."))
Copyright (C) 2004 Free Software Foundation, Inc."))
;; No mouse menus, so give help using kbd commands.
@ -1370,7 +1370,7 @@ If you have no Meta key, you may instead type ESC followed by the character.)")
(insert "\n\n" (emacs-version)
"
Copyright (C) 2002 Free Software Foundation, Inc.")
Copyright (C) 2004 Free Software Foundation, Inc.")
(if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
(eq (key-binding "\C-h\C-d") 'describe-distribution)

5
lisp/strokes.el
View file

@ -1354,7 +1354,8 @@ If STROKES-MAP is not given, `strokes-global-map' will be used instead."
:color-symbols
`(("foreground"
. ,(frame-parameter nil 'foreground-color))))))
finally do (kill-region (1+ (point)) (point-max)))
finally do (unless (eobp)
(kill-region (1+ (point)) (point-max))))
(view-buffer "*Strokes List*" nil)
(set (make-local-variable 'view-mode-map)
(let ((map (copy-keymap view-mode-map)))
@ -1745,6 +1746,8 @@ Store XPM in buffer BUFNAME if supplied \(default is ` *strokes-xpm*'\)"
(strokes-mode -1)
(remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes))
(add-hooks 'strokes-unload-hook 'strokes-unload-hook)
(run-hooks 'strokes-load-hook)
(provide 'strokes)

109
lisp/subr.el
View file

@ -1212,51 +1212,59 @@ any other non-digit terminates the character code and is then used as input."))
code))
(defun read-passwd (prompt &optional confirm default)
"Read a password, prompting with PROMPT. Echo `.' for each character typed.
End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
If optional CONFIRM is non-nil, read password twice to make sure.
Optional DEFAULT is a default password to use instead of empty input."
(if confirm
(let (success)
(while (not success)
(let ((first (read-passwd prompt nil default))
(second (read-passwd "Confirm password: " nil default)))
(if (equal first second)
(progn
(and (arrayp second) (clear-string second))
(setq success first))
(and (arrayp first) (clear-string first))
(and (arrayp second) (clear-string second))
(message "Password not repeated accurately; please start over")
(sit-for 1))))
success)
(let ((pass nil)
(c 0)
(echo-keystrokes 0)
(cursor-in-echo-area t))
(while (progn (message "%s%s"
prompt
(make-string (length pass) ?.))
(setq c (read-char-exclusive nil t))
(and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
(clear-this-command-keys)
(if (= c ?\C-u)
(progn
(and (arrayp pass) (clear-string pass))
(setq pass ""))
(if (and (/= c ?\b) (/= c ?\177))
(let* ((new-char (char-to-string c))
(new-pass (concat pass new-char)))
"Read a password, prompting with PROMPT, and return it.
If optional CONFIRM is non-nil, read the password twice to make sure.
Optional DEFAULT is a default password to use instead of empty input.
This function echoes `.' for each character that the user types.
The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
C-g quits; if `inhibit-quit' was non-nil around this function,
then it returns nil if the user types C-g.
Once the caller uses the password, it can erase the password
by doing (clear-string STRING)."
(with-local-quit
(if confirm
(let (success)
(while (not success)
(let ((first (read-passwd prompt nil default))
(second (read-passwd "Confirm password: " nil default)))
(if (equal first second)
(progn
(and (arrayp second) (clear-string second))
(setq success first))
(and (arrayp first) (clear-string first))
(and (arrayp second) (clear-string second))
(message "Password not repeated accurately; please start over")
(sit-for 1))))
success)
(let ((pass nil)
(c 0)
(echo-keystrokes 0)
(cursor-in-echo-area t))
(while (progn (message "%s%s"
prompt
(make-string (length pass) ?.))
(setq c (read-char-exclusive nil t))
(and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
(clear-this-command-keys)
(if (= c ?\C-u)
(progn
(and (arrayp pass) (clear-string pass))
(clear-string new-char)
(setq c ?\0)
(setq pass new-pass))
(if (> (length pass) 0)
(let ((new-pass (substring pass 0 -1)))
(setq pass ""))
(if (and (/= c ?\b) (/= c ?\177))
(let* ((new-char (char-to-string c))
(new-pass (concat pass new-char)))
(and (arrayp pass) (clear-string pass))
(setq pass new-pass))))))
(message nil)
(or pass default ""))))
(clear-string new-char)
(setq c ?\0)
(setq pass new-pass))
(if (> (length pass) 0)
(let ((new-pass (substring pass 0 -1)))
(and (arrayp pass) (clear-string pass))
(setq pass new-pass))))))
(message nil)
(or pass default "")))))
;; This should be used by `call-interactively' for `n' specs.
(defun read-number (prompt &optional default)
@ -1822,14 +1830,14 @@ See also `with-temp-file' and `with-output-to-string'."
(defmacro with-local-quit (&rest body)
"Execute BODY, allowing quits to terminate BODY but not escape further.
When a quit terminates BODY, `with-local-quit' requests another quit when
it finishes. That quit will be processed in turn, the next time quitting
is again allowed."
When a quit terminates BODY, `with-local-quit' returns nil but
requests another quit. That quit will be processed, the next time quitting
is allowed once again."
(declare (debug t) (indent 0))
`(condition-case nil
(let ((inhibit-quit nil))
,@body)
(quit (setq quit-flag t))))
(quit (setq quit-flag t) nil)))
(defmacro combine-after-change-calls (&rest body)
"Execute BODY, but don't call the after-change functions till the end.
@ -2023,11 +2031,12 @@ STRING should be given if the last search was by `string-match' on STRING."
(defun looking-back (regexp &optional limit)
"Return non-nil if text before point matches regular expression REGEXP.
Like `looking-at' except backwards and slower.
Like `looking-at' except matches before point, and is slower.
LIMIT if non-nil speeds up the search by specifying how far back the
match can start."
(save-excursion
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))
(not (null
(save-excursion
(re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)))))
(defconst split-string-default-separators "[ \f\t\n\r\v]+"
"The default value of separators for `split-string'.

3
lisp/term.el
View file

@ -2,7 +2,8 @@
;;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2004 Free Software Foundation, Inc.
;; Author: Per Bothner <bothner@cygnus.com>
;; Author: Per Bothner <per@bothner.com>
;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com>
;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
;; Keywords: processes

2
lisp/textmodes/flyspell.el
View file

@ -452,7 +452,7 @@ See also `flyspell-duplicate-distance'."
;;;###autoload
(defun flyspell-mode (&optional arg)
"Minor mode performing on-the-fly spelling checking.
Ispell is automatically spawned on background for each entered words.
This spawns a single Ispell process and checks each word.
The default flyspell behavior is to highlight incorrect words.
With no argument, this command toggles Flyspell mode.
With a prefix argument ARG, turn Flyspell minor mode on iff ARG is positive.

25
lisp/textmodes/ispell.el
View file

@ -1618,10 +1618,11 @@ Global `ispell-quit' set to start location to continue spell session."
(set-buffer (get-buffer-create ispell-choices-buffer))
(setq mode-line-format (concat "-- %b -- word: " word))
;; XEmacs: no need for horizontal scrollbar in choices window
(and (fboundp 'set-specifier)
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
(cons (current-buffer) nil)))
(with-no-warnings
(and (fboundp 'set-specifier)
(boundp 'horizontal-scrollbar-visible-p)
(set-specifier horizontal-scrollbar-visible-p nil
(cons (current-buffer) nil))))
(erase-buffer)
(if guess
(progn
@ -1871,7 +1872,7 @@ Global `ispell-quit' set to start location to continue spell session."
(if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer))
(progn
(framepop-display-buffer (get-buffer ispell-choices-buffer))
(get-buffer-window ispell-choices-buffer t)
;;; (get-buffer-window ispell-choices-buffer t)
(select-window (previous-window))) ; *Choices* window
;; standard selection by splitting a small buffer out of this window.
(let ((choices-window (get-buffer-window ispell-choices-buffer)))
@ -2355,7 +2356,7 @@ Keeps argument list for future ispell invocations for no async support."
(if extended-char-mode ; ~ extended character mode
(ispell-send-string (concat extended-char-mode "\n"))))
(if ispell-async-processp
(process-kill-without-query ispell-process))))
(set-process-query-on-exit-flag ispell-process nil))))
;;;###autoload
(defun ispell-kill-ispell (&optional no-error)
@ -3286,19 +3287,23 @@ You can bind this to the key C-c i in GNUS or mail by adding to
(cond
((functionp 'sc-cite-regexp) ; sc 3.0
(concat "\\(" (sc-cite-regexp) "\\)" "\\|"
(ispell-non-empty-string sc-reference-tag-string)))
(with-no-warnings
(ispell-non-empty-string sc-reference-tag-string))))
((boundp 'sc-cite-regexp) ; sc 2.3
(concat "\\(" sc-cite-regexp "\\)" "\\|"
(ispell-non-empty-string sc-reference-tag-string)))
(with-no-warnings
(ispell-non-empty-string sc-reference-tag-string))))
((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below
(equal major-mode 'message-mode)) ;GNUS 5
(concat "In article <" "\\|"
"[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|"
message-cite-prefix-regexp "\\|"
(with-no-warnings message-cite-prefix-regexp)
"\\|"
default-prefix))
((equal major-mode 'mh-letter-mode) ; mh mail message
(concat "[^,;&+=\n]+ writes:" "\\|"
(ispell-non-empty-string mh-ins-buf-prefix)))
(with-no-warnings
(ispell-non-empty-string mh-ins-buf-prefix))))
((not internal-messagep) ; Assume nn sent us this message.
(concat "In [a-zA-Z.]+ you write:" "\\|"
"In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|"

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

@ -1946,7 +1946,6 @@ since TeX does not put file names and line numbers on the same line as
for the error messages."
(require 'thingatpt)
(setq compilation-error-list nil)
(message "Parsing error messages...")
(let ((default-directory ; Perhaps dir has changed meanwhile.
(file-name-directory (buffer-file-name tex-last-buffer-texed)))
found-desired (num-errors-found 0)
@ -2012,8 +2011,7 @@ for the error messages."
compilation-error-list))
(goto-char end-of-error)))))
(set-marker compilation-parsing-end (point))
(setq compilation-error-list (nreverse compilation-error-list))
(message "Parsing error messages...done"))
(setq compilation-error-list (nreverse compilation-error-list)))
;;; The commands:

59
lisp/url/ChangeLog
View file

@ -1,3 +1,62 @@
2004-10-20 John Paul Wallington <jpw@gnu.org>
* url-gw.el (url-gateway-nslookup-host):
Use `set-process-query-on-exit-flag'.
2004-10-10 Lars Hansen <larsh@math.ku.dk>
* url-auth.el: Update header and footer.
* url-cache.el: Update header and footer.
* url-cid.el: Update header and footer.
* url-dired.el: Update header and footer.
* url-expand.el: Update header and footer.
* url-ftp.el: Update header and footer.
* url-gw.el: Update header and footer.
* url-imap.el: Update header and footer.
* url-irc.el: Update header and footer.
* url-misc.el: Update header and footer.
* url-news.el: Update header and footer.
* url-ns.el: Update header and footer.
* url-privacy.el: Update header and footer.
* url-proxy.el: Update header and footer.
* url-vars.el: Update header.
2004-10-16 Richard M. Stallman <rms@gnu.org>
* url.el (url-do-setup): Don't set url-passwd-entry-func.
* url-vars.el (url-passwd-entry-func): Var deleted.
(mm-mime-mule-charset-alist): Remove compatibility code for old Gnus.
(url-weekday-alist): Renamed from weekday-alist.
(url-monthabbrev-alist): Renamed from monthabbrev-alist.
(url-vars-unload-hook): Initialize hook var to hold the function.
* url-util.el (url-get-normalized-date): Use
url-weekday-alist and url-monthabbrev-alist.
* url-misc.el: Load cl at compile time.
* url-mailto.el: Don't load cl.
(url-mailto): Fix call to `push'.
* url-gw.el (url-open-telnet): Use read-passwd.
* url-auth.el (url-basic-auth, url-digest-auth): Use read-passwd.
2004-10-12 Simon Josefsson <jas@extundo.com>
* url-vars.el (url-gateway-method): Add new method `tls'.

50
lisp/url/url-auth.el
View file

@ -1,26 +1,27 @@
;;; url-auth.el --- Uniform Resource Locator authorization modules
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(require 'url-vars)
(require 'url-parse)
@ -78,7 +79,7 @@ instead of the pathname inheritance method."
((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: "))
pass (read-passwd "Password: "))
(set url-basic-auth-storage
(cons (list server
(cons path
@ -102,7 +103,7 @@ instead of the pathname inheritance method."
(progn
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (funcall url-passwd-entry-func "Password: ")
pass (read-passwd "Password: ")
retval (base64-encode-string (format "%s:%s" user pass))
byserv (assoc server (symbol-value url-basic-auth-storage)))
(setcdr byserv
@ -160,7 +161,7 @@ instead of hostname:portnum."
((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: ")
pass (read-passwd "Password: ")
url-digest-auth-storage
(cons (list server
(cons path
@ -187,7 +188,7 @@ instead of hostname:portnum."
(progn
(setq user (read-string (url-auth-user-prompt url realm)
(user-real-login-name))
pass (funcall url-passwd-entry-func "Password: ")
pass (read-passwd "Password: ")
retval (setq retval
(cons user
(url-digest-auth-create-key
@ -314,3 +315,4 @@ RATING a rating between 1 and 10 of the strength of the authentication.
(provide 'url-auth)
;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91
;;; url-auth.el ends here

43
lisp/url/url-cache.el
View file

@ -1,26 +1,28 @@
;;; url-cache.el --- Uniform Resource Locator retrieval tool
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(require 'url-parse)
(require 'url-util)
@ -200,3 +202,4 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise."
(provide 'url-cache)
;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c
;;; url-cache.el ends here

66
lisp/url/url-cid.el Normal file
View file

@ -0,0 +1,66 @@
;;; url-cid.el --- Content-ID URL loader
;; Copyright (c) 1998 - 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.
;;; Code:
(require 'url-vars)
(require 'url-parse)
(require 'mm-decode)
(defun url-cid-gnus (cid)
(let ((content-type nil)
(encoding nil)
(part nil)
(data nil))
(setq part (mm-get-content-id cid))
(if (not part)
(message "Unknown CID encountered: %s" cid)
(setq data (save-excursion
(set-buffer (mm-handle-buffer part))
(buffer-string))
content-type (mm-handle-type part)
encoding (symbol-name (mm-handle-encoding part)))
(if (= 0 (length content-type)) (setq content-type "text/plain"))
(if (= 0 (length encoding)) (setq encoding "8bit"))
(if (listp content-type)
(setq content-type (car content-type)))
(insert (format "Content-type: %d\r\n" (length data))
"Content-type: " content-type "\r\n"
"Content-transfer-encoding: " encoding "\r\n"
"\r\n"
(or data "")))))
;;;###autoload
(defun url-cid (url)
(cond
((fboundp 'mm-get-content-id)
;; Using Pterodactyl Gnus or later
(save-excursion
(set-buffer (generate-new-buffer " *url-cid*"))
(url-cid-gnus (url-filename url))))
(t
(message "Unable to handle CID URL: %s" url))))
;;; arch-tag: 23d9ab74-fad4-4dba-b1e7-292871e8bda5
;;; url-cid.el ends here

42
lisp/url/url-dired.el
View file

@ -1,26 +1,27 @@
;;; url-dired.el --- URL Dired minor mode
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(autoload 'w3-fetch "w3")
(autoload 'w3-open-local "w3")
@ -98,3 +99,4 @@ Example: (add-minor-mode 'view-minor-mode \" View\" view-mode-map)"
(provide 'url-dired)
;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f
;;; url-dired.el ends here

144
lisp/url/url-expand.el Normal file
View file

@ -0,0 +1,144 @@
;;; url-expand.el --- expand-file-name for URLs
;; Copyright (c) 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.
;;; Code:
(require 'url-methods)
(require 'url-util)
(require 'url-parse)
(defun url-expander-remove-relative-links (name)
;; Strip . and .. from pathnames
(let ((new (if (not (string-match "^/" name))
(concat "/" name)
name)))
;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat
;; the tests that follow are not too complicated in terms of
;; looking for '..' or '../', etc.
(if (string-match "/\\.+$" new)
(setq new (concat new "/")))
;; Remove '/./' first
(while (string-match "/\\(\\./\\)" new)
(setq new (concat (substring new 0 (match-beginning 1))
(substring new (match-end 1)))))
;; Then remove '/../'
(while (string-match "/\\([^/]*/\\.\\./\\)" new)
(setq new (concat (substring new 0 (match-beginning 1))
(substring new (match-end 1)))))
;; Remove cruft at the beginning of the string, so people that put
;; in extraneous '..' because they are morons won't lose.
(while (string-match "^/\\.\\.\\(/\\)" new)
(setq new (substring new (match-beginning 1) nil)))
new))
(defun url-expand-file-name (url &optional default)
"Convert URL to a fully specified URL, and canonicalize it.
Second arg DEFAULT is a URL to start with if URL is relative.
If DEFAULT is nil or missing, the current buffer's URL is used.
Path components that are `.' are removed, and
path components followed by `..' are removed, along with the `..' itself."
(if (and url (not (string-match "^#" url)))
;; Need to nuke newlines and spaces in the URL, or we open
;; ourselves up to potential security holes.
(setq url (mapconcat (function (lambda (x)
(if (memq x '(? ?\n ?\r))
""
(char-to-string x))))
url "")))
;; Need to figure out how/where to expand the fragment relative to
(setq default (cond
((vectorp default)
;; Default URL has already been parsed
default)
(default
;; They gave us a default URL in non-parsed format
(url-generic-parse-url default))
(url-current-object
;; We are in a URL-based buffer, use the pre-parsed object
url-current-object)
((string-match url-nonrelative-link url)
;; The URL they gave us is absolute, go for it.
nil)
(t
;; Hmmm - this shouldn't ever happen.
(error "url-expand-file-name confused - no default?"))))
(cond
((= (length url) 0) ; nil or empty string
(url-recreate-url default))
((string-match "^#" url) ; Offset link, use it raw
url)
((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately
url)
(t
(let* ((urlobj (url-generic-parse-url url))
(inhibit-file-name-handlers t)
(expander (url-scheme-get-property (url-type default) 'expand-file-name)))
(if (string-match "^//" url)
(setq urlobj (url-generic-parse-url (concat (url-type default) ":"
url))))
(funcall expander urlobj default)
(url-recreate-url urlobj)))))
(defun url-identity-expander (urlobj defobj)
(url-set-type urlobj (or (url-type urlobj) (url-type defobj))))
(defun url-default-expander (urlobj defobj)
;; The default expansion routine - urlobj is modified by side effect!
(if (url-type urlobj)
;; Well, they told us the scheme, let's just go with it.
nil
(url-set-type urlobj (or (url-type urlobj) (url-type defobj)))
(url-set-port urlobj (or (url-port urlobj)
(and (string= (url-type urlobj)
(url-type defobj))
(url-port defobj))))
(if (not (string= "file" (url-type urlobj)))
(url-set-host urlobj (or (url-host urlobj) (url-host defobj))))
(if (string= "ftp" (url-type urlobj))
(url-set-user urlobj (or (url-user urlobj) (url-user defobj))))
(if (string= (url-filename urlobj) "")
(url-set-filename urlobj "/"))
(if (string-match "^/" (url-filename urlobj))
nil
(let ((query nil)
(file nil)
(sepchar nil))
(if (string-match "[?#]" (url-filename urlobj))
(setq query (substring (url-filename urlobj) (match-end 0))
file (substring (url-filename urlobj) 0 (match-beginning 0))
sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0)))
(setq file (url-filename urlobj)))
(setq file (url-expander-remove-relative-links
(concat (url-basepath (url-filename defobj)) file)))
(url-set-filename urlobj (if query (concat file sepchar query) file))))))
(provide 'url-expand)
;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a
;;; url-expand.el ends here

44
lisp/url/url-ftp.el
View file

@ -1,26 +1,27 @@
;;; url-ftp.el --- FTP wrapper
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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:
;; We knew not what we did when we overloaded 'file' to mean 'file'
;; and 'ftp' back in the dark ages of the web.
@ -29,6 +30,8 @@
;; in url-methods.el and just maps everything onto the code in
;; url-file.
;;; Code:
(require 'url-parse)
(require 'url-file)
@ -40,3 +43,4 @@
(provide 'url-ftp)
;;; arch-tag: 9c3e70c4-350f-4d4a-bb51-a1e9b459e7dc
;;; url-ftp.el ends here

47
lisp/url/url-gw.el
View file

@ -1,27 +1,29 @@
;;; url-gw.el --- Gateway munging for URL loading
;; Copyright (c) 1997, 1998, 2004 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(eval-when-compile (require 'cl))
(require 'url-vars)
@ -115,7 +117,7 @@ linked Emacs under SunOS 4.x"
(let ((proc (start-process " *nslookup*" " *nslookup*"
url-gateway-nslookup-program host))
(res host))
(process-kill-without-query proc)
(set-process-query-on-exit-flag proc nil)
(save-excursion
(set-buffer (process-buffer proc))
(while (memq (process-status proc) '(run open))
@ -186,7 +188,7 @@ linked Emacs under SunOS 4.x"
proc (concat
(or url-gateway-telnet-password
(setq url-gateway-telnet-password
(funcall url-passwd-entry-func "Password: ")))
(read-passwd "Password: ")))
"\n"))
(erase-buffer)
(url-wait-for-string url-gateway-prompt-pattern proc)
@ -266,3 +268,4 @@ Will not make a connexion if `url-gateway-unplugged' is non-nil."
(provide 'url-gw)
;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838
;;; url-gw.el ends here

85
lisp/url/url-imap.el Normal file
View file

@ -0,0 +1,85 @@
;;; url-imap.el --- IMAP retrieval routines
;; Copyright (c) 1999 Free Software Foundation, Inc.
;; Author: Simon Josefsson <jas@pdc.kth.se>
;; 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:
;; Anyway, here's a teaser. It's quite broken in lots of regards, but at
;; least it seem to work. At least a little. At least when called
;; manually like this (I've no idea how it's supposed to be called):
;; (url-imap (url-generic-parse-url "imap://cyrus.andrew.cmu.edu/archive.c-client;UID=1021"))
;;; Code:
(eval-when-compile (require 'cl))
(require 'url-util)
(require 'url-parse)
(require 'nnimap)
(require 'mm-util)
(defconst url-imap-default-port 143 "Default IMAP port")
(defun url-imap-open-host (host port user pass)
;; xxx use user and password
(if (fboundp 'nnheader-init-server-buffer)
(nnheader-init-server-buffer))
(let ((imap-username user)
(imap-password pass)
(authenticator (if user 'login 'anonymous)))
(if (stringp port)
(setq port (string-to-int port)))
(nnimap-open-server host
`((nnimap-server-port ,port)
(nnimap-stream 'network)
(nnimap-authenticator ,authenticator)))))
(defun url-imap (url)
(check-type url vector "Need a pre-parsed URL.")
(save-excursion
(set-buffer (generate-new-buffer " *url-imap*"))
(mm-disable-multibyte)
(let* ((host (url-host url))
(port (url-port url))
;; xxx decode mailbox (see rfc2192)
(mailbox (url-filename url))
(coding-system-for-read 'binary))
(and (eq (string-to-char mailbox) ?/)
(setq mailbox (substring mailbox 1)))
(url-imap-open-host host port (url-user url) (url-password url))
(cond ((assoc "TYPE" (url-attributes url))
;; xxx list mailboxes (start gnus?)
)
((assoc "UID" (url-attributes url))
;; fetch message part
;; xxx handle partial fetches
(insert "Content-type: message/rfc822\n\n")
(nnimap-request-article (cdr (assoc "UID" (url-attributes url)))
mailbox host (current-buffer)))
(t
;; xxx list messages in mailbox (start gnus?)
)))
(current-buffer)))
;;; arch-tag: 034991ff-5425-48ea-b911-c96c90e6f47d
;;; url-imap.el ends here

46
lisp/url/url-irc.el
View file

@ -1,28 +1,31 @@
;;; url-irc.el --- IRC URL interface
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This file is part of GNU Emacs.
;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
;; 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:
;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt
;;; Code:
(require 'url-vars)
(require 'url-parse)
@ -74,3 +77,4 @@ PASSWORD - What password to use"
(provide 'url-irc)
;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e
;;; url-irc.el ends here

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

@ -25,7 +25,6 @@
;;; Code:
(eval-when-compile (require 'cl))
(require 'url-vars)
(require 'url-parse)
(require 'url-util)
@ -85,7 +84,7 @@
(setq args (cons (list "x-url-from" source-url) args)))
(if (assoc "to" args)
(push to (cdr (assoc "to" args)))
(push (cdr (assoc "to" args)) to)
(setq args (cons (list "to" to) args)))
(setq subject (cdr-safe (assoc "subject" args)))
(if (fboundp url-mail-command) (funcall url-mail-command) (mail))

43
lisp/url/url-misc.el
View file

@ -1,27 +1,29 @@
;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(eval-when-compile (require 'cl))
(require 'url-vars)
(require 'url-parse)
(autoload 'Info-goto-node "info" "" t)
@ -115,3 +117,4 @@
(provide 'url-misc)
;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0
;;; url-misc.el ends here

43
lisp/url/url-news.el
View file

@ -1,26 +1,28 @@
;;; url-news.el --- News Uniform Resource Locator retrieval code
;; Copyright (c) 1996 - 1999, 2004 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(require 'url-vars)
(require 'url-util)
(require 'url-parse)
@ -133,3 +135,4 @@
(provide 'url-news)
;;; arch-tag: 8975be13-04e8-4d38-bfff-47918e3ad311
;;; url-news.el ends here

107
lisp/url/url-ns.el Normal file
View file

@ -0,0 +1,107 @@
;;; url-ns.el --- Various netscape-ish functions for proxy definitions
;; Copyright (c) 1997 - 1999 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.
;;; Code:
(require 'url-gw)
;;;###autoload
(defun isPlainHostName (host)
(not (string-match "\\." host)))
;;;###autoload
(defun dnsDomainIs (host dom)
(string-match (concat (regexp-quote dom) "$") host))
;;;###autoload
(defun dnsResolve (host)
(url-gateway-nslookup-host host))
;;;###autoload
(defun isResolvable (host)
(if (string-match "^[0-9.]+$" host)
t
(not (string= host (url-gateway-nslookup-host host)))))
;;;###autoload
(defun isInNet (ip net mask)
(let ((netc (split-string ip "\\."))
(ipc (split-string net "\\."))
(maskc (split-string mask "\\.")))
(if (or (/= (length netc) (length ipc))
(/= (length ipc) (length maskc)))
nil
(setq netc (mapcar 'string-to-int netc)
ipc (mapcar 'string-to-int ipc)
maskc (mapcar 'string-to-int maskc))
(and
(= (logand (nth 0 netc) (nth 0 maskc))
(logand (nth 0 ipc) (nth 0 maskc)))
(= (logand (nth 1 netc) (nth 1 maskc))
(logand (nth 1 ipc) (nth 1 maskc)))
(= (logand (nth 2 netc) (nth 2 maskc))
(logand (nth 2 ipc) (nth 2 maskc)))
(= (logand (nth 3 netc) (nth 3 maskc))
(logand (nth 3 ipc) (nth 3 maskc)))))))
;; Netscape configuration file parsing
(defvar url-ns-user-prefs nil
"Internal, do not use.")
;;;###autoload
(defun url-ns-prefs (&optional file)
(if (not file)
(setq file (expand-file-name "~/.netscape/preferences.js")))
(if (not (and (file-exists-p file)
(file-readable-p file)))
(message "Could not open %s for reading" file)
(save-excursion
(let ((false nil)
(true t))
(setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal))
(set-buffer (get-buffer-create " *ns-parse*"))
(erase-buffer)
(insert-file-contents file)
(goto-char (point-min))
(while (re-search-forward "^//" nil t)
(replace-match ";;"))
(goto-char (point-min))
(while (re-search-forward "^user_pref(" nil t)
(replace-match "(url-ns-set-user-pref "))
(goto-char (point-min))
(while (re-search-forward "\"," nil t)
(replace-match "\""))
(goto-char (point-min))
(eval-buffer)))))
(defun url-ns-set-user-pref (key val)
(puthash key val url-ns-user-prefs))
;;;###autoload
(defun url-ns-user-pref (key &optional default)
(gethash key url-ns-user-prefs default))
(provide 'url-ns)
;;; arch-tag: 69520992-cf97-40b4-9ad1-c866d3cae5bf
;;; url-ns.el ends here

42
lisp/url/url-privacy.el
View file

@ -1,26 +1,27 @@
;;; url-privacy.el --- Global history tracking for URL package
;; Copyright (c) 1996 - 1999 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(eval-when-compile (require 'cl))
(require 'url-vars)
@ -79,3 +80,4 @@
(provide 'url-privacy)
;;; arch-tag: fdaf95e4-98f0-4680-94c3-f3eadafabe1d
;;; url-privacy.el ends here

79
lisp/url/url-proxy.el Normal file
View file

@ -0,0 +1,79 @@
;;; url-proxy.el --- Proxy server support
;; Copyright (c) 1999 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.
;;; Code:
(require 'url-parse)
(autoload 'url-warn "url")
(defun url-default-find-proxy-for-url (urlobj host)
(cond
((or (and (assoc "no_proxy" url-proxy-services)
(string-match
(cdr
(assoc "no_proxy" url-proxy-services))
host))
(equal "www" (url-type urlobj)))
"DIRECT")
((cdr (assoc (url-type urlobj) url-proxy-services))
(concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services))))
;;
;; Should check for socks
;;
(t
"DIRECT")))
(defvar url-proxy-locator 'url-default-find-proxy-for-url)
(defun url-find-proxy-for-url (url host)
(let ((proxies (split-string (funcall url-proxy-locator url host) " *; *"))
(proxy nil)
(case-fold-search t))
;; Not sure how I should handle gracefully degrading from one proxy to
;; another, so for now just deal with the first one
;; (while proxies
(if (listp proxies)
(setq proxy (car proxies))
(setq proxy proxies))
(cond
((string-match "^direct" proxy) nil)
((string-match "^proxy +" proxy)
(concat "http://" (substring proxy (match-end 0)) "/"))
((string-match "^socks +" proxy)
(concat "socks://" (substring proxy (match-end 0))))
(t
(url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical)
nil))))
(defun url-proxy (url callback &optional cbargs)
;; Retrieve URL from a proxy.
;; Expects `url-using-proxy' to be bound to the specific proxy to use."
(setq url-using-proxy (url-generic-parse-url url-using-proxy))
(let ((proxy-object (copy-sequence url)))
(url-set-target proxy-object nil)
(url-http url-using-proxy callback cbargs)))
(provide 'url-proxy)
;;; arch-tag: 4ff8882e-e498-42b7-abc5-acb449cdbc62
;;; url-proxy.el ends here

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

@ -192,13 +192,13 @@ Will not do anything if `url-show-status' is nil."
(nth 1 (current-time-zone))
"GMT"))
(parsed (timezone-parse-date gmt))
(day (cdr-safe (assoc (substring raw 0 3) weekday-alist)))
(day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist)))
(year nil)
(month (car
(rassoc
(string-to-int (aref parsed 1)) monthabbrev-alist)))
(string-to-int (aref parsed 1)) url-monthabbrev-alist)))
)
(setq day (or (car-safe (rassoc day weekday-alist))
(setq day (or (car-safe (rassoc day url-weekday-alist))
(substring raw 0 3))
year (aref parsed 0))
;; This is needed for plexus servers, or the server will hang trying to

78
lisp/url/url-vars.el
View file

@ -1,26 +1,27 @@
;;; url-vars.el --- Variables for Uniform Resource Locator tool
;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
;; 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.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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.
;;; Code:
(require 'mm-util)
@ -191,19 +192,6 @@ from the ACCESS_proxy environment variables."
(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
@ -240,24 +228,6 @@ Should be an assoc list of headers/contents.")
(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'
@ -381,14 +351,14 @@ Currently supported methods:
(defvar url-setup-done nil "Has setup configuration been done?")
(defconst weekday-alist
(defconst url-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
(defconst url-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)))
@ -425,6 +395,8 @@ This should be set, e.g. by mail user agents rendering HTML to avoid
(defun url-vars-unload-hook ()
(remove-hook 'set-language-environment-hook 'url-set-mime-charset-string))
(add-hook 'url-vars-unload-hook 'url-vars-unload-hook)
(provide 'url-vars)
;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49

20
lisp/url/url.el
View file

@ -113,26 +113,6 @@ Emacs."
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)))

4
lisp/vc-arch.el
View file

@ -283,8 +283,8 @@ Return non-nil if FILE is unchanged."
(setq logdir (expand-file-name version logdir))
(setq logdir (expand-file-name archive logdir))
(setq logdir (expand-file-name "patch-log" logdir))
;; Revision names go: base-0, patch-N, version-0, versionfix-N.
(dolist (file (directory-files logdir))
(dolist (file (if (file-directory-p logdir) (directory-files logdir)))
;; Revision names go: base-0, patch-N, version-0, versionfix-M.
(when (and (eq (aref file 0) ?v) (not sealed))
(setq sealed t rev-nb 0))
(if (and (string-match "-\\([0-9]+\\)\\'" file)

4
lisp/vc-hooks.el
View file

@ -754,8 +754,8 @@ current, and kill the buffer that visits the link."
(set (make-local-variable 'backup-inhibited) t))
;; Let the backend setup any buffer-local things he needs.
(vc-call-backend (vc-backend buffer-file-name) 'find-file-hook))
((let* ((link (file-symlink-p buffer-file-name))
(link-type (and link (vc-backend (file-chase-links link)))))
((let ((link-type (and (file-symlink-p buffer-file-name)
(vc-backend (file-chase-links buffer-file-name)))))
(cond ((not link-type) nil) ;Nothing to do.
((eq vc-follow-symlinks nil)
(message

15
lisp/view.el
View file

@ -117,12 +117,12 @@ functions that enable or disable view mode.")
(defvar view-page-size nil
"Default number of lines to scroll by View page commands.
If nil then the local value of this is initially set to window size.")
If nil that means use the window size.")
(make-variable-buffer-local 'view-page-size)
(defvar view-half-page-size nil
"Default number of lines to scroll by View half page commands.
If nil then the local value of this is initially set to half window size.")
If nil that means use half the window size.")
(make-variable-buffer-local 'view-half-page-size)
(defvar view-last-regexp nil)
@ -453,8 +453,8 @@ Entry to view-mode runs the normal hook `view-mode-hook'."
;; This is to guarantee that the buffer-read-only variable is restored.
(add-hook 'change-major-mode-hook 'view-mode-disable nil t)
(setq view-mode t
view-page-size (view-page-size-default view-page-size)
view-half-page-size (or view-half-page-size (/ (view-window-size) 2))
view-page-size nil
view-half-page-size nil
view-old-buffer-read-only buffer-read-only
buffer-read-only t
view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb)
@ -675,7 +675,8 @@ previous state and go to previous buffer or window."
(defun view-set-half-page-size-default (lines)
;; Get and maybe set half page size.
(if (not lines) view-half-page-size
(if (not lines) (or view-half-page-size
(/ (view-window-size) 2))
(setq view-half-page-size
(if (zerop (setq lines (prefix-numeric-value lines)))
(/ (view-window-size) 2)
@ -803,13 +804,13 @@ Exit if end of text is visible and `view-scroll-auto-exit' is non-nil.
\\[View-scroll-page-backward-set-page-size].
If LINES is more than a window-full, only the last window-full is shown."
(interactive "P")
(view-scroll-lines lines nil view-page-size nil))
(view-scroll-lines lines nil (view-page-size-default view-page-size) nil))
(defun View-scroll-page-backward (&optional lines)
"Scroll \"page size\" or prefix LINES lines backward in View mode.
See also `View-scroll-page-forward'."
(interactive "P")
(view-scroll-lines lines t view-page-size nil))
(view-scroll-lines lines t (view-page-size-default view-page-size) nil))
(defun View-scroll-page-forward-set-page-size (&optional lines)
"Scroll forward LINES lines in View mode, setting the \"page size\".

2
lisp/whitespace.el
View file

@ -859,6 +859,8 @@ This is meant to be added buffer-locally to `write-file-functions'."
(remove-hook 'write-file-functions 'whitespace-write-file-hook t)
(remove-hook 'kill-buffer-hook 'whitespace-buffer))
(add-hook 'whitespace-unload-hook 'whitespace-unload-hook)
(provide 'whitespace)
;;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c

4
lispref/ChangeLog
View file

@ -1,3 +1,7 @@
2004-10-19 Jason Rumney <jasonr@gnu.org>
* makefile.w32-in (elisp): Change order of arguments to makeinfo.
2004-10-09 Luc Teirlinck <teirllm@auburn.edu>
* text.texi (Filling): Add anchor for definition of

2
lispref/makefile.w32-in
View file

@ -104,7 +104,7 @@ info: $(infodir)/elisp
$(INSTALL_INFO) --info-dir=$(infodir) $(infodir)/elisp
$(infodir)/elisp: $(srcs)
$(MAKEINFO) -I. -I$(srcdir) $(srcdir)/elisp.texi -o $(infodir)/elisp
$(MAKEINFO) -I. -I$(srcdir) -o $(infodir)/elisp $(srcdir)/elisp.texi
elisp.dvi: $(srcs)
$(texinputdir) $(TEX) $(srcdir)/elisp.texi

50
man/ChangeLog
View file

@ -1,3 +1,43 @@
2004-10-21 Jay Belanger <belanger@truman.edu>
* calc.texi (Algebraic-Style Calculations): Removed a comment.
2004-10-19 Jason Rumney <jasonr@gnu.org>
* makefile.w32-in (info): Change order of arguments to makeinfo.
2004-10-19 Ulf Jasper <ulf.jasper@web.de>
* calendar.texi (iCalendar): Update for package changes.
2004-10-18 Luc Teirlinck <teirllm@auburn.edu>
* calc.texi (Reporting Bugs): Double up `@'.
2004-10-18 Jay Belanger <belanger@truman.edu>
* calc.texi (Reporting Bugs): Changed the address that bugs
should be sent to.
2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
* gnus.texi (New Features): Add 5.11.
* message.texi (Resending): Remove wrong default value.
* gnus.texi (Mail Source Specifiers): Describe possible problems
of `pop3-leave-mail-on-server'. Add `pop3-movemail' and
`pop3-leave-mail-on-server' to the index.
2004-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
* message.texi (Canceling News): Add how to set a password.
2004-10-12 Jay Belanger <belanger@truman.edu>
* calc.texi (Help Commands): Changed the descriptions of
calc-describe-function and calc-describe-variable to match their
current behavior.
2004-10-12 Reiner Steib <Reiner.Steib@gmx.de>
* gnus-faq.texi ([5.9]): Improve code for reply-in-news.
@ -154,6 +194,16 @@
* display.texi (Display Custom): Add `overflow-newline-into-fringe',
`indicate-buffer-boundaries' and `default-indicate-buffer-boundaries'.
2004-09-22 Jay Belanger <belanger@truman.edu>
* calc.texi (Vectors as Lists): Added a warning that the tutorial
might be hidden during part of the session.
2004-09-20 Jay Belanger <belanger@truman.edu>
* calc.texi (Notations Used in This Manual): Put in an earlier
mention that DEL could be called Backspace.
2004-09-20 Richard M. Stallman <rms@gnu.org>
* custom.texi (Hooks): Explain using setq to clear out a hook.

8
man/calc.texi
View file

@ -2038,8 +2038,7 @@ though regular numeric keys still use RPN numeric entry. There is also
a ``total algebraic mode,'' started by typing @kbd{m t}, in which all
normal keys begin algebraic entry. You must then use the @key{META} key
to type Calc commands: @kbd{M-m t} to get back out of total algebraic
mode, @kbd{M-q} to quit, etc. Total algebraic mode is not supported
under Emacs 19.)
mode, @kbd{M-q} to quit, etc.)
If you're still in algebraic mode, press @kbd{m a} again to turn it off.
@ -34286,11 +34285,10 @@ press @kbd{M-# t} to begin.
@appendix Reporting Bugs
@noindent
If you find a bug in Calc, send e-mail to Colin Walters,
If you find a bug in Calc, send e-mail to Jay Belanger,
@example
walters@@debian.org @r{or}
walters@@verbum.org
belanger@@truman.edu
@end example
@noindent

25
man/calendar.texi
View file

@ -1402,21 +1402,19 @@ 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
@findex icalendar-import-buffer
The command @code{icalendar-import-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)
(add-hook 'rmail-show-message-hook 'icalendar-import-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:
The command @code{icalendar-import-file} imports an iCalendar file
and adds the results to an Emacs diary file. For example:
@example
(icalendar-import-file "/here/is/calendar.ics" "/there/goes/ical-diary")
@ -1424,13 +1422,14 @@ diary file for importing. For 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}.
to the main diary file, if these are distinct. @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!
@findex icalendar-export-file, icalendar-export-region
Use @code{icalendar-export-file} to interactively export an entire
Emacs diary file to iCalendar format. To export only a part of a diary
file, mark the relevant area, and call @code{icalendar-export-region}.
In both cases the result is appended to the target file.
@node Daylight Savings

12
man/gnus.texi
View file

@ -885,7 +885,7 @@ New Features
* Red Gnus:: Third time best---Gnus 5.4/5.5.
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
Customization
@ -13538,10 +13538,16 @@ and says what authentication scheme to use. The default is
@end table
@vindex pop3-movemail
@vindex pop3-leave-mail-on-server
If the @code{:program} and @code{:function} keywords aren't specified,
@code{pop3-movemail} will be used. If the
@code{pop3-leave-mail-on-server} is non-@code{nil} the mail is to be
left on the POP server after fetching.
left on the @acronym{POP} server after fetching when using
@code{pop3-movemail}. Note that POP servers maintain no state
information between sessions, so what the client believes is there and
what is actually there may not match up. If they do not, then the whole
thing can fall apart and leave you with a corrupt mailbox.
Here are some examples. Fetch from the default @acronym{POP} server,
using the default user name, and default fetcher:
@ -25050,7 +25056,7 @@ actually are people who are using Gnus. Who'd'a thunk it!
* Red Gnus:: Third time best---Gnus 5.4/5.5.
* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
* Oort Gnus:: It's big. It's far out. Gnus 5.10.
* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
@end menu
These lists are, of course, just @emph{short} overviews of the

4
man/makefile.w32-in
View file

@ -125,9 +125,11 @@ dvi: $(DVI_TARGETS)
# The following target uses an explicit -o switch to work around
# the @setfilename directive in info.texi, which is required for
# the Texinfo distribution.
# Some Windows ports of makeinfo seem to require -o to come before the
# texi filename, contrary to GNU standards.
$(infodir)/info: $(INFOSOURCES)
$(MAKEINFO) --no-split info.texi -o $@
$(MAKEINFO) --no-split -o $@ info.texi
info.dvi: $(INFOSOURCES)
$(ENVADD) $(TEXI2DVI) $(srcdir)/info.texi

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