Mercurial > emacs
changeset 90033:f3ec05478165
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-62
Merge from emacs--cvs-trunk--0
Patches applied:
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-616
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-620
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-621
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-622
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-625
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-626
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-627
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-628
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-629
- miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-630
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-631
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-632
Update from CVS
* miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-633
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-51
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-52
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-53
Merge from emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-54
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-55
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-56
Update from CVS: Add lisp/legacy-gnus-agent.el
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-57
- miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-58
Update from CVS
line wrap: on
line diff
--- a/ChangeLog Tue Oct 19 11:11:47 2004 +0000 +++ b/ChangeLog Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/configure Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/configure.in Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/etc/MAILINGLISTS Fri Oct 22 10:13:52 2004 +0000 @@ -1,26 +1,31 @@ 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 * Mailing list archives -The GNU mailing lists are archived at -ftp://ftp-mailing-list-archives.gnu.org/ +The GNU mailing lists are archived at http://lists.gnu.org. -* GNU mailing lists are also distributed as USENET news groups +* Some GNU mailing lists are also distributed as USENET news groups -The mailing lists are gated both ways with the gnu.all newsgroups at -uunet. The one-to-one correspondence is indicated below. If -you don't know if your site is on USENET, ask your system administrator. -If you are a USENET site and don't get the gnu.all newsgroups, please -ask your USENET administrator to get them. If he has your feeds ask -their feeds, you should win. And everyone else wins: newsgroups make -better use of the limited bandwidth of the computer networks and your -home machine than mailing list traffic; and staying off the mailing -lists make better use of the people who maintain the lists and the -machines that the GNU people working with rms use (i.e. we have more -time to produce code!!). Thanx. +Certain GNU mailing lists are gated both ways with the gnu.all +newsgroups at uunet. You can tell which they are, because the names +correspond. For instance, bug-gnu-emacs corresponds to gnu.emacs.bug; +info-gnu-emacs, to gnu.emacs.announce; help-gnu-emacs, to +gnu.emacs.help; gnu-emacs-sources, to gnu.emacs.sources. Replacing +`emacs' with some other program in those four examples shows you +the whole pattern. + +If you don't know if your site is on USENET, ask your system +administrator. If you are a USENET site and don't get the gnu.all +newsgroups, please ask your USENET administrator to get them. If he has +your feeds ask their feeds, you should win. And everyone else wins: +newsgroups make better use of the limited bandwidth of the computer +networks and your home machine than mailing list traffic; and staying +off the mailing lists make better use of the people who maintain the +lists and the machines that the GNU people working with rms use (i.e. we +have more time to produce code!!). Thanx. * Getting the mailing lists directly @@ -35,22 +40,14 @@ Send requests to be added or removed, to help-gnu-emacs-request (or info-gnu-request, bug-gdb-request, etc.), NOT to info-gnu-emacs (or info-gnu, etc.). Most <LIST_NAME>-request addresses are now handled -automagically by the SmartList program. +automagically by GNU Mailman. If you need to report problems to a human, send mail to gnu@gnu.org explaining the problem. Many of the GNU mailing lists are very large and are received by many -people. Please don't send them anything that is not seriously important -to all their readers. All GNU mailing lists are unmoderated mail -reflectors, except info-gnu, info-gnu-emacs, info-gcc, info-g++, -info-gnu-fortran. - -All addresses below are in internet format. Consult the mail guru for -your computer to figure out address syntaxes from other networks. From -UUCP machines: - ..!ucbvax!gnu.org!ADDRESS - ..!uunet!gnu.org!ADDRESS +people. Most are unmoderated, so please don't send them anything that +is not seriously important to all their readers. If a message you mail to a list is returned from a MAILER-DAEMON (often with the line: @@ -80,11 +77,10 @@ who ask, or putting it up for FTP). In the case of gnu.emacs.sources, somewhat larger postings (up to 10 parts of no more than 25,000 characters each) are acceptable (assuming they are likely to be of -interest to a reasonable number of people); if it is larger than that -have it added to archive.cis.ohio-state.edu (the GNU Emacs Lisp ftp and -uucp archive) and announce its location there. Good bug reports are -short. See section '* General Information about bug-* lists and ...' -for further details. +interest to a reasonable number of people); if it is larger than that, +put it in a web page and announce its URL. Good bug reports are short. +See section '* General Information about bug-* lists and ...' for +further details. Most of the time, when you reply to a message sent to a list, the reply should not go to the list. But most mail reading programs supply, by @@ -170,8 +166,7 @@ bugs and make the improvements that everyone wants. If you want help for yourself in particular, you may have to hire someone. The GNU project maintains a list of people providing such services. It is -distributed with GNU Emacs in file etc/SERVICE, and can be requested -from gnu@gnu.org. +found in <URL:http://www.gnu.org/prep/SERVICE>. Anything addressed to the implementors and maintainers of a GNU program via a bug-* list, should NOT be sent to the corresponding info-* or @@ -197,27 +192,23 @@ newsgroups, they never make it to the GNU maintainers at all. Please mail them to bug-*@gnu.org instead! -See section '* General Information about all lists'. +* Some special lists that don't fit the usual patterns of help-, bug- and info- -* info-gnu-request@gnu.org to subscribe to info-gnu -** gnUSENET newsgroup: gnu.announce -** Send announcements to: info-gnu@gnu.org +** info-gnu-request@gnu.org to subscribe to info-gnu + +gnUSENET newsgroup: gnu.announce +Send announcements to: info-gnu@gnu.org This list distributes progress reports on the GNU Project. It is also used by the GNU Project to ask people for various kinds of help. It is -NOT for general discussion. +moderated and NOT for general discussion. -The list is filtered to remove items meant for info-gnu-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. +** gnu-misc-discuss-request@gnu.org to subscribe to gnu-misc-discuss -See section '* General Information about info-* lists'. +gnUSENET newsgroup: gnu.misc.discuss +Send contributions to: gnu-misc-discuss@gnu.org -* gnu-misc-discuss-request@gnu.org to subscribe to gnu-misc-discuss -** gnUSENET newsgroup: gnu.misc.discuss -** Send contributions to: gnu-misc-discuss@gnu.org - -This list is for serious discussion of freed software, the GNU Project, +This list is for serious discussion of free software, the GNU Project, the GNU Manifesto, and their implications. It's THE place for discussion that is not appropriate in the other GNU mailing lists and gnUSENET newsgroups. @@ -229,9 +220,11 @@ cool off, and think. Don't use this group for complaints and bug reports about GNU software! -The maintainers don't read this group; they won't see your complaint. -Use the appropriate bug-reporting mailing list instead, so that people -who can do something about the problem will see it. +The maintainers of the package you are using probably don't read this +group; they won't see your complaint. Use the appropriate bug-reporting +mailing list instead, so that people who can do something about the +problem will see it. Likewise, use the help- list for technical +questions. Don't trust pronouncements made on gnu-misc-discuss about what GNU is, what FSF position is, what the GNU General Public License is, etc., @@ -244,47 +237,13 @@ isn't that urgent! Readers on the Internet can anonymous FTP these articles from host ftp.uu.net under directory ?? -Someone from the Free Software Foundation will attempt to follow this -group as time and volume permits. - Remember, "GNUs Not Unix" and "gnUSENET is Not USENET". We have higher standards! -Note that sending technical questions about specific GNU software to -gnu-misc-discuss is likely to be less useful than sending them to the -appropriate mailing list or gnUSENET newsgroup, since more technical -people read those. - -* bug-gnu-sql-request@gnu.org to subscribe to bug-gnu-sql -** gnUSENET newsgroup: NONE PLANNED -** GNU-SQL BUG reports to: bug-gnu-sql@gnu.org - -This list distributes, to the active maintainers of GNU's SQL (GNU's SQL -full scale database server), bug reports and fixes for, and suggestions -for improvements to GNU's SQL. User discussion of GNU's SQL also occurs -here. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU's SQL. +** guile-sources-request@gnu.org to subscribe to guile-sources -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-guile-request@gnu.org to subscribe to bug-guile -** gnUSENET newsgroup: NONE PLANNED -** GUILE BUG reports to: bug-guile@gnu.org - -This list distributes, to the active maintainers of GUILE (GNU's -Ubiquitous Extension Language), bug reports and fixes for, and suggestions for -improvements to GUILE. User discussion of GUILE also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for GUILE . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* guile-sources-request@gnu.org to subscribe to guile-sources -** gnUSENET newsgroup: NONE PLANNED -** Guile source code to: guile-sources@gnu.org +gnUSENET newsgroup: NONE PLANNED +Guile source code to: guile-sources@gnu.org This list will be for the posting, by their authors, of GUILE, Scheme, and C sources and patches that improve Guile. Its contents will be @@ -315,143 +274,10 @@ send it. This prevents the requester from getting many redundant copies and saves network bandwidth. -* bug-gnustep-request@gnu.org to subscribe to bug-gnustep -** gnUSENET newsgroup: gnu.gnustep.bug -** Gnustep bug reports to: bug-gnustep@gnu.org -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in GNUstep to its active developers. - -Subscribers to bug-gnustep get all info-gnustep messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnustep-request@gnu.org to subscribe to help-gnustep -** gnUSENET newsgroup: gnu.gnustep.help -** Send contributions to: help-gnustep@gnu.org -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list is the place for users and installers of the GNUstep to ask -for help. Please send bug reports to bug-gnustep@gnu.org -instead of posting them here. - -See section '* General Information about help-* lists'. - -* discuss-gnustep-request@gnu.org to subscribe to discuss-gnustep -** gnUSENET newsgroup: gnu.gnustep.discuss -** Send contributions to: discuss-gnustep@gnu.org -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list is the place for GNUstep users and developers to discuss -GNUstep. Please send bug reports to bug-gnustep@gnu.org -instead of posting them here. - -See section '* General Information about discuss-* lists'. - -* info-gnustep-request@gnu.org to subscribe to info-gnustep -** gnUSENET newsgroup: gnu.gnustep.announce -** Send announcements to: info-gnustep@gnu.org -** FAQ-URL: none known -** FAQ-Archive-name: none known -** FAQ-Posting-frequency: none known - -This list distributes announcements and progress reports on GNUstep. -It is NOT for general discussion; please use discuss-gnustep for that. - -The list is filtered to remove items meant for info-gnustep-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -Do not report GNUstep bugs to info-gnustep, help-gnustep, or -discuss-gnustep, mail them to bug-gnustep@gnu.org instead. - -See section '* General Information about info-* lists'. - -* bug-hurd-request@gnu.org to subscribe to bug-hurd -** gnUSENET newsgroup: NONE -** Hurd bug reports to: bug-hurd@gnu.org - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU Hurd to its active developers. +** gnu-emacs-sources-request@gnu.org to subscribe to gnu-emacs-sources -No info-gnu-hurd list is planned. Announcements about the GNU Hurd will -be made to the list info-gnu@gnu.org (see above). - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-hurd-request@gnu.org to subscribe to help-hurd -** gnUSENET newsgroup: NONE -** Send contributions to: help-hurd@gnu.org - -This list is the place for users and installers of the GNU Hurd to ask -for help. - -No info-gnu-hurd list is planned. Announcements about the GNU Hurd will -be made to the list info-gnu@gnu.org (see above). - -See section '* General Information about help-* lists'. - -* hurd-ann-request@gnu.org IS NOW DEFUNCT -** gnUSENET newsgroup: NEVER EXISTED -** DEAD address: hurd-ann@gnu.org - -This list is dead. Announcements about the GNU Hurd will be made to the -list info-gnu@gnu.org (see above). - -* discuss-gnu-electric-request@gnu.org to subscribe to discuss-gnu-electric -** gnUSENET newsgroup: NONE -** Send contributions to: discuss-gnu-electric@gnu.org - -This list is the place for user discussion of Gnu Electric, a -sophisticated electrical CAD system that can handle many forms of -circuit design. Please send bug reports to bug-gnu-electric@gnu.org -(see next entry). - -* bug-gnu-electric-request@gnu.org to subscribe to bug-gnu-electric -** gnUSENET newsgroup: NONE -** Gnu Electric bug reports to: bug-gnu-electric@gnu.org - -This list distributes, to the active maintainers of GNU Electric, bug -reports and fixes for, and suggestions for improvements in GNU Electric, -a sophisticated electrical CAD system that can handle many forms of -circuit design. - -No info-gnu-electric list exists; announcements of new releases are -made to info-gnu@gnu.org (see above). - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gnu-emacs-request@gnu.org to subscribe to bug-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.bug -** Gnu Emacs bug reports to: bug-gnu-emacs@gnu.org - -This list distributes, to the active maintainers of GNU Emacs, bug -reports and fixes for, and suggestions for improvements in GNU Emacs. - -Send bugs in the GNU Emacs Lisp reference manual to: - lisp-manual-bugs@gnu.org - -lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. -It's just a bug-reporting address. - -Subscribers to bug-gnu-emacs get all info-gnu-emacs messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* gnu-emacs-sources-request@gnu.org to subscribe to gnu-emacs-sources -** gnUSENET newsgroup: gnu.emacs.sources -** Gnu Emacs source code to: gnu-emacs-sources@gnu.org +gnUSENET newsgroup: gnu.emacs.sources +GNU Emacs source code to: gnu-emacs-sources@gnu.org This list/newsgroup will be for the posting, by their authors, of Emacs Lisp and C sources and patches that improve GNU Emacs. Its contents @@ -485,1039 +311,6 @@ send it. This prevents the requester from getting many redundant copies and saves network bandwidth. -* help-gnu-emacs-request@gnu.org to subscribe to help-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.help (and one-way into comp.emacs) -** Send contributions to: help-gnu-emacs@gnu.org - -This list is the place for users and installers of GNU Emacs to ask for -help. Please send bug reports to bug-gnu-emacs instead of posting them -here. - -Since help-gnu-emacs is a very large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in help-gnu-emacs, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -This list is also gated one way to USENET's newsgroup comp.emacs (once -known as net.emacs). This one-way gating is done for users whose sites -get comp.emacs, but not gnu.emacs.help. Users at non-USENET sites may -receive all articles from comp.emacs by making their request to: -unix-emacs-request@bbn.com - -If Emacs crashes, or if you build Emacs following the standard procedure -on a system which Emacs is supposed to work on (see etc/MACHINES) and it -does not work at all, or if an editing command does not behave as it is -documented to behave, this is a bug. Don't send bug reports to -help-gnu-emacs (gnu.emacs.help) or post them to comp.emacs; mail them to -bug-gnu-emacs@gnu.org instead. - -See section '* General Information about help-* lists'. - -* info-gnu-emacs-request@gnu.org to subscribe to info-gnu-emacs -** gnUSENET newsgroup: gnu.emacs.announce (and one-way into comp.emacs) -** Send announcements to: info-gnu-emacs@gnu.org - -This list distributes announcements and progress reports on GNU Emacs. -It is NOT for general discussion; please use help-gnu-emacs for that. - -The list is filtered to remove items meant for info-gnu-emacs-request, -that can be answered by the moderator without bothering the list, or -should have been sent to another list. - -info-gnu-emacs is also gated one way to USENET's newsgroup comp.emacs -(once known as net.emacs). This one-way gating is done for users whose -sites get comp.emacs, but not gnu.emacs.announce. Users at non-USENET -sites may receive all articles from comp.emacs by making their request -to: unix-emacs-request@bbn.com - -Do not report GNU Emacs bugs to info-gnu-emacs or comp.emacs, instead -mail them to bug-gnu-emacs@gnu.org. - -See section '* General Information about info-* lists'. - -* vms-gnu-emacs-request@gnu.org to subscribe -** gnUSENET newsgroup: gnu.emacs.vms -** Send contributions to: vms-gnu-emacs@gnu.org - -This list was a working group who did the initial port of GNU Emacs to -the VMS operating system. It still discusses problems and solutions to -the VMS port and the distribution of it. - -* bug-bash-request@gnu.org to subscribe to bug-bash -** gnUSENET newsgroup: gnu.bash.bug -** BASH bug reports to: bug-bash@gnu.org - -This list distributes, to the active maintainers of BASH (the Bourne -Again SHell), bug reports and fixes for, and suggestions for -improvements in BASH. User discussion of BASH also occurs here. - -Always report the version number of the operating system, hardware, and -bash (flag -version on startup or check the variable $BASH_VERSION in a -running bash). - -There are no other GNU mailing lists or gnUSENET newsgroups for BASH. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gdb-request@gnu.org to subscribe to bug-gdb -** gnUSENET newsgroup: gnu.gdb.bug -** GDB bug reports to: bug-gdb@gnu.org - -This list distributes, to the active maintainers of GDB (Gnu's -DeBugger), bug reports and fixes for, and suggestions for improvements -in GDB. This list is also for user discussion. - -There are no other GNU mailing lists or gnUSENET newsgroups for GDB. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-ncurses-request@gnu.org to subscribe to bug-ncurses -** gnUSENET newsgroup: none -** NCURSES bug reports to: bug-ncurses@gnu.org - -This list distributes, to the active maintainers of ncurses -(a free implementation of the Unix curses API) bug reports and fixes -for, and suggestions for improvements in ncurses. Users can also -subscribe to this list. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-ncurses-request@gnu.org to subscribe to help-ncurses -** gnUSENET newsgroup: none -** posts go to: help-ncurses@gnu.org - -This list is the place for users and installers of ncurses to ask for -help. Please send bug reports to bug-ncurses instead of posting them -here. - -See section '* General Information about help-* lists' - -* bug-gnats-request@gnu.org to subscribe to bug-gnats -** gnUSENET newsgroup: None -** GNATS bug reports to: bug-gnats@gnu.org - -This list distributes, to the active maintainers of GNATS (GNats: A -Tracking System), bug reports and fixes for, and suggestions for improvements -in GNATS. This list is also for user discussion. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNATS. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-octave-request@bevo.che.utexas.edu to subscribe to bug-octave -** gnUSENET newsgroup: NONE PLANNED -** Octave bug reports to: bug-octave@bevo.che.utexas.edu - -This list distributes, to the active maintainers of Octave (a system -for numerical computations), bug reports and fixes for, and -suggestions for improvements to Octave. - -The help-octave mailing list is for user discussion of Octave. - -See section '* General Information about bug-* lists and reporting -program bugs'. - - -* help-octave-request@bevo.che.utexas.edu to subscribe to help-octave -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: help-octave@bevo.che.utexas.edu - -This list is the place for users and installers of Octave to ask for -help. Please send bug reports to bug-octave instead of posting them -here. - -If Octave crashes, or if you build Octave following the standard -procedure on a system on which Octave is supposed to work on and it -does not work at all, or if a command does not behave as it is -documented to behave, this is a bug. Don't send bug reports to -help-octave; mail them to bug-octave@che.utexas.edu instead. - -See section '* General Information about help-* lists'. - -* bug-bison-request@gnu.org to subscribe to bug-bison -** gnUSENET newsgroup: NONE -** Bison bug reports to: bug-bison@gnu.org - -This list distributes, to the active maintainers of Bison -bug reports and fixes for, and suggestions for improvements -in Bison. User discussion of Bison bugs occurs here. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-bison-request@gnu.org to subscribe to help-bison -** gnUSENET newsgroup: NONE -** Send contributions to: help-bison@gnu.org - -This list is the place for users and installers of Bison -to ask for help. Please send bug reports to bug-bison instead -of posting them here. - -See section '* General Information about help-* lists'. - -* bug-make-request@gnu.org to subscribe to bug-make -** gnUSENET newsgroup: NONE -** Make bug reports to: bug-make@gnu.org - -This list distributes, to the active maintainers of GNU make -bug reports and fixes for, and suggestions for improvements -in GNU make. User discussion of GNU make bugs occurs here. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-make-request@gnu.org to subscribe to help-make -** gnUSENET newsgroup: NONE -** Send contributions to: help-make@gnu.org - -This list is the place for users and installers of GNU make -to ask for help. Please send bug reports to bug-make instead -of posting them here. - -See section '* General Information about help-* lists'. - -* help-flex-request@gnu.org to subscribe to help-flex -** gnUSENET newsgroup: NONE -** Send contributions to: help-flex@gnu.org - -This list is the place for users and installers of Flex -to ask for help. Please send bug reports to bug-gnu-utils instead -of posting them here. - -See section '* General Information about help-* lists'. - -* bug-rcs-request@gnu.org to subscribe to bug-rcs -** gnUSENET newsgroup: NONE -** RCS bug reports to: bug-rcs@gnu.org - -This list distributes, to the active maintainers of RCS -bug reports and fixes for, and suggestions for improvements -in RCS. User discussion of RCS bugs occurs here. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-rcs-request@gnu.org to subscribe to help-rcs -** gnUSENET newsgroup: NONE -** Send contributions to: help-rcs@gnu.org - -This list is the place for users and installers of RCS -to ask for help. Please send bug reports to bug-rcs instead -of posting them here. - -See section '* General Information about help-* lists'. - -* bug-gcc-request@gnu.org to subscribe to bug-gcc -** gnUSENET newsgroup: gnu.gcc.bug -** GCC bug reports to: bug-gcc@gnu.org - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU C Compiler to its active -developers. - -Please don't send in a patch without a test case to illustrate the -problem the patch is supposed to fix. Sometimes the patches aren't -correct or aren't the best way to do the job, and without a test case -there is no way to debug an alternate fix. - -The most convenient form of test case is a piece of cpp output that can -be passed directly to cc1. Preferably written in C, not C++ or -Objective C. - -Subscribers to bug-gcc get all info-gcc messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gcc-request@gnu.org to subscribe to help-gcc -** gnUSENET newsgroup: gnu.gcc.help -** Send contributions to: help-gcc@gnu.org - -This list is the place for users and installers of the GNU C Compiler to -ask for help. - -If gcc crashes, or if you build gcc following the standard procedure on -a system which gcc is supposed to work on (see config.sub) and it does -not work at all, or if an command line option does not behave as it is -documented to behave, this is a bug. Don't send bug reports to help-gcc -(gnu.gcc.help); mail them to bug-gcc@gnu.org instead. - -See section '* General Information about help-* lists'. - -* info-gcc-request@gnu.org to subscribe to info-gcc -** gnUSENET newsgroup: gnu.gcc.announce -** Send announcements to: info-gcc@gnu.org - -This list distributes announcements and progress reports on the GNU C -Compiler. It is NOT for general discussion; please use help-gcc for -that. - -The list is filtered to remove items meant for info-gcc-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -See section '* General Information about info-* lists'. - -* bug-gnu960-request@ichips.intel.com to subscribe to bug-gnu960 -** gnUSENET newsgroup: NONE PLANNED -** Intel 960 Port bug reports to: bug-gnu960@ichips.intel.com - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in Intel's port of GNU software to the -Intel 960 microprocessor. - -You can also fax to: GNU/960 - 1-503-696-4930. - -There are no other GNU mailing lists or gnUSENET newsgroups for Intel's -port of GNU software to the Intel 960 microprocessor. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-glibc-request@gnu.org to subscribe to bug-glibc -** gnUSENET newsgroup: gnu.glibc.bug -** GNU C Library bug reports to: bug-glibc@gnu.org - -This list distributes, to the active maintainers of glibc (GNU's C -library), bug reports and fixes for, and suggestions for improvements in -glibc. User discussion of glibc also occurs here. - -Announcements of new releases of glibc are made on both info-gcc and -bug-glibc. - -There are no other GNU mailing lists or gnUSENET newsgroups for the GNU -C Library. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-g++-request@gnu.org to subscribe to bug-g++ -** gnUSENET newsgroup: gnu.g++.bug -** G++ bug reports to: bug-g++@gnu.org - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in the GNU C++ Compiler to its active -developers. - -G++ uses the GNU C-Compiler back end. Active developers may wish to -subscribe to bug-gcc@gnu.org as well. - -Subscribers to bug-g++ get all info-g++ messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-g++-request@gnu.org to subscribe to help-g++ -** gnUSENET newsgroup: gnu.g++.help (and one-way into comp.lang.c++) -** Send contributions to: help-g++@gnu.org - -This list is the place for users and installers of the GNU C++ Compiler -to ask for help. Please send bug reports to bug-g++@gnu.org -instead of posting them here. - -help-g++ is also gated one way to USENET's newsgroup comp.lang.c++. -This one-way gating is done for users whose sites get comp.lang.c++, but -not gnu.g++.help. - -See section '* General Information about help-* lists'. - -* info-g++-request@gnu.org to subscribe to info-g++ -** gnUSENET newsgroup: gnu.g++.announce (and one-way into comp.lang.c++) -** Send announcements to: info-g++@gnu.org - -This list distributes announcements and progress reports on the GNU C++ -Compiler. It is NOT for general discussion; please use help-g++ for -that. - -The list is filtered to remove items meant for info-g++-request, that -can be answered by the moderator without bothering the list, or should -have been sent to another list. - -It is also gated one way to USENET's newsgroup comp.lang.c++. This -one-way gating is done for users whose sites get comp.lang.c++, but not -gnu.g++.announce. - -Do not report g++ bugs to info-g++ or comp.lang.c++, mail them to -bug-g++@gnu.org instead. - -See section '* General Information about info-* lists'. - -* bug-lib-g++-request@gnu.org to subscribe to bug-lib-g++ -** gnUSENET newsgroup: gnu.g++.lib.bug -** lib-g++ bug reports to: bug-lib-g++@gnu.org - -This list distributes, to the active maintainers of libg++ (GNU's -library for C++), bug reports and fixes for, and suggestions for -improvements in lib-g++. User discussion of libg++ also occurs here. - -Announcements of new releases of libg++ are made on both info-g++ and -bug-lib-g++. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU's -G++ Library. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* info-gnu-fortran-request@gnu.org to subscribe to info-gnu-fortran -** gnUSENET newsgroup: NONE YET -** Send announcements to: info-gnu-fortran@gnu.org - -This list is for progress reports and release notices for G77/GNU -Fortran. - -The list is filtered to remove items meant for info-gnu-fortran-request, -that can be answered by the moderator without bothering the list, or that -should have been sent to another list. - -People on the Internet can get a current status report by fingering the -address fortran@gnu.org or by looking at the GNU Fortran web pages at -http://www.gnu.org/software/fortran/fortran.html. - -Users looking for help should ask the help-gnu-fortran@gnu.org list. -Bug reports should go to bug-gnu-fortran@gnu.org. - -See section '* General Information about info-* lists'. - -* help-gnu-fortran-request@gnu.org to subscribe to help-gnu-fortran -** gnUSENET newsgroup: NONE YET -** Send messages to: help-gnu-fortran@gnu.org - -This list is for user requests for help and discussion about GNU -Fortran (G77). Bug reports should go to bug-gnu-fortran@gnu.org. - -See section '* General Information about help-* lists'. - -* bug-gnu-fortran@@gnu.org to subscribe to bug-gnu-fortran -** gnUSENET newsgroup: NONE YET -** Send messages to: help-gnu-fortran@gnu.org - -This list is for bug-reports and patches for GNU Fortran -(G77). Requests for help should go to help-gnu-fortran@gnu.org. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-oleo-request@gnu.org to subscribe to bug-oleo -** gnUSENET newsgroup: NONE PLANNED -** Oleo bug reports to: bug-oleo@gnu.org - -This list distributes, to the active maintainers of Oleo (the GNU -spreadsheet), bug reports and fixes for, and suggestions for -improvements to Oleo. User discussion of Oleo also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for Oleo. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gmp-request@gnu.org to subscribe to bug-gmp -** gnUSENET newsgroup: NONE PLANNED -** gmp bug reports to: bug-gmp@gnu.org - -This list distributes, to the active maintainers of gmp (the GNU -Multiple Precision Library), bug reports and fixes for, and suggestions -for improvements to gmp. User discussion of gmp also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for gmp . - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-panorama-request@gnu.org to subscribe to bug-panorama -** gnUSENET newsgroup: NONE PLANNED -** panorama bug reports to: bug-panorama@gnu.org - -This list is a place for users of Panorama to send bug reports, fixes -for them, and suggestions for improvements. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-panorama-request@gnu.org to subscribe to help-panorama -** gnUSENET newsgroup: NONE PLANNED -** articles to: help-panorama@gnu.org - -This list is the place for users and installers of Panorama to ask for -help. Please send bug reports to bug-panorama instead of posting them -here. - -* devel-panorama-request@gnu.org to subscribe to devel-panorama -** gnUSENET newsgroup: NONE PLANNED -** articles to: devel-panorama@gnu.org - -This list is a place for discussion among active developers of Panorama -API or any of its plugins. - -* bug-mana-request@gnu.org to subscribe to bug-mana -** gnUSENET newsgroup: NONE PLANNED -** mana bug reports to: bug-mana@gnu.org - -This list distributes, to the active maintainers of mana (the GNU -stand-alone mail reader), bug reports and fixes for, and suggestions -for improvements to mana. User discussion of mana also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for mana. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-zebra-request@gnu.org to subscribe to bug-zebra -** gnUSENET newsgroup: NONE PLANNED -** zebra bug reports to: bug-zebra@gnu.org - -This list distributes, to the active maintainers of zebra (a GPLed -program to manage TCP/IP based routing protocols), bug reports, bug fixes, -and suggestions for improvements to zebra. User discussion of zebra -also occurs here. - -There are no other GNU mailing lists or gnUSENET newsgroups for zebra. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-cfengine-request@gnu.org to subscribe to bug-cfengine -** gnUSENET newsgroup: gnu.cfengine.bug -** cfengine bug reports to: bug-cfengine@gnu.org - -This list distributes, to the active maintainers of cfengine (configure -BSD and System-5-like operating systems attached to a TCP/IP network), -bug reports and fixes for, and suggestions for improvements to cfengine. -User discussion of cfengine also occurs here. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-cfengine-request@gnu.org to subscribe to help-cfengine -** gnUSENET newsgroup: gnu.cfengine.help -** Send contributions to: help-cfengine@gnu.org - -This list is the place for users and installers of cfengine to ask for -help. Please send bug reports to bug-cfengine instead of posting them -here. - -This list is also used for announcements about cfengine and related -programs, and small but important patches. Announcements of cfengine -releases are also made to info-gnu@gnu.org (see above) - -Since help-cfengine is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in help-cfengine, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-gnu-smalltalk-request@gnu.org to subscribe to bug-gnu-smalltalk -** gnUSENET newsgroup: gnu.smalltalk.bug -** GNU Smalltalk bug reports to: bug-gnu-smalltalk@gnu.org - -GNU Smalltalk is the GNU project implementation of the Smalltalk language. - -This list distributes, to the active maintainers of GNU Smalltalk, bug -reports and fixes for, and suggestions for improvements to GNU -Smalltalk. User discussion of GNU Smalltalk also occurs here. - -For now, new releases of GNU Smalltalk will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Smalltalk. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* st-next-request@laplace.eng.sun.com to subscribe to st-next -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: st-next@laplace.eng.sun.com - -For people interested in working on GNU Smalltalk on the NeXT. - -* bug-groff-request@gnu.org to subscribe to bug-groff -** gnUSENET newsgroup: gnu.groff.bug -** GNU groff bug reports to: bug-groff@gnu.org - -groff is the GNU project implementation, in C++, of the traditional Unix -document formatting tools. - -This list distributes, to the active maintainers of groff, bug reports -and fixes for, and suggestions for improvements to groff (and it -component programs). User discussion of groff also occurs here. - -For now, new releases of groff will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for groff. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-ghostscript-request@gnu.org to subscribe to bug-ghostscript -** gnUSENET newsgroup: gnu.ghostscript.bug -** Ghostscript bug reports to: bug-ghostscript@gnu.org - -Ghostscript is the GNU project implementation of a language and graphics -library with a remarkable similarity to PostScript. - -This list distributes, to the active maintainers of Ghostscript, bug -reports and fixes for, and suggestions for improvements in Ghostscript. - -For now, new releases of Ghostscript will also be announced on this list. - -There are no other GNU mailing lists or gnUSENET newsgroups for -Ghostscript. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-gnu-utils-request@gnu.org to subscribe to bug-gnu-utils -** gnUSENET newsgroup: gnu.utils.bug -** GNU Utilities bug reports to: bug-gnu-utils@gnu.org - -This list distributes, to the active maintainers of these programs, bug -reports and fixes for, and suggestions for improvements in GNU programs -not covered by other bug-* mailing lists/gnu.*.bug newsgroups. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnu-utils-request@gnu.org to subscribe to help-gnu-utils -** gnUSENET newsgroup: gnu.utils.help -** Send contributions to: help-gnu-utils@gnu.org - -This list is the place for users and installers of GNU programs not -covered by other GNU mailing lists/gnu.* newsgroups to ask for help. - -Don't send bug reports to help-gnu-utils (gnu.utils.help); mail them to -bug-gnu-utils@gnu.org instead. - -See section '* General Information about help-* lists'. - -* info-gnu-utils-request@gnu.org IS NOW DEFUNCT -** a gnUSENET newsgroup bever existed -** DEAD address: info-gnu-utils@gnu.org - -This list is dead. Announcements about GNU Utilities will be made to the -list info-gnu@gnu.org (see above). - -* info-cvs-request@gnu.org to subscribe to info-cvs. -** USENET newsgroup: (none) -** CVS discussions/questions to: info-cvs@gnu.org - -This list is for discussion and dissemination of information about -CVS. Please check the FAQ before posting questions, however. - -* bug-cvs-request@gnu.org to subscribe to bug-cvs. -** USENET newsgroup: (none) -** CVS bug reports to: bug-cvs@gnu.org - -This list distributes bug reports, fixes, and suggestions for -improvements to the maintainers of CVS. - -* bug-dr-geo-request@gnu.org to subscribe to bug-dr-geo -** gnUSENET newsgroup: NONE -** Dr. Geo bug reports to: bug-dr-geo@gnu.org - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in Dr. Geo to its active developers. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-fortran-mode-request@erl.mit.edu to subscribe to bug-fortran-mode -** USENET newsgroup: (none) -** Fortran mode bug reports to: bug-fortran-mode@erl.mit.edu - -This list collects bug reports, fixes for bugs, and suggestions for -improvements in GNU Emacs's Fortran mode (a major mode to support -editing Fortran source code). - -It is the place to report Fortran mode bugs by all users of Fortran -mode. - -Always report the version number Fortran mode reports on startup as well -as the version of Emacs. - -There is no info-fortran-mode list. There are no USENET gateways to -bug-fortran-mode at this time. - -* info-gnus-request@flab.fujitsu.co.jp to subscribe -** gnUSENET newsgroup: NONE YET -** Send contributions to: info-gnus@flab.fujitsu.co.jp - -The list is intended to exchange useful information about GNUS, such as -bug reports, useful hooks, and extensions of GNUS. GNUS is an NNTP-base -network news reader for GNU Emacs (which also works with a news spool). -English and Japanese are the official languages of the list. GNUS is -quite different than gnews. - -* info-gnus-english-request@gnu.org to subscribe -** gnUSENET newsgroup: gnu.emacs.gnus -** Send contributions to: info-gnus-english@gnu.org - -The list has the same charter as info-gnus. The difference is that -English is the only official language of the list. - -info-gnus-english/gnu.emacs.gnus is forward to info-gnus, but NOT -vice-versa. - -* info-gnews-request@ics.uci.edu to subscribe to info-gnews -** gnUSENET newsgroup: gnu.emacs.gnews -** Send contributions to: info-gnews@ics.uci.edu - -This newsgroup is intended to exchange useful information about gnews, -such as bug reports, useful hooks, and extensions of gnews. gnews is an -NNTP-base network news reader for GNU Emacs (which also works a news -spool). It is quite different than GNUS. - -* gnu-emacs-ada-request@grebyn.com to subscribe to gnu-emacs-ada -** gnUSENET newsgroup: NONE PLANNED -** Gnu Emacs Ada support bug reports to: gnu-emacs-ada@grebyn.com - -This list distributes bug reports for, fixes for bugs in, and -suggestions for improvements in GNU Emacs' editing support of the Ada -programming language. - -There are no other GNU mailing lists or gnUSENET newsgroups for GNU -Emacs' editing support of Ada. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* bug-vm-request@uunet.uu.net to subscribe to bug-vm -** gnUSENET newsgroup: gnu.emacs.vm.bug -** VM mail reader bug reports to: bug-vm@uunet.uu.net - -This list discusses bugs in View Mail mode for GNU Emacs, with an -emphasis on beta and prerelease versions. - -Always report the version number of VM you are using, as well as the -version of Emacs you're running. If you believe it is significant, -report the operating system used and the hardware. - -Subscribers to bug-vm get all info-vm messages. - -* info-vm-request@uunet.uu.net to subscribe to info-vm -** gnUSENET newsgroup: gnu.emacs.vm.info -** Send contributions to: info-vm@uunet.uu.net - -This list discusses the View Mail mode for GNU Emacs, an alternative to -rmail mode. - -* supercite-request@warsaw.nlm.nih.gov to subscribe to supercite -** gnUSENET newsgroup: NONE PLANNED -** Send articles to: supercite@warsaw.nlm.nih.gov -*** UUCP: ..!uunet!warsaw.nlm.nih.gov!supercite-request - -The supercite mailing list covers issues related to the advanced -mail/news citation package called Supercite for GNU Emacs. - -* auc-tex-request@sunsite.dk to subscribe -** USENET newsgroup: NONE YET -** Send contributions to: auc-tex@sunsite.dk - -The list is intended to exchange information about AUCTeX, such as -bug reports, request for help, and information on current -developments. AUCTeX is a much enhanced TeX/LaTeX/ConTeXt/Texinfo mode -for GNU Emacs. - -The list is unmoderated. - -* bug-gnu-chess-request@gnu.org to subscribe to bug-gnu-chess -** gnUSENET newsgroup: gnu.chess.bug -** GNU Chess bug reports to: bug-gnu-chess@gnu.org - -This list directly accesses the GNU Chess developer's group. If you -have a *BUG* to report about the program, which can also include a -feature enhancement request, please send it to this list. - -Subscribers to bug-gnu-chess get all info-gnu-chess messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-gnu-chess-request@gnu.org IS NOW DEFUNCT -** gnUSENET newsgroup: NONE PLANNED -** DEAD address: help-gnu-chess@gnu.org - -This list is dead. Use info-gnu-chess@gnu.org/gnu.chess instead. - -* info-gnu-chess-request@gnu.org to subscribe to info-gnu-chess -** gnUSENET newsgroup: gnu.chess -** Send contributions to: info-gnu-chess@gnu.org -** FAQ-URL: http://www.tim-mann.org/chess.html -** FAQ-Archive-name: games/chess/gnu-faq -** FAQ-Posting-frequency: monthly - -This list is the place for users and installers of GNU Chess to ask for -help. This list is also used for games played by people or other -entities against the program, and other generalized non-bug, -non-enhancement data. Please send bug reports to bug-gnu-chess instead -of posting them here. - -This list is also used for announcements about GNU Chess and related -programs, and small but important patches. Announcements of GNU Chess -releases are also made to info-gnu@gnu.org (see above) - -Since info-gnu-chess is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in info-gnu-chess, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-gnu-shogi-request@gnu.org to subscribe to bug-gnu-shogi -** gnUSENET newsgroup: NONE PLANNED -** GNU Shogi bug reports to: bug-gnu-shogi@gnu.org - -This list directly accesses the GNU Shogi developer's group. If you -have a *BUG* to report about the program, which can also include a -feature enhancement request, please send it to this list. - -Subscribers to bug-gnu-shogi get all info-gnu-shogi messages. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -Shogi is a game something like chess. There are several different types -of pieces, a board that is 9 by 9 squares, and the modification that a -captured piece can be reintroduced on the board by the capturing player -(and used). Due to this last difference from Western chess, a Shogi -game never simplifies. - -* bug-mcsim-request@gnu.org to subscribe to bug-mcsim -** gnUSENET newsgroup: None at present. -** MCSim bug reports to: bug-mcsim@gnu.org - -This list is used for bug reports concerning MCSim, a general- -purpose modeling and simulation program. It is also for user -discussion of bug fixes and patches. - -This list is unmoderated. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-mcsim-request@gnu.org to subscribe to help-mcsim -** gnUSENET newsgroup: None at present. -** Send contributions to: help-mcsim@gnu.org - -This list is the place for users and installers of MCSim to ask for -help. Please send bug reports to bug-mcsim instead of posting them -here. - -This list is also used for announcements about MCSim and related -programs, and small but important patches. Announcements of MCSim -releases are also made to info-gnu@gnu.org (see above) - -* bug-m4-request@gnu.org to subscribe to bug-m4 -** gnUSENET newsgroup: None at present. -** Send contributions to: bug-m4@gnu.org - -This list is used for bug reports concerning m4, the GNU implementation -of the traditional Unix macro processor. It is also for user -discussion of bug fixes and patches. - -This list is unmoderated. - -* gpc-request@gnu.de to subscribe to gpc -** gnUSENET newsgroup: None at present. -** Send contributions to: gpc@gnu.de - -This list is the user mailing list for GNU Pascal. -*NOTE* This list was formerly at gpc@hut.fi, and moved as of 1999-05-13. -Announcements will now be sent to an announcements list (see next entry) -as well as to this list and info-gnu@gnu.org. - -* gpc-announce-request@gnu.de to subscribe to gpc-announce -** gnUSENET newsgroup: None at present. -** Send contributions to: gpc-announce@gnu.de - -This list will have announcements to interest to users of GNU Pascal, -including new releases. - -* autoconf-request@gnu.org to subscribe to automake -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: autoconf@gnu.org - -The list can be used to discuss the autoconf build system and related -tools (eg config.guess). The discussion can range from simple "how-to" -questions up to patches and future directions for this tool. - -* automake-request@gnu.org to subscribe to automake -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: automake@gnu.org - -The list can be used to discuss automake and related tools (eg libtool). -The discussion can range from simple "how-to" questions up to patches -and configuration philosophy. - -* libtool-request@gnu.org to subscribe to libtool -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: libtool@gnu.org - -The list can be used to discuss development and porting of libtool, and -anything else that the libtool developers might find interesting (excepting -bug-reports which have a list of their own). - -This list is unmoderated. - -* bug-libtool-request@gnu.org to subscribe to bug-libtool -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: bug-libtool@gnu.org - -The list can be used to submit and to discuss bugs in libtool. The -discussion can range from bug reports and patches themselves to discourse -related to specific bugs and patches. - -This list is unmoderated. - -* libtool-commit-request@gnu.org to subscribe to libtool -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: libtool-commit@gnu.org - -The list distributes automatic reports of cvs commits to the libtool -development sources to the list subscribers. Probably, any discussion -related to these automatic submissions should go to the libtool list which -has more subscribers who will see the submission. - -This list is unmoderated. - -* bug-a2ps-request@gnu.org to subscribe to bug-a2ps -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: bug-a2ps@gnu.org - -This list is used for bug reports concerning GNU a2ps, an Any to -PostScript filter. People willing to help (debugging, or helping users) -may subscribe to this list. - -This list is unmoderated. - -* a2ps-request@gnu.org to subscribe to a2ps -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: a2ps@gnu.org - -On this list are sent announcements about GNU a2ps --included betas--, -discussions on the interface, implementations etc. It is by no means a -bug reporting address, and its volume should be kept moderate. To this -end, and to avoid `accidents' (bug reports and spam), this list is not -moderated but members only can post. - -* wget-subscribe@sunsite.auc.dk to subscribe to wget@sunsite.auc.dk -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: wget@sunsite.auc.dk - -This list is for user discussion of wget. This list is not moderated. - -* help-gnu-shogi-request@gnu.org IS NOW DEFUNCT -** gnUSENET newsgroup: NONE PLANNED -** DEAD address: help-gnu-shogi@gnu.org - -This list is dead. - -* info-gnu-shogi-request@gnu.org to subscribe to info-gnu-shogi -** gnUSENET newsgroup: NONE PLANNED -** Send contributions to: info-gnu-shogi@gnu.org - -This list is the place for users and installers of GNU Shogi to ask for -help. This list is also used for games played by people or other -entities against the program, and other generalized non-bug, -non-enhancement data. Please send bug reports to bug-gnu-shogi instead -of posting them here. - -This list is also used for announcements about GNU Shogi and related -programs, and small but important patches. Announcements of GNU Shogi -releases are also made to info-gnu@gnu.org (see above) - -Since info-gnu-shogi is a large list, send it only those items that -are seriously important to many people. - -If source or patches that were previously posted or a simple fix is -requested in info-gnu-shogi, please mail it to the requester. Do NOT -repost it. If you also want something that is requested, send mail to -the requester asking him to forward it to you. This kind of traffic is -best handled by e-mail, not a broadcast medium that reaches millions of -sites. - -See section '* General Information about help-* lists'. -Also see section '* General Information about info-* lists'. - -* bug-texinfo-request@gnu.org to subscribe to bug-texinfo -** gnUSENET newsgroup: NONE -** GNU Texinfo bug reports to: bug-texinfo@gnu.org - -This list distributes, to the active maintainers of these programs, bug -reports and fixes for, and suggestions for improvements in GNU Texinfo, -both the programs and the language. - -See section '* General Information about bug-* lists and reporting -program bugs'. - -* help-texinfo-request@gnu.org to subscribe to help-texinfo -** gnUSENET newsgroup: NONE -** Send contributions to: help-texinfo@gnu.org - -This list is the place for authors, users and installers of GNU Texinfo -to ask for help. - -Don't send bug reports to help-texinfo; mail them to -bug-texinfo@gnu.org instead. - -See section '* General Information about help-* lists'. - -* gnu-manual-request@a.cs.uiuc.edu IS NOW DEFUNCT -** DEAD: Gnusenet newsgroup: gnu.emacs.lisp.manual -** DEAD address: gnu-manual@a.cs.uiuc.edu -*** DEAD UUCP address: ..!uunet!uiucdcs!gnu-manual-request - -This list and newsgroup is dead. It was a working group whose -volunteers wrote, proofread and commented on the developing GNU Emacs -Lisp programmers manual. - -Send bugs in the GNU Emacs Lisp reference manual to: - lisp-manual-bugs@gnu.org - -lisp-manual-bugs is neither a mailing list nor a gnUSENET newsgroup. -It's just a bug-reporting address. - -* no mailing list request -** gnUSENET newsgroup: gnu.gnusenet.config -** no mailing list - -This newsgroup has nothing to do with GNU software, especially its -configuration. It exists to distribute information about the -administration and configuration of gnUSENET: the gnu.all alternative -USENET hierarchy that carry the GNU mailing lists. - -Administrators of gnUSENET hosts receiving the gnu.all newsgroups are -welcome to ask questions here or via e-mail of gnu@gnu.org. - -* no mailing list request -** gnUSENET newsgroup: gnu.gnusenet.test -** no mailing list - -This newsgroup has nothing to do with GNU software, especially its -testing. It exists to allow test messages to be made in gnUSENET: the -gnu.all alternative USENET hierarchy that carry the GNU mailing lists. - Local variables: mode: outline fill-column: 72
--- a/etc/refcard.tex Tue Oct 19 11:11:47 2004 +0000 +++ b/etc/refcard.tex Fri Oct 22 10:13:52 2004 +0000 @@ -1,12 +1,19 @@ % Reference Card for GNU Emacs version 21 on Unix systems %**start of header \newcount\columnsperpage +\newcount\letterpaper % This file can be printed with 1, 2, or 3 columns per page (see below). -% Specify how many you want here. Nothing else needs to be changed. +% Specify how many you want here. + +\columnsperpage=3 -\columnsperpage=1 +% Set letterpapaer to 0 for A4 paper, 1 for letter (US) paper. Useful +% only when columnsperpage is 2 or 3. +\letterpaper=1 + +% Nothing else needs to be changed below this line. % Copyright (c) 1987, 1993, 1996, 1997 Free Software Foundation, Inc. % This file is part of GNU Emacs. @@ -42,6 +49,10 @@ % For this you need a dvi device driver that can print sideways. % Which mode to use is controlled by setting \columnsperpage above. % +% To compile and print this document: +% tex refcard.tex +% dvips -t landscape refcard.dvi +% % Author: % Stephen Gildea % Internet: gildea@stop.mail-abuse.org @@ -103,7 +114,11 @@ \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} \else %2 or 3 columns uses prereduced size \hsize 3.2in - \vsize 7.95in + \if 1\the\letterpaper + \vsize 7.95in + \else + \vsize 7.65in + \fi \hoffset -.75in \voffset -.745in \font\titlefont=cmbx10 \scaledmag2 @@ -123,7 +138,11 @@ \def\bf{\eightbf} \def\it{\eightit} \def\tt{\eighttt} - \normalbaselineskip=.8\normalbaselineskip + \if 1\the\letterpaper + \normalbaselineskip=.8\normalbaselineskip + \else + \normalbaselineskip=.7\normalbaselineskip + \fi \normallineskip=.8\normallineskip \normallineskiplimit=.8\normallineskiplimit \normalbaselines\rm %make definitions take effect
--- a/lisp/ChangeLog Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/ChangeLog Fri Oct 22 10:13:52 2004 +0000 @@ -1,10 +1,255 @@ +2004-10-21 Jay Belanger <belanger@truman.edu> + + * calc/calc-aent.el (calc-alg-ent-map, calc-alg-ent-esc-map): + Declared these variables with defvar. + + * calc/calc-aent.el (calc-do-alg-entry): Since `calc-alg-ent-map' + is bound, only check to see if it is bound. + +2004-10-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * calc/calc-help.el (calc-describe-bindings): Fix last change. + +2004-10-21 John Paul Wallington <jpw@gnu.org> + + * calc/calc-graph.el (calc-graph-init): + Use `set-process-query-on-exit-flag'. + +2004-10-21 Daniel Pfeiffer <occitan@esperanto.org> + + * progmodes/compile.el (compilation-start): Rely on `cd' to get + dir right and also allow argumentless cd. + +2004-10-19 Richard M. Stallman <rms@gnu.org> + + * textmodes/flyspell.el (flyspell-mode): Doc fix. + + * eshell/em-unix.el (eshell-grep): + Don't bind compilation-process-setup-function. + + * comint.el (comint-insert-input): Use @ in `interactive'. + (comint-input-filter-functions): Doc fix. + (comint-kill-whole-line, comint-get-source): Doc fix. + + * progmodes/compile.el (compilation-setup): + Don't set buffer-read-only if MINOR is non-nil. + +2004-10-19 Jay Belanger <belanger@truman.edu> + + * calc/calc.el (calc-emacs-type-19, calc-emacs-type-epoch) + (calc-emacs-type-gnu19): Remove. + (calc-digit-map, calc-read-key-sequence, calc-read-key): + Remove check for old emacs versions. + + * calc/calc-ext.el (calc-fancy-prefix): Remove emacs version check. + (calc-init-extensions): Define `calc-alg-map' and `calc-alg-esc-map' + for current Emacs. + + * calc/calc-aent.el (calcAlg-previous): Check to see if looking at + the end of the minibuffer. + (calc-do-alg-entry): Remove Emacs version check. Use `copy-keymap' to + copy `esc-map'. + + * calc/calc-graph.el (calc-graph-plot): Remove emacs version check. + + * calc/calc-mode.el (calc-total-algebraic-mode): Remove error + call that would be given when the current emacs was used. + +2004-10-19 Ulf Jasper <ulf.jasper@web.de> + + * calendar/icalendar.el: Set coding to utf-8. + (icalendar-version): Increase to 0.07. + (icalendar-monthnumber-table): Change March pattern. + (icalendar-get-all-event-properties) + (icalendar-set-event-property): Delete. + (icalendar-all-events): No longer interactive. + (icalendar-convert-diary-to-ical) + (icalendar-extract-ical-from-buffer): Make obsolete, and alias to + their replacements. + (icalendar-export-file, icalendar-export-region): New functions; + essentially old `icalendar-convert-diary-to-ical' but appending to + target rather than overwriting. + (icalendar-import-file): Append to target file rather than + overwriting. Fourth arg deleted. + (icalendar-import-buffer): New name for old + `icalendar-extract-ical-from-buffer'. + (icalendar--convert-string-for-import): New name for + old `icalendar-convert-for-import'. + (include-icalendar-files): Delete. + Prefix for all internal functions changed from `icalendar-' + to `icalendar--'. + +2004-10-19 Richard M. Stallman <rms@gnu.org> + + * paths.el (news-path): Fix previous change. + +2004-10-18 Jay Belanger <belanger@truman.edu> + + * calc/calc-help.el (calc-describe-bindings): + Set `buffer-read-only' to nil while working in the keybindings buffer; + remove some extra information from the keybindings buffer. + +2004-10-18 David Ponce <david@dponce.com> + + * mouse.el (mouse-drag-move-window-top): New function. + (mouse-drag-mode-line-1): Use it. + +2004-10-18 Thien-Thi Nguyen <ttn@gnu.org> + + * info.el (Info-fontify-node): For multiline refs, + arrange to unfontify newline and surrounding whitespace. + +2004-10-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-arch.el (vc-arch-workfile-version): Don't burp if the patch-log + directory is missing. + +2004-10-17 John Paul Wallington <jpw@gnu.org> + + * ibuffer.el (ibuffer-default-display-maybe-show-predicates): + New customizable variable; whether to display buffers that match + `ibuffer-maybe-show-predicates' by default. + (ibuffer-maybe-show-predicates): Mention it in docstring. + (ibuffer-display-maybe-show-predicates): New variable. + (ibuffer-update): Prefix arg now toggles whether buffers that + match `ibuffer-maybe-show-predicates' should be displayed. + (ibuffer-mode): Set `ibuffer-display-maybe-show-predicates' + locally to heed `ibuffer-default-display-maybe-show-predicates'. + (ibuffer-redisplay-engine): Rename optional second arg to `ignore'. + +2004-10-17 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el: Redo sync with Tramp 2.0.45. Last commit did not + work correctly. + +2004-10-17 Daniel Pfeiffer <occitan@esperanto.org> + + * buff-menu.el (Buffer-menu-revert-function): Emulate save-excursion. + (Buffer-menu-beginning): New helper function. + (Buffer-menu-execute): Use it. + (Buffer-menu-select): Use it. + (Buffer-menu-sort): Use it and also keep markers. + +2004-10-17 Richard M. Stallman <rms@gnu.org> + + * paths.el (news-directory): Rename from news-path. Old name alias. + (rmail-spool-directory): Use defvar. + (sendmail-program): Use defcustom. + (remote-shell-program): Use defcustom. + (term-file-prefix): Use defvar. + (abbrev-file-name): Use defvar. + + * term.el: Add maintainer. + + * subr.el (with-local-quit): Return nil if there's a quit. + (read-passwd): Use with-local-quit. Doc fix. + + * strokes.el (strokes-list-strokes): Don't try to delete char at eob. + (strokes-unload-hook): Set as a variable with add-hook. + + * startup.el (fancy-splash-tail, normal-splash-screen): + Update copyright year. + + * shadowfile.el (shadowfile-unload-hook): Set as variable w/ add-hook. + + * server.el (server-unload-hook): Set as a variable with add-hook. + + * help-at-pt.el (help-at-pt-unload-hook): Use add-hook; no defvar. + + * frame.el (special-display-popup-frame): + Make the buffer current as its frame is created. + + * delsel.el (delsel-unload-hook): Set as a variable. + + * comint.el (comint-output-filter-functions): + Add comint-watch-for-password-prompt. + (comint-read-noecho): Function deleted. + (send-invisible): Use read-passwd. + + * fringe.el (fringe-mode-initialize): New function. + (fringe-mode): Use fringe-mode-initialize as :initialize. + +2004-10-17 Kim F. Storm <storm@cua.dk> + + * language/indian.el (indian-script-language-alist): Swap value and doc. + (indian-font-char-index-table): Doc fix. + +2004-10-16 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc-hooks.el (vc-find-file-hook): Call vc-backend with absolute name. + +2004-10-16 Juri Linkov <juri@jurta.org> + + * progmodes/compile.el (compilation-start): Move let-binding of + `process-environment' into `with-current-buffer' body. + Reported by Matt Hodges <MPHodges@member.fsf.org>. + +2004-10-16 Richard M. Stallman <rms@gnu.org> + + * pcvs-util.el (cvs-bury-buffer): + Don't call get-buffer-window for effect. + + * outline.el (hide-other): Call outline-up-heading with INVISIBLE-OK=t. + + * newcomment.el (comment-auto-fill-only-comments): Add autoload. + + * msb.el (msb-unload-hook): Set the variable. + + * mouse.el (mouse-yank-at-click, mouse-yank-secondary): + Use * to err if buffer is readonly. + + * subr.el (looking-back): Return only t or nil. + + * whitespace.el (whitespace-unload-hook): Set the variable. + + * view.el (view-mode-enable): Set view-page-size and + view-half-page-size to nil. + (view-set-half-page-size-default): view-half-page-size = nil + means the default. + (View-scroll-page-forward): Use view-page-size-default. + (View-scroll-page-backward): Likewise. + (view-page-size, view-half-page-size): Doc fixes. + + * emacs-lisp/elp.el (elp-unload-hook): Set the variable. + + * emacs-lisp/cl.el (cl-unload-hook): Don't defvar it, just set it. + + * emacs-lisp/bytecomp.el (byte-compile-eval): Don't process + "cl" like other files. Instead, call byte-compile-find-cl-functions. + (byte-compile-log-1): Bind inhibit-read-only. + (byte-compile-warning-prefix, byte-compile-log-file): Likewise. + (byte-compile-log-warning): Likewise. + (byte-compile-file-form-require): Detect "cl" from the arg value. + + * progmodes/compile.el (compilation-start): Assume compilation-mode + will make the buffer read-only. + (compilation-mode): Take arg name-of-mode. + (compilation-setup): Make buffer read-only. + (compilation-handle-exit): Bind inhibit-read-only. + + * textmodes/ispell.el (ispell-command-loop): Use with-no-warnings. + (ispell-message): Likewise. + (ispell-show-choices): Don't call get-buffer-window uselessly. + (ispell-init-process): Use set-process-query-on-exit-flag. + +2004-10-16 Kim F. Storm <storm@cua.dk> + + * fringe.el (fringe-bitmaps): Only initialize when defined. + + * pcvs.el (cvs-mode-view-file, cvs-mode-view-file-other-window): Add. + (cvs-mode-find-file): Add optional `view' arg to enter view mode. + + * pcvs-defs.el (cvs-mode-map): Bind v to cvs-mode-view-file. + +2004-10-15 Simon Josefsson <jas@extundo.com> + + * net/password.el: Add. + 2004-10-13 Daniel Pfeiffer <occitan@esperanto.org> - * button.el (button-activate): Allow a marker to display as an - action. - - * help-fns.el (describe-variable): Use it to make "below" a - hyperlink. + * button.el (button-activate): Allow a marker to display as an action. + + * help-fns.el (describe-variable): Use it to make "below" a hyperlink. * help.el (describe-mode): Use it to make minor mode list into hyperlinks. @@ -25,6 +270,25 @@ (event-modifiers): Use push. (mouse-movement-p, with-temp-buffer): Simplify. +2004-10-12 Jay Belanger <belanger@truman.edu> + + * calc/calc-help.el (calc-help-function-list, calc-help-variable-list): + New variables. + (calc-help-index-entries): New function. + (calc-describe-function): Use `calc-help-function-list' instead of + obarray for completion. + (calc-describe-variable): Use `calc-help-variable-list' instead + of obarray for completion. + +2004-10-12 Richard M. Stallman <rms@gnu.org> + + * info-look.el (info-lookup-file): Add info-file property. + (info-lookup-symbol): Likewise. + + * info.el (info-xref): Add underlining. + (info): Add info-file property. + (Info-find-emacs-command-nodes): Specify case-sensitive search. + 2004-10-12 Michael Albinus <michael.albinus@gmx.de> Sync with Tramp 2.0.45. @@ -78,6 +342,15 @@ * subr.el (substitute-key-definition): Mention command remapping in doc string. +2004-10-11 Jay Belanger <belanger@truman.edu> + + * calc/calc-misc.el (calc-info-goto-node): New function. + (calc-tutorial, calc-info-summary): Go to appropriate Calc info + node in one step. + (calc-describe-copying, calc-describe-distribution) + (calc-describe-thing, calc-describe-no-warranty, calc-describe-key): + Go to appropriate info node in one step. + 2004-10-11 Stefan Monnier <monnier@iro.umontreal.ca> * pcvs-defs.el (pcl-cvs-load-hook): Remove unused var. @@ -201,7 +474,7 @@ 2004-10-05 Juri Linkov <juri@jurta.org> * isearch.el (isearch-done): Set mark after running hook. - Suggested by Drew Adams <drew.adams@oracle.com>. + Reported by Drew Adams <drew.adams@oracle.com>. * info.el (Info-history, Info-toc): Fix Info headers. (Info-toc): Narrow buffer before Info-fontify-node. @@ -443,6 +716,12 @@ * progmodes/tcl.el (inferior-tcl): Use pop-to-buffer. +2004-09-21 Jay Belanger <belanger@truman.edu> + + * calc/calc-graph.el (calc-graph-add-curve): Moved the call to + `calc-graph-set-styles' so the gnuplot buffer will appear in a + separate window. + 2004-09-21 Luc Teirlinck <teirllm@auburn.edu> * subr.el (after-change-major-mode-hook): Doc fix. @@ -457,6 +736,10 @@ * descr-text.el (describe-char): Checking of quail activation fixed. +2004-09-21 Jay Belanger <belanger@truman.edu> + + * calc/calc.el (calc-mode-var-list): Removed unnecessary quotes. + 2004-09-20 Luc Teirlinck <teirllm@auburn.edu> * subr.el (run-mode-hooks): Run `after-change-major-mode-hook' @@ -542,6 +825,11 @@ * calc/calc-units.el (calc-quick-units): Fix overzealous s/or/unless/. +2004-09-17 Jay Belanger <belanger@truman.edu> + + * calc/calc.el (calc-mode-var-list): Fixed the value of + `calc-matrix-brackets'. + 2004-09-17 Romain Francoise <romain@orebokech.com> * ibuf-ext.el (define-ibuffer-filter filename): @@ -573,6 +861,44 @@ (term-protocol-version): Increment. (term-current-face): Set to default. +2004-09-15 Jay Belanger <belanger@truman.edu> + + * calc/calc.el (calc-mode-var-list): Define this variable. + (calc-always-load-extensions, calc-line-numbering) + (calc-line-breaking, calc-display-just, calc-display-origin) + (calc-number-radix, calc-leading-zeros, calc-group-digits) + (calc-group-char, calc-point-char, calc-frac-format) + (calc-prefer-frac, calc-hms-format, calc-date-format) + (calc-float-format, calc-full-float-format, calc-complex-format) + (calc-complex-mode, calc-infinite-mode, calc-display-strings) + (calc-matrix-just, calc-break-vectors, calc-full-vectors) + (calc-full-trail-vectors, calc-vector-commas, calc-vector-brackets) + (calc-matrix-brackets, calc-language, calc-language-option) + (calc-left-label, calc-right-label, calc-word-size) + (calc-previous-modulo, calc-simplify-mode, calc-auto-recompute) + (calc-display-raw, calc-internal-prec, calc-angle-mode) + (calc-algebraic-mode, calc-incomplete-algebraic-mode) + (calc-symbolic-mode, calc-matrix-mode, calc-shift-prefix) + (calc-window-height, calc-display-trail, calc-show-selections) + (calc-use-selections, calc-assoc-selections) + (calc-display-working-message, calc-auto-why, calc-timing) + (calc-mode-save-mode, calc-standard-date-formats) + (calc-autorange-units, calc-was-keypad-mode, calc-full-mode) + (calc-user-parse-tables, calc-gnuplot-default-device) + (calc-gnuplot-default-output, calc-gnuplot-print-device) + (calc-gnuplot-print-output, calc-gnuplot-geometry) + (calc-graph-default-resolution, calc-graph-default-resolution-3d) + (calc-invocation-macro, calc-show-banner): Give these values as + part of `calc-mode-var-list's initialization after the variables + are declared with defvar. + (calc-bug-address): Changed email address to send bug + reports to. Also changed the maintainer address at the top. + (calc-mode): Compare `calc-settings-file' to `user-init-file' rather + than "\\.emacs" to determine if it is the user-init-file. + + * calc/calc-embed.el (calc-embedded-set-modes): Use + `calc-mode-var-list' correctly. + 2004-09-15 Thien-Thi Nguyen <ttn@gnu.org> * vc.el (annotate-time): Document point handling.
--- a/lisp/autorevert.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/autorevert.el Fri Oct 22 10:13:52 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/buff-menu.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/buff-menu.el Fri Oct 22 10:13:52 2004 +0000 @@ -197,9 +197,15 @@ (defun Buffer-menu-revert-function (ignore1 ignore2) ;; We can not use save-excursion here. The buffer gets erased. - (let ((old-point (point))) + (let ((ocol (current-column)) + (oline (progn (move-to-column 4) + (get-text-property (point) 'buffer))) + (prop (point-min))) (list-buffers-noselect Buffer-menu-files-only) - (goto-char old-point))) + (while (setq prop (next-single-property-change prop 'buffer)) + (when (eq (get-text-property prop 'buffer) oline) + (goto-char prop) + (move-to-column ocol))))) (defun Buffer-menu-toggle-files-only (arg) "Toggle whether the current buffer-menu displays only file buffers. @@ -354,13 +360,16 @@ (delete-char 1) (insert (if arg ?* ? )))))) +(defun Buffer-menu-beginning () + (goto-char (point-min)) + (unless Buffer-menu-use-header-line + (forward-line))) + (defun Buffer-menu-execute () "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands." (interactive) (save-excursion - (goto-char (point-min)) - (unless Buffer-menu-use-header-line - (forward-line 1)) + (Buffer-menu-beginning) (while (re-search-forward "^..S" nil t) (let ((modp nil)) (save-excursion @@ -371,9 +380,7 @@ (delete-char -1) (insert (if modp ?* ? )))))) (save-excursion - (goto-char (point-min)) - (unless Buffer-menu-use-header-line - (forward-line 1)) + (Buffer-menu-beginning) (let ((buff-menu-buffer (current-buffer)) (buffer-read-only nil)) (while (re-search-forward "^D" nil t) @@ -399,9 +406,7 @@ (menu (current-buffer)) (others ()) tem) - (goto-char (point-min)) - (unless Buffer-menu-use-header-line - (forward-line 1)) + (Buffer-menu-beginning) (while (re-search-forward "^>" nil t) (setq tem (Buffer-menu-buffer t)) (let ((buffer-read-only nil)) @@ -581,7 +586,35 @@ (if (< column 2) (setq column 2)) (if (> column 5) (setq column 5))) (setq Buffer-menu-sort-column column) - (Buffer-menu-revert)) + (let (buffer-read-only l buf m1 m2) + (save-excursion + (Buffer-menu-beginning) + (while (not (eobp)) + (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer))) + (setq m1 (char-after) + m1 (if (memq m1 '(?> ?D)) m1) + m2 (char-after (+ (point) 2)) + m2 (if (eq m2 ?S) m2)) + (if (or m1 m2) + (push (list buf m1 m2) l))) + (forward-line))) + (Buffer-menu-revert) + (setq buffer-read-only) + (save-excursion + (Buffer-menu-beginning) + (while (not (eobp)) + (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l)) + (setq m1 (cadr buf) + m2 (cadr (cdr buf))) + (when m1 + (delete-char 1) + (insert m1) + (backward-char 1)) + (when m2 + (forward-char 2) + (delete-char 1) + (insert m2))) + (forward-line))))) (defun Buffer-menu-make-sort-button (name column) (if (equal column Buffer-menu-sort-column) (setq column nil)) @@ -592,7 +625,9 @@ 'mouse-face 'highlight 'keymap (let ((map (make-sparse-keymap))) (define-key map [header-line mouse-2] - `(lambda () (interactive) + `(lambda (e) + (interactive "e") + (if e (set-buffer (window-buffer (posn-window (event-end e))))) (Buffer-menu-sort ,column))) map)))
--- a/lisp/calc/calc-aent.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/calc/calc-aent.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/calc/calc-ext.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/calc/calc-graph.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/calc/calc-help.el Fri Oct 22 10:13:52 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,34 +113,27 @@ (describe-bindings) (save-excursion (set-buffer "*Help*") - (goto-char (point-min)) - (if (search-forward "Global bindings:" nil t) - (delete-region (match-beginning 0) (point-max))) - (goto-char (point-min)) - (while (re-search-forward "\n[a-z] ESC" nil t) - (end-of-line) - (delete-region (match-beginning 0) (point))) - (goto-char (point-min)) - (while (re-search-forward "\nESC m" nil t) - (end-of-line) - (delete-region (match-beginning 0) (point))) - (goto-char (point-min)) - (while (search-forward "\n\n\n" nil t) - (backward-delete-char 1) - (backward-char 2)) - (goto-char (point-min)) - (while - (re-search-forward - "\n[a-z] [0-9]\\(\t\t.*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1" - nil t) - (let ((dig1 (char-after (1- (match-beginning 1)))) - (dig2 (char-after (match-beginning 3)))) - (delete-region (match-end 1) (match-end 0)) - (goto-char (match-beginning 1)) - (delete-backward-char 1) - (delete-char 1) - (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2))))) - (goto-char (point-min)))) + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (when (search-forward "Major Mode Bindings:" nil t) + (delete-region (point-min) (point)) + (insert "Calc Mode Bindings:")) + (when (search-forward "Global bindings:" nil t) + (forward-line -1) + (delete-region (point) (point-max))) + (goto-char (point-min)) + (while + (re-search-forward + "\n[a-z] [0-9]\\( .*\n\\)\\([a-z] [0-9]\\1\\)*[a-z] \\([0-9]\\)\\1" + nil t) + (let ((dig1 (char-after (1- (match-beginning 1)))) + (dig2 (char-after (match-beginning 3)))) + (delete-region (match-end 1) (match-end 0)) + (goto-char (match-beginning 1)) + (delete-backward-char 1) + (delete-char 5) + (insert (format "%c .. %c" (min dig1 dig2) (max dig1 dig2))))) + (goto-char (point-min))))) (defun calc-describe-key-briefly (key) (interactive "kDescribe key briefly: ") @@ -680,5 +674,5 @@ "} (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 11:11:47 2004 +0000 +++ b/lisp/calc/calc-mode.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/calc/calc.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/calendar/icalendar.el Fri Oct 22 10:13:52 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,18 @@ ;;; 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. + +;; 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 +71,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 +83,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.") ;; ====================================================================== @@ -173,7 +180,7 @@ (defconst icalendar-monthnumber-table '(("^jan\\(uar\\)?y?$" . 1) ("^feb\\(ruar\\)?y?$" . 2) - ("^mar\\(ch\\)?\\|märz?$" . 3) + ("^mar\\(ch\\)?\\|märz$" . 3) ("^apr\\(il\\)?$" . 4) ("^ma[iy]$" . 5) ("^jun[ie]?$" . 6) @@ -195,11 +202,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 +226,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 +239,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 +247,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 +275,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 +294,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 +309,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 +335,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 +361,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 +386,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 +408,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 +422,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 +432,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,40 +483,40 @@ ;;(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)))) -(defun icalendar-get-weekday-abbrev (weekday) +(defun icalendar--get-weekday-abbrev (weekday) "Return the abbreviated WEEKDAY." ;;FIXME: ISO-like(?). (save-match-data @@ -511,108 +524,118 @@ (assoc-default weekday icalendar-weekdayabbrev-table 'string-match)))) -(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 +644,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 +664,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 +688,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 +697,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 +719,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 +741,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 +760,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 +780,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 +797,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 +831,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 +843,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 +867,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 +903,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 +912,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 +931,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 +970,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 +1025,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 +1033,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 +1047,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 +1076,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 +1101,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,69 +1112,69 @@ (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") + (cdr (rassoc + byday + icalendar-weekdayabbrev-table)))) + (icalendar--dmsg "weekly not-all-day") (if weekday (setq diary-string (format "%s %s%s%s" weekday @@ -1169,19 +1185,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 +1205,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 +1241,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 +1259,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 +1283,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 +1303,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 11:11:47 2004 +0000 +++ b/lisp/comint.el Fri Oct 22 10:13:52 2004 +0000 @@ -369,10 +369,10 @@ history list. Default is to save anything that isn't all whitespace.") (defvar comint-input-filter-functions '() - "Special hook run before input is sent to the process. + "Abnormal hook run before input is sent to the process. These functions get one argument, a string containing the text to send.") -(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom) +(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "Functions to call after output is inserted into the buffer. One possible function is `comint-postoutput-scroll-to-bottom'. These functions get one argument, a string containing the text as originally @@ -788,7 +788,7 @@ (defun comint-insert-input (&optional event) "In a Comint buffer, set the current input to the previous input at point." - (interactive (list last-input-event)) + (interactive "@") (if event (mouse-set-point event)) (let ((pos (point))) (if (not (eq (get-char-property pos 'field) 'input)) @@ -1901,65 +1901,7 @@ ;; These three functions are for entering text you don't want echoed or ;; saved -- typically passwords to ftp, telnet, or somesuch. -;; Just enter m-x send-invisible and type in your line, or add -;; `comint-watch-for-password-prompt' to `comint-output-filter-functions'. - -(defun comint-read-noecho (prompt &optional stars) - "Read a single line of text from user without echoing, and return it. -Prompt with argument PROMPT, a string. Optional argument STARS causes -input to be echoed with '*' characters on the prompt line. Input ends with -RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. C-g aborts (if -`inhibit-quit' is set because e.g. this function was called from a process -filter and C-g is pressed, this function returns nil rather than a string). - -Note that the keystrokes comprising the text can still be recovered -\(temporarily) with \\[view-lossage]. Some people find this worrisome (see, -however, `clear-this-command-keys'). -Once the caller uses the password, it can erase the password -by doing (clear-string STRING)." - (let ((ans "") - (newans nil) - (c 0) - (echo-keystrokes 0) - (cursor-in-echo-area t) - (message-log-max nil) - (done nil)) - (while (not done) - (if stars - (message "%s%s" prompt (make-string (length ans) ?*)) - (message "%s" prompt)) - ;; Use this instead of `read-char' to avoid "Non-character input-event". - (setq c (read-char-exclusive)) - (cond ((= c ?\C-g) - ;; This function may get called from a process filter, where - ;; inhibit-quit is set. In later versions of emacs read-char - ;; may clear quit-flag itself and return C-g. That would make - ;; it impossible to quit this loop in a simple way, so - ;; re-enable it here (for backward-compatibility the check for - ;; quit-flag below would still be necessary, so this seems - ;; like the simplest way to do things). - (setq quit-flag t - done t)) - ((or (= c ?\r) (= c ?\n) (= c ?\e)) - (setq done t)) - ((= c ?\C-u) - (clear-string ans) - (setq ans "")) - ((and (/= c ?\b) (/= c ?\177)) - (setq newans (concat ans (char-to-string c))) - (clear-string ans) - (setq ans newans)) - ((> (length ans) 0) - (aset ans (1- (length ans)) 0) - (setq ans (substring ans 0 -1))))) - (if quit-flag - ;; Emulate a true quit, except that we have to return a value. - (prog1 - (setq quit-flag nil) - (message "Quit") - (beep t)) - (message "") - ans))) +;; Just enter m-x send-invisible and type in your line. (defun send-invisible (&optional prompt) "Read a string without echoing. @@ -1970,7 +1912,7 @@ (interactive "P") ; Defeat snooping via C-x ESC ESC (let ((proc (get-buffer-process (current-buffer)))) (if proc - (let ((str (comint-read-noecho (or prompt "Non-echoed text: ") t))) + (let ((str (read-passwd (or prompt "Non-echoed text: ")))) (if (stringp str) (progn (comint-snapshot-last-prompt) @@ -2340,7 +2282,7 @@ (defun comint-kill-whole-line (&optional arg) "Kill current line, ignoring read-only and field properties. -With prefix ARG, kill that many lines starting from the current line. +With prefix arg, kill that many lines starting from the current line. If arg is negative, kill backward. Also kill the preceding newline, instead of the trailing one. \(This is meant to make \\[repeat] work well with negative arguments.) @@ -2488,7 +2430,7 @@ 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/delsel.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/delsel.el Fri Oct 22 10:13:52 2004 +0000 @@ -147,6 +147,8 @@ (define-key minibuffer-local-must-match-map "\C-g" 'abort-recursive-edit) (define-key minibuffer-local-isearch-map "\C-g" 'abort-recursive-edit)) +(add-hook 'delsel-unload-hook 'delsel-unload-hook) + (provide 'delsel) ;;; arch-tag: 1e388890-1b50-4ed0-9347-763b1343b6ed
--- a/lisp/emacs-lisp/bytecomp.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/emacs-lisp/bytecomp.el Fri Oct 22 10:13:52 2004 +0000 @@ -792,7 +792,8 @@ (let ((xs (pop hist-new)) old-autoloads) ;; Make sure the file was not already loaded before. - (unless (assoc (car xs) hist-orig) + (unless (or (assoc (car xs) hist-orig) + (equal (car xs) "cl")) (dolist (s xs) (cond ((symbolp s) @@ -809,7 +810,18 @@ (when (and (symbolp s) (not (memq s old-autoloads))) (push s byte-compile-noruntime-functions)) (when (and (consp s) (eq t (car s))) - (push (cdr s) old-autoloads)))))))))) + (push (cdr s) old-autoloads))))))) + (when (memq 'cl-functions byte-compile-warnings) + (let ((hist-new load-history) + (hist-nil-new current-load-list)) + ;; Go through load-history, look for newly loaded files + ;; and mark all the functions defined therein. + (while (and hist-new (not (eq hist-new hist-orig))) + (let ((xs (pop hist-new)) + old-autoloads) + ;; Make sure the file was not already loaded before. + (when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig))) + (byte-compile-find-cl-functions))))))))) (defun byte-compile-eval-before-compile (form) "Evaluate FORM for `eval-and-compile'." @@ -848,12 +860,13 @@ ;; Log something that isn't a warning. (defun byte-compile-log-1 (string) (with-current-buffer "*Compile-Log*" - (goto-char (point-max)) - (byte-compile-warning-prefix nil nil) - (cond (noninteractive - (message " %s" string)) - (t - (insert (format "%s\n" string)))))) + (let ((inhibit-read-only t)) + (goto-char (point-max)) + (byte-compile-warning-prefix nil nil) + (cond (noninteractive + (message " %s" string)) + (t + (insert (format "%s\n" string))))))) (defvar byte-compile-read-position nil "Character position we began the last `read' from.") @@ -904,7 +917,8 @@ ;; This is used as warning-prefix for the compiler. ;; It is always called with the warnings buffer current. (defun byte-compile-warning-prefix (level entry) - (let* ((dir default-directory) + (let* ((inhibit-read-only t) + (dir default-directory) (file (cond ((stringp byte-compile-current-file) (format "%s:" (file-relative-name byte-compile-current-file dir))) ((bufferp byte-compile-current-file) @@ -950,7 +964,8 @@ (save-excursion (set-buffer (get-buffer-create "*Compile-Log*")) (goto-char (point-max)) - (let* ((dir (and byte-compile-current-file + (let* ((inhibit-read-only t) + (dir (and byte-compile-current-file (file-name-directory byte-compile-current-file))) (was-same (equal default-directory dir)) pt) @@ -984,7 +999,8 @@ (defun byte-compile-log-warning (string &optional fill level) (let ((warning-prefix-function 'byte-compile-warning-prefix) (warning-type-format "") - (warning-fill-prefix (if fill " "))) + (warning-fill-prefix (if fill " ")) + (inhibit-read-only t)) (display-warning 'bytecomp string level "*Compile-Log*"))) (defun byte-compile-warn (format &rest args) @@ -2140,17 +2156,15 @@ (setq tail (cdr tail)))) form) -(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) -(defun byte-compile-file-form-eval-boundary (form) - (let ((old-load-list current-load-list)) - (eval form) - ;; (require 'cl) turns off warnings for cl functions. - (let ((tem current-load-list)) - (while (not (eq tem old-load-list)) - (when (equal (car tem) '(require . cl)) - (setq byte-compile-warnings - (remq 'cl-functions byte-compile-warnings))) - (setq tem (cdr tem))))) +(put 'require 'byte-hunk-handler 'byte-compile-file-form-require) +(defun byte-compile-file-form-require (form) + (let ((old-load-list current-load-list) + (args (mapcar 'eval (cdr form)))) + (apply 'require args) + ;; Detech (require 'cl) in a way that works even if cl is already loaded. + (if (member (car args) '("cl" cl)) + (setq byte-compile-warnings + (remq 'cl-functions byte-compile-warnings)))) (byte-compile-keep-pending form 'byte-compile-normal-call)) (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
--- a/lisp/emacs-lisp/cl.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/emacs-lisp/cl.el Fri Oct 22 10:13:52 2004 +0000 @@ -108,8 +108,7 @@ This variable is not used at present, but it is defined in hopes that a future Emacs interpreter will be able to use it.") -(defvar cl-unload-hook '(cl-cannot-unload) - "Prevent unloading the feature `cl', since it does not work.") +(add-hook 'cl-unload-hook 'cl-cannot-unload) (defun cl-cannot-unload () (error "Cannot unload the feature `cl'"))
--- a/lisp/emacs-lisp/elp.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/emacs-lisp/elp.el Fri Oct 22 10:13:52 2004 +0000 @@ -626,6 +626,7 @@ (defun elp-unload-hook () (elp-restore-all)) +(add-hook 'elp-unload-hook 'elp-unload-hook) (provide 'elp)
--- a/lisp/eshell/em-unix.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/eshell/em-unix.el Fri Oct 22 10:13:52 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/frame.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/frame.el Fri Oct 22 10:13:52 2004 +0000 @@ -135,7 +135,9 @@ ;; (set-window-dedicated-p window t) window)) ;; If no window yet, make one in a new frame. - (let ((frame (make-frame (append args special-display-frame-alist)))) + (let ((frame + (with-current-buffer buffer + (make-frame (append args special-display-frame-alist))))) (set-window-buffer (frame-selected-window frame) buffer) (set-window-dedicated-p (frame-selected-window frame) t) (frame-selected-window frame))))))
--- a/lisp/fringe.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/fringe.el Fri Oct 22 10:13:52 2004 +0000 @@ -43,7 +43,8 @@ (defvar fringe-bitmaps) -(unless (get 'left-truncation 'fringe) +(unless (or (not (boundp 'fringe-bitmaps)) + (get 'left-truncation 'fringe)) (let ((bitmaps '(left-truncation right-truncation up-arrow down-arrow continued-line continuation-line @@ -112,6 +113,25 @@ fringe-mode)))) (setq frames (cdr frames))))) +;; For initialization of fringe-mode, take account of changes +;; made explicitly to default-frame-alist. +(defun fringe-mode-initialize (symbol value) + (let* ((left-pair (assq 'left-fringe default-frame-alist)) + (right-pair (assq 'right-fringe default-frame-alist)) + (left (cdr left-pair)) + (right (cdr right-pair))) + (if (or left-pair right-pair) + ;; If there's something in default-frame-alist for fringes, + ;; don't change it, but reflect that into the value of fringe-mode. + (progn + (setq fringe-mode (cons left right)) + (if (equal fringe-mode '(nil . nil)) + (setq fringe-mode nil)) + (if (equal fringe-mode '(0 . 0)) + (setq fringe-mode 0))) + ;; Otherwise impose the user-specified value of fringe-mode. + (custom-initialize-reset symbol value)))) + ;;;###autoload (defcustom fringe-mode nil "*Specify appearance of fringes on all frames. @@ -138,6 +158,7 @@ (integer :tag "Right width"))) :group 'frames :require 'fringe + :initialize 'fringe-mode-initialize :set 'set-fringe-mode-1) (defun fringe-query-style (&optional all-frames)
--- a/lisp/gnus/ChangeLog Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/ChangeLog Fri Oct 22 10:13:52 2004 +0000 @@ -1,3 +1,365 @@ +2004-10-21 Katsumi Yamaoka <yamaoka@jpl.org> + + * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when + running the major-mode function. + +2004-10-21 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-start.el (gnus-convert-old-newsrc): Two of the converters + have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a + boolean check to not apply converters that apply to future + versions of gnus. + +2004-10-19 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-update-summary-mark-positions): Search for + dummy marks in the right way. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to + avoid infinite recursion via gnus-get-function. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-synchronize-group-flags): When + necessary, pass full group name to gnus-request-set-marks. + (gnus-agent-synchronize-group-flags): Added support for sync'ing + tick marks. + (gnus-agent-synchronize-flags-server): Be silent when writing file. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-synchronize-group-flags): Replaced + gnus-request-update-info with explicit code to sync the in-memory + info read flags with the marks being sync'd to the backend. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore + servers that are offline. Avoids having gnus-agent-toggle-plugged + first ask if you want to open a server and then, even when you + responded with no, asking if you want to synchronize the server's + flags. + (gnus-agent-synchronize-flags-server): Rewrote read loop to handle + multi-line expressions. + (gnus-agent-synchronize-group-flags): New internal function. + Updates marks in memory (in the info structure) AND in the + backend. + (gnus-agent-check-overview-buffer): Fixed range of + deletion to remove entire duplicate line. Fixes merged article + number bug. + + * gnus-util.el (gnus-remassoc): Fixed typo in documentation. + + * nnagent.el (nnagent-request-set-mark): Use + gnus-agent-synchronize-group-flags, not backend's request-set-mark + method, to ensure that synchronization updates marks in the + backend and in the info (in memory) structure. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing + unless plugged. Disable the agent so that an open failure causes + an error. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> + * gnus-agent.el (gnus-agent-fetched-hook): Add :version. + (gnus-agent-go-online): Change :version. + (gnus-agent-expire-unagentized-dirs) + (gnus-agent-auto-agentize-methods): Add :version. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * legacy-gnus-agent.el (gnus-agent-convert-to-compressed-agentview-prompt): + New function. Used internally to only display 'gnus converting + files' message when actually necessary. + + * gnus-sum.el (): Removed (require 'gnus-agent) as required + methods now autoloaded. + + * gnus-int.el (gnus-request-move-article): Use + gnus-agent-unfetch-articles in place of gnus-agent-expire to + improve performance. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-cat-groups): rewrote avoiding defsetf + to avoid run-time CL dependencies. + (gnus-agent-unfetch-articles): New function. + (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate + article numbers even when local .overview file is missing. + (gnus-agent-read-article-number): New function. Only accepts + 27-bit article numbers. + (gnus-agent-copy-nov-line, gnus-agent-uncached-articles): Use + gnus-agent-read-article-number. + (gnus-agent-braid-nov): Rewrote to validate article numbers coming + from backend while recognizing that article numbers in .overview + must be valid. + + * gnus-start.el (gnus-convert-old-newsrc): Changed message text as + some users confused by references to .newsrc when they only have a + .newsrc.eld file. + (gnus-convert-mark-converter-prompt, + gnus-convert-converter-needs-prompt): Fixed use of property list. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-get-unread-articles-in-group): Don't do + stuff for non-living groups. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil. + (gnus-agent-regenerate-group): Using nil messages aren't valid. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-agent.el (gnus-agent-read-agentview): Inline + gnus-uncompress-range. + +2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> + + * legacy-gnus-agent.el + (gnus-agent-convert-to-compressed-agentview): Fixed typos with + help from Florian Weimer <fw@deneb.enyo.de> + + * gnus-agent.el (gnus-agentize): + gnus-agent-send-mail-real-function no longer set to current value + of message-send-mail-function but rather a lambda that calls + message-send-mail-function. The change makes the agent real-time + responsive to user changes to message-send-mail-function. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Reiner Steib <Reiner.Steib@gmx.de> + + * gnus-start.el (gnus-get-unread-articles): Fix last commit. + +2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> + + * gnus-cache.el (gnus-cache-rename-group): New function. + (gnus-cache-delete-group): New function. + + * gnus-agent.el (gnus-agent-rename-group): New function. + (gnus-agent-delete-group): New function. + (gnus-agent-save-group-info): Use gnus-command-method when + `method' parameter is nil. Don't write nil entries into the + active file. + (gnus-agent-get-group-info): New function. + (gnus-agent-get-local): Added optional parameters to avoid calling + gnus-group-real-name and gnus-find-method-for-group. + (gnus-agent-set-local): Delete stored entry if either min, or max, + are nil. + (gnus-agent-fetch-session): Reworded error/quit messages. On + quit, use gnus-agent-regenerate-group to record existance of any + articles fetched to disk before the quit occurred. + + * gnus-int.el (gnus-request-delete-group): Use + gnus-cache-delete-group and gnus-agent-delete-group to keep the + local disk in sync with the server. + (gnus-request-rename-group): Use + gnus-cache-rename-group and gnus-agent-rename-group to keep the + local disk in sync with the server. + + * gnus-start.el (gnus-get-unread-articles): Cosmetic + simplification to logic. + + * gnus-group.el (): (gnus-group-delete-group): No longer update + gnus-cache-active-altered as gnus-request-delete-group now keeps + the cache in sync. + (gnus-group-list-active): Let the agent store a server's active + list if currently plugged. + + * gnus-util.el (gnus-rename-file): New function. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-agent.el (gnus-agent-regenerate-group): Activate the group + when the group's active is not available. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> for Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to + error. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-start.el (gnus-convert-old-newsrc): Only write the + conversion message to newsrc-dribble when an actual conversion is + performed. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-agent.el (gnus-agent-read-local): Bind + nnheader-file-coding-system to gnus-agent-file-coding-system to + avoid the implicit assumption that they will always be equal. + (gnus-agent-save-local): Bind buffer-file-coding-system, not + coding-system-for-write, as the with-temp-file macro first prints + to a buffer then saves the buffer. + +2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> + + * legacy-gnus-agent.el (): New. Provides converters that are only + loaded when gnus-convert-old-newsrc needs to call them. + + * gnus-agent.el (gnus-agent-read-agentview): Removed support for + old file versions. + (gnus-group-prepare-hook): Removed function that converted list + form of gnus-agent-expire-days to group properties. + + * gnus-start.el (gnus-convert-old-newsrc): Registered new + converters to handle old agent file formats. Added logic for a + "backup before upgrading warning". + (gnus-convert-mark-converter-prompt): Developers can mark + functions as needing (default), or not needing, + gnus-convert-old-newsrc's "backup before upgrading warning". + (gnus-convert-converter-needs-prompt): Tests whether the user + should be protected from potentially irreversable changes by the + function. + +2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com> + + * gnus-int.el (gnus-request-accept-article): Inform the agent that + articles are being added to a group. + (gnus-request-replace-article): Inform the agent that articles + need to be uncached as the cached contents are no longer valid. + + * gnus-agent.el (gnus-agent-file-header-cache): Removed. + (gnus-agent-possibly-alter-active): Avoid null in numeric + comparison. + (gnus-agent-set-local): Refuse to save null in local object table. + (gnus-agent-regenerate-group): The REREAD parameter can now be a + list of articles that will be marked as unread. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-range.el (gnus-sorted-range-intersection): Now accepts + single-interval range of the form (min . max). Previously the + range had to look like ((min . max)). Likewise, return + (min . max) rather than ((min . max)). + (gnus-range-map): Use gnus-range-normalize to accept + single-interval range. + + * gnus-sum.el (gnus-summary-highlight-line): Articles stored in + the cache, but not the agent, now appear with their usual face. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of + marks consisting of a single range {for example, (3 . 5)} rather + than a list of a single range { ((3 . 5)) }. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the + uncompressed list. + +2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc> + + * gnus-draft.el (gnus-group-send-queue): Pass the group name + "nndraft:queue" along to gnus-draft-send. Use + gnus-agent-prompt-send-queue. + (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group + is "nndraft:queue". Suggested by Gaute Strokkenes + <gs234@srcf.ucam.org> + + * gnus-group.el (gnus-group-catchup): Use new + gnus-sequence-of-unread-articles, not + gnus-list-of-unread-articles, to avoid exhausting memory with huge + numbers of articles. Use gnus-range-map to avoid having to + uncompress the unread list. + (gnus-group-archive-directory, + gnus-group-recent-archive-directory): Fixed invalid ange-ftp + reference. + + * gnus-range.el (gnus-range-map): Iterate over list or sequence. + (gnus-sorted-range-intersection): Intersection of two ranges + without requiring that they first be uncompressed. + + * gnus-start.el (gnus-activate-group): Unless blocked by the + caller, possibly expand the active range to include both cached + and agentized articles. + (gnus-convert-old-newsrc): Rewrote in anticipation of having + multiple version-dependent converters. + (gnus-groups-to-gnus-format): Replaced gnus-agent-save-groups with + gnus-agent-save-active. + (gnus-save-newsrc-file): Save dirty agent range limits. + + * gnus-sum.el (gnus-select-newgroup): Replaced inline code with + gnus-agent-possibly-alter-active. + (gnus-adjust-marked-articles): Faster handling of simple lists + +2004-10-18 David Edmondson <dme@dme.org> + + * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call + excessively. + +2004-10-18 Reiner Steib <Reiner.Steib@gmx.de> + + * mml.el (mml-preview): Use `pop-to-buffer'. + + * message.el (message-goto-mail-followup-to): Insert after "To". + (message-carefully-insert-headers): Add comment. + + * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts. + + * gnus-art.el (gnus-button-alist): Improve + `gnus-button-handle-library' entry. + + * gnus-art.el (gnus-button-alist): Fixed regexp for manual links. + + * gnus-group.el (gnus-group-get-new-news-this-group): Added + doc-string. + + * gnus-start.el (gnus-activate-group): Added doc-string. + + * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to + handle manual section. + + * imap.el (imap-store-password): New variable. + (imap-interactive-login): Use it. + Suggested by Mark Plaksin <happy@mcplaksin.org>. + + * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Allow + / in mailto URLs. + + * spam.el (spam-directory): Derive from `gnus-directory'. + + * gnus-sum.el (gnus-pick-line-number): Add autoload. + +2004-10-17 Richard M. Stallman <rms@gnu.org> + + * gnus-registry.el (gnus-registry-unload-hook): + Set as a variable with add-hook. + + * nnspool.el (nnspool-spool-directory): Use news-directory instead + of news-path. + + * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook. + + * spam.el: Delete duplicate `provide'. + (spam-unload-hook): Set as a variable with add-hook. + +2004-10-15 Reiner Steib <Reiner.Steib@gmx.de> + + * pop3.el (pop3-leave-mail-on-server): Describe possible problems + in the doc string. + + * message.el (message-ignored-news-headers) + (message-ignored-supersedes-headers) + (message-ignored-resent-headers) + (message-forward-ignored-headers): Improve custom type. + +2004-10-15 Simon Josefsson <jas@extundo.com> + + * pop3.el (top-level): Don't require nnheader. + (pop3-read-timeout): Add. + (pop3-accept-process-output): Add. + (pop3-read-response, pop3-retr): Use it. + 2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org> * message.el (message-tokenize-header): Fix 2004-09-06 change @@ -9,6 +371,10 @@ (tls-certificate-information): New function, based on ssl-certificate-information. +2004-10-11 Reiner Steib <Reiner.Steib@gmx.de> + + * message.el (message-bury): Use `window-dedicated-p'. + 2004-10-10 Reiner Steib <Reiner.Steib@gmx.de> * gnus-sum.el: Mention that multibyte characters don't work as marks.
--- a/lisp/gnus/gnus-agent.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-agent.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-art.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-cache.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-draft.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-group.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-int.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-range.el Fri Oct 22 10:13:52 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-registry.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-registry.el Fri Oct 22 10:13:52 2004 +0000 @@ -693,6 +693,8 @@ (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids)) +(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook) + (when gnus-registry-install (gnus-registry-install-hooks) (gnus-registry-read))
--- a/lisp/gnus/gnus-start.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-start.el Fri Oct 22 10:13:52 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. @@ -665,6 +672,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 @@ -1481,8 +1490,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)) @@ -1513,12 +1522,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 @@ -1528,6 +1546,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 @@ -1535,8 +1557,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 @@ -1632,7 +1653,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 @@ -1655,61 +1676,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 @@ -1736,8 +1756,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 @@ -1982,10 +2002,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))) @@ -2129,7 +2149,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)) @@ -2205,17 +2225,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)) @@ -2594,6 +2691,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) @@ -2611,6 +2712,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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-sum.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/gnus-util.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/imap.el Fri Oct 22 10:13:52 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 Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/mail-source.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/message.el Fri Oct 22 10:13:52 2004 +0000 @@ -255,7 +255,12 @@ :group 'message-news :group 'message-headers :link '(custom-manual "(message)Message Headers") - :type 'regexp) + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) (defcustom message-ignored-mail-headers "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:" @@ -271,7 +276,12 @@ any confusion." :group 'message-interface :link '(custom-manual "(message)Superseding") - :type 'regexp) + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) (defcustom message-subject-re-regexp "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*" @@ -534,13 +544,22 @@ "*All headers that match this regexp will be deleted when resending a message." :group 'message-interface :link '(custom-manual "(message)Resending") - :type 'regexp) + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) + regexp)) (defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus" "*All headers that match this regexp will be deleted when forwarding a message." :version "21.1" :group 'message-forwarding - :type '(choice (const :tag "None" nil) + :type '(repeat :value-to-internal (lambda (widget value) + (custom-split-regexp-maybe value)) + :match (lambda (widget value) + (or (stringp value) + (widget-editable-list-match widget value))) regexp)) (defcustom message-ignored-cited-headers "." @@ -2610,7 +2629,7 @@ (defun message-goto-mail-followup-to () "Move point to the Mail-Followup-To header." (interactive) - (message-position-on-field "Mail-Followup-To" "From")) + (message-position-on-field "Mail-Followup-To" "To")) (defun message-goto-keywords () "Move point to the Keywords header." @@ -2720,6 +2739,7 @@ ;; 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 11:11:47 2004 +0000 +++ b/lisp/gnus/mm-view.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/gnus/mml.el Fri Oct 22 10:13:52 2004 +0000 @@ -1076,9 +1076,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 11:11:47 2004 +0000 +++ b/lisp/gnus/nnagent.el Fri Oct 22 10:13:52 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/nnspool.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/nnspool.el Fri Oct 22 10:13:52 2004 +0000 @@ -44,7 +44,7 @@ "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") -(defvoo nnspool-spool-directory (file-name-as-directory news-path) +(defvoo nnspool-spool-directory (file-name-as-directory news-directory) "Local news spool directory.") (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
--- a/lisp/gnus/pop3.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/pop3.el Fri Oct 22 10:13:52 2004 +0000 @@ -83,7 +83,14 @@ :group 'pop3) (defcustom pop3-leave-mail-on-server nil - "*Non-nil if the mail is to be left on the POP server after fetching." + "*Non-nil if the mail is to be left on the POP server after fetching. + +If the `pop3-leave-mail-on-server' is non-`nil' the mail is to be +left on the POP server after fetching. Note that POP servers +maintain no state information between sessions, so what the +client believes is there and what is actually there may not match +up. If they do not, then the whole thing can fall apart and +leave you with a corrupt mailbox." :version "21.4" ;; Oort Gnus :type 'boolean :group 'pop3) @@ -95,6 +102,32 @@ (defvar pop3-read-point nil) (defvar pop3-debug nil) +;; Borrowed from nnheader-accept-process-output in nnheader.el. +(defvar pop3-read-timeout + (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (symbol-name system-type)) + ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de + ;; + ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS. + ;; + ;; There should probably be a runtime test to determine the timing + ;; resolution, or a primitive to report it. I don't know off-hand + ;; what's possible. Perhaps better, maybe the Windows/DOS primitive + ;; could round up non-zero timeouts to a minimum of 1.0? + 1.0 + 0.1) + "How long pop3 should wait between checking for the end of output. +Shorter values mean quicker response, but are more CPU intensive.") + +;; Borrowed from nnheader-accept-process-output in nnheader.el. +(defun pop3-accept-process-output (process) + (accept-process-output + process + (truncate pop3-read-timeout) + (truncate (* (- pop3-read-timeout + (truncate pop3-read-timeout)) + 1000)))) + (defun pop3-movemail (&optional crashbox) "Transfer contents of a maildrop to the specified CRASHBOX." (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) @@ -207,7 +240,7 @@ (goto-char pop3-read-point) (while (and (memq (process-status process) '(open run)) (not (search-forward "\r\n" nil t))) - (nnheader-accept-process-output process) + (pop3-accept-process-output process) (goto-char pop3-read-point)) (setq match-end (point)) (goto-char pop3-read-point) @@ -381,8 +414,7 @@ (save-excursion (set-buffer (process-buffer process)) (while (not (re-search-forward "^\\.\r\n" nil t)) - ;; Fixme: Shouldn't depend on nnheader. - (nnheader-accept-process-output process) + (pop3-accept-process-output process) (goto-char start)) (setq pop3-read-point (point-marker)) ;; this code does not seem to work for some POP servers...
--- a/lisp/gnus/spam-stat.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/spam-stat.el Fri Oct 22 10:13:52 2004 +0000 @@ -594,6 +594,8 @@ (remove-hook 'gnus-select-article-hook 'spam-stat-store-gnus-article-buffer)) +(add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook) + (provide 'spam-stat) ;;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554
--- a/lisp/gnus/spam.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/gnus/spam.el Fri Oct 22 10:13:52 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) @@ -1814,14 +1814,12 @@ (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening) (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam)) +(add-hook 'spam-unload-hook 'spam-unload-hook) + (when spam-install-hooks (spam-initialize)) (provide 'spam) -;;; spam.el ends here. - -(provide 'spam) - ;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f ;;; spam.el ends here
--- a/lisp/help-at-pt.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/help-at-pt.el Fri Oct 22 10:13:52 2004 +0000 @@ -348,8 +348,7 @@ (interactive "p") (scan-buf-move-to-region 'help-echo (- arg) 'scan-buf-move-hook)) -(defvar help-at-pt-unload-hook '(help-at-pt-cancel-timer) - "Normal hook run when `help-at-pt' is unloaded.") +(add-hook 'help-at-pt-unload-hook 'help-at-pt-cancel-timer) (provide 'help-at-pt)
--- a/lisp/ibuffer.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/ibuffer.el Fri Oct 22 10:13:52 2004 +0000 @@ -213,12 +213,20 @@ If a function, it will be called with the buffer as an argument, and should return non-nil if this buffer should be shown. -Viewing of buffers hidden because of these predicates is enabled by -giving a non-nil prefix argument to `ibuffer-update'. Note that this -specialized filtering occurs before real filtering." +Viewing of buffers hidden because of these predicates may be customized +via `ibuffer-default-display-maybe-show-predicates' and is toggled by +giving a non-nil prefix argument to `ibuffer-update'. +Note that this specialized filtering occurs before real filtering." :type '(repeat (choice regexp function)) :group 'ibuffer) +(defcustom ibuffer-default-display-maybe-show-predicates nil + "Non-nil means show buffers that match `ibuffer-maybe-show-predicates'." + :type 'boolean + :group 'ibuffer) + +(defvar ibuffer-display-maybe-show-predicates nil) + (defvar ibuffer-current-format nil) (defcustom ibuffer-movement-cycle t @@ -2069,11 +2077,15 @@ (defun ibuffer-update (arg &optional silent) "Regenerate the list of all buffers. -Display buffers whose name matches one of `ibuffer-maybe-show-predicates' -iff arg ARG is non-nil. + +Prefix arg non-nil means to toggle whether buffers that match +`ibuffer-maybe-show-predicates' should be displayed. If optional arg SILENT is non-nil, do not display progress messages." (interactive "P") + (if arg + (setq ibuffer-display-maybe-show-predicates + (not ibuffer-display-maybe-show-predicates))) (ibuffer-forward-line 0) (let* ((bufs (buffer-list)) (blist (ibuffer-filter-buffers @@ -2086,7 +2098,7 @@ (caddr bufs) (cadr bufs)) (ibuffer-current-buffers-with-marks bufs) - arg))) + ibuffer-display-maybe-show-predicates))) (when (null blist) (if (and (featurep 'ibuf-ext) ibuffer-filtering-qualifiers) @@ -2148,7 +2160,7 @@ 'ibuffer-filter-group name))) -(defun ibuffer-redisplay-engine (bmarklist &optional all) +(defun ibuffer-redisplay-engine (bmarklist &optional ignore) (assert (eq major-mode 'ibuffer-mode)) (let* ((--ibuffer-insert-buffers-and-marks-format (ibuffer-current-format)) @@ -2475,6 +2487,8 @@ ibuffer-default-sorting-reversep) (set (make-local-variable 'ibuffer-shrink-to-minimum-size) ibuffer-default-shrink-to-minimum-size) + (set (make-local-variable 'ibuffer-display-maybe-show-predicates) + ibuffer-default-display-maybe-show-predicates) (set (make-local-variable 'ibuffer-filtering-qualifiers) nil) (set (make-local-variable 'ibuffer-filter-groups) nil) (set (make-local-variable 'ibuffer-filter-group-kill-ring) nil)
--- a/lisp/info.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/info.el Fri Oct 22 10:13:52 2004 +0000 @@ -3445,7 +3445,8 @@ (fontify-visited-p ; visited nodes need to be re-fontified (and Info-fontify-visited-nodes ;; Don't take time to refontify visited nodes in huge nodes - (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size)))) + (< (- (point-max) (point-min)) Info-fontify-maximum-menu-size))) + rbeg rend) ;; Fontify header line (goto-char (point-min)) @@ -3570,39 +3571,48 @@ "mouse-2: go to this node") 'mouse-face 'highlight))) (when (or not-fontified-p fontify-visited-p) - (add-text-properties - (match-beginning 2) (match-end 2) - (list - 'font-lock-face - ;; Display visited nodes in a different face - (if (and Info-fontify-visited-nodes - (save-match-data - (let* ((node (replace-regexp-in-string - "^[ \t]+" "" - (replace-regexp-in-string - "[ \t\n]+" " " - (or (match-string 5) - (and (not (equal (match-string 4) "")) - (match-string 4)) - (match-string 2))))) - (file (file-name-nondirectory - Info-current-file)) - (hl Info-history-list) - res) - (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) - (setq file (file-name-nondirectory - (match-string 1 node)) - node (if (equal (match-string 2 node) "") - "Top" - (match-string 2 node)))) - (while hl - (if (and (string-equal node (nth 1 (car hl))) - (string-equal file - (file-name-nondirectory - (nth 0 (car hl))))) - (setq res (car hl) hl nil) - (setq hl (cdr hl)))) - res))) 'info-xref-visited 'info-xref)))) + (setq rbeg (match-beginning 2) + rend (match-end 2)) + (put-text-property + rbeg rend + 'font-lock-face + ;; Display visited nodes in a different face + (if (and Info-fontify-visited-nodes + (save-match-data + (let* ((node (replace-regexp-in-string + "^[ \t]+" "" + (replace-regexp-in-string + "[ \t\n]+" " " + (or (match-string 5) + (and (not (equal (match-string 4) "")) + (match-string 4)) + (match-string 2))))) + (file (file-name-nondirectory + Info-current-file)) + (hl Info-history-list) + res) + (if (string-match "(\\([^)]+\\))\\([^)]*\\)" node) + (setq file (file-name-nondirectory + (match-string 1 node)) + node (if (equal (match-string 2 node) "") + "Top" + (match-string 2 node)))) + (while hl + (if (and (string-equal node (nth 1 (car hl))) + (string-equal file + (file-name-nondirectory + (nth 0 (car hl))))) + (setq res (car hl) hl nil) + (setq hl (cdr hl)))) + res))) 'info-xref-visited 'info-xref)) + ;; For multiline ref, unfontify newline and surrounding whitespace + (save-excursion + (goto-char rbeg) + (save-match-data + (while (re-search-forward "\\s-*\n\\s-*" rend t nil) + (remove-text-properties (match-beginning 0) + (match-end 0) + '(font-lock-face t)))))) (when not-fontified-p (when (memq Info-hide-note-references '(t hide)) (add-text-properties (match-beginning 3) (match-end 3)
--- a/lisp/language/indian.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/language/indian.el Fri Oct 22 10:13:52 2004 +0000 @@ -45,6 +45,15 @@ Currently supported foundries are `cdac' and `akruti'.") (defvar indian-script-language-alist + '((devanagari (hindi sanskrit) nil) + (bengali (bengali assamese) nil) + (gurmukhi (punjabi) nil) + (gujarati (gujarati) nil) + (oriya (oriya) nil) + (tamil (tamil) nil) + (telugu (telugu) nil) + (kannada (kannada) nil) + (malayalam (malayalam) nil)) "Alist of Indian scripts vs the corresponding language list and font foundry. Each element has this form: @@ -57,16 +66,7 @@ FONT-FOUNDRY is a font foundry representing a group of Indian fonts. If the value is nil, the value of `indian-font-foundry' -is used." - '((devanagari (hindi sanskrit) nil) - (bengali (bengali assamese) nil) - (gurmukhi (punjabi) nil) - (gujarati (gujarati) nil) - (oriya (oriya) nil) - (tamil (tamil) nil) - (telugu (telugu) nil) - (kannada (kannada) nil) - (malayalam (malayalam) nil))) +is used.") (defconst indian-font-char-index-table '( ; for which language(s) @@ -94,14 +94,14 @@ (#x1200 . akruti:knd) ; kannada (#x1300 . akruti:mal) ; malayalam ) - "Aliat of indices of `indian-glyph' character vs Indian font identifiers. + "Alist of indices of `indian-glyph' character vs Indian font identifiers. Each element has this form: (INDEX . FONT-IDENTIFIER) INDEX is an index number of the first character in the charset `indian-glyph' assigned for glyphs in the font specified by FONT-IDENTIFIER. Currently FONT-IDENTIFIERs are defined for CDAC and AKRUTI font groups.") - + (defun indian-font-char (index font-identifier) "Return character of charset `indian-glyph' made from glyph index INDEX. FONT-IDENTIFIER is an identifier of an Indian font listed in the @@ -122,7 +122,7 @@ (defun indian-font-char-range (font-identifier) (cons (indian-font-char 0 font-identifier) (indian-font-char 255 font-identifier))) - + (defvar indian-script-table '[ devanagari
--- a/lisp/mouse.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/mouse.el Fri Oct 22 10:13:52 2004 +0000 @@ -338,6 +338,17 @@ (select-window window) (enlarge-window growth nil (> growth 0)))) +(defsubst mouse-drag-move-window-top (window growth) + "Move the top of WINDOW up or down by GROWTH lines. +Move it down if GROWTH is positive, or up if GROWTH is negative. +If this would make WINDOW too short, shrink the window or windows +above it to make room." + ;; Moving the top of WINDOW is actually moving the bottom of the + ;; window above. + (let ((window-above (mouse-drag-window-above window))) + (and window-above + (mouse-drag-move-window-bottom window-above (- growth))))) + (defun mouse-drag-mode-line-1 (start-event mode-line-p) "Change the height of a window by dragging on the mode or header line. START-EVENT is the starting mouse-event of the drag action. @@ -444,7 +455,9 @@ (select-window start-event-window)) ;; no. grow/shrink the selected window ;(message "growth = %d" growth) - (mouse-drag-move-window-bottom start-event-window growth)) + (if mode-line-p + (mouse-drag-move-window-bottom start-event-window growth) + (mouse-drag-move-window-top start-event-window growth))) ;; if this window's growth caused another ;; window to be deleted because it was too @@ -1097,7 +1110,7 @@ Prefix arguments are interpreted as with \\[yank]. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." - (interactive "e\nP") + (interactive "*e\nP") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click)) @@ -1399,7 +1412,7 @@ Move point to the end of the inserted text. If `mouse-yank-at-point' is non-nil, insert at point regardless of where you click." - (interactive "e") + (interactive "*e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (or mouse-yank-at-point (mouse-set-point click))
--- a/lisp/msb.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/msb.el Fri Oct 22 10:13:52 2004 +0000 @@ -1153,6 +1153,7 @@ (defun msb-unload-hook () (msb-mode 0)) +(add-hook 'msb-unload-hook 'msb-unload-hook) (provide 'msb) (eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/password.el Fri Oct 22 10:13:52 2004 +0000 @@ -0,0 +1,128 @@ +;;; password.el --- Read passwords from user, possibly using a password cache. + +;; Copyright (C) 1999, 2000, 2003, 2004 Free Software Foundation, Inc. + +;; Author: Simon Josefsson <simon@josefsson.org> +;; Created: 2003-12-21 +;; Keywords: password cache passphrase key + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Greatly influenced by pgg.el written by Daiki Ueno, with timer +;; fixes for XEmacs by Katsumi Yamaoka. In fact, this is mostly just +;; a rip-off. +;; +;; (password-read "Password? " "test") +;; ;; Minibuffer prompt for password. +;; => "foo" +;; +;; (password-cache-add "test" "foo") +;; => nil + +;; Note the previous two can be replaced with: +;; (password-read-and-add "Password? " "test") +;; ;; Minibuffer prompt for password. +;; => "foo" +;; ;; "foo" is now cached with key "test" + + +;; (password-read "Password? " "test") +;; ;; No minibuffer prompt +;; => "foo" +;; +;; (password-read "Password? " "test") +;; ;; No minibuffer prompt +;; => "foo" +;; +;; ;; Wait `password-cache-expiry' seconds. +;; +;; (password-read "Password? " "test") +;; ;; Minibuffer prompt for password is back. +;; => "foo" + +;;; Code: + +(when (featurep 'xemacs) + (require 'run-at-time)) + +(eval-when-compile + (require 'cl)) + +(defcustom password-cache t + "Whether to cache passwords." + :group 'password + :type 'boolean) + +(defcustom password-cache-expiry 16 + "How many seconds passwords are cached, or nil to disable expiring. +Whether passwords are cached at all is controlled by `password-cache'." + :group 'password + :type '(choice (const :tag "Never" nil) + (integer :tag "Seconds"))) + +(defvar password-data (make-vector 7 0)) + +(defun password-read (prompt &optional key) + "Read password, for use with KEY, from user, or from cache if wanted. +KEY indicate the purpose of the password, so the cache can +separate passwords. The cache is not used if KEY is nil. It is +typically a string. +The variable `password-cache' control whether the cache is used." + (or (and password-cache + key + (symbol-value (intern-soft key password-data))) + (read-passwd prompt))) + +(defun password-read-and-add (prompt &optional key) + "Read password, for use with KEY, from user, or from cache if wanted. +Then store the password in the cache. Uses `password-read' and +`password-cache-add'." + (let ((password (password-read prompt key))) + (when (and password key) + (password-cache-add key password)) + password)) + +(defun password-cache-remove (key) + "Remove password indexed by KEY from password cache. +This is typically run be a timer setup from `password-cache-add', +but can be invoked at any time to forcefully remove passwords +from the cache. This may be useful when it has been detected +that a password is invalid, so that `password-read' query the +user again." + (let ((password (symbol-value (intern-soft key password-data)))) + (when password + (fillarray password ?_) + (unintern key password-data)))) + +(defun password-cache-add (key password) + "Add password to cache. +The password is removed by a timer after `password-cache-expiry' +seconds." + (set (intern key password-data) password) + (when password-cache-expiry + (run-at-time password-cache-expiry nil + #'password-cache-remove + key)) + nil) + +(provide 'password) + +;;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 +;;; password.el ends here
--- a/lisp/net/tramp.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/net/tramp.el Fri Oct 22 10:13:52 2004 +0000 @@ -2337,45 +2337,46 @@ ;; This function makes the same assumption as ;; `tramp-handle-set-visited-file-modtime'. (defun tramp-handle-verify-visited-file-modtime (buf) - "Like `verify-visited-file-modtime' for tramp files. -At the time `verify-visited-file-modtime' calls this function, we -already know that the buffer is visiting a file and that -`visited-file-modtime' does not return 0. Do not call this -function directly, unless those two cases are already taken care -of." + "Like `verify-visited-file-modtime' for tramp files." (with-current-buffer buf - (let ((f (buffer-file-name))) - (with-parsed-tramp-file-name f nil - (let* ((attr (file-attributes f)) - (modtime (nth 5 attr))) - (cond ((and attr (not (equal modtime '(0 0)))) - ;; Why does `file-attributes' return a list (HIGH - ;; LOW), but `visited-file-modtime' returns a cons - ;; (HIGH . LOW)? - (let ((mt (visited-file-modtime))) - (< (abs (tramp-time-diff - modtime - ;; For compatibility, deal with both the old - ;; (HIGH . LOW) and the new (HIGH LOW) - ;; return values of `visited-file-modtime'. - (if (atom (cdr mt)) - (list (car mt) (cdr mt)) - mt))) - 2))) - (attr - (save-excursion - (tramp-send-command - multi-method method user host - (format "%s -ild %s" - (tramp-get-ls-command multi-method method - user host) - (tramp-shell-quote-argument localname))) - (tramp-wait-for-output) - (setq attr (buffer-substring - (point) (progn (end-of-line) (point))))) - (equal tramp-buffer-file-attributes attr)) - ;; If file does not exist, say it is not modified. - (t nil))))))) + ;; There is no file visiting the buffer, or the buffer has no + ;; recorded last modification time. + (if (or (not (buffer-file-name)) + (eq (visited-file-modtime) 0)) + t + (let ((f (buffer-file-name))) + (with-parsed-tramp-file-name f nil + (let* ((attr (file-attributes f)) + (modtime (nth 5 attr)) + (mt (visited-file-modtime))) + + (cond + ;; file exists, and has a known modtime. + ((and attr (not (equal modtime '(0 0)))) + (< (abs (tramp-time-diff + modtime + ;; For compatibility, deal with both the old + ;; (HIGH . LOW) and the new (HIGH LOW) + ;; return values of `visited-file-modtime'. + (if (atom (cdr mt)) + (list (car mt) (cdr mt)) + mt))) + 2)) + ;; modtime has the don't know value. + (attr + (save-excursion + (tramp-send-command + multi-method method user host + (format "%s -ild %s" + (tramp-get-ls-command multi-method method user host) + (tramp-shell-quote-argument localname))) + (tramp-wait-for-output) + (setq attr (buffer-substring + (point) (progn (end-of-line) (point))))) + (equal tramp-buffer-file-attributes attr)) + ;; If file does not exist, say it is not modified + ;; if and only if that agrees with the buffer's record. + (t (equal mt '(-1 65535)))))))))) (defadvice clear-visited-file-modtime (after tramp activate) "Set `tramp-buffer-file-attributes' back to nil.
--- a/lisp/newcomment.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/newcomment.el Fri Oct 22 10:13:52 2004 +0000 @@ -1087,6 +1087,7 @@ (insert (comment-padleft comment-end add))) (indent-according-to-mode)))))) +;;;###autoload (defcustom comment-auto-fill-only-comments nil "Non-nil means to only auto-fill inside comments. This has no effect in modes that do not define a comment syntax."
--- a/lisp/outline.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/outline.el Fri Oct 22 10:13:52 2004 +0000 @@ -808,7 +808,7 @@ (save-excursion (outline-back-to-heading t) (show-entry) - (while (condition-case nil (progn (outline-up-heading 1) (not (bobp))) + (while (condition-case nil (progn (outline-up-heading 1 t) (not (bobp))) (error nil)) (outline-flag-region (1- (point)) (save-excursion (forward-line 1) (point))
--- a/lisp/paths.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/paths.el Fri Oct 22 10:13:52 2004 +0000 @@ -101,11 +101,12 @@ for initializing `Info-directory-list' when Info is started, unless the environment variable INFOPATH is set.") -(defvar news-path +(defvar news-directory (if (file-exists-p "/usr/spool/news/") "/usr/spool/news/" "/var/spool/news/") "The root directory below which all news files are stored.") +(defvaralias 'news-path 'news-directory) (defvar news-inews-program (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews") @@ -136,7 +137,7 @@ :group 'rmail :version "21.1") -(defconst rmail-spool-directory +(defvar rmail-spool-directory (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration) "/usr/spool/mail/") ;; On The Bull DPX/2 /usr/spool/mail is used although @@ -157,15 +158,17 @@ "Name of directory used by system mailer for delivering new mail. Its name should end with a slash.") -(defconst sendmail-program +(defcustom sendmail-program (cond ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") (t "fakemail")) ;In ../etc, to interface to /bin/mail. - "Program used to send messages.") + "Program used to send messages." + :group 'mail + :type 'file) -(defconst remote-shell-program +(defcustom remote-shell-program (cond ;; Some systems use rsh for the remote shell; others use that name for the ;; restricted shell and use remsh for the remote shell. Let's try to guess @@ -186,14 +189,16 @@ ((file-exists-p "/bin/rsh") "/bin/rsh") ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh") (t "rsh")) - "File name for remote-shell program (often rsh or remsh).") + "File name for remote-shell program (often rsh or remsh)." + :group 'environment + :type 'file) -(defconst term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "\ +(defvar term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/") "\ If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\"))) You may set this variable to nil in your `.emacs' file if you do not wish the terminal-initialization file to be loaded.") -(defconst abbrev-file-name +(defvar abbrev-file-name (if (eq system-type 'vax-vms) "~/abbrev.def" (convert-standard-filename "~/.abbrev_defs"))
--- a/lisp/pcvs-defs.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/pcvs-defs.el Fri Oct 22 10:13:52 2004 +0000 @@ -374,7 +374,7 @@ ("r" . cvs-mode-remove) ("s" . cvs-mode-status) ("t" . cvs-mode-tag) - ;;("v" . cvs-mode-diff-vendor) + ("v" . cvs-mode-view-file) ("x" . cvs-mode-remove-handled) ;; cvstree bindings ("+" . cvs-mode-tree)
--- a/lisp/pcvs-util.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/pcvs-util.el Fri Oct 22 10:13:52 2004 +0000 @@ -104,11 +104,12 @@ (condition-case () (delete-window win) (error (iconify-frame (window-frame win)))) - (if (and mainbuf (get-buffer-window mainbuf)) - ;; FIXME: if the buffer popped into a pre-existing window, - ;; we don't want to delete that window. - t ;;(delete-window win) - )))) +;;; (if (and mainbuf (get-buffer-window mainbuf)) +;;; ;; FIXME: if the buffer popped into a pre-existing window, +;;; ;; we don't want to delete that window. +;;; t ;;(delete-window win) +;;; ) + ))) (with-current-buffer buf (bury-buffer (unless (and (eq buf (window-buffer (selected-window))) (not (window-dedicated-p (selected-window))))
--- a/lisp/pcvs.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/pcvs.el Fri Oct 22 10:13:52 2004 +0000 @@ -1925,6 +1925,18 @@ (cvs-mode-find-file e 'dont-select)) +(defun cvs-mode-view-file (e) + "View the file." + (interactive (list last-input-event)) + (cvs-mode-find-file e nil t)) + + +(defun cvs-mode-view-file-other-window (e) + "View the file." + (interactive (list last-input-event)) + (cvs-mode-find-file e t t)) + + (defun cvs-find-modif (fi) (with-temp-buffer (call-process cvs-program nil (current-buffer) nil @@ -1935,7 +1947,7 @@ 1))) -(defun cvs-mode-find-file (e &optional other) +(defun cvs-mode-find-file (e &optional other view) "Select a buffer containing the file. With a prefix, opens the buffer in an OTHER window." (interactive (list last-input-event current-prefix-arg)) @@ -1963,8 +1975,10 @@ (let ((buf (if rev (cvs-retrieve-revision fi rev) (find-file-noselect (cvs-fileinfo->full-path fi))))) (funcall (cond ((eq other 'dont-select) 'display-buffer) - (other 'switch-to-buffer-other-window) - (t 'switch-to-buffer)) + (other + (if view 'view-buffer-other-window + 'switch-to-buffer-other-window)) + (t (if view 'view-buffer 'switch-to-buffer))) buf) (when (and cvs-find-file-and-jump (cvs-applicable-p fi 'diff-base)) (goto-line (cvs-find-modif fi)))
--- a/lisp/progmodes/compile.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/progmodes/compile.el Fri Oct 22 10:13:52 2004 +0000 @@ -866,24 +866,7 @@ (if (eq mode t) (prog1 "compilation" (require 'comint)) (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) - (process-environment - (append - compilation-environment - (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning - system-uses-terminfo) - (list "TERM=dumb" "TERMCAP=" - (format "COLUMNS=%d" (window-width))) - (list "TERM=emacs" - (format "TERMCAP=emacs:co#%d:tc=unknown:" - (window-width)))) - ;; Set the EMACS variable, but - ;; don't override users' setting of $EMACS. - (unless (getenv "EMACS") '("EMACS=t")) - (copy-sequence process-environment))) - cd-path ; in case process-environment contains CDPATH - (thisdir (if (string-match "^\\s *cd\\s +\\(.+?\\)\\s *[;&\n]" command) - (substitute-in-file-name (match-string 1 command)) - default-directory)) + (thisdir default-directory) outwin outbuf) (with-current-buffer (setq outbuf @@ -903,18 +886,26 @@ (error nil)) (error "Cannot have two processes in `%s' at once" (buffer-name))))) - ;; Clear out the compilation buffer and make it writable. - ;; Change its default-directory to the directory where the compilation - ;; will happen, and insert a `default-directory' to indicate this. - (setq buffer-read-only nil) (buffer-disable-undo (current-buffer)) - (erase-buffer) - (buffer-enable-undo (current-buffer)) - (cd thisdir) - ;; output a mode setter, for saving and later reloading this buffer - (insert "-*- mode: " name-of-mode - "; default-directory: " (prin1-to-string default-directory) - " -*-\n" command "\n") + ;; first transfer directory from where M-x compile was called + (setq default-directory thisdir) + ;; Make compilation buffer read-only. The filter can still write it. + ;; Clear out the compilation buffer. + (let ((inhibit-read-only t) + (default-directory thisdir)) + ;; Then evaluate a cd command if any, but don't perform it yet, else start-command + ;; would do it again through the shell: (cd "..") AND sh -c "cd ..; make" + (cd (if (string-match "^\\s *cd\\(?:\\s +\\(\\S +?\\)\\)?\\s *[;&\n]" command) + (if (match-end 1) + (match-string 1 command) + "~") + default-directory)) + (erase-buffer) + ;; output a mode setter, for saving and later reloading this buffer + (insert "-*- mode: " name-of-mode + "; default-directory: " (prin1-to-string default-directory) + " -*-\n" command "\n") + (setq thisdir default-directory)) (set-buffer-modified-p nil)) ;; If we're already in the compilation buffer, go to the end ;; of the buffer, so point will track the compilation output. @@ -923,70 +914,85 @@ ;; Pop up the compilation buffer. (setq outwin (display-buffer outbuf nil t)) (with-current-buffer outbuf - (if (not (eq mode t)) - (funcall mode) - (with-no-warnings (comint-mode)) - (compilation-shell-minor-mode)) - ;; In what way is it non-ergonomic ? -stef - ;; (toggle-read-only 1) ;;; Non-ergonomic. - (if highlight-regexp - (set (make-local-variable 'compilation-highlight-regexp) - highlight-regexp)) - (set (make-local-variable 'compilation-arguments) - (list command mode name-function highlight-regexp)) - (set (make-local-variable 'revert-buffer-function) - 'compilation-revert-buffer) - (set-window-start outwin (point-min)) - (or (eq outwin (selected-window)) - (set-window-point outwin (if compilation-scroll-output - (point) - (point-min)))) - ;; The setup function is called before compilation-set-window-height - ;; so it can set the compilation-window-height buffer locally. - (if compilation-process-setup-function - (funcall compilation-process-setup-function)) - (compilation-set-window-height outwin) - ;; Start the compilation. - (if (fboundp 'start-process) - (let ((proc (if (eq mode t) - (get-buffer-process - (with-no-warnings - (comint-exec outbuf (downcase mode-name) - shell-file-name nil `("-c" ,command)))) - (start-process-shell-command (downcase mode-name) - outbuf command)))) - ;; Make the buffer's mode line show process state. - (setq mode-line-process '(":%s")) - (set-process-sentinel proc 'compilation-sentinel) - (set-process-filter proc 'compilation-filter) - (set-marker (process-mark proc) (point) outbuf) - (setq compilation-in-progress - (cons proc compilation-in-progress))) - ;; No asynchronous processes available. - (message "Executing `%s'..." command) - ;; Fake modeline display as if `start-process' were run. - (setq mode-line-process ":run") - (force-mode-line-update) - (sit-for 0) ; Force redisplay - (let ((status (call-process shell-file-name nil outbuf nil "-c" - command))) - (cond ((numberp status) - (compilation-handle-exit 'exit status - (if (zerop status) - "finished\n" - (format "\ + (let ((process-environment + (append + compilation-environment + (if (if (boundp 'system-uses-terminfo) ; `if' for compiler warning + system-uses-terminfo) + (list "TERM=dumb" "TERMCAP=" + (format "COLUMNS=%d" (window-width))) + (list "TERM=emacs" + (format "TERMCAP=emacs:co#%d:tc=unknown:" + (window-width)))) + ;; Set the EMACS variable, but + ;; don't override users' setting of $EMACS. + (unless (getenv "EMACS") '("EMACS=t")) + (copy-sequence process-environment)))) + (if (not (eq mode t)) + (funcall mode) + (setq buffer-read-only nil) + (with-no-warnings (comint-mode)) + (compilation-shell-minor-mode)) + (if highlight-regexp + (set (make-local-variable 'compilation-highlight-regexp) + highlight-regexp)) + (set (make-local-variable 'compilation-arguments) + (list command mode name-function highlight-regexp)) + (set (make-local-variable 'revert-buffer-function) + 'compilation-revert-buffer) + (set-window-start outwin (point-min)) + (or (eq outwin (selected-window)) + (set-window-point outwin (if compilation-scroll-output + (point) + (point-min)))) + ;; The setup function is called before compilation-set-window-height + ;; so it can set the compilation-window-height buffer locally. + (if compilation-process-setup-function + (funcall compilation-process-setup-function)) + (compilation-set-window-height outwin) + ;; Start the compilation. + (if (fboundp 'start-process) + (let ((proc (if (eq mode t) + (get-buffer-process + (with-no-warnings + (comint-exec outbuf (downcase mode-name) + shell-file-name nil `("-c" ,command)))) + (start-process-shell-command (downcase mode-name) + outbuf command)))) + ;; Make the buffer's mode line show process state. + (setq mode-line-process '(":%s")) + (set-process-sentinel proc 'compilation-sentinel) + (set-process-filter proc 'compilation-filter) + (set-marker (process-mark proc) (point) outbuf) + (setq compilation-in-progress + (cons proc compilation-in-progress))) + ;; No asynchronous processes available. + (message "Executing `%s'..." command) + ;; Fake modeline display as if `start-process' were run. + (setq mode-line-process ":run") + (force-mode-line-update) + (sit-for 0) ; Force redisplay + (let ((status (call-process shell-file-name nil outbuf nil "-c" + command))) + (cond ((numberp status) + (compilation-handle-exit 'exit status + (if (zerop status) + "finished\n" + (format "\ exited abnormally with code %d\n" - status)))) - ((stringp status) - (compilation-handle-exit 'signal status - (concat status "\n"))) - (t - (compilation-handle-exit 'bizarre status status)))) - ;; Without async subprocesses, the buffer is not yet - ;; fontified, so fontify it now. - (let ((font-lock-verbose nil)) ; shut up font-lock messages - (font-lock-fontify-buffer)) - (message "Executing `%s'...done" command))) + status)))) + ((stringp status) + (compilation-handle-exit 'signal status + (concat status "\n"))) + (t + (compilation-handle-exit 'bizarre status status)))) + ;; Without async subprocesses, the buffer is not yet + ;; fontified, so fontify it now. + (let ((font-lock-verbose nil)) ; shut up font-lock messages + (font-lock-fontify-buffer)) + (message "Executing `%s'...done" command))) + ;; Now finally cd to where the shell started make/grep/... + (setq default-directory thisdir)) (if (buffer-local-value 'compilation-scroll-output outbuf) (save-selected-window (select-window outwin) @@ -1108,7 +1114,7 @@ :version "21.4") ;;;###autoload -(defun compilation-mode () +(defun compilation-mode (&optional name-of-mode) "Major mode for compilation log buffers. \\<compilation-mode-map>To visit the source for a line-numbered error, move point to the error message line and type \\[compile-goto-error]. @@ -1121,7 +1127,7 @@ (kill-all-local-variables) (use-local-map compilation-mode-map) (setq major-mode 'compilation-mode - mode-name "Compilation") + mode-name (or name-of-mode "Compilation")) (set (make-local-variable 'page-delimiter) compilation-page-delimiter) (compilation-setup) @@ -1187,6 +1193,8 @@ "Prepare the buffer for the compilation parsing commands to work. Optional argument MINOR indicates this is called from `compilation-minor-mode'." + (unless minor + (setq buffer-read-only t)) (make-local-variable 'compilation-current-error) (make-local-variable 'compilation-messages-start) (make-local-variable 'compilation-error-screen-columns) @@ -1248,7 +1256,7 @@ (defun compilation-handle-exit (process-status exit-status msg) "Write MSG in the current buffer and hack its mode-line-process." - (let ((buffer-read-only nil) + (let ((inhibit-read-only t) (status (if compilation-exit-message-function (funcall compilation-exit-message-function process-status exit-status msg)
--- a/lisp/server.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/server.el Fri Oct 22 10:13:52 2004 +0000 @@ -631,6 +631,8 @@ (remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function) (remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) (remove-hook 'kill-buffer-hook 'server-kill-buffer)) + +(add-hook 'server-unload-hook 'server-unload-hook) (provide 'server)
--- a/lisp/shadowfile.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/shadowfile.el Fri Oct 22 10:13:52 2004 +0000 @@ -837,6 +837,8 @@ (symbol-function 'shadow-orig-save-buffers-kill-emacs))) (remove-hook 'write-file-hooks 'shadow-add-to-todo)) +(add-hook 'shadowfile-unload-hook 'shadowfile-unload-hook) + (provide 'shadowfile) ;;; arch-tag: e2f4cdd7-2bab-4def-9130-9e69b412b79e
--- a/lisp/startup.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/startup.el Fri Oct 22 10:13:52 2004 +0000 @@ -1156,7 +1156,7 @@ (emacs-version) "\n" :face '(variable-pitch :height 0.5) - "Copyright (C) 2002 Free Software Foundation, Inc.") + "Copyright (C) 2004 Free Software Foundation, Inc.") (and auto-save-list-file-prefix ;; Don't signal an error if the ;; directory for auto-save-list files @@ -1322,7 +1322,7 @@ ") (insert "\n\n" (emacs-version) " -Copyright (C) 2002 Free Software Foundation, Inc.")) +Copyright (C) 2004 Free Software Foundation, Inc.")) ;; No mouse menus, so give help using kbd commands. @@ -1370,7 +1370,7 @@ (insert "\n\n" (emacs-version) " -Copyright (C) 2002 Free Software Foundation, Inc.") +Copyright (C) 2004 Free Software Foundation, Inc.") (if (and (eq (key-binding "\C-h\C-c") 'describe-copying) (eq (key-binding "\C-h\C-d") 'describe-distribution)
--- a/lisp/strokes.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/strokes.el Fri Oct 22 10:13:52 2004 +0000 @@ -1354,7 +1354,8 @@ :color-symbols `(("foreground" . ,(frame-parameter nil 'foreground-color)))))) - finally do (kill-region (1+ (point)) (point-max))) + finally do (unless (eobp) + (kill-region (1+ (point)) (point-max)))) (view-buffer "*Strokes List*" nil) (set (make-local-variable 'view-mode-map) (let ((map (copy-keymap view-mode-map))) @@ -1745,6 +1746,8 @@ (strokes-mode -1) (remove-hook 'kill-emacs-query-functions 'strokes-prompt-user-save-strokes)) +(add-hooks 'strokes-unload-hook 'strokes-unload-hook) + (run-hooks 'strokes-load-hook) (provide 'strokes)
--- a/lisp/subr.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/subr.el Fri Oct 22 10:13:52 2004 +0000 @@ -1212,51 +1212,59 @@ code)) (defun read-passwd (prompt &optional confirm default) - "Read a password, prompting with PROMPT. Echo `.' for each character typed. -End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. -If optional CONFIRM is non-nil, read password twice to make sure. -Optional DEFAULT is a default password to use instead of empty input." - (if confirm - (let (success) - (while (not success) - (let ((first (read-passwd prompt nil default)) - (second (read-passwd "Confirm password: " nil default))) - (if (equal first second) - (progn - (and (arrayp second) (clear-string second)) - (setq success first)) - (and (arrayp first) (clear-string first)) - (and (arrayp second) (clear-string second)) - (message "Password not repeated accurately; please start over") - (sit-for 1)))) - success) - (let ((pass nil) - (c 0) - (echo-keystrokes 0) - (cursor-in-echo-area t)) - (while (progn (message "%s%s" - prompt - (make-string (length pass) ?.)) - (setq c (read-char-exclusive nil t)) - (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) - (clear-this-command-keys) - (if (= c ?\C-u) - (progn - (and (arrayp pass) (clear-string pass)) - (setq pass "")) - (if (and (/= c ?\b) (/= c ?\177)) - (let* ((new-char (char-to-string c)) - (new-pass (concat pass new-char))) + "Read a password, prompting with PROMPT, and return it. +If optional CONFIRM is non-nil, read the password twice to make sure. +Optional DEFAULT is a default password to use instead of empty input. + +This function echoes `.' for each character that the user types. +The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. +C-g quits; if `inhibit-quit' was non-nil around this function, +then it returns nil if the user types C-g. + +Once the caller uses the password, it can erase the password +by doing (clear-string STRING)." + (with-local-quit + (if confirm + (let (success) + (while (not success) + (let ((first (read-passwd prompt nil default)) + (second (read-passwd "Confirm password: " nil default))) + (if (equal first second) + (progn + (and (arrayp second) (clear-string second)) + (setq success first)) + (and (arrayp first) (clear-string first)) + (and (arrayp second) (clear-string second)) + (message "Password not repeated accurately; please start over") + (sit-for 1)))) + success) + (let ((pass nil) + (c 0) + (echo-keystrokes 0) + (cursor-in-echo-area t)) + (while (progn (message "%s%s" + prompt + (make-string (length pass) ?.)) + (setq c (read-char-exclusive nil t)) + (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) + (clear-this-command-keys) + (if (= c ?\C-u) + (progn (and (arrayp pass) (clear-string pass)) - (clear-string new-char) - (setq c ?\0) - (setq pass new-pass)) - (if (> (length pass) 0) - (let ((new-pass (substring pass 0 -1))) + (setq pass "")) + (if (and (/= c ?\b) (/= c ?\177)) + (let* ((new-char (char-to-string c)) + (new-pass (concat pass new-char))) (and (arrayp pass) (clear-string pass)) - (setq pass new-pass)))))) - (message nil) - (or pass default "")))) + (clear-string new-char) + (setq c ?\0) + (setq pass new-pass)) + (if (> (length pass) 0) + (let ((new-pass (substring pass 0 -1))) + (and (arrayp pass) (clear-string pass)) + (setq pass new-pass)))))) + (message nil) + (or pass default ""))))) ;; This should be used by `call-interactively' for `n' specs. (defun read-number (prompt &optional default) @@ -1822,14 +1830,14 @@ (defmacro with-local-quit (&rest body) "Execute BODY, allowing quits to terminate BODY but not escape further. -When a quit terminates BODY, `with-local-quit' requests another quit when -it finishes. That quit will be processed in turn, the next time quitting -is again allowed." +When a quit terminates BODY, `with-local-quit' returns nil but +requests another quit. That quit will be processed, the next time quitting +is allowed once again." (declare (debug t) (indent 0)) `(condition-case nil (let ((inhibit-quit nil)) ,@body) - (quit (setq quit-flag t)))) + (quit (setq quit-flag t) nil))) (defmacro combine-after-change-calls (&rest body) "Execute BODY, but don't call the after-change functions till the end. @@ -2023,11 +2031,12 @@ (defun looking-back (regexp &optional limit) "Return non-nil if text before point matches regular expression REGEXP. -Like `looking-at' except backwards and slower. +Like `looking-at' except matches before point, and is slower. LIMIT if non-nil speeds up the search by specifying how far back the match can start." - (save-excursion - (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))) + (not (null + (save-excursion + (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))) (defconst split-string-default-separators "[ \f\t\n\r\v]+" "The default value of separators for `split-string'.
--- a/lisp/term.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/term.el Fri Oct 22 10:13:52 2004 +0000 @@ -2,7 +2,8 @@ ;;; Copyright (C) 1988, 1990, 1992, 1994, 1995, 2004 Free Software Foundation, Inc. -;; Author: Per Bothner <bothner@cygnus.com> +;; Author: Per Bothner <per@bothner.com> +;; Maintainer: Dan Nicolaescu <dann@ics.uci.edu>, Per Bothner <per@bothner.com> ;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu> ;; Keywords: processes
--- a/lisp/textmodes/flyspell.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/textmodes/flyspell.el Fri Oct 22 10:13:52 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/ispell.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/textmodes/ispell.el Fri Oct 22 10:13:52 2004 +0000 @@ -1618,10 +1618,11 @@ (set-buffer (get-buffer-create ispell-choices-buffer)) (setq mode-line-format (concat "-- %b -- word: " word)) ;; XEmacs: no need for horizontal scrollbar in choices window - (and (fboundp 'set-specifier) - (boundp 'horizontal-scrollbar-visible-p) - (set-specifier horizontal-scrollbar-visible-p nil - (cons (current-buffer) nil))) + (with-no-warnings + (and (fboundp 'set-specifier) + (boundp 'horizontal-scrollbar-visible-p) + (set-specifier horizontal-scrollbar-visible-p nil + (cons (current-buffer) nil)))) (erase-buffer) (if guess (progn @@ -1871,7 +1872,7 @@ (if (and ispell-use-framepop-p (fboundp 'framepop-display-buffer)) (progn (framepop-display-buffer (get-buffer ispell-choices-buffer)) - (get-buffer-window ispell-choices-buffer t) +;;; (get-buffer-window ispell-choices-buffer t) (select-window (previous-window))) ; *Choices* window ;; standard selection by splitting a small buffer out of this window. (let ((choices-window (get-buffer-window ispell-choices-buffer))) @@ -2355,7 +2356,7 @@ (if extended-char-mode ; ~ extended character mode (ispell-send-string (concat extended-char-mode "\n")))) (if ispell-async-processp - (process-kill-without-query ispell-process)))) + (set-process-query-on-exit-flag ispell-process nil)))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error) @@ -3286,19 +3287,23 @@ (cond ((functionp 'sc-cite-regexp) ; sc 3.0 (concat "\\(" (sc-cite-regexp) "\\)" "\\|" - (ispell-non-empty-string sc-reference-tag-string))) + (with-no-warnings + (ispell-non-empty-string sc-reference-tag-string)))) ((boundp 'sc-cite-regexp) ; sc 2.3 (concat "\\(" sc-cite-regexp "\\)" "\\|" - (ispell-non-empty-string sc-reference-tag-string))) + (with-no-warnings + (ispell-non-empty-string sc-reference-tag-string)))) ((or (equal major-mode 'news-reply-mode) ;GNUS 4 & below (equal major-mode 'message-mode)) ;GNUS 5 (concat "In article <" "\\|" "[^,;&+=\n]+ <[^,;&+=]+> writes:" "\\|" - message-cite-prefix-regexp "\\|" + (with-no-warnings message-cite-prefix-regexp) + "\\|" default-prefix)) ((equal major-mode 'mh-letter-mode) ; mh mail message (concat "[^,;&+=\n]+ writes:" "\\|" - (ispell-non-empty-string mh-ins-buf-prefix))) + (with-no-warnings + (ispell-non-empty-string mh-ins-buf-prefix)))) ((not internal-messagep) ; Assume nn sent us this message. (concat "In [a-zA-Z.]+ you write:" "\\|" "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|"
--- a/lisp/textmodes/tex-mode.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/textmodes/tex-mode.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/url/ChangeLog Fri Oct 22 10:13:52 2004 +0000 @@ -1,3 +1,62 @@ +2004-10-20 John Paul Wallington <jpw@gnu.org> + + * url-gw.el (url-gateway-nslookup-host): + Use `set-process-query-on-exit-flag'. + +2004-10-10 Lars Hansen <larsh@math.ku.dk> + + * url-auth.el: Update header and footer. + + * url-cache.el: Update header and footer. + + * url-cid.el: Update header and footer. + + * url-dired.el: Update header and footer. + + * url-expand.el: Update header and footer. + + * url-ftp.el: Update header and footer. + + * url-gw.el: Update header and footer. + + * url-imap.el: Update header and footer. + + * url-irc.el: Update header and footer. + + * url-misc.el: Update header and footer. + + * url-news.el: Update header and footer. + + * url-ns.el: Update header and footer. + + * url-privacy.el: Update header and footer. + + * url-proxy.el: Update header and footer. + + * url-vars.el: Update header. + +2004-10-16 Richard M. Stallman <rms@gnu.org> + + * url.el (url-do-setup): Don't set url-passwd-entry-func. + + * url-vars.el (url-passwd-entry-func): Var deleted. + (mm-mime-mule-charset-alist): Remove compatibility code for old Gnus. + (url-weekday-alist): Renamed from weekday-alist. + (url-monthabbrev-alist): Renamed from monthabbrev-alist. + (url-vars-unload-hook): Initialize hook var to hold the function. + + * url-util.el (url-get-normalized-date): Use + url-weekday-alist and url-monthabbrev-alist. + + * url-misc.el: Load cl at compile time. + + * url-mailto.el: Don't load cl. + (url-mailto): Fix call to `push'. + + * url-gw.el (url-open-telnet): Use read-passwd. + + * url-auth.el (url-basic-auth, url-digest-auth): Use read-passwd. + 2004-10-12 Simon Josefsson <jas@extundo.com> * url-vars.el (url-gateway-method): Add new method `tls'.
--- a/lisp/url/url-auth.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-auth.el Fri Oct 22 10:13:52 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) @@ -78,7 +79,7 @@ ((and prompt (not byserv)) (setq user (read-string (url-auth-user-prompt url realm) (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ")) + pass (read-passwd "Password: ")) (set url-basic-auth-storage (cons (list server (cons path @@ -102,7 +103,7 @@ (progn (setq user (read-string (url-auth-user-prompt url realm) (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") + pass (read-passwd "Password: ") retval (base64-encode-string (format "%s:%s" user pass)) byserv (assoc server (symbol-value url-basic-auth-storage))) (setcdr byserv @@ -160,7 +161,7 @@ ((and prompt (not byserv)) (setq user (read-string (url-auth-user-prompt url realm) (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") + pass (read-passwd "Password: ") url-digest-auth-storage (cons (list server (cons path @@ -187,7 +188,7 @@ (progn (setq user (read-string (url-auth-user-prompt url realm) (user-real-login-name)) - pass (funcall url-passwd-entry-func "Password: ") + pass (read-passwd "Password: ") retval (setq retval (cons user (url-digest-auth-create-key @@ -314,3 +315,4 @@ (provide 'url-auth) ;;; arch-tag: 04058625-616d-44e4-9dbf-4b46b00b2a91 +;;; url-auth.el ends here
--- a/lisp/url/url-cache.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-cache.el Fri Oct 22 10:13:52 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-cid.el Fri Oct 22 10:13:52 2004 +0000 @@ -0,0 +1,66 @@ +;;; url-cid.el --- Content-ID URL loader + +;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'url-vars) +(require 'url-parse) + +(require 'mm-decode) + +(defun url-cid-gnus (cid) + (let ((content-type nil) + (encoding nil) + (part nil) + (data nil)) + (setq part (mm-get-content-id cid)) + (if (not part) + (message "Unknown CID encountered: %s" cid) + (setq data (save-excursion + (set-buffer (mm-handle-buffer part)) + (buffer-string)) + content-type (mm-handle-type part) + encoding (symbol-name (mm-handle-encoding part))) + (if (= 0 (length content-type)) (setq content-type "text/plain")) + (if (= 0 (length encoding)) (setq encoding "8bit")) + (if (listp content-type) + (setq content-type (car content-type))) + (insert (format "Content-type: %d\r\n" (length data)) + "Content-type: " content-type "\r\n" + "Content-transfer-encoding: " encoding "\r\n" + "\r\n" + (or data ""))))) + +;;;###autoload +(defun url-cid (url) + (cond + ((fboundp 'mm-get-content-id) + ;; Using Pterodactyl Gnus or later + (save-excursion + (set-buffer (generate-new-buffer " *url-cid*")) + (url-cid-gnus (url-filename url)))) + (t + (message "Unable to handle CID URL: %s" url)))) + +;;; arch-tag: 23d9ab74-fad4-4dba-b1e7-292871e8bda5 +;;; url-cid.el ends here
--- a/lisp/url/url-dired.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-dired.el Fri Oct 22 10:13:52 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-expand.el Fri Oct 22 10:13:52 2004 +0000 @@ -0,0 +1,144 @@ +;;; url-expand.el --- expand-file-name for URLs + +;; Copyright (c) 1999 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'url-methods) +(require 'url-util) +(require 'url-parse) + +(defun url-expander-remove-relative-links (name) + ;; Strip . and .. from pathnames + (let ((new (if (not (string-match "^/" name)) + (concat "/" name) + name))) + + ;; If it ends with a '/.' or '/..', tack on a trailing '/' sot hat + ;; the tests that follow are not too complicated in terms of + ;; looking for '..' or '../', etc. + (if (string-match "/\\.+$" new) + (setq new (concat new "/"))) + + ;; Remove '/./' first + (while (string-match "/\\(\\./\\)" new) + (setq new (concat (substring new 0 (match-beginning 1)) + (substring new (match-end 1))))) + + ;; Then remove '/../' + (while (string-match "/\\([^/]*/\\.\\./\\)" new) + (setq new (concat (substring new 0 (match-beginning 1)) + (substring new (match-end 1))))) + + ;; Remove cruft at the beginning of the string, so people that put + ;; in extraneous '..' because they are morons won't lose. + (while (string-match "^/\\.\\.\\(/\\)" new) + (setq new (substring new (match-beginning 1) nil))) + new)) + +(defun url-expand-file-name (url &optional default) + "Convert URL to a fully specified URL, and canonicalize it. +Second arg DEFAULT is a URL to start with if URL is relative. +If DEFAULT is nil or missing, the current buffer's URL is used. +Path components that are `.' are removed, and +path components followed by `..' are removed, along with the `..' itself." + (if (and url (not (string-match "^#" url))) + ;; Need to nuke newlines and spaces in the URL, or we open + ;; ourselves up to potential security holes. + (setq url (mapconcat (function (lambda (x) + (if (memq x '(? ?\n ?\r)) + "" + (char-to-string x)))) + url ""))) + + ;; Need to figure out how/where to expand the fragment relative to + (setq default (cond + ((vectorp default) + ;; Default URL has already been parsed + default) + (default + ;; They gave us a default URL in non-parsed format + (url-generic-parse-url default)) + (url-current-object + ;; We are in a URL-based buffer, use the pre-parsed object + url-current-object) + ((string-match url-nonrelative-link url) + ;; The URL they gave us is absolute, go for it. + nil) + (t + ;; Hmmm - this shouldn't ever happen. + (error "url-expand-file-name confused - no default?")))) + + (cond + ((= (length url) 0) ; nil or empty string + (url-recreate-url default)) + ((string-match "^#" url) ; Offset link, use it raw + url) + ((string-match url-nonrelative-link url) ; Fully-qualified URL, return it immediately + url) + (t + (let* ((urlobj (url-generic-parse-url url)) + (inhibit-file-name-handlers t) + (expander (url-scheme-get-property (url-type default) 'expand-file-name))) + (if (string-match "^//" url) + (setq urlobj (url-generic-parse-url (concat (url-type default) ":" + url)))) + (funcall expander urlobj default) + (url-recreate-url urlobj))))) + +(defun url-identity-expander (urlobj defobj) + (url-set-type urlobj (or (url-type urlobj) (url-type defobj)))) + +(defun url-default-expander (urlobj defobj) + ;; The default expansion routine - urlobj is modified by side effect! + (if (url-type urlobj) + ;; Well, they told us the scheme, let's just go with it. + nil + (url-set-type urlobj (or (url-type urlobj) (url-type defobj))) + (url-set-port urlobj (or (url-port urlobj) + (and (string= (url-type urlobj) + (url-type defobj)) + (url-port defobj)))) + (if (not (string= "file" (url-type urlobj))) + (url-set-host urlobj (or (url-host urlobj) (url-host defobj)))) + (if (string= "ftp" (url-type urlobj)) + (url-set-user urlobj (or (url-user urlobj) (url-user defobj)))) + (if (string= (url-filename urlobj) "") + (url-set-filename urlobj "/")) + (if (string-match "^/" (url-filename urlobj)) + nil + (let ((query nil) + (file nil) + (sepchar nil)) + (if (string-match "[?#]" (url-filename urlobj)) + (setq query (substring (url-filename urlobj) (match-end 0)) + file (substring (url-filename urlobj) 0 (match-beginning 0)) + sepchar (substring (url-filename urlobj) (match-beginning 0) (match-end 0))) + (setq file (url-filename urlobj))) + (setq file (url-expander-remove-relative-links + (concat (url-basepath (url-filename defobj)) file))) + (url-set-filename urlobj (if query (concat file sepchar query) file)))))) + +(provide 'url-expand) + +;;; arch-tag: 7b5f744b-b721-49da-be47-484631680a5a +;;; url-expand.el ends here
--- a/lisp/url/url-ftp.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-ftp.el Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/lisp/url/url-gw.el Fri Oct 22 10:13:52 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)) @@ -186,7 +188,7 @@ proc (concat (or url-gateway-telnet-password (setq url-gateway-telnet-password - (funcall url-passwd-entry-func "Password: "))) + (read-passwd "Password: "))) "\n")) (erase-buffer) (url-wait-for-string url-gateway-prompt-pattern proc) @@ -266,3 +268,4 @@ (provide 'url-gw) ;;; arch-tag: 1c4c0317-6d03-45b8-b3f3-838bd8f9d838 +;;; url-gw.el ends here
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-imap.el Fri Oct 22 10:13:52 2004 +0000 @@ -0,0 +1,85 @@ +;;; url-imap.el --- IMAP retrieval routines + +;; Copyright (c) 1999 Free Software Foundation, Inc. + +;; Author: Simon Josefsson <jas@pdc.kth.se> +;; Keywords: comm, data, processes + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Anyway, here's a teaser. It's quite broken in lots of regards, but at +;; least it seem to work. At least a little. At least when called +;; manually like this (I've no idea how it's supposed to be called): + +;; (url-imap (url-generic-parse-url "imap://cyrus.andrew.cmu.edu/archive.c-client;UID=1021")) + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'url-util) +(require 'url-parse) +(require 'nnimap) +(require 'mm-util) + +(defconst url-imap-default-port 143 "Default IMAP port") + +(defun url-imap-open-host (host port user pass) + ;; xxx use user and password + (if (fboundp 'nnheader-init-server-buffer) + (nnheader-init-server-buffer)) + (let ((imap-username user) + (imap-password pass) + (authenticator (if user 'login 'anonymous))) + (if (stringp port) + (setq port (string-to-int port))) + (nnimap-open-server host + `((nnimap-server-port ,port) + (nnimap-stream 'network) + (nnimap-authenticator ,authenticator))))) + +(defun url-imap (url) + (check-type url vector "Need a pre-parsed URL.") + (save-excursion + (set-buffer (generate-new-buffer " *url-imap*")) + (mm-disable-multibyte) + (let* ((host (url-host url)) + (port (url-port url)) + ;; xxx decode mailbox (see rfc2192) + (mailbox (url-filename url)) + (coding-system-for-read 'binary)) + (and (eq (string-to-char mailbox) ?/) + (setq mailbox (substring mailbox 1))) + (url-imap-open-host host port (url-user url) (url-password url)) + (cond ((assoc "TYPE" (url-attributes url)) + ;; xxx list mailboxes (start gnus?) + ) + ((assoc "UID" (url-attributes url)) + ;; fetch message part + ;; xxx handle partial fetches + (insert "Content-type: message/rfc822\n\n") + (nnimap-request-article (cdr (assoc "UID" (url-attributes url))) + mailbox host (current-buffer))) + (t + ;; xxx list messages in mailbox (start gnus?) + ))) + (current-buffer))) + +;;; arch-tag: 034991ff-5425-48ea-b911-c96c90e6f47d +;;; url-imap.el ends here
--- a/lisp/url/url-irc.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-irc.el Fri Oct 22 10:13:52 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-mailto.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-mailto.el Fri Oct 22 10:13:52 2004 +0000 @@ -25,7 +25,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) (require 'url-vars) (require 'url-parse) (require 'url-util) @@ -85,7 +84,7 @@ (setq args (cons (list "x-url-from" source-url) args))) (if (assoc "to" args) - (push to (cdr (assoc "to" args))) + (push (cdr (assoc "to" args)) to) (setq args (cons (list "to" to) args))) (setq subject (cdr-safe (assoc "subject" args))) (if (fboundp url-mail-command) (funcall url-mail-command) (mail))
--- a/lisp/url/url-misc.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-misc.el Fri Oct 22 10:13:52 2004 +0000 @@ -1,27 +1,29 @@ ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code + +;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc. + ;; Keywords: comm, data, processes -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Copyright (c) 1996,1997,1998,1999,2002 Free Software Foundation, Inc. -;;; -;;; This file is part of GNU Emacs. -;;; -;;; GNU Emacs is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; GNU Emacs is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with GNU Emacs; see the file COPYING. If not, write to the -;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;;; Boston, MA 02111-1307, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(eval-when-compile (require 'cl)) (require 'url-vars) (require 'url-parse) (autoload 'Info-goto-node "info" "" t) @@ -115,3 +117,4 @@ (provide 'url-misc) ;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0 +;;; url-misc.el ends here
--- a/lisp/url/url-news.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-news.el Fri Oct 22 10:13:52 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-ns.el Fri Oct 22 10:13:52 2004 +0000 @@ -0,0 +1,107 @@ +;;; url-ns.el --- Various netscape-ish functions for proxy definitions + +;; Copyright (c) 1997 - 1999 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes, hypermedia + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'url-gw) + +;;;###autoload +(defun isPlainHostName (host) + (not (string-match "\\." host))) + +;;;###autoload +(defun dnsDomainIs (host dom) + (string-match (concat (regexp-quote dom) "$") host)) + +;;;###autoload +(defun dnsResolve (host) + (url-gateway-nslookup-host host)) + +;;;###autoload +(defun isResolvable (host) + (if (string-match "^[0-9.]+$" host) + t + (not (string= host (url-gateway-nslookup-host host))))) + +;;;###autoload +(defun isInNet (ip net mask) + (let ((netc (split-string ip "\\.")) + (ipc (split-string net "\\.")) + (maskc (split-string mask "\\."))) + (if (or (/= (length netc) (length ipc)) + (/= (length ipc) (length maskc))) + nil + (setq netc (mapcar 'string-to-int netc) + ipc (mapcar 'string-to-int ipc) + maskc (mapcar 'string-to-int maskc)) + (and + (= (logand (nth 0 netc) (nth 0 maskc)) + (logand (nth 0 ipc) (nth 0 maskc))) + (= (logand (nth 1 netc) (nth 1 maskc)) + (logand (nth 1 ipc) (nth 1 maskc))) + (= (logand (nth 2 netc) (nth 2 maskc)) + (logand (nth 2 ipc) (nth 2 maskc))) + (= (logand (nth 3 netc) (nth 3 maskc)) + (logand (nth 3 ipc) (nth 3 maskc))))))) + +;; Netscape configuration file parsing +(defvar url-ns-user-prefs nil + "Internal, do not use.") + +;;;###autoload +(defun url-ns-prefs (&optional file) + (if (not file) + (setq file (expand-file-name "~/.netscape/preferences.js"))) + (if (not (and (file-exists-p file) + (file-readable-p file))) + (message "Could not open %s for reading" file) + (save-excursion + (let ((false nil) + (true t)) + (setq url-ns-user-prefs (make-hash-table :size 13 :test 'equal)) + (set-buffer (get-buffer-create " *ns-parse*")) + (erase-buffer) + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward "^//" nil t) + (replace-match ";;")) + (goto-char (point-min)) + (while (re-search-forward "^user_pref(" nil t) + (replace-match "(url-ns-set-user-pref ")) + (goto-char (point-min)) + (while (re-search-forward "\"," nil t) + (replace-match "\"")) + (goto-char (point-min)) + (eval-buffer))))) + +(defun url-ns-set-user-pref (key val) + (puthash key val url-ns-user-prefs)) + +;;;###autoload +(defun url-ns-user-pref (key &optional default) + (gethash key url-ns-user-prefs default)) + +(provide 'url-ns) + +;;; arch-tag: 69520992-cf97-40b4-9ad1-c866d3cae5bf +;;; url-ns.el ends here
--- a/lisp/url/url-privacy.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-privacy.el Fri Oct 22 10:13:52 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/url-proxy.el Fri Oct 22 10:13:52 2004 +0000 @@ -0,0 +1,79 @@ +;;; url-proxy.el --- Proxy server support + +;; Copyright (c) 1999 Free Software Foundation, Inc. + +;; Keywords: comm, data, processes, hypermedia + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Code: + +(require 'url-parse) +(autoload 'url-warn "url") + +(defun url-default-find-proxy-for-url (urlobj host) + (cond + ((or (and (assoc "no_proxy" url-proxy-services) + (string-match + (cdr + (assoc "no_proxy" url-proxy-services)) + host)) + (equal "www" (url-type urlobj))) + "DIRECT") + ((cdr (assoc (url-type urlobj) url-proxy-services)) + (concat "PROXY " (cdr (assoc (url-type urlobj) url-proxy-services)))) + ;; + ;; Should check for socks + ;; + (t + "DIRECT"))) + +(defvar url-proxy-locator 'url-default-find-proxy-for-url) + +(defun url-find-proxy-for-url (url host) + (let ((proxies (split-string (funcall url-proxy-locator url host) " *; *")) + (proxy nil) + (case-fold-search t)) + ;; Not sure how I should handle gracefully degrading from one proxy to + ;; another, so for now just deal with the first one + ;; (while proxies + (if (listp proxies) + (setq proxy (car proxies)) + (setq proxy proxies)) + (cond + ((string-match "^direct" proxy) nil) + ((string-match "^proxy +" proxy) + (concat "http://" (substring proxy (match-end 0)) "/")) + ((string-match "^socks +" proxy) + (concat "socks://" (substring proxy (match-end 0)))) + (t + (url-warn 'url (format "Unknown proxy directive: %s" proxy) 'critical) + nil)))) + +(defun url-proxy (url callback &optional cbargs) + ;; Retrieve URL from a proxy. + ;; Expects `url-using-proxy' to be bound to the specific proxy to use." + (setq url-using-proxy (url-generic-parse-url url-using-proxy)) + (let ((proxy-object (copy-sequence url))) + (url-set-target proxy-object nil) + (url-http url-using-proxy callback cbargs))) + +(provide 'url-proxy) + +;;; arch-tag: 4ff8882e-e498-42b7-abc5-acb449cdbc62 +;;; url-proxy.el ends here
--- a/lisp/url/url-util.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-util.el Fri Oct 22 10:13:52 2004 +0000 @@ -192,13 +192,13 @@ (nth 1 (current-time-zone)) "GMT")) (parsed (timezone-parse-date gmt)) - (day (cdr-safe (assoc (substring raw 0 3) weekday-alist))) + (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist))) (year nil) (month (car (rassoc - (string-to-int (aref parsed 1)) monthabbrev-alist))) + (string-to-int (aref parsed 1)) url-monthabbrev-alist))) ) - (setq day (or (car-safe (rassoc day weekday-alist)) + (setq day (or (car-safe (rassoc day url-weekday-alist)) (substring raw 0 3)) year (aref parsed 0)) ;; This is needed for plexus servers, or the server will hang trying to
--- a/lisp/url/url-vars.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url-vars.el Fri Oct 22 10:13:52 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) @@ -191,19 +192,6 @@ (string :tag "Proxy"))) :group 'url) -(defcustom url-passwd-entry-func nil - "*Symbol indicating which function to call to read in a password. -It will be set up depending on whether you are running EFS or ange-ftp -at startup if it is nil. This function should accept the prompt -string as its first argument, and the default value as its second -argument." - :type '(choice (const :tag "Guess" :value nil) - (const :tag "Use Ange-FTP" :value ange-ftp-read-passwd) - (const :tag "Use EFS" :value efs-read-passwd) - (const :tag "Use Password Package" :value read-passwd) - (function :tag "Other")) - :group 'url-hairy) - (defcustom url-standalone-mode nil "*Rely solely on the cache?" :type 'boolean @@ -240,24 +228,6 @@ (defvar url-mime-encoding-string nil "*String to send in the Accept-encoding: field in HTTP requests.") -;; `mm-mime-mule-charset-alist' in Gnus 5.8/9 contains elements whose -;; cars aren't valid MIME charsets/coding systems, at least in Emacs. -;; This gets it correct by construction in Emacs. Fixme: DTRT for -;; XEmacs -- its `coding-system-list' doesn't have the BASE-ONLY arg. -(when (and (not (featurep 'xemacs)) - (fboundp 'coding-system-list)) - (setq mm-mime-mule-charset-alist - (apply - 'nconc - (mapcar - (lambda (cs) - (when (and (coding-system-get cs 'mime-charset) - (not (eq t (coding-system-get cs 'safe-charsets)))) - (list (cons (coding-system-get cs 'mime-charset) - (delq 'ascii - (coding-system-get cs 'safe-charsets)))))) - (coding-system-list 'base-only))))) - ;; Perhaps the first few should actually be given decreasing `q's and ;; the list should be trimmed significantly. ;; Fixme: do something sane if we don't have `sort-coding-systems' @@ -381,14 +351,14 @@ (defvar url-setup-done nil "Has setup configuration been done?") -(defconst weekday-alist +(defconst url-weekday-alist '(("Sunday" . 0) ("Monday" . 1) ("Tuesday" . 2) ("Wednesday" . 3) ("Thursday" . 4) ("Friday" . 5) ("Saturday" . 6) ("Tues" . 2) ("Thurs" . 4) ("Sun" . 0) ("Mon" . 1) ("Tue" . 2) ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) -(defconst monthabbrev-alist +(defconst url-monthabbrev-alist '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) ("Apr" . 4) ("May" . 5) ("Jun" . 6) ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) @@ -425,6 +395,8 @@ (defun url-vars-unload-hook () (remove-hook 'set-language-environment-hook 'url-set-mime-charset-string)) +(add-hook 'url-vars-unload-hook 'url-vars-unload-hook) + (provide 'url-vars) ;;; arch-tag: 29205e5f-c5ce-433c-8d5d-38cbaed64b49
--- a/lisp/url/url.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/url/url.el Fri Oct 22 10:13:52 2004 +0000 @@ -113,26 +113,6 @@ noproxy "") "\\)")) url-proxy-services)))) - ;; Set the password entry funtion based on user defaults or guess - ;; based on which remote-file-access package they are using. - (cond - (url-passwd-entry-func nil) ; Already been set - ((fboundp 'read-passwd) ; Use secure password if available - (setq url-passwd-entry-func 'read-passwd)) - ((or (featurep 'efs) ; Using EFS - (featurep 'efs-auto)) ; or autoloading efs - (if (not (fboundp 'read-passwd)) - (autoload 'read-passwd "passwd" "Read in a password" nil)) - (setq url-passwd-entry-func 'read-passwd)) - ((or (featurep 'ange-ftp) ; Using ange-ftp - (and (boundp 'file-name-handler-alist) - (not (featurep 'xemacs)))) ; ?? - (setq url-passwd-entry-func 'ange-ftp-read-passwd)) - (t - (url-warn - 'security - "(url-setup): Can't determine how to read passwords, winging it."))) - (url-setup-privacy-info) (run-hooks 'url-load-hook) (setq url-setup-done t)))
--- a/lisp/vc-arch.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/vc-arch.el Fri Oct 22 10:13:52 2004 +0000 @@ -283,8 +283,8 @@ (setq logdir (expand-file-name version logdir)) (setq logdir (expand-file-name archive logdir)) (setq logdir (expand-file-name "patch-log" logdir)) - ;; Revision names go: base-0, patch-N, version-0, versionfix-N. - (dolist (file (directory-files logdir)) + (dolist (file (if (file-directory-p logdir) (directory-files logdir))) + ;; Revision names go: base-0, patch-N, version-0, versionfix-M. (when (and (eq (aref file 0) ?v) (not sealed)) (setq sealed t rev-nb 0)) (if (and (string-match "-\\([0-9]+\\)\\'" file)
--- a/lisp/vc-hooks.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/vc-hooks.el Fri Oct 22 10:13:52 2004 +0000 @@ -754,8 +754,8 @@ (set (make-local-variable 'backup-inhibited) t)) ;; Let the backend setup any buffer-local things he needs. (vc-call-backend (vc-backend buffer-file-name) 'find-file-hook)) - ((let* ((link (file-symlink-p buffer-file-name)) - (link-type (and link (vc-backend (file-chase-links link))))) + ((let ((link-type (and (file-symlink-p buffer-file-name) + (vc-backend (file-chase-links buffer-file-name))))) (cond ((not link-type) nil) ;Nothing to do. ((eq vc-follow-symlinks nil) (message
--- a/lisp/view.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/view.el Fri Oct 22 10:13:52 2004 +0000 @@ -117,12 +117,12 @@ (defvar view-page-size nil "Default number of lines to scroll by View page commands. -If nil then the local value of this is initially set to window size.") +If nil that means use the window size.") (make-variable-buffer-local 'view-page-size) (defvar view-half-page-size nil "Default number of lines to scroll by View half page commands. -If nil then the local value of this is initially set to half window size.") +If nil that means use half the window size.") (make-variable-buffer-local 'view-half-page-size) (defvar view-last-regexp nil) @@ -453,8 +453,8 @@ ;; This is to guarantee that the buffer-read-only variable is restored. (add-hook 'change-major-mode-hook 'view-mode-disable nil t) (setq view-mode t - view-page-size (view-page-size-default view-page-size) - view-half-page-size (or view-half-page-size (/ (view-window-size) 2)) + view-page-size nil + view-half-page-size nil view-old-buffer-read-only buffer-read-only buffer-read-only t view-old-Helper-return-blurb (and (boundp 'Helper-return-blurb) @@ -675,7 +675,8 @@ (defun view-set-half-page-size-default (lines) ;; Get and maybe set half page size. - (if (not lines) view-half-page-size + (if (not lines) (or view-half-page-size + (/ (view-window-size) 2)) (setq view-half-page-size (if (zerop (setq lines (prefix-numeric-value lines))) (/ (view-window-size) 2) @@ -803,13 +804,13 @@ \\[View-scroll-page-backward-set-page-size]. If LINES is more than a window-full, only the last window-full is shown." (interactive "P") - (view-scroll-lines lines nil view-page-size nil)) + (view-scroll-lines lines nil (view-page-size-default view-page-size) nil)) (defun View-scroll-page-backward (&optional lines) "Scroll \"page size\" or prefix LINES lines backward in View mode. See also `View-scroll-page-forward'." (interactive "P") - (view-scroll-lines lines t view-page-size nil)) + (view-scroll-lines lines t (view-page-size-default view-page-size) nil)) (defun View-scroll-page-forward-set-page-size (&optional lines) "Scroll forward LINES lines in View mode, setting the \"page size\".
--- a/lisp/whitespace.el Tue Oct 19 11:11:47 2004 +0000 +++ b/lisp/whitespace.el Fri Oct 22 10:13:52 2004 +0000 @@ -859,6 +859,8 @@ (remove-hook 'write-file-functions 'whitespace-write-file-hook t) (remove-hook 'kill-buffer-hook 'whitespace-buffer)) +(add-hook 'whitespace-unload-hook 'whitespace-unload-hook) + (provide 'whitespace) ;;; arch-tag: 4ff44e87-b63c-402d-95a6-15e51e58bd0c
--- a/lispref/ChangeLog Tue Oct 19 11:11:47 2004 +0000 +++ b/lispref/ChangeLog Fri Oct 22 10:13:52 2004 +0000 @@ -1,3 +1,7 @@ +2004-10-19 Jason Rumney <jasonr@gnu.org> + + * makefile.w32-in (elisp): Change order of arguments to makeinfo. + 2004-10-09 Luc Teirlinck <teirllm@auburn.edu> * text.texi (Filling): Add anchor for definition of
--- a/lispref/makefile.w32-in Tue Oct 19 11:11:47 2004 +0000 +++ b/lispref/makefile.w32-in Fri Oct 22 10:13:52 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/man/ChangeLog Tue Oct 19 11:11:47 2004 +0000 +++ b/man/ChangeLog Fri Oct 22 10:13:52 2004 +0000 @@ -1,3 +1,43 @@ +2004-10-21 Jay Belanger <belanger@truman.edu> + * calc.texi (Algebraic-Style Calculations): Removed a comment. + +2004-10-19 Jason Rumney <jasonr@gnu.org> + + * makefile.w32-in (info): Change order of arguments to makeinfo. + +2004-10-19 Ulf Jasper <ulf.jasper@web.de> + + * calendar.texi (iCalendar): Update for package changes. + +2004-10-18 Luc Teirlinck <teirllm@auburn.edu> + + * calc.texi (Reporting Bugs): Double up `@'. + +2004-10-18 Jay Belanger <belanger@truman.edu> + + * calc.texi (Reporting Bugs): Changed the address that bugs + should be sent to. + +2004-10-15 Reiner Steib <Reiner.Steib@gmx.de> + + * gnus.texi (New Features): Add 5.11. + + * message.texi (Resending): Remove wrong default value. + + * gnus.texi (Mail Source Specifiers): Describe possible problems + of `pop3-leave-mail-on-server'. Add `pop3-movemail' and + `pop3-leave-mail-on-server' to the index. + +2004-10-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * message.texi (Canceling News): Add how to set a password. + +2004-10-12 Jay Belanger <belanger@truman.edu> + + * calc.texi (Help Commands): Changed the descriptions of + calc-describe-function and calc-describe-variable to match their + current behavior. + 2004-10-12 Reiner Steib <Reiner.Steib@gmx.de> * gnus-faq.texi ([5.9]): Improve code for reply-in-news. @@ -154,6 +194,16 @@ * display.texi (Display Custom): Add `overflow-newline-into-fringe', `indicate-buffer-boundaries' and `default-indicate-buffer-boundaries'. +2004-09-22 Jay Belanger <belanger@truman.edu> + + * calc.texi (Vectors as Lists): Added a warning that the tutorial + might be hidden during part of the session. + +2004-09-20 Jay Belanger <belanger@truman.edu> + + * calc.texi (Notations Used in This Manual): Put in an earlier + mention that DEL could be called Backspace. + 2004-09-20 Richard M. Stallman <rms@gnu.org> * custom.texi (Hooks): Explain using setq to clear out a hook.
--- a/man/calc.texi Tue Oct 19 11:11:47 2004 +0000 +++ b/man/calc.texi Fri Oct 22 10:13:52 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. @@ -34286,11 +34285,10 @@ @appendix Reporting Bugs @noindent -If you find a bug in Calc, send e-mail to Colin Walters, - -@example -walters@@debian.org @r{or} -walters@@verbum.org +If you find a bug in Calc, send e-mail to Jay Belanger, + +@example +belanger@@truman.edu @end example @noindent
--- a/man/calendar.texi Tue Oct 19 11:11:47 2004 +0000 +++ b/man/calendar.texi Fri Oct 22 10:13:52 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/gnus.texi Tue Oct 19 11:11:47 2004 +0000 +++ b/man/gnus.texi Fri Oct 22 10:13:52 2004 +0000 @@ -885,7 +885,7 @@ * Red Gnus:: Third time best---Gnus 5.4/5.5. * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. -* Oort Gnus:: It's big. It's far out. Gnus 5.10. +* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. Customization @@ -13538,10 +13538,16 @@ @end table +@vindex pop3-movemail +@vindex pop3-leave-mail-on-server If the @code{:program} and @code{:function} keywords aren't specified, @code{pop3-movemail} will be used. If the @code{pop3-leave-mail-on-server} is non-@code{nil} the mail is to be -left on the POP server after fetching. +left on the @acronym{POP} server after fetching when using +@code{pop3-movemail}. Note that POP servers maintain no state +information between sessions, so what the client believes is there and +what is actually there may not match up. If they do not, then the whole +thing can fall apart and leave you with a corrupt mailbox. Here are some examples. Fetch from the default @acronym{POP} server, using the default user name, and default fetcher: @@ -25050,7 +25056,7 @@ * Red Gnus:: Third time best---Gnus 5.4/5.5. * Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7. * Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9. -* Oort Gnus:: It's big. It's far out. Gnus 5.10. +* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11. @end menu These lists are, of course, just @emph{short} overviews of the
--- a/man/makefile.w32-in Tue Oct 19 11:11:47 2004 +0000 +++ b/man/makefile.w32-in Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/man/message.texi Fri Oct 22 10:13:52 2004 +0000 @@ -224,7 +224,13 @@ 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. +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 "geheimnis" + canlock-password-for-verify canlock-password) +@end lisp Whether to insert the header or not is controlled by the @code{message-insert-canlock} variable. @@ -309,8 +315,7 @@ @vindex message-ignored-resent-headers Headers that match the @code{message-ignored-resent-headers} regexp will -be removed before sending the message. The default is -@samp{^Return-receipt}. +be removed before sending the message. @node Bouncing
--- a/nt/INSTALL Tue Oct 19 11:11:47 2004 +0000 +++ b/nt/INSTALL Fri Oct 22 10:13:52 2004 +0000 @@ -16,6 +16,9 @@ fixing first. The easiest way to do this and avoid future conflicts is to run the following command in this (emacs/nt) directory: cvs update -kb + In addition to this file, you should also read INSTALL.CVS in the + parent directory, and make sure that you have a version of "touch.exe" + in your path, and that it will create files that do not yet exist. To compile Emacs, you will need either Microsoft Visual C++ 2.0 or later and nmake, or a Windows port of GCC 2.95 or later with Mingw @@ -31,10 +34,14 @@ like this, we recommend the use of the supported compilers mentioned in the previous paragraph. + You will also need a copy of the Posix cp, rm and mv programs. These + and other useful Posix utilities can be obtained from the Mingw or + Cygwin projects. + If you build Emacs on Windows 9X or ME, not on Windows 2K/XP or Windows NT, we suggest to install the Cygwin port of Bash. - Please see http://www.mingw.org for pointers to GCC/Mingw binaries. + Please see http://www.mingw.org for pointers to GCC/Mingw and binaries. For reference, here is a list of which builds of GNU make are known to work or not, and whether they work in the presence and/or absence
--- a/src/ChangeLog Tue Oct 19 11:11:47 2004 +0000 +++ b/src/ChangeLog Fri Oct 22 10:13:52 2004 +0000 @@ -1,7 +1,136 @@ +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 + gdk_window_clear and move gdk_window_process_all_updates after + clear so events are sent to the X server in correct order. + +2004-10-18 Kenichi Handa <handa@m17n.org> + + * 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. + (list_fontsets): Likewise. + + * search.c (fast_string_match_ignore_case): New function. + + * lisp.h (fast_string_match_ignore_case): Extern it. + +2004-10-17 Kim F. Storm <storm@cua.dk> + + * xdisp.c (overlay_arrow_at_row): Return overlay string rather + than bitmap if there is not left fringe. + (get_overlay_arrow_glyph_row): Also used on windows system. + (display_line): Display overlay string if no left fringe. + +2004-10-16 Jason Rumney <jasonr@gnu.org> + + * w32fns.c (w32_font_match): Encode font name being matched. + +2004-10-16 Richard M. Stallman <rms@gnu.org> + + * window.c (Fspecial_display_p): Doc fix. + +2004-10-15 Stefan <monnier@iro.umontreal.ca> + + * doc.c (Fsubstitute_command_keys): Fix remap-handling. + Don't ignore menus, because where-is-internal already does it for us. + +2004-10-15 Kim F. Storm <storm@cua.dk> + + * xdisp.c (redisplay_window): Only update fringes and vertical + border on window frames. + +2004-10-14 Andreas Schwab <schwab@suse.de> + + * m/ia64.h (DATA_SEG_BITS): Don't define. + 2004-10-14 Kim F. Storm <storm@cua.dk> * xterm.h: Include Xutil.h after keysym.h to work around bug - (incorrectly recognising AltGr key) in some X versions. + in some X versions. + +2004-10-13 Stefan Monnier <monnier@iro.umontreal.ca> + + * fns.c (map_char_table): Add missing gcpros. 2004-10-13 Stefan Monnier <monnier@iro.umontreal.ca>
--- a/src/Makefile.in Tue Oct 19 11:11:47 2004 +0000 +++ b/src/Makefile.in Fri Oct 22 10:13:52 2004 +0000 @@ -887,12 +887,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 11:11:47 2004 +0000 +++ b/src/config.in Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/src/data.c Fri Oct 22 10:13:52 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/doc.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/doc.c Fri Oct 22 10:13:52 2004 +0000 @@ -774,28 +774,18 @@ /* Save STRP in IDX. */ idx = strp - SDATA (string); - tem = Fintern (make_string (start, length_byte), Qnil); + name = Fintern (make_string (start, length_byte), Qnil); /* Ignore remappings unless there are no ordinary bindings. */ - tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qt); + tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qt); if (NILP (tem)) - tem = Fwhere_is_internal (tem, keymap, Qt, Qnil, Qnil); + tem = Fwhere_is_internal (name, keymap, Qt, Qnil, Qnil); /* Note the Fwhere_is_internal can GC, so we have to take relocation of string contents into account. */ strp = SDATA (string) + idx; start = SDATA (string) + start_idx; - /* Disregard menu bar bindings; it is positively annoying to - mention them when there's no menu bar, and it isn't terribly - useful even when there is a menu bar. */ - if (!NILP (tem)) - { - firstkey = Faref (tem, make_number (0)); - if (EQ (firstkey, Qmenu_bar)) - tem = Qnil; - } - if (NILP (tem)) /* but not on any keys */ { int offset = bufp - buf;
--- a/src/editfns.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/editfns.c Fri Oct 22 10:13:52 2004 +0000 @@ -3000,6 +3000,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); }
--- a/src/emacs.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/emacs.c Fri Oct 22 10:13:52 2004 +0000 @@ -67,6 +67,10 @@ #include <sys/resource.h> #endif +#ifdef HAVE_PERSONALITY_LINUX32 +#include <sys/personality.h> +#endif + #ifndef O_RDWR #define O_RDWR 2 #endif @@ -192,6 +196,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 Vwindow_system; #endif /* HAVE_WINDOW_SYSTEM */ @@ -733,7 +748,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; @@ -809,6 +828,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 @@ -852,6 +882,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)) @@ -2138,6 +2190,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 11:11:47 2004 +0000 +++ b/src/fontset.c Fri Oct 22 10:13:52 2004 +0000 @@ -1126,18 +1126,17 @@ for (i = 0; i < ASIZE (Vfontset_table); i++) { - Lisp_Object fontset; - unsigned char *this_name; + Lisp_Object fontset, this_name; fontset = FONTSET_FROM_ID (i); if (NILP (fontset) || !BASE_FONTSET_P (fontset)) continue; - this_name = SDATA (FONTSET_NAME (fontset)); + this_name = FONTSET_NAME (fontset); if (regexpp - ? fast_c_string_match_ignore_case (name, this_name) >= 0 - : !strcmp (SDATA (name), this_name)) + ? fast_string_match (name, this_name) >= 0 + : !strcmp (SDATA (name), SDATA (this_name))) return i; } return -1; @@ -1189,19 +1188,18 @@ for (id = 0; id < ASIZE (Vfontset_table); id++) { - Lisp_Object fontset; - unsigned char *name; + Lisp_Object fontset, name; fontset = FONTSET_FROM_ID (id); if (NILP (fontset) || !BASE_FONTSET_P (fontset) || !EQ (frame, FONTSET_FRAME (fontset))) continue; - name = SDATA (FONTSET_NAME (fontset)); + name = FONTSET_NAME (fontset); if (STRINGP (regexp) - ? (fast_c_string_match_ignore_case (regexp, name) < 0) - : strcmp (SDATA (pattern), name)) + ? (fast_string_match (regexp, name) < 0) + : strcmp (SDATA (pattern), SDATA (name))) continue; val = Fcons (Fcopy_sequence (FONTSET_NAME (fontset)), val);
--- a/src/gtkutil.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/gtkutil.c Fri Oct 22 10:13:52 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,11 @@ 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); - - /* Must force out update so changed scroll bars gets redrawn. */ - gdk_window_process_all_updates (); - - /* 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. */ - - XClearWindow (FRAME_X_DISPLAY (f), GTK_WIDGET_TO_X_WIN (wscroll)); + gtk_fixed_move (GTK_FIXED (wfixed), wparent, left, top); SET_FRAME_GARBAGED (f); cancel_mouse_face (f);
--- a/src/gtkutil.h Tue Oct 19 11:11:47 2004 +0000 +++ b/src/gtkutil.h Fri Oct 22 10:13:52 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 11:11:47 2004 +0000 +++ b/src/lastfile.c Fri Oct 22 10:13:52 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/lisp.h Tue Oct 19 11:11:47 2004 +0000 +++ b/src/lisp.h Fri Oct 22 10:13:52 2004 +0000 @@ -2833,6 +2833,7 @@ EXFUN (Flooking_at, 1); extern int fast_string_match P_ ((Lisp_Object, Lisp_Object)); extern int fast_c_string_match_ignore_case P_ ((Lisp_Object, const char *)); +extern int fast_string_match_ignore_case P_ ((Lisp_Object, Lisp_Object)); extern int scan_buffer P_ ((int, int, int, int, int *, int)); extern int scan_newline P_ ((int, int, int, int, int, int)); extern int find_next_newline P_ ((int, int));
--- a/src/m/ia64.h Tue Oct 19 11:11:47 2004 +0000 +++ b/src/m/ia64.h Fri Oct 22 10:13:52 2004 +0000 @@ -133,8 +133,6 @@ #endif /* not NOT_C_CODE */ -#define DATA_SEG_BITS 0x6000000000000000 - #define HAVE_TEXT_START /* arch-tag: 9b8e9fb2-2e49-4c22-b68f-11a488e77c66
--- a/src/search.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/search.c Fri Oct 22 10:13:52 2004 +0000 @@ -460,6 +460,27 @@ immediate_quit = 0; return val; } + +/* Like fast_string_match but ignore case. */ + +int +fast_string_match_ignore_case (regexp, string) + Lisp_Object regexp, string; +{ + int val; + struct re_pattern_buffer *bufp; + + bufp = compile_pattern (regexp, 0, Vascii_downcase_table, + 0, STRING_MULTIBYTE (string)); + immediate_quit = 1; + re_match_object = string; + + val = re_search (bufp, (char *) SDATA (string), + SBYTES (string), 0, + SBYTES (string), 0); + immediate_quit = 0; + return val; +} /* The newline cache: remembering which sections of text have no newlines. */
--- a/src/w32.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/w32.c Fri Oct 22 10:13:52 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/w32fns.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/w32fns.c Fri Oct 22 10:13:52 2004 +0000 @@ -5667,12 +5667,14 @@ char * fontname; char * pattern; { - char *regex = alloca (strlen (pattern) * 2 + 3); - char *font_name_copy = alloca (strlen (fontname) + 1); + char *font_name_copy; char *ptr; - - /* Copy fontname so we can modify it during comparison. */ - strcpy (font_name_copy, fontname); + Lisp_Object encoded_font_name; + char *regex = alloca (strlen (pattern) * 2 + 3); + + /* Convert fontname to unibyte for match. */ + encoded_font_name = string_make_unibyte (build_string (fontname)); + font_name_copy = SDATA (encoded_font_name); ptr = regex; *ptr++ = '^';
--- a/src/w32term.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/w32term.c Fri Oct 22 10:13:52 2004 +0000 @@ -1360,7 +1360,6 @@ } - static void x_set_glyph_string_clipping P_ ((struct glyph_string *)); static void x_set_glyph_string_gc P_ ((struct glyph_string *)); static void x_draw_glyph_string_background P_ ((struct glyph_string *, @@ -2212,7 +2211,6 @@ } - /* Draw a relief around the image glyph string S. */ static void @@ -2669,7 +2667,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); } } @@ -2963,14 +2961,6 @@ if (old_focus && old_focus->auto_lower) x_lower_frame (old_focus); - - - - - - - - if (dpyinfo->w32_focus_frame && dpyinfo->w32_focus_frame->auto_raise) pending_autoraise_frame = dpyinfo->w32_focus_frame; else @@ -4839,7 +4829,6 @@ if (f) x_new_focus_frame (dpyinfo, f); - dpyinfo->grabbed = 0; check_visibility = 1; break; @@ -5057,7 +5046,6 @@ } - /*********************************************************************** Text Cursor
--- a/src/window.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/window.c Fri Oct 22 10:13:52 2004 +0000 @@ -3214,10 +3214,13 @@ } DEFUN ("special-display-p", Fspecial_display_p, Sspecial_display_p, 1, 1, 0, - doc: /* Returns non-nil if a buffer named BUFFER-NAME would be created specially. -The value is actually t if the frame should be called with default frame -parameters, and a list of frame parameters if they were specified. -See `special-display-buffer-names', and `special-display-regexps'. */) + doc: /* Returns non-nil if a buffer named BUFFER-NAME gets a special frame. +If the value is t, a frame would be created for that buffer +using the default frame parameters. If the value is a list, +it is a list of frame parameters that would be used +to make a frame for that buffer. +The variables `special-display-buffer-names' +and `special-display-regexps' control this. */) (buffer_name) Lisp_Object buffer_name; {
--- a/src/xdisp.c Tue Oct 19 11:11:47 2004 +0000 +++ b/src/xdisp.c Fri Oct 22 10:13:52 2004 +0000 @@ -8087,7 +8087,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++); @@ -9634,11 +9634,13 @@ } -/* Return overlay arrow string at row, or nil. */ +/* Return overlay arrow string to display at row. + Return t if display as bitmap in left fringe. + Return nil if no overlay arrow. */ static Lisp_Object -overlay_arrow_at_row (f, row, pbitmap) - struct frame *f; +overlay_arrow_at_row (it, row, pbitmap) + struct it *it; struct glyph_row *row; int *pbitmap; { @@ -9661,9 +9663,10 @@ && (MATRIX_ROW_START_CHARPOS (row) == marker_position (val))) { val = overlay_arrow_string_or_property (var, pbitmap); - if (FRAME_WINDOW_P (f)) + if (FRAME_WINDOW_P (it->f) + && WINDOW_LEFT_FRINGE_WIDTH (it->w) > 0) return Qt; - else if (STRINGP (val)) + if (STRINGP (val)) return val; break; } @@ -12317,7 +12320,8 @@ } #ifdef HAVE_WINDOW_SYSTEM - if (update_window_fringes (w, 0) + if (FRAME_WINDOW_P (f) + && update_window_fringes (w, 0) && !just_this_one_p && (used_current_matrix_p || overlay_arrow_seen) && !w->pseudo_window_p) @@ -14172,8 +14176,8 @@ Building Desired Matrix Rows ***********************************************************************/ -/* Return a temporary glyph row holding the glyphs of an overlay - arrow. Only used for non-window-redisplay windows. */ +/* Return a temporary glyph row holding the glyphs of an overlay arrow. + Used for non-window-redisplay windows, and for windows w/o left fringe. */ static struct glyph_row * get_overlay_arrow_glyph_row (w, overlay_arrow_string) @@ -15054,11 +15058,11 @@ better to let it be displayed like cursors under X. */ if (! overlay_arrow_seen && (overlay_arrow_string - = overlay_arrow_at_row (it->f, row, &overlay_arrow_bitmap), + = overlay_arrow_at_row (it, row, &overlay_arrow_bitmap), !NILP (overlay_arrow_string))) { /* Overlay arrow in window redisplay is a fringe bitmap. */ - if (!FRAME_WINDOW_P (it->f)) + if (STRINGP (overlay_arrow_string)) { struct glyph_row *arrow_row = get_overlay_arrow_glyph_row (it->w, overlay_arrow_string); @@ -15083,10 +15087,12 @@ row->used[TEXT_AREA] = p2 - row->glyphs[TEXT_AREA]; } } - + else + { + it->w->overlay_arrow_bitmap = overlay_arrow_bitmap; + row->overlay_arrow_p = 1; + } overlay_arrow_seen = 1; - it->w->overlay_arrow_bitmap = overlay_arrow_bitmap; - row->overlay_arrow_p = 1; } /* Compute pixel dimensions of this line. */ @@ -15551,14 +15557,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); @@ -15566,9 +15573,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 11:11:47 2004 +0000 +++ b/src/xfns.c Fri Oct 22 10:13:52 2004 +0000 @@ -1921,29 +1921,83 @@ }; -/* 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; + XFontSet xfs = NULL; char **missing_list; int missing_count; char *def_string; - - xfs = XCreateFontSet (FRAME_X_DISPLAY (f), - base_fontname, &missing_list, - &missing_count, &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); - /* No need to free def_string. */ + 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 @@ -2094,11 +2148,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; } @@ -2177,6 +2229,8 @@ XVaNestedList attr; XFontSet xfs; + xic_free_xfontset (f); + xfs = xic_create_xfontset (f, base_fontname); attr = XVaCreateNestedList (0, XNFontSet, xfs, NULL); @@ -2186,8 +2240,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 11:11:47 2004 +0000 +++ b/src/xterm.c Fri Oct 22 10:13:52 2004 +0000 @@ -2829,10 +2829,6 @@ XFlush (FRAME_X_DISPLAY (f)); -#ifdef USE_GTK - xg_frame_cleared (f); -#endif - UNBLOCK_INPUT; } @@ -4867,9 +4863,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); @@ -5113,18 +5107,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) { @@ -5133,13 +5115,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 @@ -8046,11 +8036,7 @@ if (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 11:11:47 2004 +0000 +++ b/src/xterm.h Fri Oct 22 10:13:52 2004 +0000 @@ -21,8 +21,13 @@ #include <X11/Xlib.h> #include <X11/cursorfont.h> + +/* Include Xutil.h after keysym.h to work around a bug that prevents + correct recognition of AltGr key in some X versions. */ + #include <X11/keysym.h> #include <X11/Xutil.h> + #include <X11/Xatom.h> #include <X11/Xresource.h> @@ -45,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 */ @@ -596,6 +603,7 @@ XIC xic; XIMStyle xic_style; XFontSet xic_xfs; + char *xic_base_fontname; #endif /* Relief GCs, colors etc. */ @@ -730,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. */ @@ -1039,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));