Mercurial > emacs
changeset 83222:ae7fab96922c
Merged in changes from CVS trunk.
Patches applied:
* 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
Update from CVS
* 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/emacs--cvs-trunk--0--patch-634
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-635
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-636
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-637
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-638
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-54
Update from CVS
* 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
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-58
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-262
| author | Karoly Lorentey <lorentey@elte.hu> |
|---|---|
| date | Mon, 25 Oct 2004 18:17:28 +0000 |
| parents | 0fc4928cc48e (current diff) 1884184364e8 (diff) |
| children | 4056279af756 |
| files | ChangeLog lisp/ChangeLog lisp/simple.el lisp/url/url-auth.el lisp/url/url-cache.el lisp/url/url-cid.el lisp/url/url-dired.el lisp/url/url-expand.el lisp/url/url-ftp.el lisp/url/url-gw.el lisp/url/url-imap.el lisp/url/url-irc.el lisp/url/url-misc.el lisp/url/url-news.el lisp/url/url-ns.el lisp/url/url-privacy.el lisp/url/url-proxy.el lisp/url/url-vars.el lisp/vc.el man/ChangeLog src/Makefile.in src/config.in src/emacs.c src/fontset.c src/w32term.c src/xdisp.c src/xfns.c src/xterm.c src/xterm.h |
| diffstat | 97 files changed, 4223 insertions(+), 1995 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -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
--- a/configure Tue Oct 19 17:00:02 2004 +0000 +++ b/configure Mon Oct 25 18:17:28 2004 +0000 @@ -310,7 +310,7 @@ # 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 @@ 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 @@ 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,@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
--- a/configure.in Tue Oct 19 17:00:02 2004 +0000 +++ b/configure.in Mon Oct 25 18:17:28 2004 +0000 @@ -1450,6 +1450,18 @@ 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 @@ [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.
--- a/etc/MAILINGLISTS Tue Oct 19 17:00:02 2004 +0000 +++ b/etc/MAILINGLISTS Mon Oct 25 18:17:28 2004 +0000 @@ -1,5 +1,5 @@ GNU Project Electronic Mailing Lists and gnUSENET Newsgroups - Last Updated 1999-05-06 + Last Updated 2004-10-19 Please report improvements to: gnu@gnu.org
--- a/etc/NEWS Tue Oct 19 17:00:02 2004 +0000 +++ b/etc/NEWS Mon Oct 25 18:17:28 2004 +0000 @@ -2052,6 +2052,8 @@ * New modes and packages in Emacs 21.4 +** The new package password.el provide a password cache and expiring mechanism. + ** The new package dns-mode.el add syntax highlight of DNS master files. The key binding C-c C-s (`dns-mode-soa-increment-serial') can be used to increment the SOA serial. @@ -2287,6 +2289,9 @@ * Lisp Changes in Emacs 21.4 +** Function `translate-region' accepts also a char-table as TABLE +argument. + +++ ** Major mode functions now run the new normal hook `after-change-major-mode-hook', at their very end, after the mode hooks. @@ -3503,6 +3508,11 @@ +++ ** New function `call-process-shell-command'. +** New function `process-file'. + +This is similar to `call-process', but obeys file handlers. The file +handler is chosen based on default-directory. + --- ** The dummy function keys made by easymenu are now always lower case. If you specify the
--- a/lisp/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -1,3 +1,177 @@ +2004-10-24 Luc Teirlinck <teirllm@auburn.edu> + + * indent.el (set-left-margin, set-right-margin): Delete redundant + code. + (increase-right-margin): Remove erroneous call to `interactive-p'. + +2004-10-24 Kim F. Storm <storm@cua.dk> + + * help.el (describe-mode): Fix 2004-10-13 change. + Copy pure "Auto Fill" string so it can be propertized later + without causing a read-only error. + +2004-10-24 Luc Teirlinck <teirllm@auburn.edu> + + * info.el (Info-find-emacs-command-nodes): Adapt to Texinfo-4.7 + style indexes. + +2004-10-24 Kai Grossjohann <kai.grossjohann@gmx.net> + + * simple.el (process-file): Accept nil for INFILE. Reported by + Luc Teirlinck. + +2004-10-24 Masatake YAMATO <jet@gyve.org> + + * progmodes/gdb-ui.el (gdb-assembler-font-lock-keywords): Handle + periods and underscores in a function name. + Remove the address fontification. + +2004-10-24 Masatake YAMATO <jet@gyve.org> + + * progmodes/asm-mode.el (asm-font-lock-keywords): Use + font-lock-variable-name-face for registers. + +2004-10-24 Nick Roberts <nickrob@snap.net.nz> + + * progmodes/gdb-ui.el (gdb-get-create-buffer): Allow modes to run + kill-all-local-variables. + (gdb-breakpoints-mode, gdb-frames-mode, gdb-threads-mode) + (gdb-registers-mode, gdb-locals-mode, gdb-assembler-mode): Use + kill-all-local-variables and provide mode-hooks. + (gdb-assembler-font-lock-keywords): New font lock keywords + definition. + (gdb-assembler-mode): Use 'gdb-assembler-font-lock-keywords'. + Suggested by Masatake YAMATO <jet@gyve.org>. + +2004-10-23 Kai Grossjohann <kai.grossjohann@gmx.net> + + * simple.el (process-file): New function, similar to call-process + but supports file handlers. + * vc.el (vc-do-command): Use it, instead of call-process. + * net/tramp-vc.el (vc-do-command): Do not advise it if + process-file is fboundp. + * net/tramp.el (tramp-file-name-handler-alist): Add entry for + process-file. + (tramp-handle-process-file): New function. + (tramp-file-name-for-operation): Support process-file. + +2004-10-23 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el (icalendar--weekday-array): New constant. + (icalendar-weekdayabbrev-table) + (icalendar-monthnumber-table): Delete. + (icalendar--get-month-number): Use calendar-month-name-array. + (icalendar--get-weekday-number): New function. + (icalendar--get-weekday-abbrev) Use calendar-day-name-array. + (icalendar-export-region): Handle multi-line entries. + (icalendar--convert-ical-to-diary): Use calendar-day-name-array. + +2004-10-23 John Paul Wallington <jpw@gnu.org> + + * ibuffer.el (ibuffer-find-file): Remove `interactive-p' call; + `wildcards' set to t in interactive spec. + + * ibuf-ext.el (ibuffer-jump-to-buffer): Read buffer name in + interactive spec rather than use `interactive-p'. + (ibuffer-kill-line): Set arg `interactive-p' in interactive spec + rather than use function `interactive-p'. + +2004-10-22 Kenichi Handa <handa@m17n.org> + + * international/mule.el (translate-region): Implement it in Lisp + as a front end of translate-region-internal. + +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. @@ -154,6 +328,13 @@ * net/password.el: Add. +2004-10-14 Masatake YAMATO <jet@gyve.org> + + * progmodes/gud.el (gdb-script-beginning-of-defun): New function. + (gdb-script-end-of-defun): New function. + (gdb-script-mode): Use `gdb-script-beginning-of-defun' and + `gdb-script-end-of-defun' as *-of-defun-function. + 2004-10-13 Daniel Pfeiffer <occitan@esperanto.org> * button.el (button-activate): Allow a marker to display as an action. @@ -163,13 +344,6 @@ * help.el (describe-mode): Use it to make minor mode list into hyperlinks. -2004-10-14 Masatake YAMATO <jet@gyve.org> - - * progmodes/gud.el (gdb-script-beginning-of-defun): New function. - (gdb-script-end-of-defun): New function. - (gdb-script-mode): Use `gdb-script-beginning-of-defun' and - `gdb-script-end-of-defun' as *-of-defun-function. - 2004-10-13 Stefan Monnier <monnier@iro.umontreal.ca> * vc.el (vc-annotate-display-select): Fix typo. @@ -179,6 +353,16 @@ (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. @@ -241,6 +425,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. @@ -454,6 +647,15 @@ * diff-mode.el (diff-file-header-re): Tighten up regexp a tiny bit. (diff-fixup-modifs): Catch unified-diff file-headers. +2004-09-29 Kim F. Storm <storm@cua.dk> + + * progmodes/gdb-ui.el (breakpoint): Define as fringe bitmap. + (gdb-mouse-toggle-breakpoint): Fix fringe-bitmaps-at-pos usage. + (gdb-put-breakpoint-icon): Use breakpoint bitmap. + + * fringe.el (fringe-bitmap-p): New macro. + (fringe-bitmaps): Add standard fringe bitmaps on load. + 2004-09-28 Stefan Monnier <monnier@iro.umontreal.ca> * dired.el (dired-view-command-alist): Use more efficient regexps. @@ -463,15 +665,6 @@ (dired-move-to-end-of-filename): Make the " -> " search more specific. (dired-buffers-for-dir): Remove unused var `pattern'. -2004-09-29 Kim F. Storm <storm@cua.dk> - - * progmodes/gdb-ui.el (breakpoint): Define as fringe bitmap. - (gdb-mouse-toggle-breakpoint): Fix fringe-bitmaps-at-pos usage. - (gdb-put-breakpoint-icon): Use breakpoint bitmap. - - * fringe.el (fringe-bitmap-p): New macro. - (fringe-bitmaps): Add standard fringe bitmaps on load. - 2004-09-28 Matthew Mundell <matt@mundell.ukfsn.org> (tiny change) * calendar/diary-lib.el (list-diary-entries): Save diary buffer @@ -606,6 +799,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. @@ -620,6 +819,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' @@ -705,6 +908,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): @@ -736,6 +944,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.
--- a/lisp/autorevert.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/autorevert.el Mon Oct 25 18:17:28 2004 +0000 @@ -421,6 +421,9 @@ '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
--- a/lisp/calc/calc-aent.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calc/calc-aent.el Mon Oct 25 18:17:28 2004 +0000 @@ -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))
--- a/lisp/calc/calc-ext.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calc/calc-ext.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ (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)
--- a/lisp/calc/calc-graph.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calc/calc-graph.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ 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)))
--- a/lisp/calc/calc-help.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calc/calc-help.el Mon Oct 25 18:17:28 2004 +0000 @@ -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,7 +113,7 @@ (describe-bindings) (save-excursion (set-buffer "*Help*") - (let ((buffer-read-only nil)) + (let ((inhibit-read-only t)) (goto-char (point-min)) (when (search-forward "Major Mode Bindings:" nil t) (delete-region (point-min) (point)) @@ -673,5 +674,5 @@ "} (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
--- a/lisp/calc/calc-mode.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calc/calc-mode.el Mon Oct 25 18:17:28 2004 +0000 @@ -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)
--- a/lisp/calc/calc.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calc/calc.el Mon Oct 25 18:17:28 2004 +0000 @@ -656,12 +656,7 @@ ;; 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 (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 @@ (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 @@ (let ((key (event-to-character event t t))) (or key optkey (error "Expected a plain keystroke")) (cons key event)))) - (calc-emacs-type-gnu19 + (t (let ((key (read-event))) - (cons key key))) - (t - (let ((key (read-char))) (cons key key))))) (defun calc-unread-command (&optional input)
--- a/lisp/calendar/icalendar.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/calendar/icalendar.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,10 +1,10 @@ -;;; icalendar.el --- iCalendar implementation +;;; icalendar.el --- iCalendar implementation -*-coding: utf-8 -*- ;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc. -;; Author: Ulf Jasper <ulf.jasper@web.de> -;; Created: August 2002 -;; Keywords: calendar +;; Author: Ulf Jasper <ulf.jasper@web.de> +;; Created: August 2002 +;; Keywords: calendar ;; Human-Keywords: calendar, diary, iCalendar, vCalendar ;; This file is part of GNU Emacs. @@ -31,8 +31,20 @@ ;;; History: -;; 0.06 Bugfixes regarding icalendar-import-format-*. -;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp Grau. +;; 0.07: Renamed commands! +;; icalendar-extract-ical-from-buffer -> icalendar-import-buffer +;; icalendar-convert-diary-to-ical -> icalendar-export-file +;; Naming scheme: icalendar-.* = user command; icalendar--.* = +;; internal. +;; Added icalendar-export-region. +;; The import and export commands do not clear their target file, +;; but append their results to the target file. +;; I18n-problems fixed -- use calendar-(month|day)-name-array. +;; Fixed problems with export of multi-line diary entries. + +;; 0.06: Bugfixes regarding icalendar-import-format-*. +;; Fix in icalendar-convert-diary-to-ical -- thanks to Philipp +;; Grau. ;; 0.05: New import format scheme: Replaced icalendar-import-prefix-*, ;; icalendar-import-ignored-properties, and @@ -61,7 +73,7 @@ ;; ====================================================================== ;; To Do: -;; * Import from ical: +;; * Import from ical to diary: ;; + Need more properties for icalendar-import-format ;; + check vcalendar version ;; + check (unknown) elements @@ -73,24 +85,21 @@ ;; + error log is incomplete ;; + nice to have: #include "webcal://foo.com/some-calendar.ics" -;; * Export into ical +;; * Export from diary to ical ;; + diary-date, diary-float, and self-made sexp entries are not ;; understood ;; + timezones, currently all times are local! ;; * Other things -;; + defcustom icalendar-import-ignored-properties does not work with -;; XEmacs. ;; + clean up all those date/time parsing functions ;; + Handle todo items? ;; + Check iso 8601 for datetime and period ;; + Which chars to (un)escape? -;; + Time to find out how the profiler works? ;;; Code: -(defconst icalendar-version 0.06 +(defconst icalendar-version 0.07 "Version number of icalendar.el.") ;; ====================================================================== @@ -160,31 +169,7 @@ ;; NO USER SERVICABLE PARTS BELOW THIS LINE ;; ====================================================================== -(defconst icalendar-weekdayabbrev-table - '(("mon\\(day\\)?" . "MO") - ("tue\\(sday\\)?" . "TU") - ("wed\\(nesday\\)?" . "WE") - ("thu\\(rsday\\)?" . "TH") - ("fri\\(day\\)?" . "FR") - ("sat\\(urday\\)?" . "SA") - ("sun\\(day\\)?" . "SU")) - "Translation table for weekdays.") - -(defconst icalendar-monthnumber-table - '(("^jan\\(uar\\)?y?$" . 1) - ("^feb\\(ruar\\)?y?$" . 2) - ("^mar\\(ch\\)?\\|märz?$" . 3) - ("^apr\\(il\\)?$" . 4) - ("^ma[iy]$" . 5) - ("^jun[ie]?$" . 6) - ("^jul[iy]?$" . 7) - ("^aug\\(ust\\)?$" . 8) - ("^sep\\(tember\\)?$" . 9) - ("^o[ck]t\\(ober\\)?$" . 10) - ("^nov\\(ember\\)?$" . 11) - ("^de[cz]\\(ember\\)?$" . 12)) - "Regular expressions for month names. -Currently this matches only German and English.") +(defconst icalendar--weekday-array ["SU" "MO" "TU" "WE" "TH" "FR" "SA"]) (defvar icalendar-debug nil ".") @@ -195,11 +180,19 @@ (require 'appt) ;; ====================================================================== +;; misc +;; ====================================================================== +(defun icalendar--dmsg (&rest args) + "Print message ARGS if `icalendar-debug' is non-nil." + (if icalendar-debug + (apply 'message args))) + +;; ====================================================================== ;; Core functionality ;; Functions for parsing icalendars, importing and so on ;; ====================================================================== -(defun icalendar-get-unfolded-buffer (folded-ical-buffer) +(defun icalendar--get-unfolded-buffer (folded-ical-buffer) "Return a new buffer containing the unfolded contents of a buffer. Folding is the iCalendar way of wrapping long lines. In the created buffer all occurrences of CR LF BLANK are replaced by the @@ -211,13 +204,12 @@ (erase-buffer) (insert-buffer folded-ical-buffer) (while (re-search-forward "\r?\n[ \t]" nil t) - (replace-match "" nil nil)) - ) + (replace-match "" nil nil))) unfolded-buffer)) -;; Replace regexp RE with RP in string ST and return the new string. -;; This is here for compatibility with XEmacs. -(defsubst icalendar-rris (re rp st) +(defsubst icalendar--rris (re rp st) + "Replace regexp RE with RP in string ST and return the new string. +This is here for compatibility with XEmacs." ;; XEmacs: (if (fboundp 'replace-in-string) (save-match-data ;; apparently XEmacs needs save-match-data @@ -225,7 +217,7 @@ ;; Emacs: (replace-regexp-in-string re rp st))) -(defun icalendar-read-element (invalue inparams) +(defun icalendar--read-element (invalue inparams) "Recursively read the next iCalendar element in the current buffer. INVALUE gives the current iCalendar element we are reading. INPARAMS gives the current parameters..... @@ -233,7 +225,7 @@ it finds" (let (element children line name params param param-name param-value value - (continue t)) + (continue t)) (setq children '()) (while (and continue (re-search-forward "^\\([A-Za-z0-9-]+\\)[;:]" nil t)) @@ -261,13 +253,13 @@ (error "Oops")) (forward-char 1) (re-search-forward "\\(.*\\)\\(\r?\n[ \t].*\\)*" nil t) - (setq value (icalendar-rris "\r?\n[ \t]" "" (match-string 0))) + (setq value (icalendar--rris "\r?\n[ \t]" "" (match-string 0))) (setq line (list name params value)) (cond ((eq name 'BEGIN) (setq children (append children - (list (icalendar-read-element (intern value) - params))))) + (list (icalendar--read-element (intern value) + params))))) ((eq name 'END) (setq continue nil)) (t @@ -280,11 +272,11 @@ ;; helper functions for examining events ;; ====================================================================== -(defsubst icalendar-get-all-event-properties (event) - "Return the list of properties in this EVENT." - (car (cddr event))) +;;(defsubst icalendar--get-all-event-properties (event) +;; "Return the list of properties in this EVENT." +;; (car (cddr event))) -(defun icalendar-get-event-property (event prop) +(defun icalendar--get-event-property (event prop) "For the given EVENT return the value of the property PROP." (catch 'found (let ((props (car (cddr event))) pp) @@ -295,21 +287,21 @@ (setq props (cdr props)))) nil)) -(defun icalendar-set-event-property (event prop new-value) - "For the given EVENT set the property PROP to the value NEW-VALUE." - (catch 'found - (let ((props (car (cddr event))) pp) - (while props - (setq pp (car props)) - (when (eq (car pp) prop) - (setcdr (cdr pp) new-value) - (throw 'found (car (cddr pp)))) - (setq props (cdr props))) - (setq props (car (cddr event))) - (setcar (cddr event) - (append props (list (list prop nil new-value))))))) +;; (defun icalendar--set-event-property (event prop new-value) +;; "For the given EVENT set the property PROP to the value NEW-VALUE." +;; (catch 'found +;; (let ((props (car (cddr event))) pp) +;; (while props +;; (setq pp (car props)) +;; (when (eq (car pp) prop) +;; (setcdr (cdr pp) new-value) +;; (throw 'found (car (cddr pp)))) +;; (setq props (cdr props))) +;; (setq props (car (cddr event))) +;; (setcar (cddr event) +;; (append props (list (list prop nil new-value))))))) -(defun icalendar-get-children (node name) +(defun icalendar--get-children (node name) "Return all children of the given NODE which have a name NAME. For instance the VCALENDAR node can have VEVENT children as well as VTODO children." @@ -321,22 +313,21 @@ (when children (let ((subresult (delq nil - (mapcar (lambda (n) - (icalendar-get-children n name)) - children)))) + (mapcar (lambda (n) + (icalendar--get-children n name)) + children)))) (if subresult (if result (setq result (append result subresult)) (setq result subresult))))) result)) -; private -(defun icalendar-all-events (icalendar) + ; private +(defun icalendar--all-events (icalendar) "Return the list of all existing events in the given ICALENDAR." - (interactive "") - (icalendar-get-children (car icalendar) 'VEVENT)) + (icalendar--get-children (car icalendar) 'VEVENT)) -(defun icalendar-split-value (value-string) +(defun icalendar--split-value (value-string) "Splits VALUE-STRING at ';='." (let ((result '()) param-name param-value) @@ -348,22 +339,22 @@ (insert value-string) (goto-char (point-min)) (while - (re-search-forward - "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" - nil t) + (re-search-forward + "\\([A-Za-z0-9-]+\\)=\\(\\([^;,:]+\\)\\|\"\\([^\"]+\\)\"\\);?" + nil t) (setq param-name (intern (match-string 1))) (setq param-value (match-string 2)) (setq result - (append result (list (list param-name param-value))))))) + (append result (list (list param-name param-value))))))) result)) -(defun icalendar-decode-isodatetime (isodatetimestring) +(defun icalendar--decode-isodatetime (isodatetimestring) "Return ISODATETIMESTRING in format like `decode-time'. Converts from ISO-8601 to Emacs representation. If ISODATETIMESTRING specifies UTC time (trailing letter Z) the decoded time is given in the local time zone! FIXME: TZID-attributes are ignored....! FIXME: multiple comma-separated values should be allowed!" - (icalendar-dmsg isodatetimestring) + (icalendar--dmsg isodatetimestring) (if isodatetimestring ;; day/month/year must be present (let ((year (read (substring isodatetimestring 0 4))) @@ -373,14 +364,14 @@ (minute 0) (second 0)) (when (> (length isodatetimestring) 12) - ;; hour/minute present + ;; hour/minute present (setq hour (read (substring isodatetimestring 9 11))) (setq minute (read (substring isodatetimestring 11 13)))) (when (> (length isodatetimestring) 14) - ;; seconds present + ;; seconds present (setq second (read (substring isodatetimestring 13 15)))) (when (and (> (length isodatetimestring) 15) - ;; UTC specifier present + ;; UTC specifier present (char-equal ?Z (aref isodatetimestring 15))) ;; if not UTC add current-time-zone offset (setq second (+ (car (current-time-zone)) second))) @@ -395,7 +386,7 @@ ;; isodatetimestring == nil nil)) -(defun icalendar-decode-isoduration (isodurationstring) +(defun icalendar--decode-isoduration (isodurationstring) "Return ISODURATIONSTRING in format like `decode-time'. Converts from ISO-8601 to Emacs representation. If ISODURATIONSTRING specifies UTC time (trailing letter Z) the decoded time is given in @@ -409,7 +400,7 @@ "\\(\\([0-9]+\\)D\\)" ; days only "\\|" "\\(\\(\\([0-9]+\\)D\\)?T\\(\\([0-9]+\\)H\\)?" ; opt days - "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time + "\\(\\([0-9]+\\)M\\)?\\(\\([0-9]+\\)S\\)?\\)" ; mand. time "\\|" "\\(\\([0-9]+\\)W\\)" ; weeks only "\\)$") isodurationstring) @@ -419,41 +410,41 @@ (days 0) (months 0) (years 0)) - (cond - ((match-beginning 2) ;days only - (setq days (read (substring isodurationstring - (match-beginning 3) - (match-end 3)))) - (when icalendar-duration-correction - (setq days (1- days)))) - ((match-beginning 4) ;days and time - (if (match-beginning 5) - (setq days (* 7 (read (substring isodurationstring - (match-beginning 6) - (match-end 6)))))) - (if (match-beginning 7) - (setq hours (read (substring isodurationstring - (match-beginning 8) - (match-end 8))))) - (if (match-beginning 9) - (setq minutes (read (substring isodurationstring - (match-beginning 10) - (match-end 10))))) - (if (match-beginning 11) - (setq seconds (read (substring isodurationstring - (match-beginning 12) - (match-end 12))))) - ) - ((match-beginning 13) ;weeks only - (setq days (* 7 (read (substring isodurationstring - (match-beginning 14) - (match-end 14)))))) - ) - (list seconds minutes hours days months years))) + (cond + ((match-beginning 2) ;days only + (setq days (read (substring isodurationstring + (match-beginning 3) + (match-end 3)))) + (when icalendar-duration-correction + (setq days (1- days)))) + ((match-beginning 4) ;days and time + (if (match-beginning 5) + (setq days (* 7 (read (substring isodurationstring + (match-beginning 6) + (match-end 6)))))) + (if (match-beginning 7) + (setq hours (read (substring isodurationstring + (match-beginning 8) + (match-end 8))))) + (if (match-beginning 9) + (setq minutes (read (substring isodurationstring + (match-beginning 10) + (match-end 10))))) + (if (match-beginning 11) + (setq seconds (read (substring isodurationstring + (match-beginning 12) + (match-end 12))))) + ) + ((match-beginning 13) ;weeks only + (setq days (* 7 (read (substring isodurationstring + (match-beginning 14) + (match-end 14)))))) + ) + (list seconds minutes hours days months years))) ;; isodatetimestring == nil nil)) -(defun icalendar-add-decoded-times (time1 time2) +(defun icalendar--add-decoded-times (time1 time2) "Add TIME1 to TIME2. Both times must be given in decoded form. One of these times must be valid (year > 1900 or something)." @@ -470,149 +461,188 @@ ;;(or (nth 6 time1) (nth 6 time2)) ;; FIXME? ))) -(defun icalendar-datetime-to-noneuropean-date (datetime) +(defun icalendar--datetime-to-noneuropean-date (datetime) "Convert the decoded DATETIME to non-european-style format. Non-European format: (month day year)." (if datetime - (list (nth 4 datetime) ;month - (nth 3 datetime) ;day - (nth 5 datetime));year + (list (nth 4 datetime) ;month + (nth 3 datetime) ;day + (nth 5 datetime)) ;year ;; datetime == nil nil)) -(defun icalendar-datetime-to-european-date (datetime) +(defun icalendar--datetime-to-european-date (datetime) "Convert the decoded DATETIME to European format. European format: (day month year). FIXME" (if datetime - (format "%d %d %d" (nth 3 datetime); day - (nth 4 datetime) ;month - (nth 5 datetime));year + (format "%d %d %d" (nth 3 datetime) ; day + (nth 4 datetime) ;month + (nth 5 datetime)) ;year ;; datetime == nil nil)) -(defun icalendar-datetime-to-colontime (datetime) +(defun icalendar--datetime-to-colontime (datetime) "Extract the time part of a decoded DATETIME into 24-hour format. Note that this silently ignores seconds." (format "%02d:%02d" (nth 2 datetime) (nth 1 datetime))) -(defun icalendar-get-month-number (monthname) +(defun icalendar--get-month-number (monthname) "Return the month number for the given MONTHNAME." - (save-match-data - (let ((case-fold-search t)) - (assoc-default monthname icalendar-monthnumber-table - 'string-match)))) + (catch 'found + (let ((num 1) + (m (downcase monthname))) + (mapc (lambda (month) + (let ((mm (downcase month))) + (if (or (string-equal mm m) + (string-equal (substring mm 0 3) m)) + (throw 'found num)) + (setq num (1+ num)))) + calendar-month-name-array)) + ;; Error: + -1)) -(defun icalendar-get-weekday-abbrev (weekday) +(defun icalendar--get-weekday-number (abbrevweekday) + "Return the number for the ABBREVWEEKDAY." + (catch 'found + (let ((num 0) + (aw (downcase abbrevweekday))) + (mapc (lambda (day) + (let ((d (downcase day))) + (if (string-equal d aw) + (throw 'found num)) + (setq num (1+ num)))) + icalendar--weekday-array)) + ;; Error: + -1)) + +(defun icalendar--get-weekday-abbrev (weekday) "Return the abbreviated WEEKDAY." - ;;FIXME: ISO-like(?). - (save-match-data - (let ((case-fold-search t)) - (assoc-default weekday icalendar-weekdayabbrev-table - 'string-match)))) + (catch 'found + (let ((num 0) + (w (downcase weekday))) + (mapc (lambda (day) + (let ((d (downcase day))) + (if (or (string-equal d w) + (string-equal (substring d 0 3) w)) + (throw 'found (aref icalendar--weekday-array num))) + (setq num (1+ num)))) + calendar-day-name-array)) + ;; Error: + "??")) -(defun icalendar-datestring-to-isodate (datestring &optional day-shift) +(defun icalendar--datestring-to-isodate (datestring &optional day-shift) "Convert diary-style DATESTRING to iso-style date. If DAY-SHIFT is non-nil, the result is shifted by DAY-SHIFT days -- DAY-SHIFT must be either nil or an integer. This function takes care of european-style." (let ((day -1) month year) (save-match-data - (cond (;; numeric date - (string-match (concat "\\s-*" - "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" - "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*" - "\\([0-9]\\{4\\}\\)") - datestring) - (setq day (read (substring datestring (match-beginning 1) - (match-end 1)))) - (setq month (read (substring datestring (match-beginning 2) - (match-end 2)))) - (setq year (read (substring datestring (match-beginning 3) - (match-end 3)))) - (unless european-calendar-style - (let ((x month)) - (setq month day) - (setq day x)))) - (;; date contains month names -- european-style - (and european-calendar-style - (string-match (concat "\\s-*" - "0?\\([123]?[0-9]\\)[ \t/]\\s-*" - "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" - "\\([0-9]\\{4\\}\\)") - datestring)) - (setq day (read (substring datestring (match-beginning 1) - (match-end 1)))) - (setq month (icalendar-get-month-number - (substring datestring (match-beginning 2) - (match-end 2)))) - (setq year (read (substring datestring (match-beginning 3) - (match-end 3))))) - (;; date contains month names -- non-european-style - (and (not european-calendar-style) - (string-match (concat "\\s-*" - "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" - "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" - "\\([0-9]\\{4\\}\\)") - datestring)) - (setq day (read (substring datestring (match-beginning 2) - (match-end 2)))) - (setq month (icalendar-get-month-number - (substring datestring (match-beginning 1) - (match-end 1)))) - (setq year (read (substring datestring (match-beginning 3) - (match-end 3))))) - (t - nil))) + (cond ( ;; numeric date + (string-match (concat "\\s-*" + "0?\\([1-9][0-9]?\\)[ \t/]\\s-*" + "0?\\([1-9][0-9]?\\),?[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring) + (setq day (read (substring datestring (match-beginning 1) + (match-end 1)))) + (setq month (read (substring datestring (match-beginning 2) + (match-end 2)))) + (setq year (read (substring datestring (match-beginning 3) + (match-end 3)))) + (unless european-calendar-style + (let ((x month)) + (setq month day) + (setq day x)))) + ( ;; date contains month names -- european-style + (and european-calendar-style + (string-match (concat "\\s-*" + "0?\\([123]?[0-9]\\)[ \t/]\\s-*" + "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring)) + (setq day (read (substring datestring (match-beginning 1) + (match-end 1)))) + (setq month (icalendar--get-month-number + (substring datestring (match-beginning 2) + (match-end 2)))) + (setq year (read (substring datestring (match-beginning 3) + (match-end 3))))) + ( ;; date contains month names -- non-european-style + (and (not european-calendar-style) + (string-match (concat "\\s-*" + "\\([A-Za-z][^ ]+\\)[ \t/]\\s-*" + "0?\\([123]?[0-9]\\),?[ \t/]\\s-*" + "\\([0-9]\\{4\\}\\)") + datestring)) + (setq day (read (substring datestring (match-beginning 2) + (match-end 2)))) + (setq month (icalendar--get-month-number + (substring datestring (match-beginning 1) + (match-end 1)))) + (setq year (read (substring datestring (match-beginning 3) + (match-end 3))))) + (t + nil))) (if (> day 0) - (let ((mdy (calendar-gregorian-from-absolute - (+ (calendar-absolute-from-gregorian (list month day year)) - (or day-shift 0))))) - (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) + (let ((mdy (calendar-gregorian-from-absolute + (+ (calendar-absolute-from-gregorian (list month day + year)) + (or day-shift 0))))) + (format "%04d%02d%02d" (nth 2 mdy) (nth 0 mdy) (nth 1 mdy))) nil))) -(defun icalendar-dmsg (&rest args) - "Print message ARGS if `icalendar-debug' is non-nil." - (if icalendar-debug - (apply 'message args))) - -(defun icalendar-diarytime-to-isotime (timestring ampmstring) +(defun icalendar--diarytime-to-isotime (timestring ampmstring) "Convert a a time like 9:30pm to an iso-conform string like T213000. In this example the TIMESTRING would be \"9:30\" and the AMPMSTRING would be \"pm\"." (if timestring - (let ((starttimenum (read (icalendar-rris ":" "" timestring)))) + (let ((starttimenum (read (icalendar--rris ":" "" timestring)))) ;; take care of am/pm style (if (and ampmstring (string= "pm" ampmstring)) (setq starttimenum (+ starttimenum 1200))) (format "T%04d00" starttimenum)) nil)) -(defun icalendar-convert-string-for-export (s) +(defun icalendar--convert-string-for-export (s) "Escape comma and other critical characters in string S." - (icalendar-rris "," "\\\\," s)) + (icalendar--rris "," "\\\\," s)) -(defun icalendar-convert-for-import (string) +(defun icalendar--convert-string-for-import (string) "Remove escape chars for comma, semicolon etc. from STRING." - (icalendar-rris - "\\\\n" "\n " (icalendar-rris - "\\\\\"" "\"" (icalendar-rris - "\\\\;" ";" (icalendar-rris - "\\\\," "," string))))) + (icalendar--rris + "\\\\n" "\n " (icalendar--rris + "\\\\\"" "\"" (icalendar--rris + "\\\\;" ";" (icalendar--rris + "\\\\," "," string))))) ;; ====================================================================== -;; export -- convert emacs-diary to icalendar +;; Export -- convert emacs-diary to icalendar ;; ====================================================================== -(defun icalendar-convert-diary-to-ical (diary-filename ical-filename - &optional do-not-clear-diary-file) - "Export diary file to iCalendar format -- erases ical-filename!!!. -Argument DIARY-FILENAME is the input `diary-file'. -Argument ICAL-FILENAME is the output iCalendar file. -If DO-NOT-CLEAR-DIARY-FILE is not nil the target iCalendar file -is not erased." +;; User function +(defun icalendar-export-file (diary-filename ical-filename) + "Export diary file to iCalendar format. +All diary entries in the file DIARY-FILENAME are converted to iCalendar +format. The result is appended to the file ICAL-FILENAME." (interactive "FExport diary data from file: Finto iCalendar file: ") + (save-current-buffer + (set-buffer (find-file diary-filename)) + (icalendar-export-region (point-min) (point-max) ical-filename))) + +(defalias 'icalendar-convert-diary-to-ical 'icalendar-export-file) +(make-obsolete 'icalendar-convert-diary-to-ical 'icalendar-export-file + "icalendar 0.07") + +;; User function +(defun icalendar-export-region (min max ical-filename) + "Export region in diary file to iCalendar format. +All diary entries in the region from MIN to MAX in the current buffer are +converted to iCalendar format. The result is appended to the file +ICAL-FILENAME." + (interactive "r +FExport diary data into iCalendar file: ") (let ((result "") (start 0) (entry-main "") @@ -621,12 +651,11 @@ (contents) (oops nil) (nonmarker (concat "^" (regexp-quote diary-nonmarking-symbol) - "?"))) - (save-current-buffer - (set-buffer (find-file diary-filename)) - (goto-char (point-min)) + "?"))) + (save-excursion + (goto-char min) (while (re-search-forward - "^\\([^ \t\n].*\\)\\(\n[ \t].*\\)*" nil t) + "^\\([^ \t\n].*\\)\\(\\(\n[ \t].*\\)*\\)" max t) (setq entry-main (match-string 1)) (if (match-beginning 2) (setq entry-rest (match-string 2)) @@ -642,16 +671,16 @@ (concat nonmarker "%%(diary-anniversary \\([^)]+\\))\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "diary-anniversary %s" entry-main) + (icalendar--dmsg "diary-anniversary %s" entry-main) (let* ((datetime (substring entry-main (match-beginning 1) (match-end 1))) - (summary (icalendar-convert-string-for-export + (summary (icalendar--convert-string-for-export (substring entry-main (match-beginning 2) (match-end 2)))) - (startisostring (icalendar-datestring-to-isodate - datetime)) - (endisostring (icalendar-datestring-to-isodate - datetime 1))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1))) (setq contents (concat "\nDTSTART;VALUE=DATE:" startisostring "\nDTEND;VALUE=DATE:" endisostring @@ -666,7 +695,7 @@ ))) (unless (string= entry-rest "") (setq contents (concat contents "\nDESCRIPTION:" - (icalendar-convert-string-for-export + (icalendar--convert-string-for-export entry-rest))))) ;; cyclic events ;; %%(diary-cyclic ) @@ -675,18 +704,18 @@ "%%(diary-cyclic \\([^ ]+\\) +" "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "diary-cyclic %s" entry-main) + (icalendar--dmsg "diary-cyclic %s" entry-main) (let* ((frequency (substring entry-main (match-beginning 1) (match-end 1))) (datetime (substring entry-main (match-beginning 2) (match-end 2))) - (summary (icalendar-convert-string-for-export + (summary (icalendar--convert-string-for-export (substring entry-main (match-beginning 3) (match-end 3)))) - (startisostring (icalendar-datestring-to-isodate - datetime)) - (endisostring (icalendar-datestring-to-isodate - datetime 1))) + (startisostring (icalendar--datestring-to-isodate + datetime)) + (endisostring (icalendar--datestring-to-isodate + datetime 1))) (setq contents (concat "\nDTSTART;VALUE=DATE:" startisostring "\nDTEND;VALUE=DATE:" endisostring @@ -697,21 +726,21 @@ ))) (unless (string= entry-rest "") (setq contents (concat contents "\nDESCRIPTION:" - (icalendar-convert-string-for-export + (icalendar--convert-string-for-export entry-rest))))) ;; diary-date -- FIXME ((string-match (concat nonmarker "%%(diary-date \\([^)]+\\))\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "diary-date %s" entry-main) + (icalendar--dmsg "diary-date %s" entry-main) (setq oops t)) ;; float events -- FIXME ((string-match (concat nonmarker "%%(diary-float \\([^)]+\\))\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "diary-float %s" entry-main) + (icalendar--dmsg "diary-float %s" entry-main) (setq oops t)) ;; block events ((string-match @@ -719,18 +748,18 @@ "%%(diary-block \\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\) +" "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\))\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "diary-block %s" entry-main) + (icalendar--dmsg "diary-block %s" entry-main) (let* ((startstring (substring entry-main (match-beginning 1) (match-end 1))) (endstring (substring entry-main (match-beginning 2) (match-end 2))) - (summary (icalendar-convert-string-for-export + (summary (icalendar--convert-string-for-export (substring entry-main (match-beginning 3) (match-end 3)))) - (startisostring (icalendar-datestring-to-isodate - startstring)) - (endisostring (icalendar-datestring-to-isodate - endstring 1))) + (startisostring (icalendar--datestring-to-isodate + startstring)) + (endisostring (icalendar--datestring-to-isodate + endstring 1))) (setq contents (concat "\nDTSTART;VALUE=DATE:" startisostring "\nDTEND;VALUE=DATE:" endisostring @@ -738,14 +767,14 @@ )) (unless (string= entry-rest "") (setq contents (concat contents "\nDESCRIPTION:" - (icalendar-convert-string-for-export + (icalendar--convert-string-for-export entry-rest)))))) ;; other sexp diary entries -- FIXME ((string-match (concat nonmarker "%%(\\([^)]+\\))\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "diary-sexp %s" entry-main) + (icalendar--dmsg "diary-sexp %s" entry-main) (setq oops t)) ;; weekly by day ;; Monday 8:30 Team meeting @@ -758,13 +787,13 @@ "\\)?" "\\s-*\\(.*\\)$") entry-main) - (icalendar-get-weekday-abbrev - (substring entry-main (match-beginning 1) (match-end 1)))) - (icalendar-dmsg "weekly %s" entry-main) - (let* ((day (icalendar-get-weekday-abbrev + (icalendar--get-weekday-abbrev + (substring entry-main (match-beginning 1) (match-end 1)))) + (icalendar--dmsg "weekly %s" entry-main) + (let* ((day (icalendar--get-weekday-abbrev (substring entry-main (match-beginning 1) (match-end 1)))) - (starttimestring (icalendar-diarytime-to-isotime + (starttimestring (icalendar--diarytime-to-isotime (if (match-beginning 3) (substring entry-main (match-beginning 3) @@ -775,24 +804,24 @@ (match-beginning 4) (match-end 4)) nil))) - (endtimestring (icalendar-diarytime-to-isotime + (endtimestring (icalendar--diarytime-to-isotime (if (match-beginning 6) (substring entry-main - (match-beginning 6) + (match-beginning 6) (match-end 6)) nil) (if (match-beginning 7) (substring entry-main - (match-beginning 7) + (match-beginning 7) (match-end 7)) nil))) - (summary (icalendar-convert-string-for-export + (summary (icalendar--convert-string-for-export (substring entry-main (match-beginning 8) (match-end 8))))) (when starttimestring (unless endtimestring - (let ((time (read (icalendar-rris "^T0?" "" - starttimestring)))) + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) (setq contents (concat "\nDTSTART" @@ -809,7 +838,7 @@ ))) (unless (string= entry-rest "") (setq contents (concat contents "\nDESCRIPTION:" - (icalendar-convert-string-for-export + (icalendar--convert-string-for-export entry-rest))))) ;; yearly by day ;; 1 May Tag der Arbeit @@ -821,20 +850,20 @@ "\\*?\\s-*" "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" - "\\s-*\\([^0-9]+.*\\)$"; must not match years + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" + "\\s-*\\([^0-9]+.*\\)$" ; must not match years ) entry-main) - (icalendar-dmsg "yearly %s" entry-main) + (icalendar--dmsg "yearly %s" entry-main) (let* ((daypos (if european-calendar-style 1 2)) (monpos (if european-calendar-style 2 1)) (day (read (substring entry-main (match-beginning daypos) (match-end daypos)))) - (month (icalendar-get-month-number + (month (icalendar--get-month-number (substring entry-main (match-beginning monpos) (match-end monpos)))) - (starttimestring (icalendar-diarytime-to-isotime + (starttimestring (icalendar--diarytime-to-isotime (if (match-beginning 4) (substring entry-main (match-beginning 4) @@ -845,24 +874,24 @@ (match-beginning 5) (match-end 5)) nil))) - (endtimestring (icalendar-diarytime-to-isotime + (endtimestring (icalendar--diarytime-to-isotime (if (match-beginning 7) (substring entry-main - (match-beginning 7) + (match-beginning 7) (match-end 7)) nil) (if (match-beginning 8) (substring entry-main - (match-beginning 8) + (match-beginning 8) (match-end 8)) nil))) - (summary (icalendar-convert-string-for-export + (summary (icalendar--convert-string-for-export (substring entry-main (match-beginning 9) (match-end 9))))) (when starttimestring (unless endtimestring - (let ((time (read (icalendar-rris "^T0?" "" - starttimestring)))) + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) (setq contents (concat "\nDTSTART" @@ -881,7 +910,7 @@ ))) (unless (string= entry-rest "") (setq contents (concat contents "\nDESCRIPTION:" - (icalendar-convert-string-for-export + (icalendar--convert-string-for-export entry-rest))))) ;; "ordinary" events, start and end time given ;; 1 Feb 2003 Hs Hochzeitsfeier, Dreieich @@ -890,15 +919,15 @@ "\\([^ /]+[ /]+[^ /]+[ /]+[^ ]+\\)\\s-+" "\\(0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?" "\\(" - "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" - "\\)?" + "-0?\\([1-9][0-9]?:[0-9][0-9]\\)\\([ap]m\\)?\\)?" + "\\)?" "\\s-*\\(.*\\)") entry-main) - (icalendar-dmsg "ordinary %s" entry-main) - (let* ((datestring (icalendar-datestring-to-isodate + (icalendar--dmsg "ordinary %s" entry-main) + (let* ((datestring (icalendar--datestring-to-isodate (substring entry-main (match-beginning 1) (match-end 1)))) - (starttimestring (icalendar-diarytime-to-isotime + (starttimestring (icalendar--diarytime-to-isotime (if (match-beginning 3) (substring entry-main (match-beginning 3) @@ -909,38 +938,38 @@ (match-beginning 4) (match-end 4)) nil))) - (endtimestring (icalendar-diarytime-to-isotime + (endtimestring (icalendar--diarytime-to-isotime (if (match-beginning 6) (substring entry-main - (match-beginning 6) + (match-beginning 6) (match-end 6)) nil) (if (match-beginning 7) (substring entry-main - (match-beginning 7) + (match-beginning 7) (match-end 7)) nil))) - (summary (icalendar-convert-string-for-export + (summary (icalendar--convert-string-for-export (substring entry-main (match-beginning 8) (match-end 8))))) (when starttimestring (unless endtimestring - (let ((time (read (icalendar-rris "^T0?" "" - starttimestring)))) + (let ((time (read (icalendar--rris "^T0?" "" + starttimestring)))) (setq endtimestring (format "T%06d" (+ 10000 time)))))) (setq contents (format - "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" - (if starttimestring "" ";VALUE=DATE") - datestring - (or starttimestring "") - (if endtimestring "" - ";VALUE=DATE") - datestring - (or endtimestring "") - summary)) + "\nDTSTART%s:%s%s\nDTEND%s:%s%s\nSUMMARY:%s" + (if starttimestring "" ";VALUE=DATE") + datestring + (or starttimestring "") + (if endtimestring "" + ";VALUE=DATE") + datestring + (or endtimestring "") + summary)) (unless (string= entry-rest "") (setq contents (concat contents "\nDESCRIPTION:" - (icalendar-convert-string-for-export + (icalendar--convert-string-for-export entry-rest)))))) ;; everything else (t @@ -948,52 +977,42 @@ (setq oops t))) (if oops (message "Cannot export entry on line %d" - (count-lines (point-min) (point))) + (count-lines (point-min) (point))) (setq result (concat result header contents "\nEND:VEVENT")))) ;; we're done, insert everything into the file (let ((coding-system-for-write 'utf8)) (set-buffer (find-file ical-filename)) - (unless do-not-clear-diary-file - (erase-buffer)) - (insert - "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN") + (goto-char (point-max)) + (insert "BEGIN:VCALENDAR") + (insert "\nPRODID:-//Emacs//NONSGML icalendar.el//EN") (insert "\nVERSION:2.0") (insert result) (insert "\nEND:VCALENDAR\n"))))) - ;; ====================================================================== -;; import -- convert icalendar to emacs-diary +;; Import -- convert icalendar to emacs-diary ;; ====================================================================== -;; user function +;; User function (defun icalendar-import-file (ical-filename diary-filename - &optional non-marking - do-not-clear-diary-file) - "Import a iCalendar file and save to a diary file -- erases diary-file! + &optional non-marking) + "Import a iCalendar file and append to a diary file. Argument ICAL-FILENAME output iCalendar file. Argument DIARY-FILENAME input `diary-file'. Optional argument NON-MARKING determines whether events are created as -non-marking or not. -If DO-NOT-CLEAR-DIARY-FILE is not nil the target diary file is -not erased." +non-marking or not." (interactive "fImport iCalendar data from file: -Finto diary file (will be erased!): +Finto diary file: p") ;; clean up the diary file (save-current-buffer - (unless do-not-clear-diary-file - ;; clear the target diary file - (set-buffer (find-file diary-filename)) - (erase-buffer)) ;; now load and convert from the ical file (set-buffer (find-file ical-filename)) - (icalendar-extract-ical-from-buffer diary-filename t non-marking))) + (icalendar-import-buffer diary-filename t non-marking))) -; user function -(defun icalendar-extract-ical-from-buffer (&optional - diary-file do-not-ask - non-marking) +;; User function +(defun icalendar-import-buffer (&optional diary-file do-not-ask + non-marking) "Extract iCalendar events from current buffer. This function searches the current buffer for the first iCalendar @@ -1013,7 +1032,7 @@ (save-current-buffer ;; prepare ical (message "Preparing icalendar...") - (set-buffer (icalendar-get-unfolded-buffer (current-buffer))) + (set-buffer (icalendar--get-unfolded-buffer (current-buffer))) (goto-char (point-min)) (message "Preparing icalendar...done") (if (re-search-forward "^BEGIN:VCALENDAR\\s-*$" nil t) @@ -1021,11 +1040,11 @@ ;; read ical (message "Reading icalendar...") (beginning-of-line) - (setq ical-contents (icalendar-read-element nil nil)) + (setq ical-contents (icalendar--read-element nil nil)) (message "Reading icalendar...done") ;; convert ical (message "Converting icalendar...") - (setq ical-errors (icalendar-convert-ical-to-diary + (setq ical-errors (icalendar--convert-ical-to-diary ical-contents diary-file do-not-ask non-marking)) (when diary-file @@ -1035,17 +1054,23 @@ (save-buffer))) (message "Converting icalendar...done") (if (and ical-errors (y-or-n-p - (concat "Something went wrong -- " - "do you want to see the " - "error log? "))) + (concat "Something went wrong -- " + "do you want to see the " + "error log? "))) (switch-to-buffer " *icalendar-errors*"))) (message "Current buffer does not contain icalendar contents!")))) -;; ---------------------------------------------------------------------- +(defalias 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer) + +(make-obsolete 'icalendar-extract-ical-from-buffer 'icalendar-import-buffer + "icalendar 0.07") + +;; ====================================================================== ;; private area -;; ---------------------------------------------------------------------- -(defun icalendar-format-ical-event (event) +;; ====================================================================== + +(defun icalendar--format-ical-event (event) "Create a string representation of an iCalendar EVENT." (let ((string icalendar-import-format) (conversion-list @@ -1058,25 +1083,23 @@ (let* ((spec (car i)) (prop (cadr i)) (format (car (cddr i))) - (contents (icalendar-get-event-property event prop)) + (contents (icalendar--get-event-property event prop)) (formatted-contents "")) - ;;(message "%s" event) - ;;(message "contents%s = %s" prop contents) (when (and contents (> (length contents) 0)) (setq formatted-contents - (icalendar-rris "%s" - (icalendar-convert-for-import - contents) - (symbol-value format)))) - (setq string (icalendar-rris spec - formatted-contents - string)))) + (icalendar--rris "%s" + (icalendar--convert-string-for-import + contents) + (symbol-value format)))) + (setq string (icalendar--rris spec + formatted-contents + string)))) conversion-list) string)) -(defun icalendar-convert-ical-to-diary (ical-list diary-file - &optional do-not-ask - non-marking) +(defun icalendar--convert-ical-to-diary (ical-list diary-file + &optional do-not-ask + non-marking) "Convert an iCalendar file to an Emacs diary file. Import VEVENTS from the iCalendar object ICAL-LIST and saves them to a DIARY-FILE. If DO-NOT-ASK is nil the user is asked for each event @@ -1085,7 +1108,7 @@ This function attempts to return t if something goes wrong. In this case an error string which describes all the errors and problems is written into the buffer ` *icalendar-errors*'." - (let* ((ev (icalendar-all-events ical-list)) + (let* ((ev (icalendar--all-events ical-list)) (error-string "") (event-ok t) (found-error nil) @@ -1096,72 +1119,72 @@ (setq ev (cdr ev)) (setq event-ok nil) (condition-case error-val - (let* ((dtstart (icalendar-decode-isodatetime - (icalendar-get-event-property e 'DTSTART))) + (let* ((dtstart (icalendar--decode-isodatetime + (icalendar--get-event-property e 'DTSTART))) (start-d (calendar-date-string - (icalendar-datetime-to-noneuropean-date - dtstart) + (icalendar--datetime-to-noneuropean-date + dtstart) t t)) - (start-t (icalendar-datetime-to-colontime dtstart)) - (dtend (icalendar-decode-isodatetime - (icalendar-get-event-property e 'DTEND))) + (start-t (icalendar--datetime-to-colontime dtstart)) + (dtend (icalendar--decode-isodatetime + (icalendar--get-event-property e 'DTEND))) end-d end-t - (subject (icalendar-convert-for-import - (or (icalendar-get-event-property e 'SUMMARY) + (subject (icalendar--convert-string-for-import + (or (icalendar--get-event-property e 'SUMMARY) "No Subject"))) - (rrule (icalendar-get-event-property e 'RRULE)) - (rdate (icalendar-get-event-property e 'RDATE)) - (duration (icalendar-get-event-property e 'DURATION))) - (icalendar-dmsg "%s: %s" start-d subject) + (rrule (icalendar--get-event-property e 'RRULE)) + (rdate (icalendar--get-event-property e 'RDATE)) + (duration (icalendar--get-event-property e 'DURATION))) + (icalendar--dmsg "%s: %s" start-d subject) (when duration - (let ((dtend2 (icalendar-add-decoded-times + (let ((dtend2 (icalendar--add-decoded-times dtstart - (icalendar-decode-isoduration duration)))) + (icalendar--decode-isoduration duration)))) (if (and dtend (not (eq dtend dtend2))) (message "Inconsistent endtime and duration for %s" subject)) (setq dtend dtend2))) (setq end-d (if dtend (calendar-date-string - (icalendar-datetime-to-noneuropean-date - dtend) + (icalendar--datetime-to-noneuropean-date + dtend) t t) start-d)) (setq end-t (if dtend - (icalendar-datetime-to-colontime dtend) + (icalendar--datetime-to-colontime dtend) start-t)) - (icalendar-dmsg "start-d: %s, end-d: %s" start-d end-d) + (icalendar--dmsg "start-d: %s, end-d: %s" start-d end-d) (cond ;; recurring event (rrule - (icalendar-dmsg "recurring event") - (let* ((rrule-props (icalendar-split-value rrule)) + (icalendar--dmsg "recurring event") + (let* ((rrule-props (icalendar--split-value rrule)) (frequency (car (cdr (assoc 'FREQ rrule-props)))) (until (car (cdr (assoc 'UNTIL rrule-props)))) (interval (read (car (cdr (assoc 'INTERVAL - rrule-props)))))) + rrule-props)))))) (cond ((string-equal frequency "WEEKLY") (if (not start-t) (progn ;; weekly and all-day - (icalendar-dmsg "weekly all-day") + (icalendar--dmsg "weekly all-day") (setq diary-string (format - "%%%%(diary-cyclic %d %s)" - (* interval 7) - (icalendar-datetime-to-european-date - dtstart)))) + "%%%%(diary-cyclic %d %s)" + (* interval 7) + (icalendar--datetime-to-european-date + dtstart)))) ;; weekly and not all-day (let* ((byday (cadr (assoc 'BYDAY rrule-props))) (weekday - (cdr (rassoc - byday - icalendar-weekdayabbrev-table)))) - (icalendar-dmsg "weekly not-all-day") - (if weekday + (icalendar--get-weekday-number byday))) + (icalendar--dmsg "weekly not-all-day") + (if (> weekday -1) (setq diary-string - (format "%s %s%s%s" weekday + (format "%s %s%s%s" + (aref calendar-day-name-array + weekday) start-t (if end-t "-" "") (or end-t ""))) ;; FIXME!!!! @@ -1169,19 +1192,19 @@ ;; DTEND;VALUE=DATE-TIME:20030919T113000 (setq diary-string (format - "%%%%(diary-cyclic %s %s) %s%s%s" - (* interval 7) - (icalendar-datetime-to-european-date - dtstart) - start-t (if end-t "-" "") (or end-t "")))) + "%%%%(diary-cyclic %s %s) %s%s%s" + (* interval 7) + (icalendar--datetime-to-european-date + dtstart) + start-t (if end-t "-" "") (or end-t "")))) (setq event-ok t)))) ;; yearly ((string-equal frequency "YEARLY") - (icalendar-dmsg "yearly") + (icalendar--dmsg "yearly") (setq diary-string (format - "%%%%(diary-anniversary %s)" - (icalendar-datetime-to-european-date dtstart))) + "%%%%(diary-anniversary %s)" + (icalendar--datetime-to-european-date dtstart))) (setq event-ok t)) ;; FIXME: war auskommentiert: ((and (string-equal frequency "DAILY") @@ -1189,34 +1212,34 @@ ;;(not start-t) ;;(not end-t) ) - (let ((ds (icalendar-datetime-to-noneuropean-date - (icalendar-decode-isodatetime - (icalendar-get-event-property e - 'DTSTART)))) - (de (icalendar-datetime-to-noneuropean-date - (icalendar-decode-isodatetime + (let ((ds (icalendar--datetime-to-noneuropean-date + (icalendar--decode-isodatetime + (icalendar--get-event-property e + 'DTSTART)))) + (de (icalendar--datetime-to-noneuropean-date + (icalendar--decode-isodatetime until)))) (setq diary-string (format - "%%%%(diary-block %d %d %d %d %d %d)" - (nth 1 ds) (nth 0 ds) (nth 2 ds) - (nth 1 de) (nth 0 de) (nth 2 de)))) + "%%%%(diary-block %d %d %d %d %d %d)" + (nth 1 ds) (nth 0 ds) (nth 2 ds) + (nth 1 de) (nth 0 de) (nth 2 de)))) (setq event-ok t))) )) (rdate - (icalendar-dmsg "rdate event") + (icalendar--dmsg "rdate event") (setq diary-string "") (mapcar (lambda (datestring) (setq diary-string (concat diary-string (format "......")))) - (icalendar-split-value rdate))) + (icalendar--split-value rdate))) ;; non-recurring event ;; long event ((not (string= start-d end-d)) - (icalendar-dmsg "non-recurring event") - (let ((ds (icalendar-datetime-to-noneuropean-date dtstart)) - (de (icalendar-datetime-to-noneuropean-date dtend))) + (icalendar--dmsg "non-recurring event") + (let ((ds (icalendar--datetime-to-noneuropean-date dtstart)) + (de (icalendar--datetime-to-noneuropean-date dtend))) (setq diary-string (format "%%%%(diary-block %d %d %d %d %d %d)" (nth 1 ds) (nth 0 ds) (nth 2 ds) @@ -1225,17 +1248,17 @@ ;; not all-day ((and start-t (or (not end-t) (not (string= start-t end-t)))) - (icalendar-dmsg "not all day event") + (icalendar--dmsg "not all day event") (cond (end-t (setq diary-string (format "%s %s-%s" start-d - start-t end-t))) + start-t end-t))) (t (setq diary-string (format "%s %s" start-d - start-t)))) + start-t)))) (setq event-ok t)) ;; all-day event (t - (icalendar-dmsg "all day event") + (icalendar--dmsg "all day event") (setq diary-string start-d) (setq event-ok t))) ;; add all other elements unless the user doesn't want to have @@ -1243,16 +1266,16 @@ (if event-ok (progn (setq diary-string - (concat diary-string " " - (icalendar-format-ical-event e))) + (concat diary-string " " + (icalendar--format-ical-event e))) (if do-not-ask (setq subject nil)) - (icalendar-add-diary-entry diary-string diary-file - non-marking subject)) + (icalendar--add-diary-entry diary-string diary-file + non-marking subject)) ;; event was not ok (setq found-error t) (setq error-string - (format "%s\nCannot handle this event:%s" - error-string e)))) + (format "%s\nCannot handle this event:%s" + error-string e)))) ;; handle errors (error (message "Ignoring event \"%s\"" e) @@ -1267,17 +1290,17 @@ (message "Converting icalendar...done") found-error)) -(defun icalendar-add-diary-entry (string diary-file non-marking - &optional subject) +(defun icalendar--add-diary-entry (string diary-file non-marking + &optional subject) "Add STRING to the diary file DIARY-FILE. STRING must be a properly formatted valid diary entry. NON-MARKING determines whether diary events are created as non-marking. If SUBJECT is not nil it must be a string that gives the subject of the entry. In this case the user will be asked whether he wants to insert the entry." - (when (or (not subject) ; + (when (or (not subject) ; (y-or-n-p (format "Add appointment for `%s' to diary? " - subject))) + subject))) (when subject (setq non-marking (y-or-n-p (format "Make appointment non-marking? ")))) @@ -1287,12 +1310,6 @@ (read-file-name "Add appointment to this diary file: "))) (make-diary-entry string non-marking diary-file)))) -;; ====================================================================== -;; (add-hook 'list-diary-entries-hook 'include-icalendar-files) -;; ====================================================================== -(defun include-icalendar-files () - "Not yet implemented.") - (provide 'icalendar) ;; arch-tag: 74fdbe8e-0451-4e38-bb61-4416e822f4fc
--- a/lisp/comint.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/comint.el Mon Oct 25 18:17:28 2004 +0000 @@ -369,7 +369,7 @@ 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 comint-watch-for-password-prompt) @@ -788,7 +788,7 @@ (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)) @@ -2282,7 +2282,7 @@ (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.) @@ -2430,7 +2430,7 @@ 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,
--- a/lisp/eshell/em-unix.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/eshell/em-unix.el Mon Oct 25 18:17:28 2004 +0000 @@ -708,11 +708,7 @@ (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)))
--- a/lisp/gnus/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -1,3 +1,335 @@ +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):
--- a/lisp/gnus/gnus-agent.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-agent.el Mon Oct 25 18:17:28 2004 +0000 @@ -114,7 +114,7 @@ :group 'gnus-agent :type 'function) -(defcustom gnus-agent-synchronize-flags 'ask +(defcustom gnus-agent-synchronize-flags nil "Indicate if flags are synchronized when you plug in. If this is `ask' the hook will query the user." :version "21.1" @@ -362,9 +362,23 @@ (gnus-agent-cat-defaccessor gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces) + +;; This form is equivalent to defsetf except that it calls make-symbol +;; whereas defsetf calls gensym (Using gensym creates a run-time +;; dependency on the CL library). + (eval-and-compile - (defsetf gnus-agent-cat-groups (category) (groups) - (list 'gnus-agent-set-cat-groups category groups))) + (define-setf-method gnus-agent-cat-groups (category) + (let* ((--category--temp-- (make-symbol "--category--")) + (--groups--temp-- (make-symbol "--groups--"))) + (list (list --category--temp--) + (list category) + (list --groups--temp--) + (let* ((category --category--temp--) + (groups --groups--temp--)) + (list (quote gnus-agent-set-cat-groups) category groups)) + (list (quote gnus-agent-cat-groups) --category--temp--)))) + ) (defun gnus-agent-set-cat-groups (category groups) (unless (eq groups 'ignore) @@ -624,7 +638,7 @@ (unless gnus-agent-send-mail-function (setq gnus-agent-send-mail-function (or message-send-mail-real-function - message-send-mail-function) + (function (lambda () (funcall message-send-mail-function)))) message-send-mail-real-function 'gnus-agent-send-mail)) ;; If the servers file doesn't exist, auto-agentize some servers and @@ -790,25 +804,39 @@ (interactive) (save-excursion (dolist (gnus-command-method (gnus-agent-covered-methods)) - (when (file-exists-p (gnus-agent-lib-file "flags")) + (when (and (file-exists-p (gnus-agent-lib-file "flags")) + (not (eq (gnus-server-status gnus-command-method) 'offline))) (gnus-agent-possibly-synchronize-flags-server gnus-command-method))))) (defun gnus-agent-synchronize-flags-server (method) "Synchronize flags set when unplugged for server." - (let ((gnus-command-method method)) + (let ((gnus-command-method method) + (gnus-agent nil)) (when (file-exists-p (gnus-agent-lib-file "flags")) (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*")) (erase-buffer) (nnheader-insert-file-contents (gnus-agent-lib-file "flags")) - (if (null (gnus-check-server gnus-command-method)) - (gnus-message 1 "Couldn't open server %s" (nth 1 gnus-command-method)) - (while (not (eobp)) - (if (null (eval (read (current-buffer)))) - (gnus-delete-line) - (write-file (gnus-agent-lib-file "flags")) - (error "Couldn't set flags from file %s" - (gnus-agent-lib-file "flags")))) - (delete-file (gnus-agent-lib-file "flags"))) + (cond ((null gnus-plugged) + (gnus-message + 1 "You must be plugged to synchronize flags with server %s" + (nth 1 gnus-command-method))) + ((null (gnus-check-server gnus-command-method)) + (gnus-message + 1 "Couldn't open server %s" (nth 1 gnus-command-method))) + (t + (condition-case err + (while t + (let ((bgn (point))) + (eval (read (current-buffer))) + (delete-region bgn (point)))) + (end-of-file + (delete-file (gnus-agent-lib-file "flags"))) + (error + (let ((file (gnus-agent-lib-file "flags"))) + (write-region (point-min) (point-max) + (gnus-agent-lib-file "flags") nil 'silent) + (error "Couldn't set flags from file %s due to %s" + file (error-message-string err))))))) (kill-buffer nil)))) (defun gnus-agent-possibly-synchronize-flags-server (method) @@ -820,6 +848,56 @@ (cadr method))))) (gnus-agent-synchronize-flags-server method))) +;;;###autoload +(defun gnus-agent-rename-group (old-group new-group) + "Rename fully-qualified OLD-GROUP as NEW-GROUP. Always updates the agent, even when +disabled, as the old agent files would corrupt gnus when the agent was +next enabled. Depends upon the caller to determine whether group renaming is supported." + (let* ((old-command-method (gnus-find-method-for-group old-group)) + (old-path (directory-file-name + (let (gnus-command-method old-command-method) + (gnus-agent-group-pathname old-group)))) + (new-command-method (gnus-find-method-for-group new-group)) + (new-path (directory-file-name + (let (gnus-command-method new-command-method) + (gnus-agent-group-pathname new-group))))) + (gnus-rename-file old-path new-path t) + + (let* ((old-real-group (gnus-group-real-name old-group)) + (new-real-group (gnus-group-real-name new-group)) + (old-active (gnus-agent-get-group-info old-command-method old-real-group))) + (gnus-agent-save-group-info old-command-method old-real-group nil) + (gnus-agent-save-group-info new-command-method new-real-group old-active) + + (let ((old-local (gnus-agent-get-local old-group + old-real-group old-command-method))) + (gnus-agent-set-local old-group + nil nil + old-real-group old-command-method) + (gnus-agent-set-local new-group + (car old-local) (cdr old-local) + new-real-group new-command-method))))) + +;;;###autoload +(defun gnus-agent-delete-group (group) + "Delete fully-qualified GROUP. Always updates the agent, even when +disabled, as the old agent files would corrupt gnus when the agent was +next enabled. Depends upon the caller to determine whether group deletion is supported." + (let* ((command-method (gnus-find-method-for-group group)) + (path (directory-file-name + (let (gnus-command-method command-method) + (gnus-agent-group-pathname group))))) + (gnus-delete-file path) + + (let* ((real-group (gnus-group-real-name group))) + (gnus-agent-save-group-info command-method real-group nil) + + (let ((local (gnus-agent-get-local group + real-group command-method))) + (gnus-agent-set-local group + nil nil + real-group command-method))))) + ;;; ;;; Server mode commands ;;; @@ -969,6 +1047,7 @@ gnus-downloadable-mark) 'unread)))) +;;;###autoload (defun gnus-agent-get-undownloaded-list () "Construct list of articles that have not been downloaded." (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))) @@ -1113,6 +1192,49 @@ ;;; Internal functions ;;; +(defun gnus-agent-synchronize-group-flags (group actions server) +"Update a plugged group by performing the indicated actions." + (let* ((gnus-command-method (gnus-server-to-method server)) + (info + ;; This initializer is required as gnus-request-set-mark + ;; calls gnus-group-real-name to strip off the host name + ;; before calling the backend. Now that the backend is + ;; trying to call gnus-request-set-mark, I have to + ;; reconstruct the original group name. + (or (gnus-get-info group) + (gnus-get-info + (setq group (gnus-group-full-name + group gnus-command-method)))))) + (gnus-request-set-mark group actions) + + (when info + (dolist (action actions) + (let ((range (nth 0 action)) + (what (nth 1 action)) + (marks (nth 2 action))) + (dolist (mark marks) + (cond ((eq mark 'read) + (gnus-info-set-read + info + (funcall (if (eq what 'add) + 'gnus-range-add + 'gnus-remove-from-range) + (gnus-info-read info) + range)) + (gnus-get-unread-articles-in-group + info + (gnus-active (gnus-info-group info)))) + ((memq mark '(tick)) + (let ((info-marks (assoc mark (gnus-info-marks info)))) + (unless info-marks + (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info)))) + (setcdr info-marks (funcall (if (eq what 'add) + 'gnus-range-add + 'gnus-remove-from-range) + (cdr info-marks) + range))))))))) + nil)) + (defun gnus-agent-save-active (method) (when (gnus-agent-method-p method) (let* ((gnus-command-method method) @@ -1131,6 +1253,7 @@ ;; will add it while reading the file. (gnus-write-active-file file new nil))) +;;;###autoload (defun gnus-agent-possibly-alter-active (group active &optional info) "Possibly expand a group's active range to include articles downloaded into the agent." @@ -1183,7 +1306,7 @@ (defun gnus-agent-save-group-info (method group active) "Update a single group's active range in the agent's copy of the server's active file." (when (gnus-agent-method-p method) - (let* ((gnus-command-method method) + (let* ((gnus-command-method (or method gnus-command-method)) (coding-system-for-write nnheader-file-coding-system) (file-name-coding-system nnmail-pathname-coding-system) (file (gnus-agent-lib-file "active")) @@ -1199,15 +1322,39 @@ (when (re-search-forward (concat "^" (regexp-quote group) " ") nil t) (save-excursion - (setq oactive-max (read (current-buffer)) ;; max + (setq oactive-max (read (current-buffer)) ;; max oactive-min (read (current-buffer)))) ;; min (gnus-delete-line))) - (insert (format "%S %d %d y\n" (intern group) - (max (or oactive-max (cdr active)) (cdr active)) - (min (or oactive-min (car active)) (car active)))) - (goto-char (point-max)) - (while (search-backward "\\." nil t) - (delete-char 1)))))) + (when active + (insert (format "%S %d %d y\n" (intern group) + (max (or oactive-max (cdr active)) (cdr active)) + (min (or oactive-min (car active)) (car active)))) + (goto-char (point-max)) + (while (search-backward "\\." nil t) + (delete-char 1))))))) + +(defun gnus-agent-get-group-info (method group) + "Get a single group's active range in the agent's copy of the server's active file." + (when (gnus-agent-method-p method) + (let* ((gnus-command-method (or method gnus-command-method)) + (coding-system-for-write nnheader-file-coding-system) + (file-name-coding-system nnmail-pathname-coding-system) + (file (gnus-agent-lib-file "active")) + oactive-min oactive-max) + (gnus-make-directory (file-name-directory file)) + (with-temp-buffer + ;; Emacs got problem to match non-ASCII group in multibyte buffer. + (mm-disable-multibyte) + (when (file-exists-p file) + (nnheader-insert-file-contents file) + + (goto-char (point-min)) + (when (re-search-forward + (concat "^" (regexp-quote group) " ") nil t) + (save-excursion + (setq oactive-max (read (current-buffer)) ;; max + oactive-min (read (current-buffer))) ;; min + (cons oactive-min oactive-max)))))))) (defun gnus-agent-group-path (group) "Translate GROUP into a file name." @@ -1413,6 +1560,31 @@ (gnus-message 7 "")) (cdr fetched-articles)))))) +(defun gnus-agent-unfetch-articles (group articles) + "Delete ARTICLES that were fetched from GROUP into the agent." + (when articles + (gnus-agent-load-alist group) + (let* ((alist (cons nil gnus-agent-article-alist)) + (articles (sort articles #'<)) + (next-possibility alist) + (delete-this (pop articles))) + (while (and (cdr next-possibility) delete-this) + (let ((have-this (caar (cdr next-possibility)))) + (cond ((< delete-this have-this) + (setq delete-this (pop articles))) + ((= delete-this have-this) + (let ((timestamp (cdar (cdr next-possibility)))) + (when timestamp + (let* ((file-name (concat (gnus-agent-group-pathname group) + (number-to-string have-this)))) + (delete-file file-name)))) + + (setcdr next-possibility (cddr next-possibility))) + (t + (setq next-possibility (cdr next-possibility)))))) + (setq gnus-agent-article-alist (cdr alist)) + (gnus-agent-save-alist group)))) + (defun gnus-agent-crosspost (crosses article &optional date) (setq date (or date t)) @@ -1487,7 +1659,7 @@ (setq backed-up (gnus-agent-backup-overview-buffer))) (gnus-message 1 "Duplicate overview line for %d" cur) - (delete-region (point) (progn (forward-line 1) (point)))) + (delete-region p (progn (forward-line 1) (point)))) ((< cur prev-num) (or backed-up (setq backed-up (gnus-agent-backup-overview-buffer))) @@ -1519,6 +1691,7 @@ (insert "\n")) (setq gnus-agent-group-alist (cdr gnus-agent-group-alist))))) +;;;###autoload (defun gnus-agent-find-parameter (group symbol) "Search for GROUPs SYMBOL in the group's parameters, the group's topic parameters, the group's category, or the customizable @@ -1623,8 +1796,10 @@ ;; of FILE. (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - (when (file-exists-p file) - (gnus-agent-braid-nov group articles file)) + ;; NOTE: Call g-a-brand-nov even when the file does not + ;; exist. As a minimum, it will validate the article + ;; numbers already in the buffer. + (gnus-agent-braid-nov group articles file) (let ((coding-system-for-write gnus-agent-file-coding-system)) (gnus-agent-check-overview-buffer) @@ -1636,11 +1811,32 @@ (nnheader-insert-file-contents file))))) articles)) +(defsubst gnus-agent-read-article-number () + "Reads the article number at point. Returns nil when a valid article number can not be read." + + ;; It is unfortunite but the read function quietly overflows + ;; integer. As a result, I have to use string operations to test + ;; for overflow BEFORE calling read. + (when (looking-at "[0-9]+\t") + (let ((len (- (match-end 0) (match-beginning 0)))) + (cond ((< len 9) + (read (current-buffer))) + ((= len 9) + ;; Many 9 digit base-10 numbers can be represented in a 27-bit int + ;; Back convert from int to string to ensure that this is one of them. + (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0)))) + (num (read (current-buffer))) + (str2 (int-to-string num))) + (when (equal str1 str2) + num))))))) + (defsubst gnus-agent-copy-nov-line (article) + "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer." (let (art b e) (set-buffer gnus-agent-overview-buffer) (while (and (not (eobp)) - (< (setq art (read (current-buffer))) article)) + (or (not (setq art (gnus-agent-read-article-number))) + (< art article))) (forward-line 1)) (beginning-of-line) (if (or (eobp) @@ -1653,64 +1849,77 @@ (defun gnus-agent-braid-nov (group articles file) "Merge agent overview data with given file. -Takes headers for ARTICLES from `gnus-agent-overview-buffer' and the given -FILE and places the combined headers into `nntp-server-buffer'." +Takes unvalidated headers for ARTICLES from +`gnus-agent-overview-buffer' and validated headers from the given +FILE and places the combined valid headers into +`nntp-server-buffer'. This function can be used, when file +doesn't exist, to valid the overview buffer." (let (start last) (set-buffer gnus-agent-overview-buffer) (goto-char (point-min)) (set-buffer nntp-server-buffer) (erase-buffer) - (nnheader-insert-file-contents file) + (when (file-exists-p file) + (nnheader-insert-file-contents file)) (goto-char (point-max)) (forward-line -1) - (unless (looking-at "[0-9]+\t") - ;; Remove corrupted lines - (gnus-message - 1 "Overview %s is corrupted. Removing corrupted lines..." file) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "[0-9]+\t") - (forward-line 1) - (delete-region (point) (progn (forward-line 1) (point))))) - (forward-line -1)) + (unless (or (= (point-min) (point-max)) (< (setq last (read (current-buffer))) (car articles))) - ;; We do it the hard way. + ;; Old and new overlap -- We do it the hard way. (when (nnheader-find-nov-line (car articles)) ;; Replacing existing NOV entry (delete-region (point) (progn (forward-line 1) (point)))) (gnus-agent-copy-nov-line (pop articles)) (ignore-errors - (while articles - (while (let ((art (read (current-buffer)))) - (cond ((< art (car articles)) - (forward-line 1) - t) - ((= art (car articles)) - (beginning-of-line) - (delete-region - (point) (progn (forward-line 1) (point))) - nil) - (t - (beginning-of-line) - nil)))) - - (gnus-agent-copy-nov-line (pop articles))))) - - ;; Copy the rest lines - (set-buffer nntp-server-buffer) + (while articles + (while (let ((art (read (current-buffer)))) + (cond ((< art (car articles)) + (forward-line 1) + t) + ((= art (car articles)) + (beginning-of-line) + (delete-region + (point) (progn (forward-line 1) (point))) + nil) + (t + (beginning-of-line) + nil)))) + + (gnus-agent-copy-nov-line (pop articles))))) + (goto-char (point-max)) + + ;; Append the remaining lines (when articles (when last (set-buffer gnus-agent-overview-buffer) - (ignore-errors - (while (<= (read (current-buffer)) last) - (forward-line 1))) - (beginning-of-line) (setq start (point)) (set-buffer nntp-server-buffer)) - (insert-buffer-substring gnus-agent-overview-buffer start)))) + + (let ((p (point))) + (insert-buffer-substring gnus-agent-overview-buffer start) + (goto-char p)) + + (setq last (or last -134217728)) + (let (sort art) + (while (not (eobp)) + (setq art (gnus-agent-read-article-number)) + (cond ((not art) + ;; Bad art num - delete this line + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ((< art last) + ;; Art num out of order - enable sort + (setq sort t) + (forward-line 1)) + (t + ;; Good art num + (setq last art) + (forward-line 1)))) + (when sort + (sort-numeric-fields 1 (point-min) (point-max))))))) ;; Keeps the compiler from warning about the free variable in ;; gnus-agent-read-agentview. @@ -1735,7 +1944,8 @@ (defun gnus-agent-read-agentview (file) "Load FILE and do a `read' there." (with-temp-buffer - (ignore-errors + (condition-case nil + (progn (nnheader-insert-file-contents file) (goto-char (point-min)) (let ((alist (read (current-buffer))) @@ -1744,6 +1954,8 @@ changed-version) (cond + ((< version 2) + (error "gnus-agent-read-agentview no longer supports version %d. Stop gnus, manually evaluate gnus-agent-convert-to-compressed-agentview, then restart gnus." version)) ((= version 0) (let ((inhibit-quit t) entry) @@ -1767,8 +1979,9 @@ (mapcar (lambda (comp-list) (let ((state (car comp-list)) - (sequence (gnus-uncompress-sequence - (cdr comp-list)))) + (sequence (inline + (gnus-uncompress-range + (cdr comp-list))))) (mapcar (lambda (article-id) (setq uncomp (cons (cons article-id state) uncomp))) sequence))) @@ -1777,7 +1990,8 @@ (when changed-version (let ((gnus-agent-article-alist alist)) (gnus-agent-save-alist gnus-agent-read-agentview))) - alist)))) + alist)) + (file-error nil)))) (defun gnus-agent-save-alist (group &optional articles state) "Save the article-state alist for GROUP." @@ -1860,7 +2074,8 @@ (line 1)) (with-temp-buffer (condition-case nil - (nnheader-insert-file-contents file) + (let ((nnheader-file-coding-system gnus-agent-file-coding-system)) + (nnheader-insert-file-contents file)) (file-error)) (goto-char (point-min)) @@ -1903,31 +2118,31 @@ ;; NOTE: gnus-command-method is used within gnus-agent-lib-file. (dest (gnus-agent-lib-file "local"))) (gnus-make-directory (gnus-agent-lib-file "")) - (with-temp-file dest - (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) - (file-name-coding-system nnmail-pathname-coding-system) - (coding-system-for-write - gnus-agent-file-coding-system) - print-level print-length item article - (standard-output (current-buffer))) - (mapatoms (lambda (symbol) - (cond ((not (boundp symbol)) - nil) - ((member (symbol-name symbol) '("+dirty" "+method")) - nil) - (t - (prin1 symbol) - (let ((range (symbol-value symbol))) - (princ " ") - (princ (car range)) - (princ " ") - (princ (cdr range)) - (princ "\n"))))) - my-obarray))))))) - -(defun gnus-agent-get-local (group) - (let* ((gmane (gnus-group-real-name group)) - (gnus-command-method (gnus-find-method-for-group group)) + + (let ((buffer-file-coding-system gnus-agent-file-coding-system)) + (with-temp-file dest + (let ((gnus-command-method (symbol-value (intern "+method" my-obarray))) + (file-name-coding-system nnmail-pathname-coding-system) + print-level print-length item article + (standard-output (current-buffer))) + (mapatoms (lambda (symbol) + (cond ((not (boundp symbol)) + nil) + ((member (symbol-name symbol) '("+dirty" "+method")) + nil) + (t + (prin1 symbol) + (let ((range (symbol-value symbol))) + (princ " ") + (princ (car range)) + (princ " ") + (princ (cdr range)) + (princ "\n"))))) + my-obarray)))))))) + +(defun gnus-agent-get-local (group &optional gmane method) + (let* ((gmane (or gmane (gnus-group-real-name group))) + (gnus-command-method (or method (gnus-find-method-for-group group))) (local (gnus-agent-load-local)) (symb (intern gmane local)) (minmax (and (boundp symb) (symbol-value symb)))) @@ -1962,7 +2177,9 @@ nil) ((and min max) (set symb (cons min max)) - t)) + t) + (t + (unintern symb local))) (set (intern "+dirty" local) t)))) (defun gnus-agent-article-name (article group) @@ -2012,13 +2229,14 @@ group gnus-command-method) (error (unless (funcall gnus-agent-confirmation-function - (format "Error %s. Continue? " + (format "Error %s while fetching session. Should gnus continue? " (error-message-string err))) (error "Cannot fetch articles into the Gnus agent"))) (quit + (gnus-agent-regenerate-group group) (unless (funcall gnus-agent-confirmation-function (format - "Quit fetching session %s. Continue? " + "%s while fetching session. Should gnus continue? " (error-message-string err))) (signal 'quit "Cannot fetch articles into the Gnus agent"))))))))) @@ -2736,328 +2954,334 @@ (let ((dir (gnus-agent-group-pathname group))) (when (boundp 'gnus-agent-expire-current-dirs) (set 'gnus-agent-expire-current-dirs - (cons dir - (symbol-value 'gnus-agent-expire-current-dirs)))) + (cons dir + (symbol-value 'gnus-agent-expire-current-dirs)))) (if (and (not force) - (eq 'DISABLE (gnus-agent-find-parameter group - 'agent-enable-expiration))) - (gnus-message 5 "Expiry skipping over %s" group) + (eq 'DISABLE (gnus-agent-find-parameter group + 'agent-enable-expiration))) + (gnus-message 5 "Expiry skipping over %s" group) (gnus-message 5 "Expiring articles in %s" group) (gnus-agent-load-alist group) - (let* ((stats (if (boundp 'gnus-agent-expire-stats) - ;; Use the list provided by my caller - (symbol-value 'gnus-agent-expire-stats) - ;; otherwise use my own temporary list - (list 0 0 0.0))) - (info (gnus-get-info group)) - (alist gnus-agent-article-alist) - (day (- (time-to-days (current-time)) - (gnus-agent-find-parameter group 'agent-days-until-old))) - (specials (if (and alist - (not force)) - ;; This could be a bit of a problem. I need to - ;; keep the last article to avoid refetching - ;; headers when using nntp in the backend. At - ;; the same time, if someone uses a backend - ;; that supports article moving then I may have - ;; to remove the last article to complete the - ;; move. Right now, I'm going to assume that - ;; FORCE overrides specials. - (list (caar (last alist))))) - (unreads ;; Articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are marked read by global decree - nil) - ((eq articles t) - ;; All articles are marked read by function - ;; parameter - nil) - ((not articles) - ;; Unread articles are marked protected from - ;; expiration Don't call - ;; gnus-list-of-unread-articles as it returns - ;; articles that have not been fetched into the - ;; agent. - (ignore-errors - (gnus-agent-unread-articles group))) - (t - ;; All articles EXCEPT those named by the caller - ;; are protected from expiration - (gnus-sorted-difference - (gnus-uncompress-range - (cons (caar alist) - (caar (last alist)))) - (sort articles '<))))) - (marked ;; More articles that are excluded from the - ;; expiration process - (cond (gnus-agent-expire-all - ;; All articles are unmarked by global decree - nil) - ((eq articles t) - ;; All articles are unmarked by function - ;; parameter - nil) - (articles - ;; All articles may as well be unmarked as the - ;; unreads list already names the articles we are - ;; going to keep - nil) - (t - ;; Ticked and/or dormant articles are excluded - ;; from expiration - (nconc - (gnus-uncompress-range - (cdr (assq 'tick (gnus-info-marks info)))) - (gnus-uncompress-range - (cdr (assq 'dormant - (gnus-info-marks info)))))))) - (nov-file (concat dir ".overview")) - (cnt 0) - (completed -1) - dlist - type) - - ;; The normal article alist contains elements that look like - ;; (article# . fetch_date) I need to combine other - ;; information with this list. For example, a flag indicating - ;; that a particular article MUST BE KEPT. To do this, I'm - ;; going to transform the elements to look like (article# - ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse - ;; the process to generate the expired article alist. - - ;; Convert the alist elements to (article# fetch_date nil - ;; nil). - (setq dlist (mapcar (lambda (e) - (list (car e) (cdr e) nil nil)) alist)) - - ;; Convert the keep lists to elements that look like (article# - ;; nil keep_flag nil) then append it to the expanded dlist - ;; These statements are sorted by ascending precidence of the - ;; keep_flag. - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'unread nil)) - unreads))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'marked nil)) - marked))) - (setq dlist (nconc dlist - (mapcar (lambda (e) - (list e nil 'special nil)) - specials))) - - (set-buffer overview) - (erase-buffer) - (buffer-disable-undo) - (when (file-exists-p nov-file) - (gnus-message 7 "gnus-agent-expire: Loading overview...") - (nnheader-insert-file-contents nov-file) - (goto-char (point-min)) - - (let (p) - (while (< (setq p (point)) (point-max)) - (condition-case nil - ;; If I successfully read an integer (the plus zero - ;; ensures a numeric type), prepend a marker entry - ;; to the list - (push (list (+ 0 (read (current-buffer))) nil nil - (set-marker (make-marker) p)) - dlist) - (error - (gnus-message 1 "gnus-agent-expire: read error \ + (let* ((bytes-freed 0) + (files-deleted 0) + (nov-entries-deleted 0) + (info (gnus-get-info group)) + (alist gnus-agent-article-alist) + (day (- (time-to-days (current-time)) + (gnus-agent-find-parameter group 'agent-days-until-old))) + (specials (if (and alist + (not force)) + ;; This could be a bit of a problem. I need to + ;; keep the last article to avoid refetching + ;; headers when using nntp in the backend. At + ;; the same time, if someone uses a backend + ;; that supports article moving then I may have + ;; to remove the last article to complete the + ;; move. Right now, I'm going to assume that + ;; FORCE overrides specials. + (list (caar (last alist))))) + (unreads ;; Articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are marked read by global decree + nil) + ((eq articles t) + ;; All articles are marked read by function + ;; parameter + nil) + ((not articles) + ;; Unread articles are marked protected from + ;; expiration Don't call + ;; gnus-list-of-unread-articles as it returns + ;; articles that have not been fetched into the + ;; agent. + (ignore-errors + (gnus-agent-unread-articles group))) + (t + ;; All articles EXCEPT those named by the caller + ;; are protected from expiration + (gnus-sorted-difference + (gnus-uncompress-range + (cons (caar alist) + (caar (last alist)))) + (sort articles '<))))) + (marked ;; More articles that are excluded from the + ;; expiration process + (cond (gnus-agent-expire-all + ;; All articles are unmarked by global decree + nil) + ((eq articles t) + ;; All articles are unmarked by function + ;; parameter + nil) + (articles + ;; All articles may as well be unmarked as the + ;; unreads list already names the articles we are + ;; going to keep + nil) + (t + ;; Ticked and/or dormant articles are excluded + ;; from expiration + (nconc + (gnus-uncompress-range + (cdr (assq 'tick (gnus-info-marks info)))) + (gnus-uncompress-range + (cdr (assq 'dormant + (gnus-info-marks info)))))))) + (nov-file (concat dir ".overview")) + (cnt 0) + (completed -1) + dlist + type) + + ;; The normal article alist contains elements that look like + ;; (article# . fetch_date) I need to combine other + ;; information with this list. For example, a flag indicating + ;; that a particular article MUST BE KEPT. To do this, I'm + ;; going to transform the elements to look like (article# + ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse + ;; the process to generate the expired article alist. + + ;; Convert the alist elements to (article# fetch_date nil + ;; nil). + (setq dlist (mapcar (lambda (e) + (list (car e) (cdr e) nil nil)) alist)) + + ;; Convert the keep lists to elements that look like (article# + ;; nil keep_flag nil) then append it to the expanded dlist + ;; These statements are sorted by ascending precidence of the + ;; keep_flag. + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'unread nil)) + unreads))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'marked nil)) + marked))) + (setq dlist (nconc dlist + (mapcar (lambda (e) + (list e nil 'special nil)) + specials))) + + (set-buffer overview) + (erase-buffer) + (buffer-disable-undo) + (when (file-exists-p nov-file) + (gnus-message 7 "gnus-agent-expire: Loading overview...") + (nnheader-insert-file-contents nov-file) + (goto-char (point-min)) + + (let (p) + (while (< (setq p (point)) (point-max)) + (condition-case nil + ;; If I successfully read an integer (the plus zero + ;; ensures a numeric type), prepend a marker entry + ;; to the list + (push (list (+ 0 (read (current-buffer))) nil nil + (set-marker (make-marker) p)) + dlist) + (error + (gnus-message 1 "gnus-agent-expire: read error \ occurred when reading expression at %s in %s. Skipping to next \ line." (point) nov-file))) - ;; Whether I succeeded, or failed, it doesn't matter. - ;; Move to the next line then try again. - (forward-line 1))) - - (gnus-message - 7 "gnus-agent-expire: Loading overview... Done")) - (set-buffer-modified-p nil) - - ;; At this point, all of the information is in dlist. The - ;; only problem is that much of it is spread across multiple - ;; entries. Sort then MERGE!! - (gnus-message 7 "gnus-agent-expire: Sorting entries... ") - ;; If two entries have the same article-number then sort by - ;; ascending keep_flag. - (let ((special 0) - (marked 1) - (unread 2)) - (setq dlist - (sort dlist - (lambda (a b) - (cond ((< (nth 0 a) (nth 0 b)) - t) - ((> (nth 0 a) (nth 0 b)) - nil) - (t - (let ((a (or (symbol-value (nth 2 a)) - 3)) - (b (or (symbol-value (nth 2 b)) - 3))) - (<= a b)))))))) - (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") - (gnus-message 7 "gnus-agent-expire: Merging entries... ") - (let ((dlist dlist)) - (while (cdr dlist) ; I'm not at the end-of-list - (if (eq (caar dlist) (caadr dlist)) - (let ((first (cdr (car dlist))) - (secnd (cdr (cadr dlist)))) - (setcar first (or (car first) - (car secnd))) ; fetch_date - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; Keep_flag - (setq first (cdr first) - secnd (cdr secnd)) - (setcar first (or (car first) - (car secnd))) ; NOV_entry_marker - - (setcdr dlist (cddr dlist))) - (setq dlist (cdr dlist))))) - (gnus-message 7 "gnus-agent-expire: Merging entries... Done") - - (let* ((len (float (length dlist))) - (alist (list nil)) - (tail-alist alist)) - (while dlist - (let ((new-completed (truncate (* 100.0 - (/ (setq cnt (1+ cnt)) - len)))) + ;; Whether I succeeded, or failed, it doesn't matter. + ;; Move to the next line then try again. + (forward-line 1))) + + (gnus-message + 7 "gnus-agent-expire: Loading overview... Done")) + (set-buffer-modified-p nil) + + ;; At this point, all of the information is in dlist. The + ;; only problem is that much of it is spread across multiple + ;; entries. Sort then MERGE!! + (gnus-message 7 "gnus-agent-expire: Sorting entries... ") + ;; If two entries have the same article-number then sort by + ;; ascending keep_flag. + (let ((special 0) + (marked 1) + (unread 2)) + (setq dlist + (sort dlist + (lambda (a b) + (cond ((< (nth 0 a) (nth 0 b)) + t) + ((> (nth 0 a) (nth 0 b)) + nil) + (t + (let ((a (or (symbol-value (nth 2 a)) + 3)) + (b (or (symbol-value (nth 2 b)) + 3))) + (<= a b)))))))) + (gnus-message 7 "gnus-agent-expire: Sorting entries... Done") + (gnus-message 7 "gnus-agent-expire: Merging entries... ") + (let ((dlist dlist)) + (while (cdr dlist) ; I'm not at the end-of-list + (if (eq (caar dlist) (caadr dlist)) + (let ((first (cdr (car dlist))) + (secnd (cdr (cadr dlist)))) + (setcar first (or (car first) + (car secnd))) ; fetch_date + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; Keep_flag + (setq first (cdr first) + secnd (cdr secnd)) + (setcar first (or (car first) + (car secnd))) ; NOV_entry_marker + + (setcdr dlist (cddr dlist))) + (setq dlist (cdr dlist))))) + (gnus-message 7 "gnus-agent-expire: Merging entries... Done") + + (let* ((len (float (length dlist))) + (alist (list nil)) + (tail-alist alist)) + (while dlist + (let ((new-completed (truncate (* 100.0 + (/ (setq cnt (1+ cnt)) + len)))) message-log-max) - (when (> new-completed completed) - (setq completed new-completed) - (gnus-message 7 "%3d%% completed..." completed))) - (let* ((entry (car dlist)) - (article-number (nth 0 entry)) - (fetch-date (nth 1 entry)) - (keep (nth 2 entry)) - (marker (nth 3 entry))) - - (cond - ;; Kept articles are unread, marked, or special. - (keep - (gnus-agent-message 10 - "gnus-agent-expire: %s:%d: Kept %s article%s." - group article-number keep (if fetch-date " and file" "")) - (when fetch-date - (unless (file-exists-p - (concat dir (number-to-string - article-number))) - (setf (nth 1 entry) nil) - (gnus-agent-message 3 "gnus-agent-expire cleared \ + (when (> new-completed completed) + (setq completed new-completed) + (gnus-message 7 "%3d%% completed..." completed))) + (let* ((entry (car dlist)) + (article-number (nth 0 entry)) + (fetch-date (nth 1 entry)) + (keep (nth 2 entry)) + (marker (nth 3 entry))) + + (cond + ;; Kept articles are unread, marked, or special. + (keep + (gnus-agent-message 10 + "gnus-agent-expire: %s:%d: Kept %s article%s." + group article-number keep (if fetch-date " and file" "")) + (when fetch-date + (unless (file-exists-p + (concat dir (number-to-string + article-number))) + (setf (nth 1 entry) nil) + (gnus-agent-message 3 "gnus-agent-expire cleared \ download flag on %s:%d as the cached article file is missing." - group (caar dlist))) - (unless marker - (gnus-message 1 "gnus-agent-expire detected a \ + group (caar dlist))) + (unless marker + (gnus-message 1 "gnus-agent-expire detected a \ missing NOV entry. Run gnus-agent-regenerate-group to restore it."))) - (gnus-agent-append-to-list - tail-alist - (cons article-number fetch-date))) - - ;; The following articles are READ, UNMARKED, and - ;; ORDINARY. See if they can be EXPIRED!!! - ((setq type - (cond - ((not (integerp fetch-date)) - 'read) ;; never fetched article (may expire - ;; right now) - ((not (file-exists-p - (concat dir (number-to-string - article-number)))) - (setf (nth 1 entry) nil) - 'externally-expired) ;; Can't find the cached - ;; article. Handle case - ;; as though this article - ;; was never fetched. - - ;; We now have the arrival day, so we see - ;; whether it's old enough to be expired. - ((< fetch-date day) - 'expired) - (force - 'forced))) - - ;; I found some reason to expire this entry. - - (let ((actions nil)) - (when (memq type '(forced expired)) - (ignore-errors ; Just being paranoid. - (let ((file-name (concat dir (number-to-string - article-number)))) - (incf (nth 2 stats) (nth 7 (file-attributes file-name))) - (incf (nth 1 stats)) - (delete-file file-name)) - (push "expired cached article" actions)) - (setf (nth 1 entry) nil) - ) - - (when marker - (push "NOV entry removed" actions) - (goto-char marker) - - (incf (nth 0 stats)) - - (let ((from (gnus-point-at-bol)) - (to (progn (forward-line 1) (point)))) - (incf (nth 2 stats) (- to from)) - (delete-region from to))) - - ;; If considering all articles is set, I can only - ;; expire article IDs that are no longer in the - ;; active range (That is, articles that preceed the - ;; first article in the new alist). - (if (and gnus-agent-consider-all-articles - (>= article-number (car active))) - ;; I have to keep this ID in the alist - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date)) - (push (format "Removed %s article number from \ + (gnus-agent-append-to-list + tail-alist + (cons article-number fetch-date))) + + ;; The following articles are READ, UNMARKED, and + ;; ORDINARY. See if they can be EXPIRED!!! + ((setq type + (cond + ((not (integerp fetch-date)) + 'read) ;; never fetched article (may expire + ;; right now) + ((not (file-exists-p + (concat dir (number-to-string + article-number)))) + (setf (nth 1 entry) nil) + 'externally-expired) ;; Can't find the cached + ;; article. Handle case + ;; as though this article + ;; was never fetched. + + ;; We now have the arrival day, so we see + ;; whether it's old enough to be expired. + ((< fetch-date day) + 'expired) + (force + 'forced))) + + ;; I found some reason to expire this entry. + + (let ((actions nil)) + (when (memq type '(forced expired)) + (ignore-errors ; Just being paranoid. + (let* ((file-name (nnheader-concat dir (number-to-string + article-number))) + (size (float (nth 7 (file-attributes file-name))))) + (incf bytes-freed size) + (incf files-deleted) + (delete-file file-name)) + (push "expired cached article" actions)) + (setf (nth 1 entry) nil) + ) + + (when marker + (push "NOV entry removed" actions) + (goto-char marker) + + (incf nov-entries-deleted) + + (let ((from (gnus-point-at-bol)) + (to (progn (forward-line 1) (point)))) + (incf bytes-freed (- to from)) + (delete-region from to))) + + ;; If considering all articles is set, I can only + ;; expire article IDs that are no longer in the + ;; active range (That is, articles that preceed the + ;; first article in the new alist). + (if (and gnus-agent-consider-all-articles + (>= article-number (car active))) + ;; I have to keep this ID in the alist + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date)) + (push (format "Removed %s article number from \ article alist" type) actions)) (when actions (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s" group article-number (mapconcat 'identity actions ", "))))) - (t - (gnus-agent-message - 10 "gnus-agent-expire: %s:%d: Article kept as \ + (t + (gnus-agent-message + 10 "gnus-agent-expire: %s:%d: Article kept as \ expiration tests failed." group article-number) - (gnus-agent-append-to-list - tail-alist (cons article-number fetch-date))) - ) - - ;; Clean up markers as I want to recycle this buffer - ;; over several groups. - (when marker - (set-marker marker nil)) - - (setq dlist (cdr dlist)))) - - (setq alist (cdr alist)) - - (let ((inhibit-quit t)) - (unless (equal alist gnus-agent-article-alist) - (setq gnus-agent-article-alist alist) - (gnus-agent-save-alist group)) - - (when (buffer-modified-p) - (let ((coding-system-for-write - gnus-agent-file-coding-system)) - (gnus-make-directory dir) - (write-region (point-min) (point-max) nov-file nil - 'silent) - ;; clear the modified flag as that I'm not confused by - ;; its status on the next pass through this routine. - (set-buffer-modified-p nil))) - - (when (eq articles t) - (gnus-summary-update-info)))))))) + (gnus-agent-append-to-list + tail-alist (cons article-number fetch-date))) + ) + + ;; Clean up markers as I want to recycle this buffer + ;; over several groups. + (when marker + (set-marker marker nil)) + + (setq dlist (cdr dlist)))) + + (setq alist (cdr alist)) + + (let ((inhibit-quit t)) + (unless (equal alist gnus-agent-article-alist) + (setq gnus-agent-article-alist alist) + (gnus-agent-save-alist group)) + + (when (buffer-modified-p) + (let ((coding-system-for-write + gnus-agent-file-coding-system)) + (gnus-make-directory dir) + (write-region (point-min) (point-max) nov-file nil + 'silent) + ;; clear the modified flag as that I'm not confused by + ;; its status on the next pass through this routine. + (set-buffer-modified-p nil))) + + (when (eq articles t) + (gnus-summary-update-info)))) + + (when (boundp 'gnus-agent-expire-stats) + (let ((stats (symbol-value 'gnus-agent-expire-stats))) + (incf (nth 2 stats) bytes-freed) + (incf (nth 1 stats) files-deleted) + (incf (nth 0 stats) nov-entries-deleted))) + )))) (defun gnus-agent-expire (&optional articles group force) "Expire all old articles. @@ -3248,7 +3472,7 @@ (defun gnus-agent-uncached-articles (articles group &optional cached-header) "Restrict ARTICLES to numbers already fetched. -Returns a sublist of ARTICLES that excludes thos article ids in GROUP +Returns a sublist of ARTICLES that excludes those article ids in GROUP that have already been fetched. If CACHED-HEADER is nil, articles are only excluded if the article itself has been fetched." @@ -3338,12 +3562,11 @@ ;; Get the list of articles that were fetched (goto-char (point-min)) - (let ((pm (point-max))) + (let ((pm (point-max)) + art) (while (< (point) pm) - (when (looking-at "[0-9]+\t") - (gnus-agent-append-to-list - tail-fetched-articles - (read (current-buffer)))) + (when (setq art (gnus-agent-read-article-number)) + (gnus-agent-append-to-list tail-fetched-articles art)) (forward-line 1))) ;; Clip this list to the headers that will @@ -3380,12 +3603,12 @@ (set-buffer nntp-server-buffer) (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max)) - ;; Merge the temp buffer with the known headers (found on - ;; disk in FILE) into the nntp-server-buffer - (when (and uncached-articles (file-exists-p file)) + ;; Merge the temp buffer with the known headers (found on + ;; disk in FILE) into the nntp-server-buffer + (when uncached-articles (gnus-agent-braid-nov group uncached-articles file)) - ;; Save the new set of known headers to FILE + ;; Save the new set of known headers to FILE (set-buffer nntp-server-buffer) (let ((coding-system-for-write gnus-agent-file-coding-system)) @@ -3465,7 +3688,6 @@ (gnus-message 3 "Ignoring unexpected input") (sit-for 1) t))))) - (when group (gnus-message 5 "Regenerating in %s" group) (let* ((gnus-command-method (or gnus-command-method @@ -3506,7 +3728,7 @@ (gnus-delete-line) (setq nov-arts (cdr nov-arts)) (gnus-message 4 "gnus-agent-regenerate-group: NOV\ -entry of article %s deleted." l1)) + entry of article %s deleted." l1)) ((not l2) nil) ((< l1 l2) @@ -3651,10 +3873,9 @@ gnus-agent-article-alist)))) (when (gnus-buffer-live-p gnus-group-buffer) - (gnus-group-update-group group t) - (sit-for 0))) - - (gnus-message 5 nil) + (gnus-group-update-group group t))) + + (gnus-message 5 "") regenerated))) ;;;###autoload @@ -3700,49 +3921,6 @@ (defun gnus-agent-group-covered-p (group) (gnus-agent-method-p (gnus-group-method group))) -(add-hook 'gnus-group-prepare-hook - (lambda () - 'gnus-agent-do-once - - (when (listp gnus-agent-expire-days) - (beep) - (beep) - (gnus-message 1 "WARNING: gnus-agent-expire-days no longer\ - supports being set to a list.")(sleep-for 3) - (gnus-message 1 "Change your configuration to set it to an\ - integer.")(sleep-for 3) - (gnus-message 1 "I am now setting group parameters on each\ - group to match the configuration that the list offered.") - - (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)))))) - - (let ((h gnus-group-prepare-hook)) - (while h - (let ((func (pop h))) - (when (and (listp func) - (eq (cadr (caddr func)) 'gnus-agent-do-once)) - (remove-hook 'gnus-group-prepare-hook func) - (setq h nil))))) - - (gnus-message 1 "I have finished setting group parameters on\ - each group. You may now customize your groups and/or topics to control the\ - agent.")))) - (provide 'gnus-agent) ;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
--- a/lisp/gnus/gnus-art.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-art.el Mon Oct 25 18:17:28 2004 +0000 @@ -6122,7 +6122,7 @@ ("\\(<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 @@ ("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 @@ (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 @@ 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 @@ (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)
--- a/lisp/gnus/gnus-cache.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-cache.el Mon Oct 25 18:17:28 2004 +0000 @@ -726,6 +726,46 @@ (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
--- a/lisp/gnus/gnus-draft.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-draft.el Mon Oct 25 18:17:28 2004 +0000 @@ -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."
--- a/lisp/gnus/gnus-group.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-group.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ '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 @@ ;; 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 @@ (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))
--- a/lisp/gnus/gnus-int.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-int.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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.
--- a/lisp/gnus/gnus-range.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-range.el Mon Oct 25 18:17:28 2004 +0000 @@ -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> @@ -184,6 +184,58 @@ (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) ;;;###autoload @@ -589,6 +641,19 @@ (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
--- a/lisp/gnus/gnus-start.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-start.el Mon Oct 25 18:17:28 2004 +0000 @@ -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. @@ -663,6 +670,8 @@ (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 @@ -1479,8 +1488,8 @@ (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)) @@ -1511,12 +1520,21 @@ (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 @@ -1526,6 +1544,10 @@ (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 @@ -1533,8 +1555,7 @@ ;; 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 @@ -1630,7 +1651,7 @@ (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 @@ -1653,61 +1674,60 @@ (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 @@ -1734,8 +1754,8 @@ (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 @@ -1980,10 +2000,10 @@ (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))) @@ -2127,7 +2147,7 @@ (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)) @@ -2203,17 +2223,94 @@ (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)) @@ -2593,6 +2690,10 @@ ;; 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) @@ -2610,6 +2711,7 @@ (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)
--- a/lisp/gnus/gnus-sum.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-sum.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ ["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 @@ `("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 @@ (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 @@ 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 @@ (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 @@ ;; 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 @@ (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 @@ (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 @@ (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
--- a/lisp/gnus/gnus-util.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/gnus-util.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ "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 @@ ""))) (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
--- a/lisp/gnus/imap.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/imap.el Mon Oct 25 18:17:28 2004 +0000 @@ -270,6 +270,11 @@ :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 @@ (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)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/legacy-gnus-agent.el Mon Oct 25 18:17:28 2004 +0000 @@ -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
--- a/lisp/gnus/mail-source.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/mail-source.el Mon Oct 25 18:17:28 2004 +0000 @@ -257,7 +257,7 @@ :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)
--- a/lisp/gnus/message.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/message.el Mon Oct 25 18:17:28 2004 +0000 @@ -2629,7 +2629,7 @@ (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." @@ -2739,6 +2739,7 @@ ;; 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))
--- a/lisp/gnus/mm-view.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/mm-view.el Mon Oct 25 18:17:28 2004 +0000 @@ -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))
--- a/lisp/gnus/mml.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/mml.el Mon Oct 25 18:17:28 2004 +0000 @@ -1077,9 +1077,9 @@ (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)
--- a/lisp/gnus/nnagent.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/nnagent.el Mon Oct 25 18:17:28 2004 +0000 @@ -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)
--- a/lisp/gnus/spam.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/gnus/spam.el Mon Oct 25 18:17:28 2004 +0000 @@ -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)
--- a/lisp/help.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/help.el Mon Oct 25 18:17:28 2004 +0000 @@ -651,7 +651,8 @@ (push (list pretty-minor-mode mode indicator) minor-modes)))) (if auto-fill-function - (push '("Auto Fill" auto-fill-mode " Fill") + ;; copy pure string so we can add face property to it below. + (push (list (copy-sequence "Auto Fill") 'auto-fill-mode " Fill") minor-modes)) (setq minor-modes (sort minor-modes
--- a/lisp/ibuf-ext.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/ibuf-ext.el Mon Oct 25 18:17:28 2004 +0000 @@ -645,16 +645,16 @@ (ibuffer-update nil t)) ;;;###autoload -(defun ibuffer-kill-line (&optional arg) +(defun ibuffer-kill-line (&optional arg interactive-p) "Kill the filter group at point. See also `ibuffer-kill-filter-group'." - (interactive "P") + (interactive "P\np") (ibuffer-aif (save-excursion (ibuffer-forward-line 0) (get-text-property (point) 'ibuffer-filter-group-name)) (progn (ibuffer-kill-filter-group it)) - (funcall (if (interactive-p) #'call-interactively #'funcall) + (funcall (if interactive-p #'call-interactively #'funcall) #'kill-line arg))) (defun ibuffer-insert-filter-group-before (newgroup group) @@ -1237,53 +1237,51 @@ If `ibuffer-jump-offer-only-visible-buffers' is non-nil, only offer visible buffers in the completion list. Calling the command with a prefix argument reverses the meaning of that variable." - (interactive (list nil)) - (let ((only-visible ibuffer-jump-offer-only-visible-buffers)) - (when current-prefix-arg - (setq only-visible (not only-visible))) - (if only-visible - (let ((table (mapcar #'(lambda (x) - (buffer-name (car x))) - (ibuffer-current-state-list)))) - (when (null table) - (error "No buffers!")) - (when (interactive-p) - (setq name (completing-read "Jump to buffer: " - table nil t)))) - (when (interactive-p) - (setq name (read-buffer "Jump to buffer: " nil t)))) - (when (not (string= "" name)) - (let (buf-point) - ;; Blindly search for our buffer: it is very likely that it is - ;; not in a hidden filter group. - (ibuffer-map-lines #'(lambda (buf marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) - t nil) - (when (and - (null buf-point) - (not (null ibuffer-hidden-filter-groups))) - ;; We did not find our buffer. It must be in a hidden filter - ;; group, so go through all hidden filter groups to find it. - (catch 'found - (dolist (group ibuffer-hidden-filter-groups) - (ibuffer-jump-to-filter-group group) - (ibuffer-toggle-filter-group) - (ibuffer-map-lines #'(lambda (buf marks) - (when (string= (buffer-name buf) name) - (setq buf-point (point)) - nil)) - t group) - (if buf-point - (throw 'found nil) - (ibuffer-toggle-filter-group))))) - (if (null buf-point) - ;; Still not found even though we expanded all hidden filter - ;; groups: that must be because it's hidden by predicate: - ;; we won't bother trying to display it. - (error "No buffer with name %s" name) - (goto-char buf-point)))))) + (interactive (list + (let ((only-visible ibuffer-jump-offer-only-visible-buffers)) + (when current-prefix-arg + (setq only-visible (not only-visible))) + (if only-visible + (let ((table (mapcar #'(lambda (x) + (buffer-name (car x))) + (ibuffer-current-state-list)))) + (when (null table) + (error "No buffers!")) + (completing-read "Jump to buffer: " + table nil t)) + (read-buffer "Jump to buffer: " nil t))))) + (when (not (string= "" name)) + (let (buf-point) + ;; Blindly search for our buffer: it is very likely that it is + ;; not in a hidden filter group. + (ibuffer-map-lines #'(lambda (buf marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) + t nil) + (when (and + (null buf-point) + (not (null ibuffer-hidden-filter-groups))) + ;; We did not find our buffer. It must be in a hidden filter + ;; group, so go through all hidden filter groups to find it. + (catch 'found + (dolist (group ibuffer-hidden-filter-groups) + (ibuffer-jump-to-filter-group group) + (ibuffer-toggle-filter-group) + (ibuffer-map-lines #'(lambda (buf marks) + (when (string= (buffer-name buf) name) + (setq buf-point (point)) + nil)) + t group) + (if buf-point + (throw 'found nil) + (ibuffer-toggle-filter-group))))) + (if (null buf-point) + ;; Still not found even though we expanded all hidden filter + ;; groups: that must be because it's hidden by predicate: + ;; we won't bother trying to display it. + (error "No buffer with name %s" name) + (goto-char buf-point))))) ;;;###autoload (defun ibuffer-diff-with-file ()
--- a/lisp/ibuffer.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/ibuffer.el Mon Oct 25 18:17:28 2004 +0000 @@ -873,8 +873,8 @@ default-directory) default-directory)))) (list (read-file-name "Find file: " default-directory) - current-prefix-arg))) - (find-file file (or wildcards (interactive-p)))) + t))) + (find-file file wildcards)) (defun ibuffer-mouse-visit-buffer (event) "Visit the buffer chosen with the mouse."
--- a/lisp/indent.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/indent.el Mon Oct 25 18:17:28 2004 +0000 @@ -205,7 +205,6 @@ Interactively, WIDTH is the prefix argument, if specified. Without prefix argument, the command prompts for WIDTH." (interactive "r\nNSet left margin to column: ") - (if (interactive-p) (setq width (prefix-numeric-value width))) (save-excursion ;; If inside indentation, start from BOL. (goto-char from) @@ -229,7 +228,6 @@ Interactively, WIDTH is the prefix argument, if specified. Without prefix argument, the command prompts for WIDTH." (interactive "r\nNSet right margin to width: ") - (if (interactive-p) (setq width (prefix-numeric-value width))) (save-excursion (goto-char from) (skip-chars-backward " \t") @@ -289,12 +287,10 @@ the right margin width. If `auto-fill-mode' is active, re-fill the region to fit the new margin." (interactive "r\nP") - (if (interactive-p) - (setq inc (if inc (prefix-numeric-value current-prefix-arg) - standard-indent))) + (setq inc (if inc (prefix-numeric-value inc) standard-indent)) (save-excursion (alter-text-property from to 'right-margin - (lambda (v) (+ inc (or v 0)))) + (lambda (v) (+ inc (or v 0)))) (if auto-fill-function (fill-region from to nil t t))))
--- a/lisp/info.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/info.el Mon Oct 25 18:17:28 2004 +0000 @@ -3248,7 +3248,8 @@ \(FILENAME NODENAME BUFFERPOS\)." (let ((where '()) (cmd-desc (concat "^\\* +" (regexp-quote (symbol-name command)) - "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\.$")) + "\\( <[0-9]+>\\)?:\\s *\\(.*\\)\\." + "\\([ \t]*(line[ \t]*[0-9]*)\\)?$")) (info-file "emacs")) ;default ;; Determine which info file this command is documented in. (if (get command 'info-file)
--- a/lisp/international/mule.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/international/mule.el Mon Oct 25 18:17:28 2004 +0000 @@ -2015,6 +2015,34 @@ (put symbol 'translation-table-id id) id)) +(defun translate-region (start end table) + "From START to END, translate characters according to TABLE. +TABLE is a string or a char-table. +If TABLE is a string, the Nth character in it is the mapping +for the character with code N. +If TABLE is a char-table, the element for character N is the mapping +for the character with code N. +It returns the number of characters changed." + (interactive + (list (region-beginning) + (region-end) + (let (table l) + (dotimes (i (length translation-table-vector)) + (if (consp (aref translation-table-vector i)) + (push (list (symbol-name + (car (aref translation-table-vector i)))) l))) + (if (not l) + (error "No translation table defined")) + (while (not table) + (setq table (completing-read "Translation table: " l nil t))) + (intern table)))) + (if (symbolp table) + (let ((val (get table 'translation-table))) + (or (char-table-p val) + (error "Invalid translation table name: %s" table)) + (setq table val))) + (translate-region-internal start end table)) + (put 'with-category-table 'lisp-indent-function 1) (defmacro with-category-table (table &rest body)
--- a/lisp/net/tramp-vc.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/net/tramp-vc.el Mon Oct 25 18:17:28 2004 +0000 @@ -217,6 +217,7 @@ ;; Daniel Pittman <daniel@danann.net> ;;-(if (fboundp 'vc-call-backend) ;;- () ;; This is the new VC for which we don't have an appropriate advice yet +(unless (fboundp 'process-file) (if (fboundp 'vc-call-backend) (defadvice vc-do-command (around tramp-advice-vc-do-command @@ -242,7 +243,7 @@ (setq ad-return-value (apply 'tramp-vc-do-command buffer okstatus command (or file (buffer-file-name)) last flags)) - ad-do-it)))) + ad-do-it))))) ;;-)
--- a/lisp/net/tramp.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/net/tramp.el Mon Oct 25 18:17:28 2004 +0000 @@ -1770,6 +1770,7 @@ (delete-file . tramp-handle-delete-file) (directory-file-name . tramp-handle-directory-file-name) (shell-command . tramp-handle-shell-command) + (process-file . tramp-handle-process-file) (insert-directory . tramp-handle-insert-directory) (expand-file-name . tramp-handle-expand-file-name) (file-local-copy . tramp-handle-file-local-copy) @@ -3469,6 +3470,18 @@ (tramp-run-real-handler 'shell-command (list command output-buffer error-buffer)))) +(defun tramp-handle-process-file (program &optional infile buffer display &rest args) + "Like `process-file' for Tramp files." + (when infile (error "Implementation does not handle input from file")) + (when (and (numberp buffer) (zerop buffer)) + (error "Implementation does not handle immediate return")) + (when (consp buffer) (error "Implementation does not handle error files")) + (shell-command + (mapconcat 'tramp-shell-quote-argument + (cons program args) + " ") + buffer)) + ;; File Editing. (defsubst tramp-make-temp-file () @@ -3960,6 +3973,8 @@ ; COMMAND ((member operation (list 'dired-call-process 'shell-command + ; Post Emacs 21.3 only + 'process-file ; XEmacs only 'dired-print-file 'dired-shell-call-process)) default-directory)
--- a/lisp/paths.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/paths.el Mon Oct 25 18:17:28 2004 +0000 @@ -106,7 +106,7 @@ "/usr/spool/news/" "/var/spool/news/") "The root directory below which all news files are stored.") -(defalias 'news-path 'news-directory) +(defvaralias 'news-path 'news-directory) (defvar news-inews-program (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
--- a/lisp/progmodes/asm-mode.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/progmodes/asm-mode.el Mon Oct 25 18:17:28 2004 +0000 @@ -90,7 +90,9 @@ 2 font-lock-keyword-face) ;; directive started from ".". ("^\\(\\.\\(\\sw\\|\\s_\\)+\\)\\>[^:]?" - 1 font-lock-keyword-face)) + 1 font-lock-keyword-face) + ;; %register + ("%\\sw+" . font-lock-variable-name-face)) "Additional expressions to highlight in Assembler mode.") ;;;###autoload
--- a/lisp/progmodes/compile.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/progmodes/compile.el Mon Oct 25 18:17:28 2004 +0000 @@ -866,10 +866,7 @@ (if (eq mode t) (prog1 "compilation" (require 'comint)) (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) - 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 @@ -890,17 +887,25 @@ (error "Cannot have two processes in `%s' at once" (buffer-name))))) (buffer-disable-undo (current-buffer)) + ;; 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)) + (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) - ;; Change its default-directory to the directory where the compilation - ;; will happen, and insert a `cd' command to indicate this. - (setq default-directory 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")) + " -*-\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. @@ -985,7 +990,9 @@ ;; fontified, so fontify it now. (let ((font-lock-verbose nil)) ; shut up font-lock messages (font-lock-fontify-buffer)) - (message "Executing `%s'...done" command)))) + (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) @@ -1186,7 +1193,8 @@ "Prepare the buffer for the compilation parsing commands to work. Optional argument MINOR indicates this is called from `compilation-minor-mode'." - (setq buffer-read-only t) + (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)
--- a/lisp/progmodes/gdb-ui.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/progmodes/gdb-ui.el Mon Oct 25 18:17:28 2004 +0000 @@ -177,7 +177,7 @@ (setq comint-input-sender 'gdb-send) ;; - ;; (re-)initialise + ;; (re-)initialize (setq gdb-current-address "main") (setq gdb-previous-address nil) (setq gdb-previous-frame nil) @@ -482,14 +482,14 @@ (name (funcall (gdb-rules-name-maker rules))) (new (get-buffer-create name))) (with-current-buffer new - ;; FIXME: This should be set after calling the function, since the - ;; function should run kill-all-local-variables. - (set (make-local-variable 'gdb-buffer-type) key) - (if (cdr (cdr rules)) - (funcall (car (cdr (cdr rules))))) - (set (make-local-variable 'gud-minor-mode) - (with-current-buffer gud-comint-buffer gud-minor-mode)) - (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (let ((trigger)) + (if (cdr (cdr rules)) + (setq trigger (funcall (car (cdr (cdr rules)))))) + (set (make-local-variable 'gdb-buffer-type) key) + (set (make-local-variable 'gud-minor-mode) + (with-current-buffer gud-comint-buffer gud-minor-mode)) + (set (make-local-variable 'tool-bar-map) gud-tool-bar-map) + (if trigger (funcall trigger))) new)))) (defun gdb-rules-name-maker (rules) (car (cdr rules))) @@ -1190,13 +1190,15 @@ "Major mode for gdb breakpoints. \\{gdb-breakpoints-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-breakpoints-mode) (setq mode-name "Breakpoints") (use-local-map gdb-breakpoints-mode-map) (setq buffer-read-only t) + (run-mode-hooks 'gdb-breakpoints-mode-hook) (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) - (gdb-invalidate-breakpoints) - (gdbmi-invalidate-breakpoints))) + 'gdb-invalidate-breakpoints + 'gdbmi-invalidate-breakpoints)) (defun gdb-toggle-breakpoint () "Enable/disable the breakpoint at current line." @@ -1317,14 +1319,16 @@ "Major mode for gdb frames. \\{gdb-frames-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-frames-mode) (setq mode-name "Frames") (setq buffer-read-only t) (use-local-map gdb-frames-mode-map) (font-lock-mode -1) + (run-mode-hooks 'gdb-frames-mode-hook) (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) - (gdb-invalidate-frames) - (gdbmi-invalidate-frames))) + 'gdb-invalidate-frames + 'gdbmi-invalidate-frames)) (defun gdb-get-frame-number () (save-excursion @@ -1396,11 +1400,13 @@ "Major mode for gdb frames. \\{gdb-threads-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-threads-mode) (setq mode-name "Threads") (setq buffer-read-only t) (use-local-map gdb-threads-mode-map) - (gdb-invalidate-threads)) + (run-mode-hooks 'gdb-threads-mode-hook) + 'gdb-invalidate-threads) (defun gdb-get-thread-number () (save-excursion @@ -1444,11 +1450,13 @@ "Major mode for gdb registers. \\{gdb-registers-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-registers-mode) (setq mode-name "Registers") (setq buffer-read-only t) (use-local-map gdb-registers-mode-map) - (gdb-invalidate-registers)) + (run-mode-hooks 'gdb-registers-mode-hook) + 'gdb-invalidate-registers) (defun gdb-registers-buffer-name () (with-current-buffer gud-comint-buffer @@ -1518,13 +1526,15 @@ "Major mode for gdb locals. \\{gdb-locals-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-locals-mode) (setq mode-name (concat "Locals:" gdb-current-frame)) (setq buffer-read-only t) (use-local-map gdb-locals-mode-map) + (run-mode-hooks 'gdb-locals-mode-hook) (if (with-current-buffer gud-comint-buffer (eq gud-minor-mode 'gdba)) - (gdb-invalidate-locals) - (gdbmi-invalidate-locals))) + 'gdb-invalidate-locals + 'gdbmi-invalidate-locals)) (defun gdb-locals-buffer-name () (with-current-buffer gud-comint-buffer @@ -1939,10 +1949,26 @@ (suppress-keymap map) map)) +(defvar gdb-assembler-font-lock-keywords + '(;; <__function.name+n> + ("<\\(\\(\\sw\\|[_.]\\)+\\)\\(\\+[0-9]+\\)?>" + (1 font-lock-function-name-face)) + ;; 0xNNNNNNNN <__function.name+n>: opcode + ("^0x[0-9a-f]+ \\(<\\(\\(\\sw\\|[_.]\\)+\\)\\+[0-9]+>\\)?:[ \t]+\\(\\sw+\\)" + (4 font-lock-keyword-face)) + ;; %register(at least i386) + ("%\\sw+" . font-lock-variable-name-face) + ("^\\(Dump of assembler code for function\\) \\(.+\\):" + (1 font-lock-comment-face) + (2 font-lock-function-name-face)) + ("^\\(End of assembler dump\\.\\)" . font-lock-comment-face)) + "Font lock keywords used in `gdb-assembler-mode'.") + (defun gdb-assembler-mode () "Major mode for viewing code assembler. \\{gdb-assembler-mode-map}" + (kill-all-local-variables) (setq major-mode 'gdb-assembler-mode) (setq mode-name "Machine") (setq gdb-overlay-arrow-position nil) @@ -1951,7 +1977,11 @@ (setq fringes-outside-margins t) (setq buffer-read-only t) (use-local-map gdb-assembler-mode-map) - (gdb-invalidate-assembler)) + (gdb-invalidate-assembler) + (set (make-local-variable 'font-lock-defaults) + '(gdb-assembler-font-lock-keywords)) + (run-mode-hooks 'gdb-assembler-mode-hook) + 'gdb-invalidate-assembler) (defun gdb-assembler-buffer-name () (with-current-buffer gud-comint-buffer
--- a/lisp/simple.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/simple.el Mon Oct 25 18:17:28 2004 +0000 @@ -1879,6 +1879,39 @@ (with-current-buffer standard-output (call-process shell-file-name nil t nil shell-command-switch command)))) + +(defun process-file (program &optional infile buffer display &rest args) + "Process files synchronously in a separate process. +Similar to `call-process', but may invoke a file handler based on +`default-directory'. The current working directory of the +subprocess is `default-directory'. + +File names in INFILE and BUFFER are handled normally, but file +names in ARGS should be relative to `default-directory', as they +are passed to the process verbatim. \(This is a difference to +`call-process' which does not support file handlers for INFILE +and BUFFER.\) + +Some file handlers might not support all variants, for example +they might behave as if DISPLAY was nil, regardless of the actual +value passed." + (let ((fh (find-file-name-handler default-directory 'process-file)) + lc stderr-file) + (unwind-protect + (if fh (apply fh 'process-file program infile buffer display args) + (when infile (setq lc (file-local-copy infile))) + (setq stderr-file (when (and (consp buffer) (stringp (cadr buffer))) + (make-temp-file "emacs")))) + (prog1 + (apply 'call-process program + (or lc infile) + (if stderr-file (list (car buffer) stderr-file) buffer) + display args) + (when stderr-file (copy-file stderr-file (cadr buffer)))) + (when stderr-file (delete-file stderr-file)) + (when lc (delete-file lc))))) + + (defvar universal-argument-map (let ((map (make-sparse-keymap)))
--- a/lisp/textmodes/flyspell.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/textmodes/flyspell.el Mon Oct 25 18:17:28 2004 +0000 @@ -452,7 +452,7 @@ ;;;###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.
--- a/lisp/textmodes/tex-mode.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/textmodes/tex-mode.el Mon Oct 25 18:17:28 2004 +0000 @@ -1946,7 +1946,6 @@ 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 @@ 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:
--- a/lisp/url/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -1,3 +1,40 @@ +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.
--- a/lisp/url/url-auth.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-auth.el Mon Oct 25 18:17:28 2004 +0000 @@ -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) @@ -314,3 +315,4 @@ (provide 'url-auth) ;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 +;;; url-auth.el ends here
--- a/lisp/url/url-cache.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-cache.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ (provide 'url-cache) ;;; arch-tag: 95b050a6-8e81-4f23-8e63-191b9d1d657c +;;; url-cache.el ends here
--- a/lisp/url/url-cid.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-cid.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,26 +1,27 @@ ;;; url-cid.el --- Content-ID URL loader + +;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc. + ;; Keywords: comm, data, processes -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1998 - 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) @@ -62,3 +63,4 @@ (message "Unable to handle CID URL: %s" url)))) ;;; arch-tag: 23d9ab74-fad4-4dba-b1e7-292871e8bda5 +;;; url-cid.el ends here
--- a/lisp/url/url-dired.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-dired.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ (provide 'url-dired) ;;; arch-tag: 2694f21a-43e1-4391-b3cb-cf6e5349f15f +;;; url-dired.el ends here
--- a/lisp/url/url-expand.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-expand.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,26 +1,27 @@ ;;; url-expand.el --- expand-file-name for URLs + +;; Copyright (c) 1999 Free Software Foundation, Inc. + ;; Keywords: comm, data, processes -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 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-methods) (require 'url-util) @@ -140,3 +141,4 @@ (provide 'url-expand) ;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a +;;; url-expand.el ends here
--- a/lisp/url/url-ftp.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-ftp.el Mon Oct 25 18:17:28 2004 +0000 @@ -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
--- a/lisp/url/url-gw.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-gw.el Mon Oct 25 18:17:28 2004 +0000 @@ -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 @@ (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)) @@ -266,3 +268,4 @@ (provide 'url-gw) ;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 +;;; url-gw.el ends here
--- a/lisp/url/url-imap.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-imap.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,33 +1,36 @@ ;;; url-imap.el --- IMAP retrieval routines + +;; Copyright (c) 1999 Free Software Foundation, Inc. + ;; Author: Simon Josefsson <jas@pdc.kth.se> ;; Keywords: comm, data, processes -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 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. -; 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): +;; 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: -; (url-imap (url-generic-parse-url "imap://cyrus.andrew.cmu.edu/archive.c-client;UID=1021")) +;; 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) @@ -79,3 +82,4 @@ (current-buffer))) ;;; arch-tag: 034991ff-5425-48ea-b911-c96c90e6f47d +;;; url-imap.el ends here
--- a/lisp/url/url-irc.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-irc.el Mon Oct 25 18:17:28 2004 +0000 @@ -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. + +;; 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. -;;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt +;; 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 @@ (provide 'url-irc) ;;; arch-tag: 2e5eecf8-9eb3-436b-9fbd-c26f2fb2bf3e +;;; url-irc.el ends here
--- a/lisp/url/url-misc.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-misc.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,26 +1,27 @@ ;;; 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) @@ -116,3 +117,4 @@ (provide 'url-misc) ;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0 +;;; url-misc.el ends here
--- a/lisp/url/url-news.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-news.el Mon Oct 25 18:17:28 2004 +0000 @@ -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
--- a/lisp/url/url-ns.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-ns.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,26 +1,27 @@ ;;; url-ns.el --- Various netscape-ish functions for proxy definitions + +;; Copyright (c) 1997 - 1999 Free Software Foundation, Inc. + ;; Keywords: comm, data, processes, hypermedia -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1997 - 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-gw) @@ -103,3 +104,4 @@ (provide 'url-ns) ;;; arch-tag: 69520992-cf97-40b4-9ad1-c866d3cae5bf +;;; url-ns.el ends here
--- a/lisp/url/url-privacy.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-privacy.el Mon Oct 25 18:17:28 2004 +0000 @@ -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
--- a/lisp/url/url-proxy.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-proxy.el Mon Oct 25 18:17:28 2004 +0000 @@ -1,26 +1,27 @@ ;;; url-proxy.el --- Proxy server support + +;; Copyright (c) 1999 Free Software Foundation, Inc. + ;; Keywords: comm, data, processes, hypermedia -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 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) (autoload 'url-warn "url") @@ -75,3 +76,4 @@ (provide 'url-proxy) ;;; arch-tag: 4ff8882e-e498-42b7-abc5-acb449cdbc62 +;;; url-proxy.el ends here
--- a/lisp/url/url-vars.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/url/url-vars.el Mon Oct 25 18:17:28 2004 +0000 @@ -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)
--- a/lisp/vc.el Tue Oct 19 17:00:02 2004 +0000 +++ b/lisp/vc.el Mon Oct 25 18:17:28 2004 +0000 @@ -953,7 +953,7 @@ (vc-exec-after `(unless (active-minibuffer-window) (message "Running %s in the background... done" ',command)))) - (setq status (apply 'call-process command nil t nil squeezed)) + (setq status (apply 'process-file command nil t nil squeezed)) (when (or (not (integerp status)) (and okstatus (< okstatus status))) (pop-to-buffer (current-buffer)) (goto-char (point-min))
--- a/lispref/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/lispref/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -1,3 +1,26 @@ +2004-10-24 Jason Rumney <jasonr@gnu.org> + + * commands.texi (Misc Events): Remove mouse-wheel. Add wheel-up + and wheel-down. + +2004-10-24 Kai Grossjohann <kai.grossjohann@gmx.net> + + * processes.texi (Synchronous Processes): Document process-file. + +2004-10-22 Kenichi Handa <handa@m17n.org> + + * text.texi (translate-region): Document that it accepts also a + char-table. + +2004-10-22 David Ponce <david@dponce.com> + + * windows.texi (Resizing Windows): Document the `preserve-before' + argument of the functions `enlarge-window' and `shrink-window'. + +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
--- a/lispref/commands.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/lispref/commands.texi Mon Oct 25 18:17:28 2004 +0000 @@ -1501,21 +1501,20 @@ the window manager. Its standard definition is @code{ignore}; since the frame has already been made visible, Emacs has no work to do. -@cindex @code{mouse-wheel} event -@item (mouse-wheel @var{position} @var{delta}) -This kind of event is generated by moving a wheel on a mouse (such as -the MS Intellimouse). Its effect is typically a kind of scroll or zoom. - -The element @var{delta} describes the amount and direction of the wheel -rotation. Its absolute value is the number of increments by which the -wheel was rotated. A negative @var{delta} indicates that the wheel was -rotated backwards, towards the user, and a positive @var{delta} -indicates that the wheel was rotated forward, away from the user. +@cindex @code{wheel-up} event +@cindex @code{wheel-down} event +@item (wheel-up @var{position}) +@item (wheel-down @var{position}) +This kind of event is generated by moving a wheel on a mouse. Its +effect is typically a kind of scroll or zoom. The element @var{position} is a list describing the position of the event, in the same format as used in a mouse-click event. -This kind of event is generated only on some kinds of systems. +This kind of event is generated only on some kinds of systems. On +other systems, mouse-4 and mouse-5 may be used instead. For portable +code, the variables @code{mouse-wheel-up-event} and +@code{mouse-wheel-down-event} defined in @file{mwheel.el} can be used. @cindex @code{drag-n-drop} event @item (drag-n-drop @var{position} @var{files})
--- a/lispref/makefile.w32-in Tue Oct 19 17:00:02 2004 +0000 +++ b/lispref/makefile.w32-in Mon Oct 25 18:17:28 2004 +0000 @@ -104,7 +104,7 @@ $(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
--- a/lispref/processes.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/lispref/processes.texi Mon Oct 25 18:17:28 2004 +0000 @@ -317,6 +317,47 @@ @end smallexample @end defun +@defun process-file program &optional infile buffer display &rest args +This function processes files synchronously in a separate process. It +is similar to @code{call-process} but may invoke a file handler based +on the value of the variable @code{default-directory}. The current +working directory of the subprocess is @code{default-directory}. + +The arguments are handled in almost the same way as for +@code{call-process}, with the following differences: + +Some file handlers may not support all combinations and forms of the +arguments @var{infile}, @var{buffer}, and @var{display}. For example, +some file handlers might behave as if @var{display} was nil, +regardless of the value actually passed. As another example, some +file handlers might not support separating standard output and error +output by way of the @var{buffer} argument. + +If a file handler is invoked, it determines the program to run based +on the first argument @var{program}. For instance, consider that a +handler for remote files is invoked. Then the path that is used for +searching the program might be different than @code{exec-path}. + +The second argument @var{infile} may invoke a file handler. The file +handler could be different from the handler chosen for the +@code{process-file} function itself. (For example, +@code{default-directory} could be on a remote host, whereas +@var{infile} is on another remote host. Or @code{default-directory} +could be non-special, whereas @var{infile} is on a remote host.) + +If @var{buffer} has the form @code{(@var{real-destination} +@var{error-destination})}, and @var{error-destination} names a file, +then the same remarks as for @var{infile} apply. + +The remaining arguments (@var{args}) will be passed to the process +verbatim. Emacs is not involved in processing file names that are +present in @var{args}. To avoid confusion, it may be best to avoid +absolute file names in @var{args}, but rather to specify all file +names as relative to @code{default-directory}. The function +@code{file-relative-name} is useful for constructing such relative +file names. +@end defun + @defun call-process-region start end program &optional delete destination display &rest args This function sends the text from @var{start} to @var{end} as standard input to a process running @var{program}. It deletes the text
--- a/lispref/text.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/lispref/text.texi Mon Oct 25 18:17:28 2004 +0000 @@ -3620,9 +3620,9 @@ This function applies a translation table to the characters in the buffer between positions @var{start} and @var{end}. -The translation table @var{table} is a string; @code{(aref @var{table} -@var{ochar})} gives the translated character corresponding to -@var{ochar}. If the length of @var{table} is less than 256, any +The translation table @var{table} is a string or a char-table; +@code{(aref @var{table} @var{ochar})} gives the translated character +corresponding to @var{ochar}. If @var{table} is a string, any characters with codes larger than the length of @var{table} are not altered by the translation.
--- a/lispref/windows.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/lispref/windows.texi Mon Oct 25 18:17:28 2004 +0000 @@ -1922,7 +1922,7 @@ window size. Emacs does not permit overlapping windows or gaps between windows, so resizing one window affects other windows. -@deffn Command enlarge-window size &optional horizontal +@deffn Command enlarge-window size &optional horizontal preserve-before This function makes the selected window @var{size} lines taller, stealing lines from neighboring windows. It takes the lines from one window at a time until that window is used up, then takes from another. @@ -1945,6 +1945,11 @@ size of a fixed-size window, @code{enlarge-window} gets an error instead. +If @var{preserve-before} is non-@code{nil}, this function does not +change the size of the siblings above or to the left of the selected +window. Only the size of the siblings below or to the right of the +selected window are changed. + If @var{size} is negative, this function shrinks the window by @minus{}@var{size} lines or columns. If that makes the window smaller than the minimum size (@code{window-min-height} and @@ -1965,7 +1970,7 @@ @end example @end deffn -@deffn Command shrink-window size &optional horizontal +@deffn Command shrink-window size &optional horizontal preserve-before This function is like @code{enlarge-window} but negates the argument @var{size}, making the selected window smaller by giving lines (or columns) to the other windows. If the window shrinks below
--- a/man/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/man/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -1,7 +1,31 @@ +2004-10-23 Eli Zaretskii <eliz@gnu.org> + + * text.texi (Text Based Tables, Table Definition) + (Table Creation, Table Recognition, Cell Commands) + (Cell Justification, Row Commands, Column Commands) + (Fixed Width Mode, Table Conversion, Measuring Tables) + (Table Misc): New nodes, documenting the Table Mode. + +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. @@ -16,6 +40,12 @@ * 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. @@ -172,6 +202,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.
--- a/man/calc.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/man/calc.texi Mon Oct 25 18:17:28 2004 +0000 @@ -2038,8 +2038,7 @@ 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.
--- a/man/calendar.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/man/calendar.texi Mon Oct 25 18:17:28 2004 +0000 @@ -1402,21 +1402,19 @@ 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 @@ @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
--- a/man/makefile.w32-in Tue Oct 19 17:00:02 2004 +0000 +++ b/man/makefile.w32-in Mon Oct 25 18:17:28 2004 +0000 @@ -125,9 +125,11 @@ # 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
--- a/man/message.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/man/message.texi Mon Oct 25 18:17:28 2004 +0000 @@ -224,11 +224,11 @@ is that if you lose your @file{.emacs} file (which is where Gnus stores the secret cancel lock password (which is generated automatically the first time you use this feature)), you won't be -able to cancel your message. If you yourself want to manage a password, +able to cancel your message. If you want to manage a password yourself, you can put something like the following in your @file{~/.gnus.el} file: @lisp -(setq canlock-password "Salam Shalom" +(setq canlock-password "geheimnis" canlock-password-for-verify canlock-password) @end lisp
--- a/man/text.texi Tue Oct 19 17:00:02 2004 +0000 +++ b/man/text.texi Mon Oct 25 18:17:28 2004 +0000 @@ -70,6 +70,7 @@ * HTML Mode:: Editing HTML, SGML, and XML files. * Nroff Mode:: Editing input to the formatter nroff. * Formatted Text:: Editing formatted text directly in WYSIWYG fashion. +* Text Based Tables:: Editing text-based tables in WYSIWYG fashion. @end menu @node Words @@ -2290,6 +2291,517 @@ but allow character code conversion and/or automatic uncompression if appropriate, use @code{format-find-file} with suitable arguments. +@node Text Based Tables +@section Editing Text-based Tables +@cindex table mode +@cindex text-based tables + + Table Mode provides an easy and intuitive way to create and edit WYSIWYG +text-based tables. Here is an example of such a table: + +@smallexample ++-----------------+--------------------------------+-----------------+ +| Command | Description | Key Binding | ++-----------------+--------------------------------+-----------------+ +| forward-char |Move point right N characters | C-f | +| |(left if N is negative). | | +| | | | +| |On reaching end of buffer, stop | | +| |and signal error. | | ++-----------------+--------------------------------+-----------------+ +| backward-char |Move point left N characters | C-b | +| |(right if N is negative). | | +| | | | +| |On attempt to pass beginning or | | +| |end of buffer, stop and signal | | +| |error. | | ++-----------------+--------------------------------+-----------------+ +@end smallexample + + Table Mode allows the contents of the table such as this one to be +easily manipulated by inserting or deleting characters inside a cell. +A cell is effectively a localized rectangular edit region and edits to +a cell do not affect the contents of the surrounding cells. If the +contents do not fit into a cell, then the cell is automatically +expanded in the vertical and/or horizontal directions and the rest of +the table is restructured and reformatted in accordance with the +growth of the cell. + +@menu +* Table Definition:: What is a text based table. +* Table Creation:: How to create a table. +* Table Recognition:: How to activate and deactivate tables. +* Cell Commands:: Cell-oriented commands in a table. +* Cell Justification:: Justifying cell contents. +* Row Commands:: Manipulating rows of table cell. +* Column Commands:: Manipulating columns of table cell. +* Fixed Width Mode:: Fixing cell width. +* Table Conversion:: Converting between plain text and tables. +* Measuring Tables:: Analyzing table dimension. +* Table Misc:: Table miscellany. +@end menu + +@node Table Definition +@subsection What is a Text-based Table? + + Look at the following examples of valid tables as a reference while +you read this section: + +@example + +--+----+---+ +-+ +--+-----+ + | | | | | | | | | + +--+----+---+ +-+ | +--+--+ + | | | | | | | | + +--+----+---+ +--+--+ | + | | | + +-----+--+ +@end example + + A table consists of a rectangular frame and the contents inside the +frame. A table's cells must be at least one character wide and one +character high with two adjacent cells sharing a boarder line. A cell +can be subdivided into multiple rectangular cells but cannot nest or +overlap. + + Both the table frame and cell border lines must consist of one of +three special characters. The variables that hold these characters +are described below: + +@table @code +@vindex table-cell-vertical-char +@item table-cell-vertical-char +Holds the character used for vertical lines. The default value is +@samp{|}. + +@vindex table-cell-horizontal-char +@item table-cell-horizontal-char +Holds the character used for horizontal lines. The default value is +@samp{-}. + +@vindex table-cell-intersection-char +@item table-cell-intersection-char +Holds the character used at where horizontal line and vertical line +meet. The default value is @samp{+}. +@end table + +@noindent +Based on this definition, the following five tables are examples of invalid +tables: + +@example + +-----+ +-----+ +--+ +-++--+ ++ + | | | | | | | || | ++ + | +-+ | | | | | | || | + | | | | +--+ | +--+--+ +-++--+ + | +-+ | | | | | | | +-++--+ + | | | | | | | | | || | + +-----+ +--+--+ +--+--+ +-++--+ + a b c d e +@end example + +From left to right: + +@enumerate a +@item +Nested cells are not allowed. +@item +Overlapped cells or non-rectangular cells are not allowed. +@item +The border must be rectangular. +@item +Cells must have a minimum width/height of one character. +@item +Same as d. +@end enumerate + +@node Table Creation +@subsection How to Create a Table? +@cindex create a text-based table +@cindex table creation + +@findex table-insert + The command to create a table is @code{table-insert}. When called +interactively, it asks for the number of columns, number of rows, cell +width and cell height. The number of columns is a number of cells +within the table's width. The number of rows is the number of cells +within the table's height. The cell width is a number of characters +that fit within a cell width. The cell height is a number of lines +within cell height. While the number of columns and number of rows +must be an integer number, the cell width and the cell height can be +either an integer number (when the value is constant across the table) +or a series of integer numbers, separated by spaces or commas, where +each number corresponds to each cell width within a row from left to +right or each cell height within a column from top to bottom. + +@node Table Recognition +@subsection Table Recognition +@cindex table recognition + +@findex table-recognize +@findex table-unrecognize + Table Mode maintains special text properties in the buffer to allow +editing in a convenient fashion. When a buffer with tables is saved +to its file, these text properties are lost, so when you visit this +file again later, Emacs does not see a table, but just formatted text. +To resurrect the table text properties, issue the @kbd{M-x +table-recognize} command. It scans the current buffer, recognizes +valid table cells, and attaches appropriate text properties to allow +for table editing. The converse command, @code{table-unrecognize}, is +used to remove the special text properties and revert the buffer back +to plain text. + + An optional numeric prefix argument can precede the +@code{table-recognize} command. If the argument is negative, tables +in the buffer become inactive. This is equivalent to invoking +@code{table-unrecognize}. + + Similar functions exist to enable or disable tables within a region, +enable or disable individual tables, and enable/disable individual +cells. These commands are: + +@table @kbd +@findex table-recognize-region +@item M-x table-recognize-region +Recognize tables within the current region and activate them. +@findex table-unrecognize-region +@item M-x table-unrecognize-region +Deactivate tables within the current region. +@findex table-recognize-table +@item M-x table-recognize-table +Recognize the table under point and activate it. +@findex table-unrecognize-table +@item M-x table-unrecognize-table +Deactivate the table under point. +@findex table-recognize-cell +@item M-x table-recognize-cell +Recognize the cell under point and activate it. +@findex table-unrecognize-cell +@item M-x table-unrecognize-cell +Deactivate the cell under point. +@end table + + For another way of converting text into tables, see @ref{Table +Conversion}. + +@node Cell Commands +@subsection Commands for Table Cells + +@findex table-forward-cell +@findex table-backward-cell + The commands @code{table-forward-cell} and +@code{table-backward-cell} move point from the current cell to an +adjacent cell forward and backward respectively. The order of the +cell is wrapped. When point is positioned in the last cell of a +table, typing @kbd{M-x table-forward-cell} moves point to the first +cell in the table. Likewise @kbd{M-x table-backward-cell} from the +first cell in a table moves point to the last cell in the table. + +@findex table-span-cell + The command @code{table-span-cell} spans the current cell into one +of the four directions---right, left, above or below---and merges the +current cell with the adjacent cell. It does not allow directions to +which spanning does not produce a legitimate cell. + +@findex table-split-cell +@cindex text-based tables, split a cell +@cindex split table cell + The command @code{table-split-cell} splits the current cell +vertically or horizontally. This command is a wrapper to the +direction specific commands @code{table-split-cell-vertically} and +@code{table-split-cell-horizontally}. + +@findex table-split-cell-vertically + The command @code{table-split-cell-vertically} splits the current +cell vertically and creates a pair of cells above and below where +point is located. The content in the original cell is split as well. + +@findex table-split-cell-horizontally + The command @code{table-split-cell-horizontally} splits the current +cell horizontally and creates a pair of cells right and left of where +point is located. If the subject cell to split is not empty the user +is asked how to handle the cell contents. The three options are: +@code{split}, @code{left}, or @code{right}. @code{split} splits the +contents at point literally while the @code{left} and @code{right} +options move the entire contents into the left or right cell +respectively. + +@cindex enlarge a table cell +@cindex shrink a table cell + The next four commands enlarge or shrink a cell. These commands +accept numeric arguments (@pxref{Arguments}) to specify how many +columns or rows to enlarge or shrink a particular table. + +@table @kbd +@findex table-heighten-cell +@item M-x table-heighten-cell +Enlarge the current cell vertically. +@findex table-shorten-cell +@item M-x table-shorten-cell +Shrink the current cell vertically. +@findex table-widen-cell +@item M-x table-widen-cell +Enlarge the current cell horizontally. +@findex table-narrow-cell +@item M-x table-narrow-cell +Shrink the current cell horizontally. +@end table + +@node Cell Justification +@subsection Cell Justification +@cindex cell text justification + + You can specify text justification for each cell. The justification +is remembered independently for each cell and the subsequent editing +of cell contents is subject to the specified justification. + +@findex table-justify + The command @code{table-justify} requests the user to specify what +to justify: a cell,a column, or a row. If you select cell +justification, this command sets the justification only to the current +cell. Selecting column or row justification set the justification to +all the cells within a column or row respectively. The command then +requests the user to enter which justification to apply: @code{left}, +@code{center}, @code{right}, @code{top}, @code{middle}, @code{bottom}, +or @code{none}. The options @code{left}, @code{center}, and +@code{right} specify horizontal justification while the options +@code{top}, @code{middle}, @code{bottom}, and @code{none} specify +vertical justification. The vertical justification @code{none} +effectively removes vertical justification while horizontal +justification must be one of @code{left}, @code{center}, or +@code{right}. Horizontal justification and vertical justification are +specified independently. + +@vindex table-detect-cell-alignment + Justification information is stored in the buffer as a part of text +property. Therefore, this information is ephemeral and does not +survive through the loss of the buffer (closing the buffer and +revisiting the buffer erase any previous text properties). To +countermand for this, the command @code{table-recognize} and other +recognition commands (@pxref{Table Recognition}) are equipped with a +convenience feature (turned on by default). During table recognition, +the contents of a cell are examined to determine which justification +was originally applied to the cell and then applies this justification +to the the cell. This is a speculative algorithm and is therefore not +perfect, however, the justification is deduced correctly most of the +time. If you desire to disable this feature, customize the variable +@code{table-detect-cell-alignment} to set it to @code{nil}. + +@node Row Commands +@subsection Commands for Table Rows +@cindex table row commands + +@cindex insert row in table +@findex table-insert-row + The command @code{table-insert-row} inserts a row of cells before +the current row in a table. The current row where point is located is +pushed down after the newly inserted row. A numeric prefix argument +specifies the number of rows to insert. Note that in order to insert +rows @emph{after} the last row at the bottom of a table, you must +place point below the table, i.e.@: outside the table, prior to +invoking this command. + +@cindex delete row in table +@findex table-delete-row + The command @code{table-delete-row} deletes a row of cells at point. +A numeric prefix argument specifies the number of rows to delete. + +@node Column Commands +@subsection Commands for Table Columns +@cindex table column commands + +@cindex insert column in table +@findex table-insert-column + The command @code{table-insert-column} inserts a column of cells to +the left of the current row in a table. The current column where +point is located at is pushed right of the newly inserted column. To +insert a column to the right side of the right most column, place +point to the right of the rightmost column, which is outside of the +table, prior to invoking this command. A numeric prefix argument +specifies the number of columns to insert. + +@cindex delete column in table + A command @code{table-delete-column} deletes a column of cells at +point. A numeric prefix argument specifies the number of columns to +delete. + +@node Fixed Width Mode +@subsection Fix Width of Cells +@cindex fix width of table cells + +@findex table-fixed-width-mode + The command @code{table-fixed-width-mode} toggles fixed width mode +on and off. When the fixed width mode is turned on, editing inside a +cell never changes the cell width; when it is off, the cell width +expands automatically in order to prevent a word from being folded +into multiple lines. By default, the fixed width mode is turned off. + + +@node Table Conversion +@subsection Conversion Between Plain Text and Tables +@cindex text to table +@cindex table to text + +@findex table-capture + The command @code{table-capture} captures plain text in a region and +turns it into a table. Unlike @code{table-recognize} (@pxref{Table +Recognition}), the original text does not have a table appearance but +may hold a logical table structure. For example, some elements +separated by known patterns form a two dimensional structure which can +be turned into a table. Look at the numbers below. The numbers are +horizontally separated by a comma and vertically separated by a +newline character. + +@example +1, 2, 3, 4 +5, 6, 7, 8 +, 9, 10 +@end example + +@noindent +When you invoke @kbd{M-x table-capture} on the above three-line +region, the region can be turned into the next table: + +@example ++-----+-----+-----+-----+ +|1 |2 |3 |4 | ++-----+-----+-----+-----+ +|5 |6 |7 |8 | ++-----+-----+-----+-----+ +| |9 |10 | | ++-----+-----+-----+-----+ +@end example + +@noindent +where @samp{,} is used for a column delimiter regexp, a newline is +used for a row delimiter regexp, cells are left justified, and minimum +cell width is 5. + +@findex table-release + The command @code{table-release} does the opposite of +@code{table-capture}. It releases a table by removing the table frame +and cell borders. This leaves the table contents as plain text. One +of the useful applications of @code{table-capture} and +@code{table-release} is to edit a text in layout. Look at the +following three paragraphs (the latter two are indented with header +lines): + +@example +@samp{table-capture} is a powerful command however mastering its power +requires some practice. Here is a list of items what it can do. + +Parse Cell Items By using column delimiter regular + expression and raw delimiter regular + expression, it parses the specified text + area and extracts cell items from + non-table text and then forms a table out + of them. + +Capture Text Area When no delimiters are specified it + creates a single cell table. The text in + the specified region is placed in that + cell. +@end example + +@noindent +Applying @code{table-capture} to a region containing the above three +paragraphs, with empty strings for column delimiter regexp and row +delimiter regexp, creates a table with a single cell like the +following one. + +@c The first line's right-hand frame in the following two examples +@c sticks out to accommodate for the removal of @samp in the +@c produced output!! +@example ++-----------------------------------------------------------------+ +|@samp{table-capture} is a powerful command however mastering its | +|power requires some practice. Here is a list of items what it | +|can do. | +| | +|Parse Cell Items By using column delimiter regular | +| expression and raw delimiter regular | +| expression, it parses the specified text | +| area and extracts cell items from | +| non-table text and then forms a table out | +| of them. | +| | +|Capture Text Area When no delimiters are specified it | +| creates a single cell table. The text in | +| the specified region is placed in that | +| cell. | ++-----------------------------------------------------------------+ +@end example + +@noindent +By splitting the cell appropriately we now have a table consisting of +paragraphs occupying its own cell. Each cell can now be edited +independently without affecting the layout of other cells. + +@example ++-----------------------------------------------------------------+ +|@samp{table-capture} is a powerful command however mastering its | +|power requires some practice. Here is a list of items what it | +|can do. | ++---------------------+-------------------------------------------+ +|Parse Cell Items |By using column delimiter regular | +| |expression and raw delimiter regular | +| |expression, it parses the specified text | +| |area and extracts cell items from | +| |non-table text and then forms a table out | +| |of them. | ++---------------------+-------------------------------------------+ +|Capture Text Area |When no delimiters are specified it | +| |creates a single cell table. The text in | +| |the specified region is placed in that | +| |cell. | ++---------------------+-------------------------------------------+ +@end example + +@noindent +By applying @code{table-release}, which does the opposite process, the +contents become once again plain text. @code{table-release} works as +a companion command to @code{table-capture}. + +@node Measuring Tables +@subsection Analyzing Table Dimensions +@cindex table dimensions + +@findex table-query-dimension + The command @code{table-query-dimension} analyzes a table structure +and reports information regarding its dimensions. In case of the +above example table, the @code{table-query-dimension} command displays +in echo area: + +@smallexample +Cell: (21w, 6h), Table: (67w, 16h), Dim: (2c, 3r), Total Cells: 5 +@end smallexample + +@noindent +This indicates that the current cell is 21 character wide and 6 lines +high, the entire table is 67 characters wide and 16 lines high. The +table has 2 columns and 3 rows. It has a total of 5 cells, since the +first row has a spanned cell. + +@node Table Misc +@subsection Table Miscellany + +@cindex insert string into table cells +@findex table-insert-sequence + The command @code{table-insert-sequence} inserts a string into each +cell. Each string is a part of a sequence i.e.@: a series of +increasing integer numbers. + +@cindex table in language format +@cindex table for HTML and LaTeX +@findex table-generate-source +The command @code{table-generate-source} generates a table formatted +for a specific markup language. It asks for a language (which must be +one of @code{html}, @code{latex}, or @code{cals}), a destination +buffer where to put the result, and the table caption (a string), and +then inserts the generated table in the proper syntax into the +destination buffer. The default destination buffer is +@code{table.@var{lang}}, where @var{lang} is the language you +specified. + @ignore arch-tag: 8db54ed8-2036-49ca-b0df-23811d03dc70 @end ignore
--- a/src/ChangeLog Tue Oct 19 17:00:02 2004 +0000 +++ b/src/ChangeLog Mon Oct 25 18:17:28 2004 +0000 @@ -1,3 +1,103 @@ +2004-10-25 Kenichi Handa <handa@m17n.org> + + * fontset.c (fontset_pattern_regexp): Optimize for the case that + PATTERN is full XLFD. + +2004-10-24 Kenichi Handa <handa@m17n.org> + + * regex.h (enum reg_errcode_t): New value REG_ERANGEX. + + * regex.c (re_error_msgid): Add an entry for REG_ERANGEX. + (regex_compile): Return REG_ERANGEX if appropriate. + +2004-10-22 Kenichi Handa <handa@m17n.org> + + * editfns.c (Ftranslate_region_internal): New function. + (syms_of_editfns): Defsubr it. + +2004-10-22 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xfns.c (xic_create_xfontset): Initialize missing_list to NULL. + +2004-10-21 K,Aa(Broly L$,1 q(Brentey <lorentey@elte.hu> + + * xterm.h (x_output): New member `xic_base_fontname'. + (FRAME_XIC_BASE_FONTNAME): New macro. + (xic_free_xfontset): Declare. + + * xfns.c (xic_create_xfontset): Share fontsets between frames + based on base_fontname. + (xic_free_xfontset): New function. + (free_frame_xic): Use it. + (xic_set_xfontset): Ditto. + + * xterm.c (xim_destroy_callback): Ditto. + + +2004-10-20 B. Anyos <banyos@freemail.hu> (tiny change) + + * w32term.c (x_draw_glyph_string): Use overline_color for overlines. + +2004-10-20 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * xterm.h (XSync): If USE_GTK, define XSync as process_all and then + XSync. + + * emacs.c (my_heap_start, heap_bss_diff, MAX_HEAP_BSS_DIFF): + New variables and constant. + (main): Calculate heap_bss_diff. If we are dumping and the + heap_bss_diff is greater than MAX_HEAP_BSS_DIFF, set PER_LINUX32 + and exec ourself again. + (Fdump_emacs): If heap_bss_diff is greater than MAX_HEAP_BSS_DIFF + print a warning. + + * lastfile.c: Make my_endbss and my_endbss_static available on all + platforms. + + * Makefile.in (RUN_TEMACS): Remove @SETARCH@. + * config.in (HAVE_PERSONALITY_LINUX32): Regenerate. + +2004-10-19 Luc Teirlinck <teirllm@auburn.edu> + + * data.c (Flocal_variable_if_set_p): Doc fix. + +2004-10-19 Jason Rumney <jasonr@gnu.org> + + * w32.c (init_environment): Set emacs_dir correctly when running + emacs from the build directory. + +2004-10-19 Richard M. Stallman <rms@gnu.org> + + * editfns.c (Fdelete_and_extract_region): + If region is empty, return null string. + +2004-10-19 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> + + * gtkutil.h (xg_update_scrollbar_pos): Remove arguments real_left + and canon_width. + (xg_frame_cleared): Removed. + + * gtkutil.c (xg_frame_cleared, xg_fixed_handle_expose, + xg_find_top_left_in_fixed): Removed. + (xg_create_scroll_bar): Put an event box widget between + the scroll bar widget and the edit widget. + (xg_show_scroll_bar): Show the parent widget (the event box). + (xg_remove_scroll_bar): Destroy parent (the event box) also. + (xg_update_scrollbar_pos): Remove arguments real_left and canon_width. + Move the parent (the event box) widget inside the fixed widget. + Move window clear to xterm.c. + + * gtkutil.h (xg_frame_cleared): Removed. + + * xterm.c (x_clear_frame): Remove call to xg_frame_cleared + (x_scroll_bar_create, XTset_vertical_scroll_bar): Remove + arguments left and width to xg_update_scrollbar_pos. + (XTset_vertical_scroll_bar): Do x_clear_area for USE_GTK also. + +2004-10-19 Kenichi Handa <handa@m17n.org> + + * xdisp.c (display_mode_element): Fix display of wide chars. + 2004-10-18 Jan Dj,Ad(Brv <jan.h.d@swipnet.se> * gtkutil.c (xg_update_scrollbar_pos): Change XClearWindow to @@ -8,8 +108,7 @@ * fontset.c (fs_load_font): Use fast_string_match_ignore_case for comparing font names. - (fs_query_fontset): Use fast_string_match for comparing fontset - names. + (fs_query_fontset): Use fast_string_match for comparing fontset names. (list_fontsets): Likewise. * search.c (fast_string_match_ignore_case): New function.
--- a/src/Makefile.in Tue Oct 19 17:00:02 2004 +0000 +++ b/src/Makefile.in Mon Oct 25 18:17:28 2004 +0000 @@ -909,12 +909,7 @@ #define OBJECTS_MACHINE #endif -#ifdef HAVE_RANDOM_HEAPSTART -#undef i386 -RUN_TEMACS = @SETARCH@ i386 ./temacs -#else RUN_TEMACS = ./temacs -#endif all: emacs${EXEEXT} OTHER_FILES
--- a/src/config.in Tue Oct 19 17:00:02 2004 +0000 +++ b/src/config.in Mon Oct 25 18:17:28 2004 +0000 @@ -414,6 +414,9 @@ /* Define to 1 if you have the <nlist.h> header file. */ #undef HAVE_NLIST_H +/* Define to 1 if personality LINUX32 can be set. */ +#undef HAVE_PERSONALITY_LINUX32 + /* Define to 1 if you have the png library (-lpng). */ #undef HAVE_PNG @@ -432,9 +435,6 @@ /* Define to 1 if you have the `random' function. */ #undef HAVE_RANDOM -/* Define to 1 if this OS randomizes the start address of the heap. */ -#undef HAVE_RANDOM_HEAPSTART - /* Define to 1 if you have the `recvfrom' function. */ #undef HAVE_RECVFROM @@ -757,9 +757,9 @@ /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at run-time. - STACK_DIRECTION > 0 => grows toward higher addresses - STACK_DIRECTION < 0 => grows toward lower addresses - STACK_DIRECTION = 0 => direction of growth unknown */ + STACK_DIRECTION > 0 => grows toward higher addresses + STACK_DIRECTION < 0 => grows toward lower addresses + STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION /* Define to 1 if you have the ANSI C header files. */
--- a/src/data.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/data.c Mon Oct 25 18:17:28 2004 +0000 @@ -1794,7 +1794,11 @@ DEFUN ("local-variable-if-set-p", Flocal_variable_if_set_p, Slocal_variable_if_set_p, 1, 2, 0, - doc: /* Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. + doc: /* Non-nil if VARIABLE will be local in buffer BUFFER when set there. +More precisely, this means that setting the variable \(with `set' or`setq'), +while it does not have a `let'-style binding that was made in BUFFER, +will produce a buffer local binding. See Info node +`(elisp)Creating Buffer-Local'. BUFFER defaults to the current buffer. */) (variable, buffer) register Lisp_Object variable, buffer;
--- a/src/editfns.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/editfns.c Mon Oct 25 18:17:28 2004 +0000 @@ -2736,8 +2736,10 @@ return Qnil; } -DEFUN ("translate-region", Ftranslate_region, Stranslate_region, 3, 3, 0, - doc: /* From START to END, translate characters according to TABLE. +DEFUN ("translate-region-internal", Ftranslate_region_internal, + Stranslate_region_internal, 3, 3, 0, + doc: /* Internal use only. +From START to END, translate characters according to TABLE. TABLE is a string; the Nth character in it is the mapping for the character with code N. It returns the number of characters changed. */) @@ -2750,31 +2752,37 @@ register int nc; /* New character. */ int cnt; /* Number of changes made. */ int size; /* Size of translate table. */ - int pos, pos_byte; + int pos, pos_byte, end_pos; int multibyte = !NILP (current_buffer->enable_multibyte_characters); int string_multibyte; validate_region (&start, &end); - CHECK_STRING (table); - - if (multibyte != (SCHARS (table) < SBYTES (table))) - table = (multibyte - ? string_make_multibyte (table) - : string_make_unibyte (table)); - string_multibyte = SCHARS (table) < SBYTES (table); - - size = SCHARS (table); - tt = SDATA (table); + if (CHAR_TABLE_P (table)) + { + size = MAX_CHAR; + tt = NULL; + } + else + { + CHECK_STRING (table); + + if (! multibyte && (SCHARS (table) < SBYTES (table))) + table = string_make_unibyte (table); + string_multibyte = SCHARS (table) < SBYTES (table); + size = SCHARS (table); + tt = SDATA (table); + } pos = XINT (start); pos_byte = CHAR_TO_BYTE (pos); + end_pos = XINT (end); modify_region (current_buffer, pos, XINT (end)); cnt = 0; - for (; pos < XINT (end); ) + for (; pos < end_pos; ) { register unsigned char *p = BYTE_POS_ADDR (pos_byte); - unsigned char *str; + unsigned char *str, buf[MAX_MULTIBYTE_LENGTH]; int len, str_len; int oc; @@ -2784,16 +2792,45 @@ oc = *p, len = 1; if (oc < size) { - if (string_multibyte) + if (tt) { - str = tt + string_char_to_byte (table, oc); - nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, str_len); + if (string_multibyte) + { + str = tt + string_char_to_byte (table, oc); + nc = STRING_CHAR_AND_LENGTH (str, MAX_MULTIBYTE_LENGTH, + str_len); + } + else + { + nc = tt[oc]; + if (! ASCII_BYTE_P (nc) && multibyte) + { + str_len = CHAR_STRING (nc, buf); + str = buf; + } + else + { + str_len = 1; + str = tt + oc; + } + } } else { - str = tt + oc; - nc = tt[oc], str_len = 1; + Lisp_Object val; + int c; + + nc = oc; + val = CHAR_TABLE_REF (table, oc); + if (INTEGERP (val) + && (c = XINT (val), CHAR_VALID_P (c, 0))) + { + nc = c; + str_len = CHAR_STRING (nc, buf); + str = buf; + } } + if (nc != oc) { if (len != str_len) @@ -2844,6 +2881,8 @@ Lisp_Object start, end; { validate_region (&start, &end); + if (XINT (start) == XINT (end)) + return build_string (""); return del_range_1 (XINT (start), XINT (end), 1, 1); } @@ -4288,7 +4327,7 @@ defsubr (&Sinsert_buffer_substring); defsubr (&Scompare_buffer_substrings); defsubr (&Ssubst_char_in_region); - defsubr (&Stranslate_region); + defsubr (&Stranslate_region_internal); defsubr (&Sdelete_region); defsubr (&Sdelete_and_extract_region); defsubr (&Swiden);
--- a/src/emacs.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/emacs.c Mon Oct 25 18:17:28 2004 +0000 @@ -68,6 +68,10 @@ #include <sys/resource.h> #endif +#ifdef HAVE_PERSONALITY_LINUX32 +#include <sys/personality.h> +#endif + #ifndef O_RDWR #define O_RDWR 2 #endif @@ -193,6 +197,17 @@ Tells GC how to save a copy of the stack. */ char *stack_bottom; +/* The address where the heap starts (from the first sbrk (0) call). */ +static void *my_heap_start; + +/* The gap between BSS end and heap start as far as we can tell. */ +static unsigned long heap_bss_diff; + +/* If the gap between BSS end and heap start is larger than this we try to + work around it, and if that fails, output a warning in dump-emacs. */ +#define MAX_HEAP_BSS_DIFF (1024*1024) + + #ifdef HAVE_WINDOW_SYSTEM extern Lisp_Object Vinitial_window_system; #endif /* HAVE_WINDOW_SYSTEM */ @@ -734,7 +749,11 @@ free (malloc_state_ptr); } else - malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL; + { + if (my_heap_start == 0) + my_heap_start = sbrk (0); + malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL; + } } void (*__malloc_initialize_hook) () = malloc_initialize_hook; @@ -810,6 +829,17 @@ stack_base = &dummy; #endif + if (!initialized) + { + extern char my_endbss[]; + extern char *my_endbss_static; + + if (my_heap_start == 0) + my_heap_start = sbrk (0); + + heap_bss_diff = (char *)my_heap_start - max (my_endbss, my_endbss_static); + } + #ifdef LINUX_SBRK_BUG __sbrk (1); #endif @@ -853,6 +883,28 @@ } } +#ifdef HAVE_PERSONALITY_LINUX32 + /* See if there is a gap between the end of BSS and the heap. + In that case, set personality and exec ourself again. */ + if (!initialized + && (strcmp (argv[argc-1], "dump") == 0 + || strcmp (argv[argc-1], "bootstrap") == 0) + && heap_bss_diff > MAX_HEAP_BSS_DIFF) + { + if (! getenv ("EMACS_HEAP_EXEC")) + { + /* Set this so we only do this once. */ + putenv("EMACS_HEAP_EXEC=true"); + personality (PER_LINUX32); + execvp (argv[0], argv); + + /* If the exec fails, try to dump anyway. */ + perror ("execvp"); + } + } +#endif /* HAVE_PERSONALITY_LINUX32 */ + + /* Map in shared memory, if we are using that. */ #ifdef HAVE_SHM if (argmatch (argv, argc, "-nl", "--no-shared-memory", 6, NULL, &skip_args)) @@ -2129,6 +2181,17 @@ if (! noninteractive) error ("Dumping Emacs works only in batch mode"); + if (heap_bss_diff > MAX_HEAP_BSS_DIFF) + { + fprintf (stderr, "**************************************************\n"); + fprintf (stderr, "Warning: Your system has a gap between BSS and the\n"); + fprintf (stderr, "heap. This usually means that exec-shield or\n"); + fprintf (stderr, "something similar is in effect. The dump may fail\n"); + fprintf (stderr, "because of this. See the section about exec-shield\n"); + fprintf (stderr, "in etc/PROBLEMS for more information.\n"); + fprintf (stderr, "**************************************************\n"); + } + /* Bind `command-line-processed' to nil before dumping, so that the dumped Emacs will process its command line and set up to work with X windows if appropriate. */
--- a/src/fontset.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/fontset.c Mon Oct 25 18:17:28 2004 +0000 @@ -790,16 +790,34 @@ || strcmp (SDATA (pattern), CACHED_FONTSET_NAME)) { /* We must at first update the cached data. */ - char *regex = (char *) alloca (SCHARS (pattern) * 2 + 3); - char *p0, *p1 = regex; + char *regex, *p0, *p1; + int ndashes = 0, nstars = 0; + + for (p0 = SDATA (pattern); *p0; p0++) + { + if (*p0 == '-') + ndashes++; + else if (*p0 == '*') + nstars++; + } - /* Convert "*" to ".*", "?" to ".". */ + /* If PATTERN is not full XLFD we conert "*" to ".*". Otherwise + we convert "*" to "[^-]*" which is much faster in regular + expression matching. */ + if (ndashes < 14) + p1 = regex = (char *) alloca (SBYTES (pattern) + 2 * nstars + 1); + else + p1 = regex = (char *) alloca (SBYTES (pattern) + 5 * nstars + 1); + *p1++ = '^'; for (p0 = (char *) SDATA (pattern); *p0; p0++) { if (*p0 == '*') { - *p1++ = '.'; + if (ndashes < 14) + *p1++ = '.'; + else + *p1++ = '[', *p1++ = '^', *p1++ = '-', *p1++ = ']'; *p1++ = '*'; } else if (*p0 == '?')
--- a/src/gtkutil.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/gtkutil.c Mon Oct 25 18:17:28 2004 +0000 @@ -550,24 +550,6 @@ gdk_window_process_all_updates (); } -/* This gets called after the frame F has been cleared. Since that is - done with X calls, we need to redraw GTK widget (scroll bars). */ -void -xg_frame_cleared (f) - FRAME_PTR f; -{ - GtkWidget *w = f->output_data.x->widget; - - if (w) - { - gtk_container_set_reallocate_redraws (GTK_CONTAINER (w), TRUE); - gtk_container_foreach (GTK_CONTAINER (w), - (GtkCallback) gtk_widget_queue_draw, - 0); - gdk_window_process_all_updates (); - } -} - /* Function to handle resize of our widgets. Since Emacs has some layouts that does not fit well with GTK standard containers, we do most layout manually. @@ -585,8 +567,10 @@ int columns = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, pixelwidth); if (FRAME_GTK_WIDGET (f) - && (columns != FRAME_COLS (f) || rows != FRAME_LINES (f) - || pixelwidth != FRAME_PIXEL_WIDTH (f) || pixelheight != FRAME_PIXEL_HEIGHT (f))) + && (columns != FRAME_COLS (f) + || rows != FRAME_LINES (f) + || pixelwidth != FRAME_PIXEL_WIDTH (f) + || pixelheight != FRAME_PIXEL_HEIGHT (f))) { struct x_output *x = f->output_data.x; GtkAllocation all; @@ -681,54 +665,6 @@ gdk_colormap_query_color (map, pixel, c); } -/* Turning off double buffering for our GtkFixed widget has the side - effect of turning it off also for its children (scroll bars). - But we want those to be double buffered to not flicker so handle - expose manually here. - WIDGET is the GtkFixed widget that gets exposed. - EVENT is the expose event. - USER_DATA is unused. - - Return TRUE to tell GTK that this expose event has been fully handeled - and that GTK shall do nothing more with it. */ -static gboolean -xg_fixed_handle_expose (GtkWidget *widget, - GdkEventExpose *event, - gpointer user_data) -{ - GList *iter; - - for (iter = GTK_FIXED (widget)->children; iter; iter = g_list_next (iter)) - { - GtkFixedChild *child_data = (GtkFixedChild *) iter->data; - GtkWidget *child = child_data->widget; - GdkWindow *window = child->window; - GdkRegion *region = gtk_widget_region_intersect (child, event->region); - - if (! gdk_region_empty (region)) - { - GdkEvent child_event; - child_event.expose = *event; - child_event.expose.region = region; - - /* Turn on double buffering, i.e. draw to an off screen area. */ - gdk_window_begin_paint_region (window, region); - - /* Tell child to redraw itself. */ - gdk_region_get_clipbox (region, &child_event.expose.area); - gtk_widget_send_expose (child, &child_event); - gdk_window_process_updates (window, TRUE); - - /* Copy off screen area to the window. */ - gdk_window_end_paint (window); - } - - gdk_region_destroy (region); - } - - return TRUE; -} - /* Create and set up the GTK widgets for frame F. Return 0 if creation failed, non-zero otherwise. */ int @@ -804,12 +740,6 @@ a lot, so we turn off double buffering. */ gtk_widget_set_double_buffered (wfixed, FALSE); - /* Turning off double buffering above has the side effect of turning - it off also for its children (scroll bars). But we want those - to be double buffered to not flicker so handle expose manually. */ - g_signal_connect (G_OBJECT (wfixed), "expose-event", - G_CALLBACK (xg_fixed_handle_expose), 0); - /* GTK documents says use gtk_window_set_resizable. But then a user can't shrink the window from its starting size. */ gtk_window_set_policy (GTK_WINDOW (wtop), TRUE, TRUE, TRUE); @@ -2770,6 +2700,7 @@ char *scroll_bar_name; { GtkWidget *wscroll; + GtkWidget *webox; GtkObject *vadj; int scroll_id; @@ -2779,6 +2710,7 @@ 0.1, 0.1, 0.1); wscroll = gtk_vscrollbar_new (GTK_ADJUSTMENT (vadj)); + webox = gtk_event_box_new (); gtk_widget_set_name (wscroll, scroll_bar_name); gtk_range_set_update_policy (GTK_RANGE (wscroll), GTK_UPDATE_CONTINUOUS); @@ -2804,11 +2736,18 @@ G_CALLBACK (scroll_bar_button_cb), (gpointer) bar); - gtk_fixed_put (GTK_FIXED (f->output_data.x->edit_widget), - wscroll, -1, -1); + /* The scroll bar widget does not draw on a window of its own. Instead + it draws on the parent window, in this case the edit widget. So + whenever the edit widget is cleared, the scroll bar needs to redraw + also, which causes flicker. Put an event box between the edit widget + and the scroll bar, so the scroll bar instead draws itself on the + event box window. */ + gtk_fixed_put (GTK_FIXED (f->output_data.x->edit_widget), webox, -1, -1); + gtk_container_add (GTK_CONTAINER (webox), wscroll); + /* Set the cursor to an arrow. */ - xg_set_cursor (wscroll, FRAME_X_DISPLAY_INFO (f)->xg_cursor); + xg_set_cursor (webox, FRAME_X_DISPLAY_INFO (f)->xg_cursor); SET_SCROLL_BAR_X_WINDOW (bar, scroll_id); } @@ -2820,7 +2759,7 @@ { GtkWidget *w = xg_get_widget_from_map (scrollbar_id); if (w) - gtk_widget_show (w); + gtk_widget_show_all (gtk_widget_get_parent (w)); } /* Remove the scroll bar represented by SCROLLBAR_ID from the frame F. */ @@ -2832,42 +2771,19 @@ GtkWidget *w = xg_get_widget_from_map (scrollbar_id); if (w) { + GtkWidget *wparent = gtk_widget_get_parent (w); gtk_widget_destroy (w); + gtk_widget_destroy (wparent); SET_FRAME_GARBAGED (f); } } -/* Find left/top for widget W in GtkFixed widget WFIXED. */ -static void -xg_find_top_left_in_fixed (w, wfixed, left, top) - GtkWidget *w, *wfixed; - int *left, *top; -{ - GList *iter; - - for (iter = GTK_FIXED (wfixed)->children; iter; iter = g_list_next (iter)) - { - GtkFixedChild *child = (GtkFixedChild *) iter->data; - - if (child->widget == w) - { - *left = child->x; - *top = child->y; - return; - } - } - - /* Shall never end up here. */ - abort (); -} - /* Update the position of the vertical scroll bar represented by SCROLLBAR_ID in frame F. TOP/LEFT are the new pixel positions where the bar shall appear. WIDTH, HEIGHT is the size in pixels the bar shall have. */ void -xg_update_scrollbar_pos (f, scrollbar_id, top, left, width, height, - real_left, canon_width) +xg_update_scrollbar_pos (f, scrollbar_id, top, left, width, height) FRAME_PTR f; int scrollbar_id; int top; @@ -2881,44 +2797,12 @@ if (wscroll) { GtkWidget *wfixed = f->output_data.x->edit_widget; - - gtk_container_set_reallocate_redraws (GTK_CONTAINER (wfixed), TRUE); + GtkWidget *wparent = gtk_widget_get_parent (wscroll); /* Move and resize to new values. */ - gtk_fixed_move (GTK_FIXED (wfixed), wscroll, left, top); gtk_widget_set_size_request (wscroll, width, height); - - /* Scroll bars in GTK has a fixed width, so if we say width 16, it - will only be its fixed width (14 is default) anyway, the rest is - blank. We are drawing the mode line across scroll bars when - the frame is split: - |bar| |fringe| - ---------------- - mode line - ---------------- - |bar| |fringe| - - When we "unsplit" the frame: - - |bar| |fringe| - -| |-| | - m¦ |i| | - -| |-| | - | | | | - - - the remains of the mode line can be seen in these blank spaces. - So we must clear them explicitly. - GTK scroll bars should do that, but they don't. - Also, the canonical width may be wider than the width for the - scroll bar so that there is some space (typically 1 pixel) between - the scroll bar and the edge of the window and between the scroll - bar and the fringe. */ - gdk_window_clear (wscroll->window); - - /* Must force out update so changed scroll bars gets redrawn. */ - gdk_window_process_all_updates (); - + gtk_fixed_move (GTK_FIXED (wfixed), wparent, left, top); + SET_FRAME_GARBAGED (f); cancel_mouse_face (f); }
--- a/src/gtkutil.h Tue Oct 19 17:00:02 2004 +0000 +++ b/src/gtkutil.h Mon Oct 25 18:17:28 2004 +0000 @@ -168,9 +168,7 @@ int top, int left, int width, - int height, - int real_left, - int canon_width)); + int height)); extern void xg_set_toolkit_scroll_bar_thumb P_ ((struct scroll_bar *bar, int portion, @@ -184,7 +182,6 @@ extern void xg_resize_widgets P_ ((FRAME_PTR f, int pixelwidth, int pixelheight)); -extern void xg_frame_cleared P_ ((FRAME_PTR f)); extern void xg_frame_set_char_size P_ ((FRAME_PTR f, int cols, int rows)); extern GtkWidget * xg_win_to_widget P_ ((Display *dpy, Window wdesc));
--- a/src/lastfile.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/lastfile.c Mon Oct 25 18:17:28 2004 +0000 @@ -40,7 +40,6 @@ char my_edata[] = "End of Emacs initialized data"; -#if defined(WINDOWSNT) || defined(CYGWIN) /* Help unexec locate the end of the .bss area used by Emacs (which isn't always a separate section in NT executables). */ char my_endbss[1]; @@ -50,7 +49,6 @@ of the bss area used by Emacs. */ static char _my_endbss[1]; char * my_endbss_static = _my_endbss; -#endif /* arch-tag: 67e81ab4-e14f-44b2-8875-c0c12252223e (do not change this comment) */
--- a/src/regex.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/regex.c Mon Oct 25 18:17:28 2004 +0000 @@ -1283,6 +1283,7 @@ gettext_noop ("Premature end of regular expression"), /* REG_EEND */ gettext_noop ("Regular expression too big"), /* REG_ESIZE */ gettext_noop ("Unmatched ) or \\)"), /* REG_ERPAREN */ + gettext_noop ("Range striding over charsets") /* REG_ERANGEX */ }; /* Avoiding alloca during matching, to placate r_alloc. */ @@ -2871,7 +2872,7 @@ } } else if (!SAME_CHARSET_P (c, c1)) - FREE_STACK_RETURN (REG_ERANGE); + FREE_STACK_RETURN (REG_ERANGEX); } else /* Range from C to C. */
--- a/src/regex.h Tue Oct 19 17:00:02 2004 +0000 +++ b/src/regex.h Mon Oct 25 18:17:28 2004 +0000 @@ -316,7 +316,8 @@ /* Error codes we've added. */ REG_EEND, /* Premature end. */ REG_ESIZE, /* Compiled pattern bigger than 2^16 bytes. */ - REG_ERPAREN /* Unmatched ) or \); not returned from regcomp. */ + REG_ERPAREN, /* Unmatched ) or \); not returned from regcomp. */ + REG_ERANGEX /* Range striding over charsets. */ } reg_errcode_t; /* This data structure represents a compiled pattern. Before calling
--- a/src/w32.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/w32.c Mon Oct 25 18:17:28 2004 +0000 @@ -1005,6 +1005,32 @@ _snprintf (buf, sizeof(buf)-1, "emacs_dir=%s", modname); _putenv (strdup (buf)); } + /* Handle running emacs from the build directory: src/oo-spd/i386/ */ + + /* FIXME: should use substring of get_emacs_configuration (). + But I don't think the Windows build supports alpha, mips etc + anymore, so have taken the easy option for now. */ + else if (p && stricmp (p, "\\i386") == 0) + { + *p = 0; + p = strrchr (modname, '\\'); + if (p != NULL) + { + *p = 0; + p = strrchr (modname, '\\'); + if (p && stricmp (p, "\\src") == 0) + { + char buf[SET_ENV_BUF_SIZE]; + + *p = 0; + for (p = modname; *p; p++) + if (*p == '\\') *p = '/'; + + _snprintf (buf, sizeof(buf)-1, "emacs_dir=%s", modname); + _putenv (strdup (buf)); + } + } + } } for (i = 0; i < (sizeof (env_vars) / sizeof (env_vars[0])); i++)
--- a/src/w32term.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/w32term.c Mon Oct 25 18:17:28 2004 +0000 @@ -2516,7 +2516,7 @@ } else { - w32_fill_area (s->f, s->hdc, s->face->underline_color, s->x, + w32_fill_area (s->f, s->hdc, s->face->overline_color, s->x, s->y + dy, s->width, h); } }
--- a/src/xdisp.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/xdisp.c Mon Oct 25 18:17:28 2004 +0000 @@ -7974,7 +7974,7 @@ /* Copy at most PRECISION chars from STR. */ nbytes = strlen (str); - n+= c_string_width (str, nbytes, precision, &dummy, &nbytes); + n += c_string_width (str, nbytes, precision, &dummy, &nbytes); while (nbytes--) store_frame_title_char (*str++); @@ -15459,14 +15459,15 @@ if (this - 1 != last) { + int nchars, nbytes; + /* Output to end of string or up to '%'. Field width is length of string. Don't output more than PRECISION allows us. */ --this; - prec = chars_in_text (last, this - last); - if (precision > 0 && prec > precision - n) - prec = precision - n; + prec = c_string_width (last, this - last, precision - n, + &nchars, &nbytes); if (frame_title_ptr) n += store_frame_title (last, 0, prec); @@ -15474,9 +15475,12 @@ { int bytepos = last - lisp_string; int charpos = string_byte_to_char (elt, bytepos); + int endpos = (precision <= 0 ? SCHARS (elt) + : charpos + nchars); + n += store_mode_line_string (NULL, Fsubstring (elt, make_number (charpos), - make_number (charpos + prec)), + make_number (endpos)), 0, 0, 0, Qnil); } else
--- a/src/xfns.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/xfns.c Mon Oct 25 18:17:28 2004 +0000 @@ -1951,29 +1951,85 @@ }; -/* Create an X fontset on frame F with base font name - BASE_FONTNAME.. */ +/* Create an X fontset on frame F with base font name BASE_FONTNAME. */ static XFontSet xic_create_xfontset (f, base_fontname) struct frame *f; char *base_fontname; { - XFontSet xfs; - char **missing_list; + XFontSet xfs = NULL; + char **missing_list = NULL; int missing_count; char *def_string; - - xfs = XCreateFontSet (FRAME_X_DISPLAY (f), - base_fontname, &missing_list, - &missing_count, &def_string); - if (missing_list) - XFreeStringList (missing_list); - - /* No need to free def_string. */ + Lisp_Object rest, frame; + + /* See if there is another frame already using same fontset. */ + FOR_EACH_FRAME (rest, frame) + { + struct frame *cf = XFRAME (frame); + if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf) + && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f) + && !strcmp (FRAME_XIC_BASE_FONTNAME (cf), base_fontname)) + { + xfs = FRAME_XIC_FONTSET (cf); + break; + } + } + + if (!xfs) + { + /* New fontset. */ + xfs = XCreateFontSet (FRAME_X_DISPLAY (f), + base_fontname, &missing_list, + &missing_count, &def_string); + if (missing_list) + XFreeStringList (missing_list); + } + + if (FRAME_XIC_BASE_FONTNAME (f)) + xfree (FRAME_XIC_BASE_FONTNAME (f)); + FRAME_XIC_BASE_FONTNAME (f) = xstrdup (base_fontname); + + /* No need to free def_string. */ return xfs; } +/* Free the X fontset of frame F if it is the last frame using it. */ + +void +xic_free_xfontset (f) + struct frame *f; +{ + Lisp_Object rest, frame; + int shared_p = 0; + + if (!FRAME_XIC_FONTSET (f)) + return; + + /* See if there is another frame sharing the same fontset. */ + FOR_EACH_FRAME (rest, frame) + { + struct frame *cf = XFRAME (frame); + if (cf != f && FRAME_LIVE_P (f) && FRAME_X_P (cf) + && FRAME_X_DISPLAY_INFO (cf) == FRAME_X_DISPLAY_INFO (f) + && FRAME_XIC_FONTSET (cf) == FRAME_XIC_FONTSET (f)) + { + shared_p = 1; + break; + } + } + + if (!shared_p) + /* The fontset is not used anymore. It is safe to free it. */ + XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f)); + + if (FRAME_XIC_BASE_FONTNAME (f)) + xfree (FRAME_XIC_BASE_FONTNAME (f)); + FRAME_XIC_BASE_FONTNAME (f) = NULL; + FRAME_XIC_FONTSET (f) = NULL; +} + /* Value is the best input style, given user preferences USER (already checked to be supported by Emacs), and styles supported by the @@ -2124,11 +2180,9 @@ return; XDestroyIC (FRAME_XIC (f)); - if (FRAME_XIC_FONTSET (f)) - XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f)); + xic_free_xfontset (f); FRAME_XIC (f) = NULL; - FRAME_XIC_FONTSET (f) = NULL; } @@ -2207,6 +2261,8 @@ XVaNestedList attr; XFontSet xfs; + xic_free_xfontset (f); + xfs = xic_create_xfontset (f, base_fontname); attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL); @@ -2216,8 +2272,6 @@ XSetICValues (FRAME_XIC (f), XNStatusAttributes, attr, NULL); XFree (attr); - if (FRAME_XIC_FONTSET (f)) - XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f)); FRAME_XIC_FONTSET (f) = xfs; }
--- a/src/xterm.c Tue Oct 19 17:00:02 2004 +0000 +++ b/src/xterm.c Mon Oct 25 18:17:28 2004 +0000 @@ -2819,10 +2819,6 @@ XFlush (FRAME_X_DISPLAY (f)); -#ifdef USE_GTK - xg_frame_cleared (f); -#endif - UNBLOCK_INPUT; } @@ -4865,9 +4861,7 @@ top, left + VERTICAL_SCROLL_BAR_WIDTH_TRIM, width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2, - max (height, 1), - left, - width); + max (height, 1)); xg_show_scroll_bar (SCROLL_BAR_X_WINDOW (bar)); #else /* not USE_GTK */ Widget scroll_bar = SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar); @@ -5111,18 +5105,6 @@ #ifdef USE_TOOLKIT_SCROLL_BARS -#ifdef USE_GTK - if (mask) - xg_update_scrollbar_pos (f, - SCROLL_BAR_X_WINDOW (bar), - top, - sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM, - sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2, - max (height, 1), - left, - width); -#else /* not USE_GTK */ - /* Move/size the scroll bar widget. */ if (mask) { @@ -5131,13 +5113,21 @@ if (width > 0 && height > 0) x_clear_area (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), left, top, width, height, False); +#ifdef USE_GTK + xg_update_scrollbar_pos (f, + SCROLL_BAR_X_WINDOW (bar), + top, + sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM, + sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM *2, + max (height, 1)); +#else /* not USE_GTK */ XtConfigureWidget (SCROLL_BAR_X_WIDGET (FRAME_X_DISPLAY (f), bar), sb_left + VERTICAL_SCROLL_BAR_WIDTH_TRIM, top, sb_width - VERTICAL_SCROLL_BAR_WIDTH_TRIM * 2, max (height, 1), 0); +#endif /* not USE_GTK */ } -#endif /* not USE_GTK */ #else /* not USE_TOOLKIT_SCROLL_BARS */ /* Clear areas not covered by the scroll bar because of @@ -8031,11 +8021,7 @@ if (FRAME_X_P (f) && FRAME_X_DISPLAY_INFO (f) == dpyinfo) { FRAME_XIC (f) = NULL; - if (FRAME_XIC_FONTSET (f)) - { - XFreeFontSet (FRAME_X_DISPLAY (f), FRAME_XIC_FONTSET (f)); - FRAME_XIC_FONTSET (f) = NULL; - } + xic_free_xfontset (f); } }
--- a/src/xterm.h Tue Oct 19 17:00:02 2004 +0000 +++ b/src/xterm.h Mon Oct 25 18:17:28 2004 +0000 @@ -50,7 +50,9 @@ typedef GtkWidget *xt_or_gtk_widget; #define XtParent(x) (gtk_widget_get_parent (x)) #undef XSync -#define XSync(d, b) gdk_window_process_all_updates () +#define XSync(d, b) do { gdk_window_process_all_updates (); \ + XSync (d, b); } while (0) + #endif /* USE_GTK */ @@ -601,6 +603,7 @@ XIC xic; XIMStyle xic_style; XFontSet xic_xfs; + char *xic_base_fontname; #endif /* Relief GCs, colors etc. */ @@ -735,6 +738,7 @@ #define FRAME_X_XIM_STYLES(f) (FRAME_X_DISPLAY_INFO (f)->xim_styles) #define FRAME_XIC_STYLE(f) ((f)->output_data.x->xic_style) #define FRAME_XIC_FONTSET(f) ((f)->output_data.x->xic_xfs) +#define FRAME_XIC_BASE_FONTNAME(f) ((f)->output_data.x->xic_base_fontname) /* Value is the smallest width of any character in any font on frame F. */ @@ -1044,6 +1048,7 @@ extern unsigned char * x_encode_text P_ ((Lisp_Object, Lisp_Object, int, int *, int *)); extern void x_implicitly_set_name P_ ((struct frame *, Lisp_Object, Lisp_Object)); +extern void xic_free_xfontset P_ ((struct frame *)); extern void create_frame_xic P_ ((struct frame *)); extern void destroy_frame_xic P_ ((struct frame *)); extern void xic_set_preeditarea P_ ((struct window *, int, int));