Mercurial > hg > xemacs-beta
changeset 108:360340f9fd5f r20-1b6
Import from CVS: tag r20-1b6
line wrap: on
line diff
--- a/CHANGES-beta Mon Aug 13 09:17:27 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:18:39 2007 +0200 @@ -1,4 +1,27 @@ -*- indented-text -*- +to 20.1 beta6 +-- filladapt.el-2.09 courtesy of Kyle Jones +-- itimer.el-1.03 +-- more work on sit-for, etc. courtesy of David Moore +-- describe-beta command added, etc/BETA, C-h B +-- updates to hyper-apropos.el courtesy of Christoph Wedler +-- texinfo manual updated to 2.23 +-- texinfo.tex update to 3.9 +-- Gnus-5.4.23 +-- tm-7.105.1 +-- W3-3.0.65 +-- Custom-1.59 +-- AUCTeX-9.7l +-- VM-6.19 +-- Build fixes from Martin Buchholz +-- More work on Linux libc-5/libc-6 portability, it works out of the box now? +-- more frame visibility patches courtesy of Jan Vroonhof +-- Synch to MULE patches courtesy of MORIOKA Tomohiko +-- graphical updates to time.el +-- gnuattach fixes courtesy of Hunter Kelly +-- dynamic PURESIZE fixes +-- miscellaneous bug fixes + to 20.1 beta5 -- bug fix to gnus-mime.el -- custom-1.50
--- a/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,19 @@ +Sat Mar 8 15:19:33 1997 Steven L Baur <steve@altair.xemacs.org> + + * XEmacs-20.1-b6 is released. + * XEmacs-19.15-b98 is released. + +Wed Mar 5 18:55:36 1997 Steven L Baur <steve@altair.xemacs.org> + + * Makefile.in (install-arch-indep): Offer to compress lisp sources. + (gzip-el): New targe for compressed installed lisp sources. + +Tue Mar 4 23:28:37 1997 Martin Buchholz <mrb@eng.sun.com> + + * lib-src/update-elc.sh: VM is compiled after the byte-compiler, + but before anything else. More flexible about finding an xemacs + to use for byte-compilation (default src/xemacs). Other minor fixes. + Mon Mar 3 23:57:56 1997 Steven L Baur <steve@altair.xemacs.org> * XEmacs 20.1-b5 is released.
--- a/Makefile.in Mon Aug 13 09:17:27 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:18:39 2007 +0200 @@ -410,6 +410,15 @@ ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${mandir}/$${page}${manext} ; \ chmod 0644 ${mandir}/$${page}${manext} ; \ done + @echo "If you would like to save approximately 15M of disk space, do" + @echo "make gzip-el" + @echo "or you may run " + @echo lib-src/gzip-el.sh lispdir " from the command line." + @echo "Where lispdir is where the lisp files were installed, i.e.," + @echo "${lispdir}" + +gzip-el: + lib-src/gzip-el.sh ${lispdir} MAKEPATH=./lib-src/make-path ### Build all the directories we're going to install XEmacs in. Since
--- a/configure Mon Aug 13 09:17:27 2007 +0200 +++ b/configure Mon Aug 13 09:18:39 2007 +0200 @@ -1439,6 +1439,7 @@ *-linux* ) opsys=linux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; + *-bsdi3* ) opsys=bsdos2-1 ;; *-bsdi2.1* ) opsys=bsdos2-1 ;; *-bsdi2* ) opsys=bsdos2 ;; *-sco3.2v5* ) opsys=sco5 ;
--- a/configure.in Mon Aug 13 09:17:27 2007 +0200 +++ b/configure.in Mon Aug 13 09:18:39 2007 +0200 @@ -1445,6 +1445,7 @@ *-linux* ) opsys=linux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; + *-bsdi3* ) opsys=bsdos2-1 ;; *-bsdi2.1* ) opsys=bsdos2-1 ;; *-bsdi2* ) opsys=bsdos2 ;; *-sco3.2v5* ) opsys=sco5 ;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/BETA Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,165 @@ + -*- mode:outline; minor-mode:outl-mouse -*- + +* Introduction +============== + +You are running an experimental version of XEmacs. Please do not +report problems with Beta XEmacs to comp.emacs.xemacs. Report them to +xemacs-beta@xemacs.org. + +** XEmacs Beta Mailing List +=========================== + +*** Subscribing +--------------- + +If you are not subscribed to the XEmacs beta list you should be. Send +an email message with a subject of `subscribe' (without the quotes) to +xemacs-beta-request@xemacs.org and follow the directions. You do not +have to fill out the survey if you don't want to. + +*** Unsubscribing +----------------- + +To unsubscribe from the list send an email message with a subject of +`unsubscribe' (without the quotes) to xemacs-beta-request@xemacs.org. + +*** Administrivia +----------------- + +The XEmacs beta list is managed by the SmartList mailing list package, +and the usual SmartList commands work. Do not send mailing list +requests to the main address (xemacs-beta@xemacs.org), always send +them to xemacs-beta-request@xemacs.org. If you have problems with the +list itself, they should be brought to the attention of the Mailing +List manager Chuck Thompson <cthomp@xemacs.org>. + + +** Reporting Problems +===================== + +The best way to get problems fixed in XEmacs is to submit good problem +reports. Since this is beta software problems are certain to exist. +Please read through all of part II of the XEmacs FAQ for an overview +of problem reporting. Other items which are most important are: + +1. Do not submit C stack backtraces without line numbers. Since it + is possible to compile optimized with debug information with GCC + it is never a good idea to compile XEmacs without the -g flag. + XEmacs runs on a variety of platforms, and often it is not + possible to recreate problems which afflict a specific platform. + The line numbers in the C stack backtrace help isolate where the + problem is actually occurring. + +2. Attempt to recreate the problem starting with an invocation of + XEmacs with `xemacs -q -no-site-file'. Quite often problems are + due to package interdependencies, and the like. An actual bug in + XEmacs should be reproducible in a default configuration without + loading any special packages (or the one or two specific packages + that cause the bug to appear). + +3. A picture can be worth a thousand words. When reporting an + unusual display, it is generally best to capture the problem in a + screen dump and include that with the problem report. The easiest + way to get a screen dump is to use the xv program and its grab + function. Save the image as a GIF to keep bandwidth requirements + down without loss of information. MIME is the preferred method + for making the image attachments. + +* Compiling Beta XEmacs +======================= + +** Building an XEmacs from patches +================================== + +All beta releases of XEmacs are included with patches from the +previous version in an attempt to keep bandwidth requirements down. +Patches should be applied with the GNU patch program in something like +the following. Let's say you're upgrading XEmacs 20.4-beta10 to +XEmacs 20.4-beta11 and you have a full unmodified XEmacs 20.4-beta10 +source tree to work with. Cd to the top level directory and issue the +shell command: + +$ gunzip -c /tmp/xemacs-20.4-b10-20.4-b11.patch.gz | patch -p1 + +After patching check to see that no patches were missed by doing +$ find . -name \*.rej -print + +Any rejections should be treated as serious problems to be resolved +before starting compilation. + +After seeing that there were no rejections, issue the command + +$ make all-elc + +and go play minesweep for awhile on an older XEmacs while the binary +is rebuilt. + +** Building an XEmacs from a full distribution +============================================== + +Locate a convenient place where you have at least 100MB of free space +and issue the command + +$ gunzip -c /tmp/xemacs-20.4-b11.tar.gz | tar xvf - + +(or the simpler `tar zxvf /tmp/xemacs-20.4-b11.tar.gz' if you use GNU +tar). + +cd to the top level directory and issue an appropriate configure +command. The maintainer uses the following at the time of this +writing: + +./configure --with-offix --with-mule=yes --with-dialogs=athena3d \ + --cflags="-m486 -g -O4 -fno-strength-reduce -malign-loops=2 \ + -malign-jumps=2 -malign-functions=2" --with-sound=no \ + --with-xface=yes --error-checking=all --debug=yes \ + --with-scrollbars=athena3d \ + --with-canna=yes --with-wnn=yes --wnn-includes=/usr/X11R6/include/wnn + +Save the output from configure that looks something like: +Configured for `i586-unknown-linux2.0.28'. + + Where should the build process find the source code? /usr/src/xemacs-20.0 + What installation prefix should install use? /usr/local + What operating system and machine description files should XEmacs use? + `s/linux.h' and `m/intel386.h' + What compiler should XEmacs be built with? gcc -m486 -g -O4 -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2 + Should XEmacs use the GNU version of malloc? yes + Should XEmacs use the relocating allocator for buffers? yes + What window system should XEmacs use? x11 + Where do we find X Windows header files? /usr/X11R6/include + Where do we find X Windows libraries? /usr/X11R6/lib + Compiling in support for XAUTH. + Compiling in support for XPM. + Compiling in support for X-Face headers. + Compiling in support for GIF image conversion. + Compiling in support for JPEG image conversion. + Compiling in support for PNG image conversion. + Compiling in support for Berkeley DB. + Compiling in support for GNU DBM. + Compiling in Mule (multi-lingual) support. + Compiling in support for OffiX. + Using the Lucid menubar. + Using the Athena-3d scrollbar. + Using the Athena-3d dialog boxes. + +Then type make and you should have a working XEmacs. + +After you have verified that you have a functional editor, fire up +your favorite mail program and send a build report to +xemacs-beta@xemacs.org. The build report should include + +1. Your hardware configuration (OS version, etc.) + +2. Version numbers of software in use (X11 version, system library + versions if appropriate, graphics library versions if appropriate). + If you're on a system like Linux, include all the version numbers + you can because chances are it makes a difference. + +3. The options given to configure + +4. The configuration report illustrated above + +5. Any other unusual items you feel should be brought to the attention + of the developers.
--- a/etc/Emacs.ad Mon Aug 13 09:17:27 2007 +0200 +++ b/etc/Emacs.ad Mon Aug 13 09:18:39 2007 +0200 @@ -99,8 +99,8 @@ ! Emacs.leftToolBarWidth: 0 ! Emacs.rightToolBarWidth: 0 -*topToolBarShadowColor: Gray90 -*bottomToolBarShadowColor: Gray40 +!*topToolBarShadowColor: Gray90 +!*bottomToolBarShadowColor: Gray40 *backgroundToolBarColor: Gray75 *toolBarShadowThickness: 2
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/0.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1E1C", +/* pixels */ +"`````````", +"````aaaaa", +"```a````a", +"```a````a", +"``a````a`", +"``a````a`", +"`````````", +"`a````a``", +"`a````a``", +"a````a```", +"a````a```", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/1.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CA1E1C", +/* pixels */ +"`````````", +"`````````", +"````````a", +"````````a", +"```````a`", +"```````a`", +"`````````", +"``````a``", +"``````a``", +"`````a```", +"`````a```", +"`````````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/2.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"a c #CB1D1C", +"` s None c None", +/* pixels */ +"`````````", +"````aaaaa", +"````````a", +"````````a", +"```````a`", +"```````a`", +"``aaaaa``", +"`a```````", +"`a```````", +"a````````", +"a````````", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/3.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1D1C", +/* pixels */ +"`````````", +"````aaaaa", +"````````a", +"````````a", +"```````a`", +"```````a`", +"``aaaaa``", +"``````a``", +"``````a``", +"`````a```", +"`````a```", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/4.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CA1E1C", +/* pixels */ +"`````````", +"`````````", +"```a````a", +"```a````a", +"``a````a`", +"``a````a`", +"``aaaaa``", +"``````a``", +"``````a``", +"`````a```", +"`````a```", +"`````````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/5.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1D1C", +/* pixels */ +"`````````", +"````aaaaa", +"```a`````", +"```a`````", +"``a``````", +"``a``````", +"``aaaaa``", +"``````a``", +"``````a``", +"`````a```", +"`````a```", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/6.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1E1C", +/* pixels */ +"`````````", +"````aaaaa", +"```a`````", +"```a`````", +"``a``````", +"``a``````", +"``aaaaa``", +"`a````a``", +"`a````a``", +"a````a```", +"a````a```", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/7.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1E1C", +/* pixels */ +"`````````", +"````aaaaa", +"````````a", +"````````a", +"```````a`", +"```````a`", +"`````````", +"``````a``", +"``````a``", +"`````a```", +"`````a```", +"`````````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/8.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1E1C", +/* pixels */ +"`````````", +"````aaaaa", +"```a````a", +"```a````a", +"``a````a`", +"``a````a`", +"``aaaaa``", +"`a````a``", +"`a````a``", +"a````a```", +"a````a```", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/9.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CB1E1C", +/* pixels */ +"`````````", +"````aaaaa", +"```a````a", +"```a````a", +"``a````a`", +"``a````a`", +"``aaaaa``", +"``````a``", +"``````a``", +"`````a```", +"`````a```", +"aaaaa````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/am.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"4 13 2 1", +/* colors */ +"` s None c None", +"a c #CA1E1C", +/* pixels */ +"````", +"``aa", +"``aa", +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/dp.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"9 13 2 1", +/* colors */ +"` s None c None", +"a c #CA1E1C", +/* pixels */ +"`````````", +"`````````", +"`````````", +"`````````", +"````a````", +"````a````", +"`````````", +"```a`````", +"```a`````", +"`````````", +"`````````", +"`````````", +"`````````" +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-0.0.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,21 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 1 1", +/* colors */ +" s None c None", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" " +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-0.5.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 2 1", +/* colors */ +" s None c None", +"a c #2AD244", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" aaaaaaaaa", +" " +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-1.0.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 2 1", +/* colors */ +" s None c None", +"a c #2AD244", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" aaaaaaaa", +" ", +" aaaaaaaaa", +" " +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-1.5.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,23 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 3 1", +/* colors */ +" s None c None", +"a c #2AD244", +"b c #DEE614", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" ", +" ", +" bbbbbbb", +" ", +" aaaaaaaa", +" ", +" aaaaaaaaa", +" " +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-2.0.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,23 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 3 1", +/* colors */ +" s None c None", +"a c #2AD244", +"b c #DEE614", +/* pixels */ +" ", +" ", +" ", +" ", +" ", +" bbbbbb", +" ", +" bbbbbbb", +" ", +" aaaaaaaa", +" ", +" aaaaaaaaa", +" " +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-2.5.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,24 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 4 1", +/* colors */ +" s None c None", +"` c #FE0204", +"b c #2AD244", +"c c #DEE614", +/* pixels */ +" ", +" ", +" ", +" `````", +" ", +" cccccc", +" ", +" ccccccc", +" ", +" bbbbbbbb", +" ", +" bbbbbbbbb", +" " +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/l-3.0.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,24 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"10 13 4 1", +/* colors */ +" s None c None", +"` c #FE0204", +"b c #2AD244", +"c c #DEE614", +/* pixels */ +" ", +" ````", +" ", +" `````", +" ", +" cccccc", +" ", +" ccccccc", +" ", +" bbbbbbbb", +" ", +" bbbbbbbbb", +" " +};
--- a/etc/time/letter.xpm Mon Aug 13 09:17:27 2007 +0200 +++ b/etc/time/letter.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ /* XPM */ static char * jmail_xpm[] = { "18 13 4 1", -" s None c None", +" s None c None", ". c gray85", "X c yellow", "o c black",
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/time/pm.xpm Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,22 @@ +/* XPM */ +static char *noname[] = { +/* width height ncolors chars_per_pixel */ +"4 13 2 1", +/* colors */ +"` s None c None", +"a c #CA1E1C", +/* pixels */ +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"````", +"aa``", +"aa``", +"````" +};
--- a/lib-src/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,13 @@ +Wed Mar 5 18:07:57 1997 Steven L Baur <steve@altair.xemacs.org> + + * gzip-el.sh: New file. Courtesy of Jeff Miller and Hrvoje Niksic. + + * update-elc.sh (els): Remove out of date .elcs before building. + +Tue Mar 4 18:45:10 1997 Martin Buchholz <mrb@eng.sun.com> + + * update-elc.sh (els): No more special treatment for vm.elc. + Wed Feb 26 18:17:59 1997 Steven L Baur <steve@altair.xemacs.org> * make-docfile.c (next_extra_elc): New function.
--- a/lib-src/gnuclient.c Mon Aug 13 09:17:27 2007 +0200 +++ b/lib-src/gnuclient.c Mon Aug 13 09:18:39 2007 +0200 @@ -66,6 +66,67 @@ static char cwd[MAXPATHLEN+2]; /* current working directory when calculated */ static char *cp = NULL; /* ptr into valid bit of cwd above */ +#ifdef GNUATTACH +#include <signal.h> + +static pid_t emacs_pid; /* Process id for emacs process */ + +void tell_emacs_to_resume(int sig) +{ + char buffer[GSERV_BUFSZ+1]; + int s; /* socket / msqid to server */ + int connect_type; /* CONN_UNIX, CONN_INTERNET, or + * CONN_IPC */ + + /* Why is SYSV so retarded? */ + /* We want emacs to realize that we are resuming */ + signal(SIGCONT, tell_emacs_to_resume); + + connect_type = make_connection (NULL, (u_short) 0, &s); + + sprintf(buffer,"(server-eval '(resume-pid-console %d))", getpid()); + send_string(s, buffer); + +#ifdef SYSV_IPC + if (connect_type == (int) CONN_IPC) + disconnect_from_ipc_server (s, msgp, FALSE); +#else /* !SYSV_IPC */ + if (connect_type != (int) CONN_IPC) + disconnect_from_server (s, FALSE); +#endif /* !SYSV_IPC */ +} + +void pass_signal_to_emacs(int sig) +{ + if (kill(emacs_pid, sig) == -1) { + fprintf(stderr, "gnuattach: Could not pass signal to emacs process\n"); + exit(1); + } +} + +void initialize_signals() +{ + /* Set up signal handler to pass relevant signals to emacs process */ + signal(SIGHUP, pass_signal_to_emacs); + signal(SIGQUIT, pass_signal_to_emacs); + signal(SIGILL, pass_signal_to_emacs); + signal(SIGTRAP, pass_signal_to_emacs); + signal(SIGSEGV, pass_signal_to_emacs); + signal(SIGPIPE, pass_signal_to_emacs); + signal(SIGTERM, pass_signal_to_emacs); +#ifdef SIGBUS + signal(SIGBUS, pass_signal_to_emacs); +#endif +#ifdef SIGIOT + signal(SIGIOT, pass_signal_to_emacs); +#endif + + /* We want emacs to realize that we are resuming */ + signal(SIGCONT, tell_emacs_to_resume); +} + +#endif /* GNUATTACH */ + /* get_current_working_directory -- return the cwd. @@ -131,7 +192,7 @@ main (int argc, char *argv[]) { int starting_line = 1; /* line to start editing at */ - char command[MAXPATHLEN+50]; /* emacs command buffer */ + char command[MAXPATHLEN+50]; /* emacs command buffer */ char fullpath[MAXPATHLEN+1]; /* full pathname to file */ #ifndef GNUATTACH int qflg = 0; /* quick edit, don't wait for @@ -155,6 +216,7 @@ #endif /* SYSV_IPC */ #ifdef GNUATTACH char *tty; + char buffer[GSERV_BUFSZ+1]; /* buffer to read pid */ #endif #ifdef INTERNET_DOMAIN_SOCKETS @@ -166,11 +228,7 @@ while ((c = getopt (argc, argv, #ifdef INTERNET_DOMAIN_SOCKETS -# ifdef GNUATTACH - "h:p:r" -# else "h:p:r:q" -# endif #else /* !INTERNET_DOMAIN_SOCKETS */ # ifdef GNUATTACH "" @@ -209,13 +267,8 @@ { fprintf (stderr, #ifdef INTERNET_DOMAIN_SOCKETS -# ifdef GNUATTACH - "usage: %s [-h hostname] [-p port] [-r pathname] " - "[[+line] path] ...\n", -# else "usage: %s [-q] [-h hostname] [-p port] [-r pathname] " "[[+line] path] ...\n", -# endif #else /* !INTERNET_DOMAIN_SOCKETS */ # ifdef GNUATTACH "usage: %s [[+line] path] ...\n", @@ -234,9 +287,35 @@ fprintf (stderr, "%s: Not connected to a tty", progname); exit (1); } -#endif + + /* This next stuff added in an attempt to make handling of + the tty do the right thing when dealing with signals. + Idea is to pass all the appropriate signals to the emacs process + */ + + connect_type = make_connection (NULL, (u_short) 0, &s); -#ifdef INTERNET_DOMAIN_SOCKETS + send_string(s,"(server-eval '(emacs-pid))"); + send_string(s,EOT_STR); + + if (read_line(s,buffer) == 0) { + fprintf(stderr, "%s: Could not establish emacs procces id\n",progname); + exit(1); + } + /* don't do disconnect_from_server becasue we have already read data, + and disconnect doesn't do anything else + */ +#ifdef SYSV_IPC + if (connect_type == (int) CONN_IPC) + disconnect_from_ipc_server (s, msgp, FALSE); +#endif /* !SYSV_IPC */ + + emacs_pid = (pid_t)atol(buffer); + initialize_signals(); + +#endif /*GNUATTACH */ + +#if defined(INTERNET_DOMAIN_SOCKETS) && !defined(GNUATTACH) connect_type = make_connection (hostarg, portarg, &s); #else connect_type = make_connection (NULL, (u_short) 0, &s); @@ -288,7 +367,8 @@ fprintf (stderr, "%s: unknown terminal type\n", progname); exit (1); } - sprintf (command, "(server-tty-edit-files \"%s\" \"%s\" '(", tty, ptr); + sprintf (command, "(server-tty-edit-files \"%s\" \"%s\" %d '(", + tty, ptr, getpid()); send_string (s, command); #else if (qflg)
--- a/lib-src/gnuserv.c Mon Aug 13 09:17:27 2007 +0200 +++ b/lib-src/gnuserv.c Mon Aug 13 09:18:39 2007 +0200 @@ -345,7 +345,10 @@ fprintf(stderr,"%s: garbage after result\n",progname); exit(1); } - close(s); + /* send the newline */ + buf[1] = '\0'; + send_string(s,buf); + close(s); } /* handle_response */ #endif /* INTERNET_DOMAIN_SOCKETS || UNIX_DOMAIN_SOCKETS */
--- a/lib-src/gnuslib.c Mon Aug 13 09:17:27 2007 +0200 +++ b/lib-src/gnuslib.c Mon Aug 13 09:18:39 2007 +0200 @@ -33,6 +33,7 @@ static char rcsid [] = "!Header: gnuslib.c,v 2.4 95/02/16 11:57:37 arup alpha !"; #endif +#include <errno.h> #include "gnuserv.h" #ifdef SYSV_IPC @@ -216,6 +217,29 @@ }; /* while */ #endif } /* send_string */ + +/* + read_line -- read a \n terminated line from a socket +*/ +int read_line(s,dest) + int s; + char *dest; +{ + char *index = NULL; + int length; + int offset=0; + char buffer[GSERV_BUFSZ+1]; + + while ((length=read(s,buffer+offset,1)>0) && buffer[offset]!='\n' + && buffer[offset] != EOT_CHR) { + offset += length; + if (offset >= GSERV_BUFSZ) + break; + } + buffer[offset] = '\0'; + strcpy(dest,buffer); + return 1; +} /* read_line */ #endif /* INTERNET_DOMAIN_SOCKETS || UNIX_DOMAIN_SOCKETS */ @@ -405,11 +429,14 @@ add_newline = (buffer[length-1] != '\n'); }; /* while */ #else - while ((length = read(s,buffer,GSERV_BUFSZ)) > 0) { - buffer[length] = '\0'; - if (echo) { - fputs(buffer,stdout); - add_newline = (buffer[length-1] != '\n'); + while ((length = read(s,buffer,GSERV_BUFSZ)) > 0 || + (length == -1 && errno == EINTR)) { + if (length) { + buffer[length] = '\0'; + if (echo) { + fputs(buffer,stdout); + add_newline = (buffer[length-1] != '\n'); + }; /* if */ }; /* if */ }; /* while */ #endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib-src/gzip-el.sh Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,21 @@ +#! /bin/sh +### gzip-el.sh --- compress superfluous installed source lisp + +# Author: Jeff Miller <jmiller@bay1.bayserve.net> +# Author: Hrvoje Niksic <hniksic@srce.hr> +# Maintainer: Steve Baur <steve@altair.xemacs.org> +# Created: 13 Feb 1997 +# Version: 1.0 +# Keywords: internal + + +# +# +echo Compressing .el files in "$1"... + +find "$1" -type f -name "*.el" -print | + while read file; do + [ -s "${file}c" ] && echo "$file" && gzip -f9 "$file" + done + +echo Compressing .el files in "$1"...done.
--- a/lib-src/update-elc.sh Mon Aug 13 09:17:27 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 09:18:39 2007 +0200 @@ -1,42 +1,64 @@ #!/bin/sh -# update-elc.sh --- recompile all missing or out-or-date .elc files +# update-elc.sh --- recompile all missing or out-of-date .elc files # Author: Jamie Zawinski, Ben Wing, Martin Buchholz # Maintainer: Martin Buchholz -# Keywords: recompile .el .elc +# Keywords: recompile byte-compile .el .elc ### Commentary: ## Recompile all .elc files that need recompilation. Requires a -## working version of 'xemacs'. Correctly handles the case where the -## .elc files are missing; thus you can execute 'rm lisp/*/*.elc' +## working version of "xemacs". Correctly handles the case where the +## .elc files are missing; thus you can execute "rm lisp/*/*.elc" ## before running this script. Run this from the parent of the -## `lisp' directory, or another nearby directory. +## "lisp" directory, or another nearby directory. -set -eu +set -e # Try to find the lisp directory in several places. -# (Sun workspaces have an `editor' directory) +# (Sun workspaces have an "editor" directory) for dir in . .. ../.. editor ../editor ; do - if test -d $dir ; then cd $dir ; break ; fi + if test -d $dir/lisp/. ; then cd $dir ; break ; fi done if test ! -d lisp/. ; then - echo "$0: Cannot find the \`lisp' directory." + echo "$0: Cannot find the \"lisp\" directory." exit 1 fi +# Determine xemacs executable to use for compilation. +if test -n "$XEMACS" ; then + EMACS="$XEMACS" +elif test -x ./src/xemacs ; then + EMACS="./src/xemacs" +elif test -x "$EMACS" ; then + : +else + EMACS=xemacs +fi +case "$EMACS" in + */* ) : ;; # Pathname specified + *) # Need to find executable on PATH + for dir in `echo $PATH | sed 's/:/ /g'` ; do + if test -x "dir/xemacs" ; then + EMACS="$dir/$EMACS" + break + fi + done ;; +esac +# Canonicalize +EMACS=`cd \`dirname $EMACS\` ; pwd | sed 's:^/tmp_mnt::'`/`basename $EMACS` +export EMACS -EMACS=${XEMACS:-./src/xemacs}; export EMACS -REAL=`cd \`dirname $EMACS\` ; pwd | sed 's:^/tmp_mnt::'`/`basename $EMACS` -BYTECOMP="$REAL -batch -q -no-site-file -l bytecomp" echo "Recompiling in `pwd|sed 's:^/tmp_mnt::'`" -echo " with $REAL..." +echo " with $EMACS..." prune_vc="( -name SCCS -o -name RCS -o -name CVS ) -prune -o" +$EMACS -batch -q -no-site-file -l cleantree -f batch-remove-old-elc lisp + # $els is a list of all .el files # $elcs is a list of all .elc files -els=/tmp/rcl1.$$ ; elcs=/tmp/rcl2.$$ +els=/tmp/update-elc-1.$$ elcs=/tmp/update-elc-2.$$ rm -f $els $elcs trap "rm -f $els $elcs" 0 1 2 3 15 find lisp/. $prune_vc -name '*.el' -print | sort > $els @@ -44,7 +66,7 @@ echo "Deleting .elc files without .el files..." -comm -13 $els $elcs | sed -e '\!/vm.el!d' -e '\!/w3.el!d' -e 's/el$/elc/' | \ +comm -13 $els $elcs | sed -e '\!/vm.el!d' -e 's/el$/elc/' | \ while read file ; do echo rm "$file" ; rm "$file" ; done echo "Deleting .elc files without .el files... Done" @@ -55,7 +77,7 @@ # Only use Mule XEmacs to compile Mule-specific elisp dirs echo "Checking for Mule support..." lisp_prog='(princ (featurep (quote mule)))' -mule_p="`$REAL -batch -no-site-file -eval \"$lisp_prog\"`" +mule_p="`$EMACS -batch -no-site-file -eval \"$lisp_prog\"`" if test "$mule_p" = nil ; then echo No ignore_dirs="$ignore_dirs mule" @@ -70,8 +92,16 @@ # with the latest version (assuming we're compiling the lisp dir of the emacs # we're running, which might not be the case, but often is.) echo "Checking the byte compiler..." +BYTECOMP="$EMACS -batch -q -no-site-file -l bytecomp" $BYTECOMP -f batch-byte-recompile-directory lisp/bytecomp +# Byte-compile VM first, because other packages depend on it, +# but it depends on nothing (Kyle is like that). +ignore_dirs="$ignore_dirs vm" +echo "Compiling in lisp/vm"; +(cd lisp/vm && ${MAKE:-make} EMACS=$EMACS) +echo "lisp/vm done." + # Prepare for byte-compiling directories with directory-specific instructions make_special_commands='' make_special () { @@ -79,15 +109,14 @@ ignore_dirs="$ignore_dirs $dir" make_special_commands="$make_special_commands \ echo \"Compiling in lisp/$dir\"; \ -(cd \"lisp/$dir\"; \ -${MAKE:-make} EMACS=$REAL ${1+$*}); \ +(cd \"lisp/$dir\" && ${MAKE:-make} EMACS=$EMACS ${1+$*}); \ echo \"lisp/$dir done.\";" } -make_special vm -make_special efs +#make_special vm #make_special ediff elc #make_special viper elc +make_special efs make_special gnus some make_special w3 make_special hyperbole elc @@ -134,5 +163,4 @@ xargs -t $BYTECOMP -f batch-byte-recompile-directory echo "Compiling files with out-of-date .elc... Done" - eval "$make_special_commands"
--- a/lisp/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,93 @@ +Sat Mar 8 11:20:47 1997 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-faces.el (*try-oblique-before-italic-fonts*): New user + variable. Allow trying oblique fonts ahead of italic fonts (from + Raymond Toy). + (x-make-font-italic): Use it. + + * prim/obsolete.el (window-system): Make it compatible not + obsolete. + +Fri Oct 11 14:21:05 1996 Christoph Wedler <wedler@fmi.uni-passau.de> + + * hyper-apropos.el (hypropos-get-doc): Put font names etc in + parentheses if instantiation uses fallback. + (hypropos-face-history): New variable. + (hyper-describe-face): New function. + (hyper-where-is): New command. + (hypropos-read-function-symbol): New function. + (hyper-describe-key): New command. + (hyper-describe-key-briefly): New command. + (hypropos-read-variable-symbol): New function. + (hyper-set-variable): New command. + (hypropos-set-variable): Changed to work with buffer-locals. + +Fri Jul 19 12:01:51 1996 Christoph Wedler <wedler@fmi.uni-passau.de> + + * hyper-apropos.el: Massive changes--the original knew nothing + about buffer-locals and local-bindings. + (hypropos-shrink-window): New user option. + (hypropos-ref-buffer): New variable. + (hypropos-regexp-history): New variable. + (hyper-apropos): Better interactive version. + (hypropos-grok-variables): Omit OBSOLETE stuff. + (hyper-describe-variable): Additional ARG, better interactive + version. + (hyper-describe-function): Ditto. + (hypropos-last-help): Without prefix arg, just display buffer. + (hypropos-insert-face): New function. + (hypropos-insert-keybinding): New function. + (hypropos-get-doc): Additional ARG, display documentation for + faces, complete change. + (hypropos-this-symbol): Using better regexp. + +Fri Mar 7 10:44:48 1997 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-menubar.el (default-menubar): Reorganize again undoing + previous change. Customize submenu moved to top of options menu. + Edit faces restored to edit-faces and renamed to Browse faces. + +Thu Mar 6 08:43:27 1997 Steven L Baur <steve@altair.xemacs.org> + + * x11/x-menubar.el (options-menu): New variable. + (default-menubar): Use it. + + * prim/about.el (view-less): Explicit require. + +Wed Mar 5 18:03:02 1997 Steven L Baur <steve@altair.xemacs.org> + + * prim/cleantree.el: New file based on suggestion by David Moore, + and derived from Gnus nnml code. + +Tue Mar 4 01:19:37 1997 Hrvoje Niksic <hniksic@srce.hr> + + * edebug/edebug.el (edebug-compute-previous-result): Don't treat + numbers as chars. + +Wed Mar 5 10:11:55 1997 Steven L Baur <steve@altair.xemacs.org> + + * prim/startup.el (splash-hack-version-string): New function to + narrow the output of (emacs-version) for the splash screen. + (splash-frame-present): Use it. + +Tue Mar 4 19:52:10 1997 Steven L Baur <steve@altair.xemacs.org> + + * packages/supercite.el (sc-name-filter-alist): (Idea from Bob + Weiner). Update to handle names like Michael Sperber + [Mr. Preprocessor]. + +Mon Mar 3 17:50:04 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * prim/faces.el (init-face-from-resources): New variable. + (init-face-from-resources): Use it. + (init-device-faces): Use it. + (init-frame-faces): Use it. + (make-empty-face): New function. + + * x11/x-faces.el (x-init-face-from-resources): Made second + argument optional, and added a third argument. + (make-face-x-resource-internal): New alias. + Mon Mar 3 14:45:16 1997 Steven L Baur <steve@altair.xemacs.org> * prim/loadup.el: Remove custom.elc. @@ -638,7 +728,7 @@ * modes/m4-mode.el: Changed m4-program to point to /usr/bin/m4. -Sun Jan 12 18:49:30 1997 $B<i2,(B $BCNI'(B/MORIOKA Tomohiko <morioka@jaist.ac.jp> +Sun Jan 12 18:49:30 1997 ~~ ~~/MORIOKA Tomohiko <morioka@jaist.ac.jp> * mule/mule-misc.el: `-columns' -> `-width' and define `-columns' alias @@ -1188,7 +1278,7 @@ * utils/smtpmail.el: New file from Emacs 19.34. -Fri Dec 6 09:28:04 1996 $B<i2,(B $BCNI'(B/MORIOKA Tomohiko <morioka@jaist.ac.jp> +Fri Dec 6 09:28:04 1996 ~~ ~~/MORIOKA Tomohiko <morioka@jaist.ac.jp> * prim/startup.el (set-default-load-path): Set default-load-path dynamically since file-detect.el is dumped with XEmacs.
--- a/lisp/auctex/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,15 @@ +Tue Mar 04 11:29:23 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 9.7l released. + +Tue Mar 4 11:27:43 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Makefile (some): Don't use `style/*.elc'. + +Thu Feb 27 11:02:24 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * tex.el (TeX-electric-macro): Default to space after dot. + Wed Feb 26 23:15:27 1997 Per Abrahamsen <abraham@dina.kvl.dk> * Version 9.7k released.
--- a/lisp/auctex/Makefile Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/Makefile Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ # Makefile - for the AUC TeX distribution. # # Maintainer: Per Abrahamsen <auc-tex@sunsite.auc.dk> -# Version: 9.7k +# Version: 9.7l # # Edit the makefile, type `make', and follow the instructions. @@ -57,6 +57,8 @@ ## BELOW THIS LINE ON YOUR OWN RISK! ##---------------------------------------------------------------------- +.SUFFIXES: .el .elc .texi + SHELL = /bin/sh FTPDIR = /home/ftp/pub/Staff/Per.Abrahamsen/auctex @@ -98,7 +100,7 @@ lisp: $(ELC) $(AUCSRC) $(STYLESRC) $(CONTRIB) -some: $(AUCELC) style/*.elc +some: $(AUCELC) $(STYLESRC:.el=.elc) install: install-lisp
--- a/lisp/auctex/auc-old.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/auc-old.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; auc-old.el - Compatibility with AUC TeX 6.* ;; ;; Maintainer: Per Abrahamsen <auc-tex@sunsite.auc.dk> -;; Version: 9.7k +;; Version: 9.7l ;; ;; Copyright (C) 1991 Kresten Krab Thorup ;; Copyright (C) 1993 Per Abrahamsen
--- a/lisp/auctex/bib-cite.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/bib-cite.el Mon Aug 13 09:18:39 2007 +0200 @@ -7,7 +7,7 @@ ;; Version: 2.28 (22 January 97) ;; Keywords: bibtex, cite, auctex, emacs, xemacs -;; RCS $Id: bib-cite.el,v 1.1 1997/02/20 02:17:35 steve Exp $ +;; RCS $Id: bib-cite.el,v 1.2 1997/03/08 23:25:42 steve Exp $ ;; Note: RCS version number does not correspond to release number. ;; Everyone is granted permission to copy, modify and redistribute this @@ -149,7 +149,7 @@ ;; ;; For multi-file documents, you must be using auctex (so that bib-cite can ;; find the master file) and all \input and \include commands must be first -;; on a line (not preceeded by any non-white text). +;; on a line (not preceded by any non-white text). ;; ;; imenu support (Suggested key binding: Shift-Mouse-3) ;; @@ -501,7 +501,7 @@ ;; - Add key def for bibtex-mode to create auc-tex's parsing file. ;; - Fix bugs found by <thompson@loon.econ.wisc.edu> ;; - fix bib-get-citation for options -;; - fix bib-get-citation for commas preceeded citation command +;; - fix bib-get-citation for commas preceded citation command ;; - better regexp for citations and their keys. ;; - Added @string support for any entry (not just journal entries). ;; (I had to disallow numbers in @string keys because of years.
--- a/lisp/auctex/latex.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/latex.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; latex.el --- Support for LaTeX documents. ;; ;; Maintainer: Per Abrahamsen <auc-tex@sunsite.auc.dk> -;; Version: 9.7k +;; Version: 9.7l ;; Keywords: wp ;; X-URL: http://sunsite.auc.dk/auctex
--- a/lisp/auctex/tex-buf.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/tex-buf.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; tex-buf.el - External commands for AUC TeX. ;; ;; Maintainer: Per Abrahamsen <auc-tex@sunsite.auc.dk> -;; Version: 9.7k +;; Version: 9.7l ;; Copyright (C) 1991 Kresten Krab Thorup ;; Copyright (C) 1993, 1996 Per Abrahamsen
--- a/lisp/auctex/tex-info.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/tex-info.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; tex-info.el - Support for editing TeXinfo source. ;; ;; Maintainer: Per Abrahamsen <auc-tex@sunsite.auc.dk> -;; Version: 9.7k +;; Version: 9.7l ;; Copyright (C) 1993, 1994, 1997 Per Abrahamsen ;;
--- a/lisp/auctex/tex-jp.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/tex-jp.el Mon Aug 13 09:18:39 2007 +0200 @@ -311,7 +311,7 @@ ;; modified by S.Tomura 88-Jun-21 ;;(subst-char-in-region from (point-max) ?\n ?\ ) ;; modified by K.Handa 92-Mar-2 - ;; Spacing is not necessary for charcters of no word-separater. + ;; Spacing is not necessary for characters of no word-separator. ;; The regexp word-across-newline is used for this check. (if (not (stringp word-across-newline)) (subst-char-in-region from (point-max) ?\n ?\ ) @@ -499,7 +499,7 @@ ;; bug fixed by S.Tomura 88-May-25 ;; modified by S.Tomura 88-Jun-21 ;; modified by K.Handa 92-Mar-2 - ;; Spacing is not necessary for charcters of no word-separater. + ;; Spacing is not necessary for characters of no word-separator. ;; The regexp word-across-newline is used for this check. (if (not (stringp word-across-newline)) (subst-char-in-region from (point-max) ?\n ?\ )
--- a/lisp/auctex/tex.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/auctex/tex.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; tex.el --- Support for TeX documents. ;; Maintainer: Per Abrahamsen <auc-tex@sunsite.auc.dk> -;; Version: 9.7k +;; Version: 9.7l ;; Keywords: wp ;; X-URL: http://sunsite.auc.dk/auctex @@ -486,10 +486,10 @@ ;; These two variables are automatically updated with "make dist", so ;; be careful before changing anything. -(defconst AUC-TeX-version "9.7k" +(defconst AUC-TeX-version "9.7l" "AUC TeX version number") -(defconst AUC-TeX-date "Wed Feb 26 23:15:31 MET 1997" +(defconst AUC-TeX-date "Tue Mar 4 11:29:28 MET 1997" "AUC TeX release date") ;;; Buffer @@ -1083,10 +1083,15 @@ AUC TeX knows of some macros, and may query for extra arguments. Space will complete and exit." (interactive) - (if (memq (preceding-char) '(?\\ ?.)) - (call-interactively 'self-insert-command) - (let ((minibuffer-local-completion-map TeX-electric-macro-map)) - (call-interactively 'TeX-insert-macro)))) + (cond ((eq (preceding-char) ?\\) + (call-interactively 'self-insert-command)) + ((eq (preceding-char) ?.) + (let ((TeX-default-macro " ") + (minibuffer-local-completion-map TeX-electric-macro-map)) + (call-interactively 'TeX-insert-macro))) + (t + (let ((minibuffer-local-completion-map TeX-electric-macro-map)) + (call-interactively 'TeX-insert-macro))))) (defun TeX-parse-macro (symbol args) "How to parse TeX macros which takes one or more arguments."
--- a/lisp/bytecomp/bytecomp-runtime.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/bytecomp/bytecomp-runtime.el Mon Aug 13 09:18:39 2007 +0200 @@ -197,7 +197,7 @@ warnings list of warnings byte-compile-warnings file-format emacs19, emacs20 byte-compile-emacs19-compatibility -The value specificed with the `warnings' option must be a list, containing +The value specified with the `warnings' option must be a list, containing some subset of the following flags: free-vars references to variables not in the current lexical scope.
--- a/lisp/calendar/appt.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/calendar/appt.el Mon Aug 13 09:18:39 2007 +0200 @@ -138,7 +138,7 @@ ;;; up so that you get a notification twenty minutes before each appt, ;;; then a notification should come at 3:10 for the first appt, and at ;;; 3:15 for the second. Currently, no notifications are generated for an -;;; appointment until all preceeding appointments have completely expired. +;;; appointment until all preceding appointments have completely expired. ;;; ;;; o If there are two appointments at the same time, all but the first are ;;; ignored (not announced.)
--- a/lisp/comint/comint.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/comint/comint.el Mon Aug 13 09:18:39 2007 +0200 @@ -1998,7 +1998,7 @@ ;;; want them present in specific modes. (defvar comint-completion-autolist nil - "*If non-nil, automatically list possiblities on partial completion. + "*If non-nil, automatically list possibilities on partial completion. This mirrors the optional behavior of tcsh.") (defvar comint-completion-addsuffix t
--- a/lisp/comint/gud.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/comint/gud.el Mon Aug 13 09:18:39 2007 +0200 @@ -916,7 +916,7 @@ ;; annotation rule binding of whatever gdb sends to tell us this command ;; might have changed it's output. ;; -;; NAME is the fucntion name. DEMAND-PREDICATE tests if output is really needed. +;; NAME is the function name. DEMAND-PREDICATE tests if output is really needed. ;; GDB-COMMAND is a string of such. OUTPUT-HANDLER is the function bound to the ;; input in the input queue (see comment about ``gdb communications'' above). (defmacro def-gdb-auto-update-trigger (name demand-predicate gdb-command output-handler)
--- a/lisp/comint/shell.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/comint/shell.el Mon Aug 13 09:18:39 2007 +0200 @@ -284,12 +284,17 @@ (remove-hook 'font-lock-mode-hook 'shell-font-lock-mode-hook)) (add-hook 'font-lock-mode-hook 'shell-font-lock-mode-hook) -(defvar shell-prompt-pattern-for-font-lock shell-prompt-pattern - "Pattern to use to font-lock the prompt. -Defaults to `shell-prompt-pattern'.") +(defvar shell-prompt-pattern-for-font-lock nil + "If non-nil, pattern to use to font-lock the prompt. +When nil, shell-prompt-pattern will be used. Set this to a regular +expression if you want the font-locked pattern to be different then +the shell's prompt pattern.") (defvar shell-font-lock-keywords - (list (cons 'shell-prompt-pattern-for-font-lock shell-prompt-face) + (list '(eval . (cons (if shell-prompt-pattern-for-font-lock + shell-prompt-pattern-for-font-lock + shell-prompt-pattern) + shell-prompt-face)) '("[ \t]\\([+-][^ \t\n>]+\\)" 1 shell-option-face) '("^[^ \t\n]+:.*" . shell-output-2-face) '("^\\[[1-9][0-9]*\\]" . shell-output-3-face)
--- a/lisp/custom/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,145 @@ +Sat Mar 08 17:21:12 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.59 released. + +Sat Mar 8 10:16:59 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * widget.texi (editable-list): Documented new keywords. + (radio-button-choice): Ditto. + (checklist): Ditto. + + * cus-edit.el (custom-face-edit-args): Deleted. + + * wid-edit.el (color-item): Don't make sample a button. + + * widget.el (:insert-button-args): New keyword. + (:delete-button-args): Ditto. + + * wid-edit.el (widget-editable-list-entry-create): Use them. + * cus-edit.el (custom-face-value-create): Ditto. + + * widget.el (:append-button-args): New keyword. + * wid-edit.el (widget-editable-list-format-handler): Use it. + + * cus-edit.el (custom-face-edit): Add `:help-echo' to checkboxes. + * cus-face.el (custom-face-attributes): Add `:echo-help'. + * wid-edit.el (delete-button): Ditto. + (insert-button): Ditto. + + * widget.el (:button-args): New keyword. + (:sibling-args): New keyword. + * wid-edit.el (widget-checklist-add-item): Support them. + (widget-radio-add-item): Ditto. + + * wid-edit.el: (widget-mouse-help): Renamed from + `widget-ballon-help'. + (widget-specify-button): Support `help-echo'. + (widget-glyph-insert-glyph): Ditto. + (widget-specify-field-update): Ditto. + + * wid-edit.el: Minor spelling corrections. + Patch by Martin Buchholz <mrb@Eng.Sun.COM>. + +Fri Mar 07 21:29:07 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.58 released. + +Fri Mar 7 14:55:22 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el (custom-buffer-create): Go to top of buffer after + creating it. + + * custom.texi (The Customization Buttons): Documented `[Done]'. + +Fri Mar 07 14:40:52 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.57 released. + +Fri Mar 7 10:46:48 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el: Removed "Push me" from :help-echo strings. + * wid-edit.el: Ditto. + + * wid-edit.el (widget-specify-button): Support ballon-help. + (widget-glyph-insert-glyph): Ditto. + (widget-balloon-help): New function. + + * Makefile (some): New target. + + * wid-edit.el: A bit of compiler warning avoidance with new target. + + * cus-face.el (custom-face-attributes-set): Renamed from + `custom-face-attribites-set'. + (custom-face-display-set): Changed caller. + (custom-invert-face): Renamed from `reverse-face'. + (custom-face-attributes): Changed caller. + +Fri Mar 7 04:17:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * cus-face.el: Moved variable defintions around a bit to avoid + compilation warnings. + +Thu Mar 06 16:30:04 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.56 released. + +Thu Mar 6 15:40:34 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el (custom-notify): Don't modify hidden items. + +Wed Mar 05 17:42:47 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.55 released. + +Wed Mar 5 17:20:05 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-face.el (set-face-doc-string). Renamed from + `set-face-documentation'. + (face-doc-string). Renamed from `face-documentation'. + (custom-declare-face): Changed caller. + * cus-edit.el (custom-face): Changed caller. + +Wed Mar 05 17:00:42 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.54 released. + + * cus-face.el (reverse-face): New function. + (custom-face-attributes): Use it. + +Wed Mar 05 15:08:30 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.53 released. + +Wed Mar 5 15:03:58 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-face.el (custom-relevant-frames): Don't cache the frames. + (custom-initialize-frame): Ditto. + +Wed Mar 05 14:39:19 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.52 released. + +Wed Mar 5 14:38:20 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * wid-edit.el (widget-choose): Call `try-completion' to make sure + case changes are done. + +Tue Mar 04 21:04:30 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * Version 1.51 released. + +Tue Mar 4 11:58:02 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * widget.texi, custom.texi: Use @* instead of @br. + + * wid-edit.el (widget-glyph-insert): Allow glyphs as well as file + names from `widget-glyph-directory'. + +Mon Mar 3 19:38:57 1997 Per Abrahamsen <abraham@dina.kvl.dk> + + * cus-edit.el (custom-mode-map): Bind `bury-buffer' to `q'. + Suggested by Neal Becker <neal@ctd.comsat.com>. + Mon Mar 03 18:29:27 1997 Per Abrahamsen <abraham@dina.kvl.dk> * Version 1.50 released.
--- a/lisp/custom/cus-edit.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/cus-edit.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -300,7 +300,8 @@ (unless custom-mode-map (setq custom-mode-map (make-sparse-keymap)) - (set-keymap-parent custom-mode-map widget-keymap)) + (set-keymap-parent custom-mode-map widget-keymap) + (define-key custom-mode-map "q" 'bury-buffer)) (easy-menu-define custom-mode-menu custom-mode-map @@ -518,7 +519,7 @@ Push RET or click mouse-2 on the word ") (widget-create 'info-link :tag "help" - :help-echo "Push me for help." + :help-echo "Read the online help." "(custom)The Customization Buffer") (widget-insert " for more information.\n\n") (setq custom-options @@ -542,25 +543,26 @@ (mapcar 'custom-magic-reset custom-options) (widget-create 'push-button :tag "Set" - :help-echo "Push me to set all modifications." + :help-echo "Set all modifications for this session." :action (lambda (widget &optional event) (custom-set))) (widget-insert " ") (widget-create 'push-button :tag "Save" - :help-echo "Push me to make the modifications default." + :help-echo "\ +Make the modifications default for future sessions." :action (lambda (widget &optional event) (custom-save))) (widget-insert " ") (widget-create 'push-button :tag "Reset" - :help-echo "Push me to undo all modifications." + :help-echo "Undo all modifications." :action (lambda (widget &optional event) (custom-reset event))) (widget-insert " ") (widget-create 'push-button :tag "Done" - :help-echo "Push me to bury the buffer." + :help-echo "Bury the buffer." :action (lambda (widget &optional event) (bury-buffer) ;; Steal button release event. @@ -574,7 +576,8 @@ (when (memq 'down (event-modifiers event)) (read-event))))) (widget-insert "\n") - (widget-setup)) + (widget-setup) + (goto-char (point-min))) ;;; Modification of Basic Widgets. ;; @@ -599,7 +602,7 @@ (define-widget 'custom-manual 'info-link "Link to the manual entry for this customization option." - :help-echo "Push me to read the manual." + :help-echo "Read the manual entry for this option." :tag "Manual") ;;; The `custom-magic' Widget. @@ -771,7 +774,7 @@ (when custom-magic-show (push (widget-create-child-and-convert widget 'choice-item :help-echo "\ -Push me to change the state of this item." +Change the state of this item." :format "%[%t%]" :tag "State") children) @@ -789,8 +792,7 @@ (insert-char ? indent)))) (push (widget-create-child-and-convert widget 'choice-item :button-face face - :help-echo "\ -Push me to change the state." + :help-echo "Change the state." :format "%[%t%]" :tag (if lisp (concat "(" magic ")") @@ -809,7 +811,7 @@ (define-widget 'custom-level 'item "The custom level buttons." :format "%[%t%]" - :help-echo "Push me to expand or collapse this item." + :help-echo "Expand or collapse this item." :action 'custom-level-action) (defun custom-level-action (widget &optional event) @@ -902,7 +904,8 @@ (defun custom-notify (widget &rest args) "Keep track of changes." - (widget-put widget :custom-state 'modified) + (unless (memq (widget-get widget :custom-state) '(nil unknown hidden)) + (widget-put widget :custom-state 'modified)) (let ((buffer-undo-list t)) (custom-magic-reset widget)) (apply 'widget-default-notify widget args)) @@ -973,7 +976,7 @@ (define-widget 'custom-variable 'custom "Customize variable." :format "%l%v%m%h%a" - :help-echo "Push me to set or reset this variable." + :help-echo "Set or reset this variable." :documentation-property 'variable-documentation :custom-state nil :custom-menu 'custom-variable-menu-create @@ -1205,22 +1208,16 @@ ;;; The `custom-face-edit' Widget. -(defvar custom-face-edit-args - (mapcar (lambda (att) - (list 'group - :inline t - (list 'const :format "" :value (nth 0 att)) - (nth 1 att))) - custom-face-attributes)) - (define-widget 'custom-face-edit 'checklist "Edit face attributes." :format "%t: %v" :tag "Attributes" :extra-offset 12 + :button-args '(:help-echo "Control whether this attribute have any effect.") :args (mapcar (lambda (att) (list 'group :inline t + :sibling-args (widget-get (nth 1 att) :sibling-args) (list 'const :format "" :value (nth 0 att)) (nth 1 att))) custom-face-attributes)) @@ -1231,39 +1228,70 @@ "Select a display type." :tag "Display" :value t + :help-echo "Specify frames where the face attributes should be used." :args '((const :tag "all" t) - (checklist :offset 0 - :extra-offset 9 - :args ((group (const :format "Type: " type) - (checklist :inline t - :offset 0 - (const :format "X " - x) - (const :format "PM " - pm) - (const :format "Win32 " - win32) - (const :format "DOS " - pc) - (const :format "TTY%n" - tty))) - (group (const :format "Class: " class) - (checklist :inline t - :offset 0 - (const :format "Color " - color) - (const :format - "Grayscale " - grayscale) - (const :format "Monochrome%n" - mono))) - (group (const :format "Background: " background) - (checklist :inline t - :offset 0 - (const :format "Light " - light) - (const :format "Dark\n" - dark))))))) + (checklist + :offset 0 + :extra-offset 9 + :args ((group :sibling-args (:help-echo "\ +Only match the specified window systems.") + (const :format "Type: " + type) + (checklist :inline t + :offset 0 + (const :format "X " + :sibling-args (:help-echo "\ +The X11 Window System.") + x) + (const :format "PM " + :sibling-args (:help-echo "\ +OS/2 Presentation Manager.") + pm) + (const :format "Win32 " + :sibling-args (:help-echo "\ +Windows NT/95/97.") + win32) + (const :format "DOS " + :sibling-args (:help-echo "\ +Plain MS-DOS.") + pc) + (const :format "TTY%n" + :sibling-args (:help-echo "\ +Plain text terminals.") + tty))) + (group :sibling-args (:help-echo "\ +Only match the frames with the specified color support.") + (const :format "Class: " + class) + (checklist :inline t + :offset 0 + (const :format "Color " + :sibling-args (:help-echo "\ +Match color frames.") + color) + (const :format "Grayscale " + :sibling-args (:help-echo "\ +Match grayscale frames.") + grayscale) + (const :format "Monochrome%n" + :sibling-args (:help-echo "\ +Match frames with no color support.") + mono))) + (group :sibling-args (:help-echo "\ +Only match frames with the specified intensity.") + (const :format "\ +Background brightness: " + background) + (checklist :inline t + :offset 0 + (const :format "Light " + :sibling-args (:help-echo "\ +Match frames with light backgrounds.") + light) + (const :format "Dark\n" + :sibling-args (:help-echo "\ +Match frames with dark backgrounds.") + dark))))))) ;;; The `custom-face' Widget. @@ -1276,9 +1304,9 @@ :format "%l%{%t%}: %s%m%h%a%v" :format-handler 'custom-face-format-handler :sample-face 'custom-face-tag-face - :help-echo "Push me to set or reset this face." + :help-echo "Set or reset this face." :documentation-property '(lambda (face) - (face-documentation face)) + (face-doc-string face)) :value-create 'custom-face-value-create :action 'custom-face-action :custom-set 'custom-face-set @@ -1320,6 +1348,12 @@ :entry-format "%i %d %v" :value (or (get symbol 'saved-face) (get symbol 'factory-face)) + :insert-button-args '(:help-echo "\ +Insert new display specification here.") + :append-button-args '(:help-echo "\ +Append new display specification here.") + :delete-button-args '(:help-echo "\ +Delete this display specification.") '(group :format "%v" custom-display custom-face-edit)))) (custom-face-state-set widget) @@ -1526,7 +1560,7 @@ :format "%l%{%t%}:%L\n%m%h%a%v" :sample-face-get 'custom-group-sample-face-get :documentation-property 'group-documentation - :help-echo "Push me to set or reset all members of this group." + :help-echo "Set or reset all members of this group." :value-create 'custom-group-value-create :action 'custom-group-action :custom-set 'custom-group-set @@ -1809,7 +1843,7 @@ ,(widget-apply '(custom-group) :custom-menu 'emacs) ,@(cdr (cdr custom-help-menu))))) (if (fboundp 'add-submenu) - (add-submenu '("Help") menu) + (add-submenu '("Options") menu) (define-key global-map [menu-bar help-menu customize-menu] (cons (car menu) (easy-menu-create-keymaps (car menu) (cdr menu)))))))
--- a/lisp/custom/cus-face.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/cus-face.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -15,14 +15,29 @@ (require 'custom) +(eval-and-compile (require 'cl)) + ;;; Compatibility. -(unless (fboundp 'frame-property) - ;; XEmacs function missing in Emacs 19.34. - (defun frame-property (frame property &optional default) - "Return FRAME's value for property PROPERTY." - (or (cdr (assq property (frame-parameters frame))) - default))) +(eval-and-compile + (unless (fboundp 'frame-property) + ;; XEmacs function missing in Emacs 19.34. + (defun frame-property (frame property &optional default) + "Return FRAME's value for property PROPERTY." + (or (cdr (assq property (frame-parameters frame))) + default))) + + (unless (fboundp 'face-doc-string) + ;; XEmacs function missing in Emacs. + (defun face-doc-string (face) + "Get the documentation string for FACE." + (get face 'face-doc-string))) + + (unless (fboundp 'set-face-doc-string) + ;; XEmacs function missing in Emacs. + (defun set-face-doc-string (face string) + "Set the documentation string for FACE to STRING." + (put face 'face-doc-string string)))) (unless (fboundp 'x-color-values) ;; Emacs function missing in XEmacs 19.14. @@ -48,7 +63,9 @@ (unless (fboundp 'make-empty-face) ;; This should be moved to `faces.el'. (if (string-match "XEmacs" emacs-version) + ;; Give up for old XEmacs pre 19.15/20.1. (defalias 'make-empty-face 'make-face) + ;; Define for Emacs pre 19.35. (defun make-empty-face (name) "Define a new FACE on all frames, ignoring X resources." (interactive "SMake face: ") @@ -74,7 +91,6 @@ name))) (defcustom initialize-face-resources t - ;; Not implemented in XEmacs. "If non nil, allow X resources to initialize face properties. This only affects faces declared with `defface', and only NT or X11 frames." :group 'customize @@ -96,169 +112,32 @@ (defalias 'initialize-face-resources 'ignore))) (if (string-match "XEmacs" emacs-version) - (progn - (defun custom-extract-frame-properties (frame) - "Return a plist with the frame properties of FRAME used by custom." - (list 'type (device-type (frame-device frame)) - 'class (device-class (frame-device frame)) - 'background (or custom-background-mode - (frame-property frame - 'background-mode) - (custom-background-mode frame)))) - -(defun face-documentation (face) - "Get the documentation string for FACE." - (face-property face 'doc-string)) - - (defun set-face-documentation (face string) - "Set the documentation string for FACE to STRING." - (set-face-property face 'doc-string string))) - - (defun custom-extract-frame-properties (frame) - "Return a plist with the frame properties of FRAME used by custom." - (list 'type window-system - 'class (frame-property frame 'display-type) - 'background (or custom-background-mode - (frame-property frame 'background-mode) - (custom-background-mode frame)))) - - (defun face-documentation (face) - "Get the documentation string for FACE." - (get face 'face-documentation)) - - (defun set-face-documentation (face string) - "Set the documentation string for FACE to STRING." - (put face 'face-documentation string))) - -;;; Declaring a face. - -;;;###autoload -(defun custom-declare-face (face spec doc &rest args) - "Like `defface', but FACE is evaluated as a normal argument." - (when (fboundp 'load-gc) - ;; This should be allowed, somehow. - (error "Attempt to declare a face during dump")) - (unless (get face 'factory-face) - (put face 'factory-face spec) - (when (fboundp 'facep) - (unless (and (custom-facep face) - (not (get face 'saved-face))) - ;; If the user has already created the face, respect that. - (let ((value (or (get face 'saved-face) spec)) - (frames (custom-relevant-frames)) - frame) - ;; Create global face. - (make-empty-face face) - (custom-face-display-set face value) - ;; Create frame local faces - (while frames - (setq frame (car frames) - frames (cdr frames)) - (custom-face-display-set face value frame)) - (initialize-face-resources face)))) - (when (and doc (null (face-documentation face))) - (set-face-documentation face doc)) - (custom-handle-all-keywords face args 'custom-face) - (run-hooks 'custom-define-hook)) - face) - -;;; Font Attributes. - -(defun custom-face-attribites-set (face frame &rest atts) - "For FACE on FRAME set the attributes [KEYWORD VALUE].... -Each keyword should be listed in `custom-face-attributes'. - -If FRAME is nil, set the default face." - (while atts - (let* ((name (nth 0 atts)) - (value (nth 1 atts)) - (fun (nth 2 (assq name custom-face-attributes)))) - (setq atts (cdr (cdr atts))) - (condition-case nil - (funcall fun face value frame) - (error nil))))) - -(defconst custom-face-attributes - '((:bold (toggle :format "Bold: %[%v%]\n") custom-set-face-bold) - (:italic (toggle :format "Italic: %[%v%]\n") custom-set-face-italic) - (:underline - (toggle :format "Underline: %[%v%]\n") set-face-underline-p) - (:foreground (color :tag "Foreground") set-face-foreground) - (:background (color :tag "Background") set-face-background) - (:stipple (editable-field :format "Stipple: %v") set-face-stipple)) - "Alist of face attributes. - -The elements are of the form (KEY TYPE SET) where KEY is a symbol -identifying the attribute, TYPE is a widget type for editing the -attibute, SET is a function for setting the attribute value. - -The SET function should take three arguments, the face to modify, the -value of the attribute, and optionally the frame where the face should -be changed.") - -(defun custom-set-face-bold (face value &optional frame) - "Set the bold property of FACE to VALUE." - (if value - (make-face-bold face frame) - (make-face-unbold face frame))) - -(defun custom-set-face-italic (face value &optional frame) - "Set the italic property of FACE to VALUE." - (if value - (make-face-italic face frame) - (make-face-unitalic face frame))) - -(when (string-match "XEmacs" emacs-version) - ;; Support for special XEmacs font attributes. - (autoload 'font-create-object "font" nil) - - (unless (fboundp 'face-font-name) - (defun face-font-name (face &rest args) - (apply 'face-font face args))) - - (defun custom-set-face-font-size (face size &rest args) - "Set the font of FACE to SIZE" - (let* ((font (apply 'face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-size fontobj size) - (apply 'set-face-font face fontobj args))) - - (defun custom-set-face-font-family (face family &rest args) - "Set the font of FACE to FAMILY" - (let* ((font (apply 'face-font-name face args)) - (fontobj (font-create-object font))) - (set-font-family fontobj family) - (apply 'set-face-font face fontobj args))) - - (nconc custom-face-attributes - '((:family (editable-field :format "Family: %v") - custom-set-face-font-family) - (:size (editable-field :format "Size: %v") - custom-set-face-font-size))) - - ;; Disable frame local faces. - (setq custom-relevant-frames nil) - (remove-hook 'after-make-frame-hook 'custom-initialize-frame)) - -;;; Frames. - -(defun custom-face-display-set (face spec &optional frame) - "Set FACE to the attributes to the first matching entry in SPEC. -Iff optional FRAME is non-nil, set it for that frame only. -See `defface' for information about SPEC." - (when (fboundp 'make-face) - (while spec - (let* ((entry (car spec)) - (display (nth 0 entry)) - (atts (nth 1 entry))) - (setq spec (cdr spec)) - (when (custom-display-match-frame display frame) - ;; Avoid creating frame local duplicates of the global face. - (unless (and frame (eq display (get face 'custom-face-display))) - (apply 'custom-face-attribites-set face frame atts)) - (unless frame - (put face 'custom-face-display display)) - (setq spec nil)))))) + ;; Xemacs. + (defun custom-invert-face (face &optional frame) + "Swap the foreground and background colors of face FACE. +If the colors are not specified in the face, use the default colors." + (interactive (list (read-face-name "Reverse face: "))) + (let ((fg (color-name (face-foreground face frame) frame)) + (bg (color-name (face-background face frame) frame))) + (set-face-foreground face bg frame) + (set-face-background face fg frame))) + ;; Emacs. + (defun custom-invert-face (face &optional frame) + "Swap the foreground and background colors of face FACE. +If the colors are not specified in the face, use the default colors." + (interactive (list (read-face-name "Reverse face: "))) + (let ((fg (or (face-foreground face frame) + (face-foreground 'default frame) + (frame-property (or frame (selected-frame)) + 'foreground-color) + "black")) + (bg (or (face-background face frame) + (face-background 'default frame) + (frame-property (or frame (selected-frame)) + 'background-color) + "white"))) + (set-face-foreground face bg frame) + (set-face-background face fg frame)))) (defcustom custom-background-mode nil "The brightness of the background. @@ -297,6 +176,177 @@ (modify-frame-parameters frame (list (cons 'background-mode mode))) mode)) +(eval-and-compile + (if (string-match "XEmacs" emacs-version) + ;; XEmacs. + (defun custom-extract-frame-properties (frame) + "Return a plist with the frame properties of FRAME used by custom." + (list 'type (device-type (frame-device frame)) + 'class (device-class (frame-device frame)) + 'background (or custom-background-mode + (frame-property frame + 'background-mode) + (custom-background-mode frame)))) + ;; Emacs. + (defun custom-extract-frame-properties (frame) + "Return a plist with the frame properties of FRAME used by custom." + (list 'type window-system + 'class (frame-property frame 'display-type) + 'background (or custom-background-mode + (frame-property frame 'background-mode) + (custom-background-mode frame)))))) + +;;; Declaring a face. + +;;;###autoload +(defun custom-declare-face (face spec doc &rest args) + "Like `defface', but FACE is evaluated as a normal argument." + (when (fboundp 'load-gc) + ;; This should be allowed, somehow. + (error "Attempt to declare a face during dump")) + (unless (get face 'factory-face) + (put face 'factory-face spec) + (when (fboundp 'facep) + (unless (and (custom-facep face) + (not (get face 'saved-face))) + ;; If the user has already created the face, respect that. + (let ((value (or (get face 'saved-face) spec)) + (frames (custom-relevant-frames)) + frame) + ;; Create global face. + (make-empty-face face) + (custom-face-display-set face value) + ;; Create frame local faces + (while frames + (setq frame (car frames) + frames (cdr frames)) + (custom-face-display-set face value frame)) + (initialize-face-resources face)))) + (when (and doc (null (face-doc-string face))) + (set-face-doc-string face doc)) + (custom-handle-all-keywords face args 'custom-face) + (run-hooks 'custom-define-hook)) + face) + +;;; Font Attributes. + +(defconst custom-face-attributes + '((:bold (toggle :format "Bold: %[%v%]\n" + :help-echo "Control whether a bold font should be used.") + custom-set-face-bold) + (:italic (toggle :format "Italic: %[%v%]\n" + :help-echo "\ +Control whether an italic font should be used.") + custom-set-face-italic) + (:underline (toggle :format "Underline: %[%v%]\n" + :help-echo "\ +Control whether the text should be underlined.") + set-face-underline-p) + (:foreground (color :tag "Foreground" + :help-echo "Set foreground color.") + set-face-foreground) + (:background (color :tag "Background" + :help-echo "Set background color.") + set-face-background) + (:invert (const :format "Invert Face\n" + :sibling-args (:help-echo "\ +Reverse the foreground and background color. +If you haven't specified them for the face, the default colors will be used.") + t) + (lambda (face value &optional frame) + ;; We don't use VALUE. + (custom-invert-face face frame))) + (:stipple (editable-field :format "Stipple: %v" + :help-echo "Name of background bitmap file.") + set-face-stipple)) + "Alist of face attributes. + +The elements are of the form (KEY TYPE SET) where KEY is a symbol +identifying the attribute, TYPE is a widget type for editing the +attibute, SET is a function for setting the attribute value. + +The SET function should take three arguments, the face to modify, the +value of the attribute, and optionally the frame where the face should +be changed.") + +(defun custom-face-attributes-set (face frame &rest atts) + "For FACE on FRAME set the attributes [KEYWORD VALUE].... +Each keyword should be listed in `custom-face-attributes'. + +If FRAME is nil, set the default face." + (while atts + (let* ((name (nth 0 atts)) + (value (nth 1 atts)) + (fun (nth 2 (assq name custom-face-attributes)))) + (setq atts (cdr (cdr atts))) + (condition-case nil + (funcall fun face value frame) + (error nil))))) + +(defun custom-set-face-bold (face value &optional frame) + "Set the bold property of FACE to VALUE." + (if value + (make-face-bold face frame) + (make-face-unbold face frame))) + +(defun custom-set-face-italic (face value &optional frame) + "Set the italic property of FACE to VALUE." + (if value + (make-face-italic face frame) + (make-face-unitalic face frame))) + +(when (string-match "XEmacs" emacs-version) + ;; Support for special XEmacs font attributes. + (autoload 'font-create-object "font" nil) + + (unless (fboundp 'face-font-name) + (defun face-font-name (face &rest args) + (apply 'face-font face args))) + + (defun custom-set-face-font-size (face size &rest args) + "Set the font of FACE to SIZE" + (let* ((font (apply 'face-font-name face args)) + (fontobj (font-create-object font))) + (set-font-size fontobj size) + (apply 'set-face-font face fontobj args))) + + (defun custom-set-face-font-family (face family &rest args) + "Set the font of FACE to FAMILY" + (let* ((font (apply 'face-font-name face args)) + (fontobj (font-create-object font))) + (set-font-family fontobj family) + (apply 'set-face-font face fontobj args))) + + (nconc custom-face-attributes + '((:family (editable-field :format "Font Family: %v" + :help-echo "\ +Name of font family to use (e.g. times).") + custom-set-face-font-family) + (:size (editable-field :format "Size: %v" + :help-echo "\ +Text size (e.g. 9pt or 2mm).") + custom-set-face-font-size)))) + +;;; Frames. + +(defun custom-face-display-set (face spec &optional frame) + "Set FACE to the attributes to the first matching entry in SPEC. +Iff optional FRAME is non-nil, set it for that frame only. +See `defface' for information about SPEC." + (when (fboundp 'make-face) + (while spec + (let* ((entry (car spec)) + (display (nth 0 entry)) + (atts (nth 1 entry))) + (setq spec (cdr spec)) + (when (custom-display-match-frame display frame) + ;; Avoid creating frame local duplicates of the global face. + (unless (and frame (eq display (get face 'custom-face-display))) + (apply 'custom-face-attributes-set face frame atts)) + (unless frame + (put face 'custom-face-display display)) + (setq spec nil)))))) + (defvar custom-default-frame-properties nil "The frame properties used for the global faces. Frames who doesn't match these propertiess should have frame local faces. @@ -350,22 +400,18 @@ req options))))) match))) -(defvar custom-relevant-frames t - "List of frames whose custom properties differ from the default.") - (defun custom-relevant-frames () "List of frames whose custom properties differ from the default." - (when (eq custom-relevant-frames t) - (setq custom-relevant-frames nil) - (let ((default (custom-get-frame-properties)) - (frames (frame-list)) - frame) - (while frames - (setq frame (car frames) - frames (cdr frames)) - (unless (equal default (custom-get-frame-properties frame)) - (push frame custom-relevant-frames))))) - custom-relevant-frames) + (let ((relevant nil) + (default (custom-get-frame-properties)) + (frames (frame-list)) + frame) + (while frames + (setq frame (car frames) + frames (cdr frames)) + (unless (equal default (custom-get-frame-properties frame)) + (push frame relevant))) + relevant)) (defun custom-initialize-faces (&optional frame) "Initialize all custom faces for FRAME. @@ -385,12 +431,11 @@ (setq frame (car (frame-list)))) (unless (equal (custom-get-frame-properties) (custom-get-frame-properties frame)) - (custom-initialize-faces frame) - (custom-relevant-frames) - (push frame custom-relevant-frames))) + (custom-initialize-faces frame))) ;; Enable. This should go away when bundled with Emacs. -(add-hook 'after-make-frame-hook 'custom-initialize-frame) +(unless (string-match "XEmacs" emacs-version) + (add-hook 'after-make-frame-hook 'custom-initialize-frame)) ;;; Initializing.
--- a/lisp/custom/custom.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -311,12 +311,15 @@ (remove-hook 'custom-define-hook 'custom-menu-reset) (if (string-match "XEmacs" emacs-version) (when (fboundp 'add-submenu) - (add-submenu '("Help") custom-help-menu)) + (add-submenu '("Options") custom-help-menu)) (define-key global-map [menu-bar help-menu customize-menu] (cons (car custom-help-menu) (easy-menu-create-keymaps (car custom-help-menu) (cdr custom-help-menu)))))) +(unless (string-match "XEmacs" emacs-version) + (custom-menu-reset)) + ;;; The End. (provide 'custom)
--- a/lisp/custom/wid-browse.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/wid-browse.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary:
--- a/lisp/custom/wid-edit.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/wid-edit.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -14,32 +14,37 @@ ;;; Code: (require 'widget) -(require 'cl) -(autoload 'pp-to-string "pp") -(autoload 'Info-goto-node "info") + +(eval-and-compile + (require 'cl)) + +;;; Compatibility. -(if (string-match "XEmacs" emacs-version) - ;; XEmacs spell `intangible' as `atomic'. - (defun widget-make-intangible (from to side) - "Make text between FROM and TO atomic with regard to movement. +(eval-and-compile + (autoload 'pp-to-string "pp") + (autoload 'Info-goto-node "info") + + (if (string-match "XEmacs" emacs-version) + ;; XEmacs spell `intangible' as `atomic'. + (defun widget-make-intangible (from to side) + "Make text between FROM and TO atomic with regard to movement. Third argument should be `start-open' if it should be sticky to the rear, and `end-open' if it should sticky to the front." - (require 'atomic-extents) - (let ((ext (make-extent from to))) - ;; XEmacs doesn't understant different kinds of read-only, so - ;; we have to use extents instead. - (put-text-property from to 'read-only nil) - (set-extent-property ext 'read-only t) - (set-extent-property ext 'start-open nil) - (set-extent-property ext 'end-open nil) - (set-extent-property ext side t) - (set-extent-property ext 'atomic t))) - (defun widget-make-intangible (from to size) - "Make text between FROM and TO intangible." - (put-text-property from to 'intangible 'front))) + (require 'atomic-extents) + (let ((ext (make-extent from to))) + ;; XEmacs doesn't understant different kinds of read-only, so + ;; we have to use extents instead. + (put-text-property from to 'read-only nil) + (set-extent-property ext 'read-only t) + (set-extent-property ext 'start-open nil) + (set-extent-property ext 'end-open nil) + (set-extent-property ext side t) + (set-extent-property ext 'atomic t))) + (defun widget-make-intangible (from to size) + "Make text between FROM and TO intangible." + (put-text-property from to 'intangible 'front))) ;; The following should go away when bundled with Emacs. -(eval-and-compile (condition-case () (require 'custom) (error nil)) @@ -54,27 +59,25 @@ (when (fboundp 'copy-face) (copy-face 'default 'widget-documentation-face) (copy-face 'bold 'widget-button-face) - (copy-face 'italic 'widget-field-face)))) - -;;; Compatibility. + (copy-face 'italic 'widget-field-face))) -(unless (fboundp 'event-point) - ;; XEmacs function missing in Emacs. - (defun event-point (event) - "Return the character position of the given mouse-motion, button-press, + (unless (fboundp 'event-point) + ;; XEmacs function missing in Emacs. + (defun event-point (event) + "Return the character position of the given mouse-motion, button-press, or button-release event. If the event did not occur over a window, or did not occur over text, then this returns nil. Otherwise, it returns an index into the buffer visible in the event's window." - (posn-point (event-start event)))) + (posn-point (event-start event)))) -(unless (fboundp 'error-message-string) - ;; Emacs function missing in XEmacs. - (defun error-message-string (obj) - "Convert an error value to an error message." - (let ((buf (get-buffer-create " *error-message*"))) - (erase-buffer buf) - (display-error obj buf) - (buffer-string buf)))) + (unless (fboundp 'error-message-string) + ;; Emacs function missing in XEmacs. + (defun error-message-string (obj) + "Convert an error value to an error message." + (let ((buf (get-buffer-create " *error-message*"))) + (erase-buffer buf) + (display-error obj buf) + (buffer-string buf))))) ;;; Customization. @@ -188,9 +191,13 @@ (car (event-object val)))) (cdr (assoc val items)))) (t - (cdr (assoc (completing-read (concat title ": ") - items nil t) - items))))) + (let ((val (completing-read (concat title ": ") items nil t))) + (if (stringp val) + (let ((try (try-completion val items))) + (when (stringp try) + (setq val try)) + (cdr (assoc val items))) + nil))))) (defun widget-get-sibling (widget) "Get the item WIDGET is assumed to toggle. @@ -228,8 +235,8 @@ ;; Make it possible to edit the front end of the field. (add-text-properties (1- from) from (list 'rear-nonsticky t - 'end-open t - 'invisible t)) + 'end-open t + 'invisible t)) (when (or (string-match "\\(.\\|\n\\)%v" (widget-get widget :format)) (widget-get widget :hide-front-space)) ;; WARNING: This is going to lose horrible if the character just @@ -270,7 +277,13 @@ (secret-to to) (size (widget-get widget :size)) (face (or (widget-get widget :value-face) - 'widget-field-face))) + 'widget-field-face)) + (help-echo (widget-get widget :help-echo)) + (help-property (if (featurep 'balloon-help) + 'balloon-help + 'help-echo))) + (unless (or (stringp help-echo) (null help-echo)) + (setq help-echo 'widget-mouse-help)) (when secret (while (and size @@ -291,8 +304,9 @@ 'read-only nil 'keymap map 'local-map map + help-property help-echo 'face face)) - + (when secret (save-excursion (goto-char from) @@ -304,19 +318,39 @@ (unless (widget-get widget :size) (add-text-properties to (1+ to) (list 'field widget + help-property help-echo 'face face))) (add-text-properties to (1+ to) (list 'local-map map 'keymap map)))) (defun widget-specify-button (widget from to) ;; Specify button for WIDGET between FROM and TO. - (let ((face (widget-apply widget :button-face-get))) + (let ((face (widget-apply widget :button-face-get)) + (help-echo (widget-get widget :help-echo)) + (help-property (if (featurep 'balloon-help) + 'balloon-help + 'help-echo))) + (unless (or (null help-echo) (stringp help-echo)) + (setq help-echo 'widget-mouse-help)) (add-text-properties from to (list 'button widget 'mouse-face widget-mouse-face 'start-open t 'end-open t + help-property help-echo 'face face)))) +(defun widget-mouse-help (extent) + "Find mouse help string for button in extent." + (let* ((widget (widget-at (extent-start-position extent))) + (help-echo (and widget (widget-get widget :help-echo)))) + (cond ((stringp help-echo) + help-echo) + ((and (symbolp help-echo) (fboundp help-echo) + (stringp (setq help-echo (funcall help-echo widget)))) + help-echo) + (t + (format "(widget %S :help-echo %S)" widget help-echo))))) + (defun widget-specify-sample (widget from to) ;; Specify sample for WIDGET between FROM and TO. (let ((face (widget-apply widget :sample-face-get))) @@ -383,7 +417,7 @@ (defun widget-apply (widget property &rest args) "Apply the value of WIDGET's PROPERTY to the widget itself. -ARGS are passed as extra argments to the function." +ARGS are passed as extra arguments to the function." (apply (widget-get widget property) widget args)) (defun widget-value (widget) @@ -422,24 +456,34 @@ (defun widget-glyph-insert (widget tag image) "In WIDGET, insert the text TAG or, if supported, IMAGE. -IMAGE should be a name sans extension of an xpm or xbm file located in -`widget-glyph-directory'" - (if (and (string-match "XEmacs" emacs-version) - widget-glyph-enable - (fboundp 'make-glyph) - image) - (let ((file (concat widget-glyph-directory - (if (string-match "/\\'" widget-glyph-directory) - "" - "/") - image - (if (featurep 'xpm) ".xpm" ".xbm")))) - (if (file-readable-p file) - (widget-glyph-insert-glyph widget tag (make-glyph file)) - ;; File not readable, give up. - (insert tag))) - ;; We don't want or can't use glyphs. - (insert tag))) +IMAGE should either be a glyph, or a name sans extension of an xpm or +xbm file located in `widget-glyph-directory'. + +WARNING: If you call this with a glyph, and you want theuser to be +able to activate the glyph, make sure it is unique. If you use the +same glyph for multiple widgets, " + (cond ((not (and (string-match "XEmacs" emacs-version) + widget-glyph-enable + (fboundp 'make-glyph) + image)) + ;; We don't want or can't use glyphs. + (insert tag)) + ((and (fboundp 'glyphp) + (glyphp image)) + ;; Already a glyph. Insert it. + (widget-glyph-insert-glyph widget tag image)) + (t + ;; A string. Look it up in. + (let ((file (concat widget-glyph-directory + (if (string-match "/\\'" widget-glyph-directory) + "" + "/") + image + (if (featurep 'xpm) ".xpm" ".xbm")))) + (if (file-readable-p file) + (widget-glyph-insert-glyph widget tag (make-glyph file)) + ;; File not readable, give up. + (insert tag)))))) (defun widget-glyph-insert-glyph (widget tag glyph) "In WIDGET, with alternative text TAG, insert GLYPH." @@ -448,7 +492,16 @@ (insert "*") (add-text-properties (1- (point)) (point) (list 'invisible t - 'end-glyph glyph))) + 'end-glyph glyph)) + (let ((help-echo (widget-get widget :help-echo))) + (when help-echo + (let ((extent (extent-at (1- (point)) nil 'end-glyph)) + (help-property (if (featurep 'balloon-help) + 'balloon-help + 'help-echo))) + (set-extent-property extent help-property (if (stringp help-echo) + help-echo + 'widget-mouse-help)))))) ;;; Creating Widgets. @@ -553,7 +606,7 @@ (apply 'insert args) (widget-specify-text from (point)))) -;;; Keymap and Comands. +;;; Keymap and Commands. (defvar widget-keymap nil "Keymap containing useful binding for buffers containing widgets. @@ -1141,7 +1194,7 @@ (define-widget 'link 'item "An embedded link." - :help-echo "Push me to follow the link." + :help-echo "Follow the link." :format "%[_%t_%]") ;;; The `info-link' Widget. @@ -1468,6 +1521,8 @@ (widget-specify-insert (let* ((children (widget-get widget :children)) (buttons (widget-get widget :buttons)) + (button-args (or (widget-get type :sibling-args) + (widget-get widget :button-args))) (from (point)) child button) (insert (widget-get widget :entry-format)) @@ -1479,8 +1534,10 @@ (cond ((eq escape ?%) (insert "%")) ((eq escape ?b) - (setq button (widget-create-child-and-convert - widget 'checkbox :value (not (null chosen))))) + (setq button (apply 'widget-create-child-and-convert + widget 'checkbox + :value (not (null chosen)) + button-args))) ((eq escape ?v) (setq child (cond ((not chosen) @@ -1647,6 +1704,8 @@ (let* ((value (widget-get widget :value)) (children (widget-get widget :children)) (buttons (widget-get widget :buttons)) + (button-args (or (widget-get type :sibling-args) + (widget-get widget :button-args))) (from (point)) (chosen (and (null (widget-get widget :choice)) (widget-apply type :match value))) @@ -1660,9 +1719,10 @@ (cond ((eq escape ?%) (insert "%")) ((eq escape ?b) - (setq button (widget-create-child-and-convert - widget 'radio-button - :value (not (null chosen))))) + (setq button (apply 'widget-create-child-and-convert + widget 'radio-button + :value (not (null chosen)) + button-args))) ((eq escape ?v) (setq child (if chosen (widget-create-child-value @@ -1765,6 +1825,7 @@ (define-widget 'insert-button 'push-button "An insert button for the `editable-list' widget." :tag "INS" + :help-echo "Insert a new item into the list at this position." :action 'widget-insert-button-action) (defun widget-insert-button-action (widget &optional event) @@ -1777,6 +1838,7 @@ (define-widget 'delete-button 'push-button "A delete button for the `editable-list' widget." :tag "DEL" + :help-echo "Delete this item from the list." :action 'widget-delete-button-action) (defun widget-delete-button-action (widget &optional event) @@ -1814,7 +1876,9 @@ (cond ((eq escape ?i) (and (widget-get widget :indent) (insert-char ? (widget-get widget :indent))) - (widget-create-child-and-convert widget 'insert-button)) + (apply 'widget-create-child-and-convert + widget 'insert-button + (widget-get widget :append-button-args))) (t (widget-default-format-handler widget escape))))) @@ -1940,11 +2004,13 @@ (cond ((eq escape ?%) (insert "%")) ((eq escape ?i) - (setq insert (widget-create-child-and-convert - widget 'insert-button))) + (setq insert (apply 'widget-create-child-and-convert + widget 'insert-button + (widget-get widget :insert-button-args)))) ((eq escape ?d) - (setq delete (widget-create-child-and-convert - widget 'delete-button))) + (setq delete (apply 'widget-create-child-and-convert + widget 'delete-button + (widget-get widget :delete-button-args)))) ((eq escape ?v) (if conv (setq child (widget-create-child-value @@ -2030,7 +2096,7 @@ (define-widget 'widget-help 'push-button "The widget documentation button." :format "%[[%t]%] %d" - :help-echo "Push me to toggle the documentation." + :help-echo "Toggle display of documentation." :action 'widget-help-action) (defun widget-help-action (widget &optional event) @@ -2261,7 +2327,7 @@ (define-widget 'color-item 'choice-item "A color name (with sample)." - :format "%v (%[sample%])\n" + :format "%v (%{sample%})\n" :button-face-get 'widget-color-item-button-face-get) (defun widget-color-item-button-face-get (widget)
--- a/lisp/custom/widget-example.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/widget-example.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ (require 'widget)
--- a/lisp/custom/widget.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/custom/widget.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, extensions, faces, hypermedia -;; Version: 1.50 +;; Version: 1.59 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ ;;; Commentary: @@ -27,7 +27,9 @@ (set (car keywords) (car keywords))) (setq keywords (cdr keywords))))))) -(define-widget-keywords :tag-glyph :off-glyph :on-glyph :valid-regexp +(define-widget-keywords :sibling-args :delete-button-args + :insert-button-args :append-button-args :button-args + :tag-glyph :off-glyph :on-glyph :valid-regexp :secret :sample-face :sample-face-get :case-fold :widget-doc :create :convert-widget :format :value-create :offset :extra-offset :tag :doc :from :to :args :value :value-from :value-to :action
--- a/lisp/edebug/cl-read.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/edebug/cl-read.el Mon Aug 13 09:18:39 2007 +0200 @@ -83,7 +83,7 @@ ;; Dispatch Character Macro" `#' ;; ;; #'<function> function quoting -;; #\<charcter> character syntax +;; #\<character> character syntax ;; #.<form> read time evaluation ;; #p<path>, #P<path> paths ;; #+<feature>, #-<feature> conditional reading @@ -208,8 +208,8 @@ ; Change History ; ; $Log: cl-read.el,v $ -; Revision 1.1.1.2 1996/12/18 22:51:45 steve -; XEmacs 20.0 -- Beta 31 +; Revision 1.2 1997/03/08 23:25:50 steve +; Patches to Beta6 ; ; Revision 1.19 94/03/21 19:59:24 liberte ; Add invalid-cl-read-syntax error symbol. @@ -382,8 +382,8 @@ ;; character is a macro character. ;; ;; 3. A vector of length `reader::readtable-size'. Elements of this vector -;; may be `nil' or a function (see 2.). It means the charater is a -;; dispatch character, and the vector its dispatch fucntion table. +;; may be `nil' or a function (see 2.). It means the character is a +;; dispatch character, and the vector its dispatch function table. (defvar *readtable*) (defvar reader::internal-standard-readtable) @@ -1300,7 +1300,7 @@ ;; in lisp, and based on more primitive read functions we already ;; replaced. The reading happens during the interactive parameter ;; retrieval, which is written in lisp, too. So this replacement of -;; eval-expresssion is only required fro (FSF) Emacs 18 (and 19?). +;; eval-expression is only required for (FSF) Emacs 18 (and 19?). (or (fboundp 'reader::original-eval-expression) (fset 'reader::original-eval-expression
--- a/lisp/edebug/edebug.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/edebug/edebug.el Mon Aug 13 09:18:39 2007 +0200 @@ -29,7 +29,7 @@ ;; LCD Archive Entry: ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |A source level debugger for Emacs Lisp. -;; |$Date: 1997/02/24 01:13:06 $|$Revision: 1.2 $|~/modes/edebug.el| +;; |$Date: 1997/03/08 23:25:52 $|$Revision: 1.3 $|~/modes/edebug.el| ;; This minor mode allows programmers to step through Emacs Lisp ;; source code while executing functions. You can also set @@ -87,7 +87,7 @@ ;;; Code: (defconst edebug-version - (let ((raw-version "$Revision: 1.2 $")) + (let ((raw-version "$Revision: 1.3 $")) (substring raw-version (string-match "[0-9.]*" raw-version) (match-end 0)))) @@ -3715,11 +3715,8 @@ (defun edebug-compute-previous-result (edebug-previous-value) (setq edebug-previous-result - (if (and (numberp edebug-previous-value) - (< edebug-previous-value 256) - (>= edebug-previous-value 0)) - (format "Result: %s = %s" edebug-previous-value - (single-key-description edebug-previous-value)) + (if (numberp edebug-previous-value) + (format "Result: %s" edebug-previous-value) (if edebug-unwrap-results (setq edebug-previous-value (edebug-unwrap* edebug-previous-value)))
--- a/lisp/egg/egg-quail.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/egg/egg-quail.el Mon Aug 13 09:18:39 2007 +0200 @@ -7,7 +7,7 @@ (defconst quail-mode-egg-map (make-keymap)) (set-keymap-parents quail-mode-egg-map (list quail-mode-map)) -(define-key quail-mode-egg-map " " 'quail-henkan-region)) +(define-key quail-mode-egg-map " " 'quail-henkan-region) (defvar quail-henkan-start nil) (make-variable-buffer-local 'quail-henkan-start) @@ -27,7 +27,7 @@ (define-key quail-henkan-mode-map "\C-c" 'quail-henkan-quit) (define-key quail-henkan-mode-map "\C-g" 'quail-henkan-quit) (define-key quail-henkan-mode-map "\177" 'quail-henkan-quit) -(define-key quail-henkan-mode-map "\eg" 'quail-henkan-quit)) +(define-key quail-henkan-mode-map "\eg" 'quail-henkan-quit) (defun quail-henkan-mark () "Set mark at the current position to indicate starting point of henkan."
--- a/lisp/emulators/teco.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/emulators/teco.el Mon Aug 13 09:18:39 2007 +0200 @@ -186,7 +186,7 @@ ;; a-z Treated the same as A-Z ;; { Not a Teco command ;; | Conditional 'else' -;; } Not a Teco comand +;; } Not a Teco command ;; ~ Not a Teco command ;; DEL Delete last character typed in @@ -221,7 +221,7 @@ "Set if we have just executed a digit.") (defvar teco-exp-exp nil - "Expression value preceeding operator.") + "Expression value preceding operator.") (defvar teco-exp-val1 nil "Current argument value.")
--- a/lisp/energize/energize-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/energize/energize-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -129,7 +129,7 @@ "If connected to Energize, the Energize database is used. Otherwise, `find-tag' is invoked. The X selection is used as a default, if it exists and contains no -newlines. Otherwise, the preceeding token is used as a default. +newlines. Otherwise, the preceding token is used as a default. If invoked from a mouse command, prompting happens with a dialog box; otherwise, the minibuffer is used." (interactive @@ -637,7 +637,7 @@ (error "no next project"))))) (defun energize-top-prev-project () - "Position the cursor at the beginning of the preceeding project." + "Position the cursor at the beginning of the preceding project." (interactive) (let ((p (point))) (let ((e (energize-next-extent-for "editproject" t t)))
--- a/lisp/eterm/term.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/eterm/term.el Mon Aug 13 09:18:39 2007 +0200 @@ -2968,7 +2968,7 @@ ;;; want them present in specific modes. (defvar term-completion-autolist nil - "*If non-nil, automatically list possiblities on partial completion. + "*If non-nil, automatically list possibilities on partial completion. This mirrors the optional behavior of tcsh.") (defvar term-completion-addsuffix t
--- a/lisp/gnus/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,167 @@ +Sat Mar 8 08:34:22 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.23 is released. + +Sat Mar 8 02:09:53 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * message.el (message-font-lock-keywords): Recognize continuation + headers. + + * gnus-group.el (gnus-group-expire-articles): Touch dribble + buffer. + + * gnus-sum.el (gnus-summary-default-score): Doc fix. + + * gnus.el (gnus-local-organization): Doc fix. + + * gnus-spec.el (gnus-compile): Don't work under XEmacs. + + * gnus-art.el (gnus-article-highlight-headers): Work on bodiless + articles. + +Fri Mar 7 23:33:34 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.22 is released. + +Fri Mar 7 08:25:20 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-msg.el (gnus-inews-do-gcc): Made interactive. + + * gnus-sum.el (gnus-read-move-group-name): Beep on empty names. + + * nnmail.el (nnmail-check-duplication): Don't rename Message-ID. + (nnmail-cache-message-id-when-accepting): Removed. + + * gnus-sum.el (gnus-nov-parse-line): Allow showing of multiple + articles with the same Message-ID. + (gnus-get-newsgroup-headers): Ditto. + + * gnus.el: Removed trailing spaces throughout. + + * gnus-art.el (gnus-header-name-face): Made easier on the eyes. + (gnus-article-add-buttons): Make buffer read/write before doing + anything. + + * message.el (message-font-lock-keywords): Changed expression and + faces. + +Fri Mar 7 07:36:14 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.21 is released. + +Fri Mar 7 04:17:40 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * nnfolder.el (nnfolder-request-accept-article): Switch to the + right folder. + + * Makefile (gnus-load.el): cus-edit. + + * gnus.el: Removed all compilation warnings under both Emacs and + XEmacs. + + * cus-face.el: Moved variable defintions around a bit to avoid + compilation warnings. + + * nnmail.el (nnmail-cache-message-id-when-accepting): New + variable. + + * nnfolder.el (nnfolder-dont-cache-message-id): Removed. + * nnmh.el (nnmh-request-accept-article): Ditto. + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + * nnml.el (nnml-request-accept-article): Ditto. + * nnmbox.el (nnmbox-request-accept-article): Use it. + +Thu Mar 6 18:22:29 1997 Steven L Baur <steve@altair.xemacs.org> + + * nnfolder.el (nnfolder-dont-cache-message-id): Variable to allow + backwards compatibility with respect to saved messages. + (nnfolder-request-accept-article): Use it. + +Fri Mar 7 04:10:21 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * nnmail.el: Autoload pop3. + +Fri Mar 7 01:33:34 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.20 is released. + +Fri Mar 7 00:12:39 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * message.el (message-header-to-face): New faces. + (message-font-lock-keywords): Use them. + + * gnus-sum.el (gnus-summary-make-menu-bar): No addition. + (gnus-summary-move-article): When crossposting, get the Xrefs + header right. + + * nnfolder.el (nnfolder-request-accept-article): Work when + respooling. + +Thu Mar 6 08:41:16 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.19 is released. + +Thu Mar 6 08:00:31 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * message.el (message-newgroups-header-regexp): Include Gcc + header. + + * gnus-sum.el (gnus-summary-delete-article): Message errors. + + * gnus-group.el (gnus-group-unsubscribe-group): Work on ranked + groups. + +Thu Mar 6 07:46:56 1997 Katsumi Yamaoka <yamaoka@ga.sony.co.jp> + + * nnmail.el (nnmail-move-inbox): Protect against nil results. + +Thu Mar 6 04:23:11 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * message.el (message-kill-buffer): Ask before killing. + + * nnfolder.el (nnfolder-possibly-activate-groups): Removed. + (nnfolder-request-group): Changed servers too late. + (nnfolder-active-timestamp): New variable. + + * gnus-sum.el (gnus-summary-respool-query): Narrow to head instead + of body. + + * nntp.el (nntp-accept-process-output): Inhibit logging. + + * gnus-group.el (gnus-group-sort-groups): Doc fix. + + * nnfolder.el (nnfolder-request-accept-article): Insert Message-ID + into cache. + * nnmh.el (nnmh-request-accept-article): Ditto. + * nnml.el (nnml-request-accept-article): Ditto. + * nnbabyl.el (nnbabyl-request-accept-article): Ditto. + * nnmbox.el (nnmbox-request-accept-article): Ditto. + + * nnmail.el (nnmail-cache-close): Kill buffer. + (nnmail-cache-insert): Make sure the cache is open. + (nnmail-fetch-field): New function. + +Thu Mar 6 02:19:31 1997 James LewisMoss <dres@scsn.net> + + * smiley.el (smiley-deformed-regexp-alist): Fix FaceIronic. + +Wed Mar 5 09:15:04 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * nnmail.el (nnmail-check-duplication): Ditto. + +Wed Mar 5 09:14:12 1997 Carsten Leonhardt <leo@arioch.oche.de> + + * nnmail.el (nnmail-check-duplication): Use a different + Message-ID. + +Sun Mar 2 16:58:16 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> + + * gnus.el: Gnus v5.4.18 is released. + +Sun Mar 2 05:48:56 1997 Lars Magne Ingebrigtsen <larsi@ifi.uio.no> + + * gnus-load.el (customize): Load `cus-edit'. + Sun Mar 2 04:40:48 1997 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no> * gnus.el: Gnus v5.4.17 is released.
--- a/lisp/gnus/Makefile Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/Makefile Mon Aug 13 09:18:39 2007 +0200 @@ -28,7 +28,7 @@ echo ";;" >> gnus-load.el echo ";;; Code:" >> gnus-load.el echo >> gnus-load.el - $(EMACS) $(FLAGS) -l ./dgnushack.el -l custom-edit.el *.el \ + $(EMACS) $(FLAGS) -l ./dgnushack.el -l cus-edit.el *.el \ -f custom-make-dependencies >> gnus-load.el echo >> gnus-load.el echo "(provide 'gnus-load)" >> gnus-load.el
--- a/lisp/gnus/dgnushack.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/dgnushack.el Mon Aug 13 09:18:39 2007 +0200 @@ -47,6 +47,9 @@ (fset 'x-defined-colors 'ignore) (fset 'read-color 'ignore))) +(setq byte-compile-warnings + '(free-vars unresolved callargs redefine)) + (defun dgnushack-compile () ;;(setq byte-compile-dynamic t) (let ((files (directory-files "." nil ".el$")) @@ -57,13 +60,7 @@ (require 'w3-forms) (error (setq files (delete "nnweb.el" files)))) (while (setq file (pop files)) - (cond - ((or (string= file "custom.el") (string= file "browse-url.el")) - (setq byte-compile-warnings nil)) - (t - (setq byte-compile-warnings - '(free-vars unresolved callargs redefine obsolete)))) - (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" + (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" "messagexmas.el" "nnheaderxm.el" "smiley.el"))) xemacs) @@ -76,5 +73,5 @@ (require 'gnus) (byte-recompile-directory "." 0)) -;;; dgnushack.el ends here +;;; dgnushack.el ends here
--- a/lisp/gnus/earcon.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/earcon.el Mon Aug 13 09:18:39 2007 +0200 @@ -142,7 +142,7 @@ gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) - (gnus-add-text-properties + (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face))
--- a/lisp/gnus/gnus-art.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-art.el Mon Aug 13 09:18:39 2007 +0200 @@ -92,7 +92,7 @@ '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" - "^Approved:" "^Sender:" "^Received:" "^Mail-from:") + "^Approved:" "^Sender:" "^Received:" "^Mail-from:") "All headers that match this regexp will be hidden. This variable can also be a list of regexps of headers to be ignored. If `gnus-visible-headers' is non-nil, this variable will be ignored." @@ -101,7 +101,7 @@ (repeat regexp)) :group 'gnus-article-hiding) -(defcustom gnus-visible-headers +(defcustom gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From" "All headers that do not match this regexp will be hidden. This variable can also be a list of regexp of headers to remain visible. @@ -156,7 +156,7 @@ (defcustom gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text." - :type 'sexp + :type 'sexp :group 'gnus-article-hiding) (defcustom gnus-article-x-face-command @@ -232,7 +232,7 @@ "Face used for displaying bold italic emphasized text (/*word*/)." :group 'gnus-article-emphasis) -(defface gnus-emphasis-underline-bold-italic +(defface gnus-emphasis-underline-bold-italic '((t (:bold t :italic t :underline t))) "Face used for displaying underlined bold italic emphasized text. Esample: (_/*word*/_)." @@ -250,11 +250,6 @@ (autoload 'timezone-make-date-arpa-standard "timezone") (autoload 'mail-extract-address-components "mail-extr")) -(defcustom gnus-article-save-directory gnus-directory - "*Name of the directory articles will be saved in (default \"~/News\")." - :group 'gnus-article-saving - :type 'directory) - (defcustom gnus-save-all-headers t "*If non-nil, don't remove any headers before saving." :group 'gnus-article-saving @@ -421,53 +416,53 @@ :group 'gnus-article-highlight :group 'gnus-article-signature) -(defface gnus-header-from-face +(defface gnus-header-from-face '((((class color) (background dark)) - (:foreground "light blue" :bold t :italic t)) + (:foreground "spring green" :bold t :italic t)) (((class color) (background light)) - (:foreground "MidnightBlue" :bold t :italic t)) - (t + (:foreground "indianred" :bold t :italic t)) + (t (:bold t :italic t))) "Face used for displaying from headers." :group 'gnus-article-headers :group 'gnus-article-highlight) -(defface gnus-header-subject-face +(defface gnus-header-subject-face '((((class color) (background dark)) - (:foreground "pink" :bold t :italic t)) + (:foreground "SeaGreen3" :bold t :italic t)) (((class color) (background light)) (:foreground "firebrick" :bold t :italic t)) - (t + (t (:bold t :italic t))) "Face used for displaying subject headers." :group 'gnus-article-headers :group 'gnus-article-highlight) -(defface gnus-header-newsgroups-face +(defface gnus-header-newsgroups-face '((((class color) (background dark)) (:foreground "yellow" :bold t :italic t)) (((class color) (background light)) - (:foreground "indianred" :bold t :italic t)) - (t + (:foreground "MidnightBlue" :bold t :italic t)) + (t (:bold t :italic t))) "Face used for displaying newsgroups headers." :group 'gnus-article-headers :group 'gnus-article-highlight) -(defface gnus-header-name-face +(defface gnus-header-name-face '((((class color) (background dark)) - (:foreground "cyan" :bold t)) + (:foreground "SeaGreen")) (((class color) (background light)) - (:foreground "DarkGreen" :bold t)) - (t + (:foreground "maroon")) + (t (:bold t))) "Face used for displaying header names." :group 'gnus-article-headers @@ -479,8 +474,8 @@ (:foreground "forest green" :italic t)) (((class color) (background light)) - (:foreground "DarkGreen" :italic t)) - (t + (:foreground "indianred4" :italic t)) + (t (:italic t))) "Face used for displaying header content." :group 'gnus-article-headers :group 'gnus-article-highlight) @@ -492,7 +487,7 @@ ("" gnus-header-name-face gnus-header-content-face)) "Controls highlighting of article header. -An alist of the form (HEADER NAME CONTENT). +An alist of the form (HEADER NAME CONTENT). HEADER is a regular expression which should match the name of an header header and NAME and CONTENT are either face names or nil. @@ -535,7 +530,7 @@ "Set text PROPS on the B to E region, extending `intangible' 1 past B." (add-text-properties b e props) (when (memq 'intangible props) - (put-text-property + (put-text-property (max (1- b) (point-min)) b 'intangible (cddr (memq 'intangible props))))) @@ -650,16 +645,16 @@ (while (re-search-forward "^[^ \t]*:" nil t) (beginning-of-line) ;; Mark the rank of the header. - (put-text-property + (put-text-property (point) (1+ (point)) 'message-rank (if (or (and visible (looking-at visible)) (and ignored (not (looking-at ignored)))) - (gnus-article-header-rank) + (gnus-article-header-rank) (+ 2 max))) (forward-line 1)) (message-sort-headers-1) - (when (setq beg (text-property-any + (when (setq beg (text-property-any (point-min) (point-max) 'message-rank (+ 2 max))) ;; We make the unwanted headers invisible. (if delete @@ -693,7 +688,7 @@ (forward-line -1) (gnus-article-hide-text-type (progn (beginning-of-line) (point)) - (progn + (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) (match-beginning 0) @@ -717,7 +712,7 @@ (when (and from reply-to (ignore-errors - (equal + (equal (nth 1 (mail-extract-address-components from)) (nth 1 (mail-extract-address-components reply-to))))) (gnus-article-hide-header "reply-to")))) @@ -734,7 +729,7 @@ (when (re-search-forward (concat "^" header ":") nil t) (gnus-article-hide-text-type (progn (beginning-of-line) (point)) - (progn + (progn (end-of-line) (if (re-search-forward "^[^ \t]" nil t) (match-beginning 0) @@ -753,7 +748,7 @@ ;; We do the boldification/underlining by hiding the ;; overstrikes and putting the proper text property ;; on the letters. - (cond + (cond ((eq next previous) (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) (put-text-property (point) (1+ (point)) 'face 'bold)) @@ -863,14 +858,14 @@ (goto-char (point-min)) (or (search-forward "\n\n" nil t) (point-max))) (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) (setq string (match-string 1)) (save-restriction (narrow-to-region (match-beginning 0) (match-end 0)) (delete-region (point-min) (point-max)) (insert string) - (article-mime-decode-quoted-printable + (article-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) (subst-char-in-region (point-min) (point-max) ?_ ? ) (goto-char (point-max))) @@ -898,7 +893,7 @@ (defun article-mime-decode-quoted-printable-buffer () "Decode Quoted-Printable in the current buffer." (article-mime-decode-quoted-printable (point-min) (point-max))) - + (defun article-mime-decode-quoted-printable (from to) "Decode Quoted-Printable in the region between FROM and TO." (interactive "r") @@ -949,7 +944,7 @@ (narrow-to-region beg end) (goto-char (point-min)) (while (re-search-forward "^- " nil t) - (gnus-article-hide-text-type + (gnus-article-hide-text-type (match-beginning 0) (match-end 0) 'pgp)) (widen)))))) @@ -991,7 +986,7 @@ (save-restriction (let ((buffer-read-only nil)) (when (gnus-article-narrow-to-signature) - (gnus-article-hide-text-type + (gnus-article-hide-text-type (point-min) (point-max) 'signature))))))) (defun article-strip-leading-blank-lines () @@ -1043,7 +1038,7 @@ (narrow-to-region (funcall (intern "mime::preview-content-info/point-min") pcinfo) (point-max))))) - + (when (gnus-article-search-signature) (forward-line 1) ;; Check whether we have some limits to what we consider @@ -1177,7 +1172,7 @@ If TYPE is `local', convert to local time; if it is `lapsed', output how much time has lapsed since DATE." (interactive (list 'ut t)) - (let* ((header (or header + (let* ((header (or header (mail-header-date gnus-current-headers) (message-fetch-field "date") "")) @@ -1284,7 +1279,7 @@ (prog1 (concat (if prev ", " "") (int-to-string (floor num)) - " " (symbol-name (car unit)) + " " (symbol-name (car unit)) (if (> num 1) "s" "")) (setq prev t)))) article-time-units "") @@ -1385,7 +1380,7 @@ (when (eq gnus-prompt-before-saving t) num))) ; Magic (set-buffer gnus-summary-buffer) - (funcall gnus-default-article-saver filename))))) + (funcall gnus-default-article-saver filename))))) (defun gnus-read-save-file-name (prompt default-name &optional filename) (cond @@ -1557,7 +1552,7 @@ (cond ((eq command 'default) gnus-last-shell-command) (command command) - (t (read-string + (t (read-string (format "Shell command on %s: " (if (and gnus-number-of-articles-to-be-saved @@ -1649,7 +1644,7 @@ gfunc (cdr func)) (setq afunc func gfunc (intern (format "gnus-%s" func)))) - (fset gfunc + (fset gfunc (if (not (fboundp afunc)) nil `(lambda (&optional interactive &rest args) @@ -2248,7 +2243,7 @@ (set-buffer gnus-summary-buffer) (let ((header (gnus-summary-article-header article))) (when (< article 0) - (cond + (cond ((memq article gnus-newsgroup-sparse) ;; This is a sparse gap article. (setq do-update-line article) @@ -2264,8 +2259,8 @@ ;; It is an extracted pseudo-article. (setq article 'pseudo) (gnus-request-pseudo-article header)))) - - (let ((method (gnus-find-method-for-group + + (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (not (eq (car method) 'nneething)) () @@ -2319,7 +2314,7 @@ (when (numberp article) (gnus-async-prefetch-next group article gnus-summary-buffer) (when gnus-keep-backlog - (gnus-backlog-enter-article + (gnus-backlog-enter-article group article (current-buffer)))) 'article))) ;; It was a pseudo. @@ -2343,7 +2338,7 @@ (erase-buffer) (insert-buffer-substring gnus-article-buffer)) (setq gnus-original-article (cons group article)))) - + ;; Update sparse articles. (when (and do-update-line (or (numberp article) @@ -2369,7 +2364,7 @@ (defvar gnus-article-edit-mode-map nil) -(unless gnus-article-edit-mode-map +(unless gnus-article-edit-mode-map (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) (gnus-define-keys gnus-article-edit-mode-map @@ -2452,10 +2447,10 @@ (gnus-article-mode) ;; The cache and backlog have to be flushed somewhat. (when gnus-use-cache - (gnus-cache-update-article + (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current))) (when gnus-keep-backlog - (gnus-backlog-remove-article + (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) ;; Flush original article as well. (save-excursion @@ -2469,7 +2464,7 @@ (set-window-start (get-buffer-window (current-buffer)) window-start) (goto-char p) (set-buffer buf))))) - + (defun gnus-article-edit-full-stops () "Interactively repair spacing at end of sentences." (interactive) @@ -2479,7 +2474,7 @@ (let ((case-fold-search nil)) (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) -;;; +;;; ;;; Article highlights ;;; @@ -2492,14 +2487,14 @@ :group 'gnus-article-buttons :type 'regexp) -(defcustom gnus-button-alist +(defcustom gnus-button-alist `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t gnus-button-message-id 2) ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*+\\)" 0 t gnus-button-message-id 1) ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t gnus-button-fetch-group 4) ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) - ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 + ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 t gnus-button-message-id 3) ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>" 0 t gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2) @@ -2513,14 +2508,14 @@ REGEXP: is the string matching text around the button, BUTTON: is the number of the regexp grouping actually matching the button, FORM: is a lisp expression which must eval to true for the button to -be added, +be added, CALLBACK: is the function to call when the user push this button, and each PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. CALLBACK can also be a variable, in that case the value of that variable it the real callback function." :group 'gnus-article-buttons - :type '(repeat (list regexp + :type '(repeat (list regexp (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -2528,11 +2523,11 @@ :inline t (integer :tag "Regexp group"))))) -(defcustom gnus-header-button-alist +(defcustom gnus-header-button-alist `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" 0 t gnus-button-message-id 0) ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) - ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" + ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 0 t gnus-button-mailto 0) ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) @@ -2550,7 +2545,7 @@ :group 'gnus-article-buttons :group 'gnus-article-headers :type '(repeat (list (regexp :tag "Header") - regexp + regexp (integer :tag "Button") (sexp :tag "Form") (function :tag "Callback") @@ -2626,7 +2621,7 @@ (defun gnus-article-highlight (&optional force) "Highlight current article. This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-citation', +`gnus-article-highlight-citation', `gnus-article-highlight-signature', and `gnus-article-add-buttons' to do the highlighting. See the documentation for those functions." (interactive (list 'force)) @@ -2657,40 +2652,38 @@ (case-fold-search t) (inhibit-point-motion-hooks t) entry regexp header-face field-face from hpoints fpoints) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (narrow-to-region (1- (point)) (point-min)) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (unless (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face))))))))) + (message-narrow-to-head) + (while (setq entry (pop alist)) + (goto-char (point-min)) + (setq regexp (concat "^\\(" + (if (string-equal "" (nth 0 entry)) + "[^\t ]" + (nth 0 entry)) + "\\)") + header-face (nth 1 entry) + field-face (nth 2 entry)) + (while (and (re-search-forward regexp nil t) + (not (eobp))) + (beginning-of-line) + (setq from (point)) + (unless (search-forward ":" nil t) + (forward-char 1)) + (when (and header-face + (not (memq (point) hpoints))) + (push (point) hpoints) + (gnus-put-text-property from (point) 'face header-face)) + (when (and field-face + (not (memq (setq from (point)) fpoints))) + (push from fpoints) + (if (re-search-forward "^[^ \t]" nil t) + (forward-char -2) + (goto-char (point-max))) + (gnus-put-text-property from (point) 'face field-face)))))))) (defun gnus-article-highlight-signature () "Highlight the signature in an article. It does this by highlighting everything after -`gnus-signature-separator' using `gnus-signature-face'." +`gnus-signature-separator' using `gnus-signature-face'." (interactive) (save-excursion (set-buffer gnus-article-buffer) @@ -2719,22 +2712,22 @@ (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) - ;; Remove all old markers. - (let (marker entry) - (while (setq marker (pop gnus-button-marker-list)) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) (case-fold-search t) (alist gnus-button-alist) beg entry regexp) + ;; Remove all old markers. + (let (marker entry) + (while (setq marker (pop gnus-button-marker-list)) + (goto-char marker) + (when (setq entry (gnus-button-entry)) + (put-text-property (match-beginning (nth 1 entry)) + (match-end (nth 1 entry)) + 'gnus-callback nil)) + (set-marker marker nil))) + ;; We skip the headers. (goto-char (point-min)) - ;; We skip the headers. (unless (search-forward "\n\n" nil t) (goto-char (point-max))) (setq beg (point)) @@ -2751,8 +2744,8 @@ start end 'gnus-callback))) ;; That optional form returned non-nil, so we add the ;; button. - (gnus-article-add-button - start end 'gnus-button-push + (gnus-article-add-button + start end 'gnus-button-push (car (push (set-marker (make-marker) from) gnus-button-marker-list)))))))))) @@ -2788,7 +2781,7 @@ (form (nth 2 entry))) (goto-char (match-end 0)) (when (eval form) - (gnus-article-add-button + (gnus-article-add-button start end (nth 3 entry) (buffer-substring (match-beginning (nth 4 entry)) (match-end (nth 4 entry))))))) @@ -2802,7 +2795,7 @@ (when gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) - (gnus-add-text-properties + (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face (list gnus-mouse-face-prop gnus-article-mouse-face)) @@ -2884,7 +2877,7 @@ (setq parts (cons (substring string start (match-beginning 0)) parts) start (match-end 0))) (nreverse (cons (substring string start) parts)))) - + (defun gnus-url-parse-query-string (query &optional downcase) (let (retval pairs cur key val) (setq pairs (gnus-split-string query "&")) @@ -2902,14 +2895,14 @@ (setcdr cur (cons val (cdr cur))) (setq retval (cons (list key val) retval))))) retval)) - + (defun gnus-url-unhex (x) (if (> x ?9) (if (>= x ?a) (+ 10 (- x ?a)) (+ 10 (- x ?A))) (- x ?0))) - + (defun gnus-url-unhex-string (str &optional allow-newlines) "Remove %XXX embedded spaces, etc in a url. If optional second argument ALLOW-NEWLINES is non-nil, then allow the @@ -2923,7 +2916,7 @@ (ch1 (gnus-url-unhex (elt str (+ start 1)))) (code (+ (* 16 ch1) (gnus-url-unhex (elt str (+ start 2)))))) - (setq tmp (concat + (setq tmp (concat tmp (substring str 0 start) (cond (allow-newlines @@ -2934,7 +2927,7 @@ str (substring str (match-end 0))))) (setq tmp (concat tmp str)) tmp)) - + (defun gnus-url-mailto (url) ;; Send mail to someone (when (string-match "mailto:/*\\(.*\\)" url) @@ -2989,7 +2982,7 @@ (defun gnus-insert-prev-page-button () (let ((buffer-read-only nil)) - (gnus-eval-format + (gnus-eval-format gnus-prev-page-line-format nil `(gnus-prev t local-map ,gnus-prev-page-map gnus-callback gnus-article-button-prev-page)))) @@ -3021,7 +3014,7 @@ (let ((buffer-read-only nil)) (gnus-eval-format gnus-next-page-line-format nil `(gnus-next t local-map ,gnus-next-page-map - gnus-callback + gnus-callback gnus-article-button-next-page)))) (defun gnus-article-button-next-page (arg) @@ -3038,7 +3031,7 @@ (let ((win (selected-window))) (select-window (get-buffer-window gnus-article-buffer t)) (gnus-article-prev-page) - (select-window win))) + (select-window win))) (gnus-ems-redefine)
--- a/lisp/gnus/gnus-async.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-async.el Mon Aug 13 09:18:39 2007 +0200 @@ -50,7 +50,7 @@ (defcustom gnus-prefetched-article-deletion-strategy '(read exit) "List of symbols that say when to remove articles from the prefetch buffer. -Possible values in this list are `read', which means that +Possible values in this list are `read', which means that articles are removed as they are read, and `exit', which means that all articles belonging to a group are removed on exit from that group." @@ -105,7 +105,7 @@ (put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) (put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) - + ;;; ;;; Article prefetch ;;; @@ -138,7 +138,7 @@ ;; do this, which leads to slightly slower article ;; buffer display. (gnus-async-prefetch-article group next summary) - (run-with-idle-timer + (run-with-idle-timer 0.1 nil 'gnus-async-prefetch-article group next summary))))))) (defun gnus-async-prefetch-article (group article summary &optional next) @@ -181,7 +181,7 @@ (when do-fetch (setq article (car gnus-async-fetch-list)))) - + (when (and do-fetch article) ;; We want to fetch some more articles. (save-excursion @@ -191,9 +191,9 @@ (goto-char (point-max)) (setq mark (point-marker)) (let ((nnheader-callback-function - (gnus-make-async-article-function + (gnus-make-async-article-function group article mark summary next)) - (nntp-server-buffer + (nntp-server-buffer (get-buffer gnus-async-prefetch-article-buffer))) (when do-message (gnus-message 7 "Prefetching article %d in group %s" @@ -240,7 +240,7 @@ (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) (gnus-async-with-semaphore - (setq gnus-async-article-alist + (setq gnus-async-article-alist (delq entry gnus-async-article-alist)))) (defun gnus-async-prefetch-remove-group (group) @@ -254,7 +254,7 @@ (when (equal group (nth 3 (car alist))) (gnus-async-delete-prefected-entry (car alist))) (pop alist)))))) - + (defun gnus-async-prefetched-article-entry (group article) "Return the entry for ARTICLE in GROUP iff it has been prefetched." (let ((entry (assq (intern (format "%s-%d" group article)) @@ -266,7 +266,7 @@ (ignore-errors (set-marker (cadr entry) nil) (set-marker (caddr entry) nil)) - (setq gnus-async-article-alist + (setq gnus-async-article-alist (delq entry gnus-async-article-alist)) nil) entry))) @@ -309,7 +309,7 @@ (erase-buffer) (setq gnus-async-header-prefetched nil) t))) - + (provide 'gnus-async) ;;; gnus-async.el ends here
--- a/lisp/gnus/gnus-cache.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-cache.el Mon Aug 13 09:18:39 2007 +0200 @@ -42,7 +42,7 @@ :group 'gnus-cache :type 'directory) -(defcustom gnus-cache-active-file +(defcustom gnus-cache-active-file (concat (file-name-as-directory gnus-cache-directory) "active") "*The cache active file." :group 'gnus-cache @@ -129,7 +129,7 @@ (gnus-kill-buffer buffer) (setq gnus-cache-buffer nil)))) -(defun gnus-cache-possibly-enter-article +(defun gnus-cache-possibly-enter-article (group article headers ticked dormant unread &optional force) (when (and (or force (not (eq gnus-use-cache 'passive))) (numberp article) @@ -138,7 +138,7 @@ ; This might be a dummy article. ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art + (let ((result (nnvirtual-find-group-art (gnus-group-real-name group) article))) (setq group (car result) headers (copy-sequence headers)) @@ -258,7 +258,7 @@ (when (equal group "no.norsk") (error "hie")) (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (and cache-active + (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active @@ -267,7 +267,7 @@ (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) "Retrieve the headers for ARTICLES in GROUP." - (let ((cached + (let ((cached (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) (if (not cached) ;; No cached articles here, so we just retrieve them @@ -279,12 +279,12 @@ articles)) (cache-file (gnus-cache-file-name group ".overview")) type) - ;; We first retrieve all the headers that we don't have in + ;; We first retrieve all the headers that we don't have in ;; the cache. (let ((gnus-use-cache nil)) (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers + (setq type (and articles + (gnus-retrieve-headers uncached-articles group fetch-old))))) (gnus-cache-save-buffers) ;; Then we insert the cached headers. @@ -294,7 +294,7 @@ ;; There are no cached headers. type) ((null type) - ;; There were no uncached headers (or retrieval was + ;; There were no uncached headers (or retrieval was ;; unsuccessful), so we use the cached headers exclusively. (set-buffer nntp-server-buffer) (erase-buffer) @@ -321,8 +321,8 @@ article out) (while (setq article (pop articles)) (if (natnump article) - (when (gnus-cache-possibly-enter-article - gnus-newsgroup-name article + (when (gnus-cache-possibly-enter-article + gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t) (push article out)) @@ -387,7 +387,7 @@ (let ((file (gnus-cache-file-name group ".overview"))) (when (file-exists-p file) (nnheader-insert-file-contents file))) - ;; We have a fresh (empty/just loaded) buffer, + ;; We have a fresh (empty/just loaded) buffer, ;; mark it as unmodified to save a redundant write later. (set-buffer-modified-p nil)))) @@ -415,11 +415,11 @@ "If ARTICLE is in the cache, remove it and re-enter it." (when (gnus-cache-possibly-remove-article article nil nil nil t) (let ((gnus-use-cache nil)) - (gnus-cache-possibly-enter-article + (gnus-cache-possibly-enter-article gnus-newsgroup-name article (gnus-summary-article-header article) nil nil nil t)))) -(defun gnus-cache-possibly-remove-article (article ticked dormant unread +(defun gnus-cache-possibly-remove-article (article ticked dormant unread &optional force) "Possibly remove ARTICLE from the cache." (let ((group gnus-newsgroup-name) @@ -427,7 +427,7 @@ file) ;; If this is a virtual group, we find the real group. (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art + (let ((result (nnvirtual-find-group-art (gnus-group-real-name group) article))) (setq group (car result) number (cdr result)))) @@ -539,8 +539,8 @@ (gnus) ;; Go through all groups... (gnus-group-mark-buffer) - (gnus-group-universal-argument - nil nil + (gnus-group-universal-argument + nil nil (lambda () (interactive) (gnus-summary-read-group (gnus-group-group-name) nil t) @@ -562,11 +562,11 @@ (gnus-set-work-buffer) (insert-file-contents gnus-cache-active-file) (gnus-active-to-gnus-format - nil (setq gnus-cache-active-hashtb - (gnus-make-hashtable + nil (setq gnus-cache-active-hashtb + (gnus-make-hashtable (count-lines (point-min) (point-max))))) (setq gnus-cache-active-altered nil)))) - + (defun gnus-cache-write-active (&optional force) "Write the active hashtb to the active file." (when (or force @@ -604,14 +604,14 @@ (let* ((top (null directory)) (directory (expand-file-name (or directory gnus-cache-directory))) (files (directory-files directory 'full)) - (group + (group (if top "" - (string-match + (string-match (concat "^" (file-name-as-directory (expand-file-name gnus-cache-directory))) (directory-file-name directory)) - (nnheader-replace-chars-in-string + (nnheader-replace-chars-in-string (substring (directory-file-name directory) (match-end 0)) ?/ ?.))) nums alphs) @@ -654,5 +654,5 @@ (rename-file gnus-cache-directory dir)) (provide 'gnus-cache) - + ;;; gnus-cache.el ends here
--- a/lisp/gnus/gnus-cite.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-cite.el Mon Aug 13 09:18:39 2007 +0200 @@ -68,7 +68,7 @@ :type '(choice (const :tag "all" nil) integer)) -(defcustom gnus-cite-prefix-regexp +(defcustom gnus-cite-prefix-regexp "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" "Regexp matching the longest possible citation prefix on a line." :group 'gnus-cite @@ -79,7 +79,7 @@ :group 'gnus-cite :type 'integer) -(defcustom gnus-supercite-regexp +(defcustom gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") "Regexp matching normal Supercite attribution lines. @@ -110,7 +110,7 @@ :group 'gnus-cite :type 'regexp) -(defface gnus-cite-attribution-face '((t +(defface gnus-cite-attribution-face '((t (:underline t))) "Face used for attribution lines.") @@ -126,7 +126,7 @@ (((class color) (background light)) (:foreground "MidnightBlue")) - (t + (t (:italic t))) "Citation face.") @@ -136,7 +136,7 @@ (((class color) (background light)) (:foreground "firebrick")) - (t + (t (:italic t))) "Citation face.") @@ -146,7 +146,7 @@ (((class color) (background light)) (:foreground "dark green")) - (t + (t (:italic t))) "Citation face.") @@ -156,7 +156,7 @@ (((class color) (background light)) (:foreground "OrangeRed")) - (t + (t (:italic t))) "Citation face.") @@ -166,7 +166,7 @@ (((class color) (background light)) (:foreground "dark khaki")) - (t + (t (:italic t))) "Citation face.") @@ -176,7 +176,7 @@ (((class color) (background light)) (:foreground "dark violet")) - (t + (t (:italic t))) "Citation face.") @@ -186,7 +186,7 @@ (((class color) (background light)) (:foreground "SteelBlue4")) - (t + (t (:italic t))) "Citation face.") @@ -196,7 +196,7 @@ (((class color) (background light)) (:foreground "magenta")) - (t + (t (:italic t))) "Citation face.") @@ -206,7 +206,7 @@ (((class color) (background light)) (:foreground "violet")) - (t + (t (:italic t))) "Citation face.") @@ -216,7 +216,7 @@ (((class color) (background light)) (:foreground "medium purple")) - (t + (t (:italic t))) "Citation face.") @@ -226,15 +226,15 @@ (((class color) (background light)) (:foreground "turquoise")) - (t + (t (:italic t))) "Citation face.") -(defcustom gnus-cite-face-list - '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 - gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 +(defcustom gnus-cite-face-list + '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 + gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) - "List of faces used for highlighting citations. + "List of faces used for highlighting citations. When there are citations from multiple articles in the same message, Gnus will try to give each citation from each article its own face. @@ -257,7 +257,7 @@ (defvar gnus-cite-article nil) (defvar gnus-cite-prefix-alist nil) -;; Alist of citation prefixes. +;; Alist of citation prefixes. ;; The cdr is a list of lines with that prefix. (defvar gnus-cite-attribution-alist nil) @@ -277,7 +277,7 @@ ;; PREFIX: Is the citation prefix of the attribution line(s), and ;; TAG: Is a Supercite tag, if any. -(defvar gnus-cited-text-button-line-format-alist +(defvar gnus-cited-text-button-line-format-alist `((?b (marker-position beg) ?d) (?e (marker-position end) ?d) (?l (- end beg) ?d))) @@ -293,7 +293,7 @@ corresponding citation merged with `gnus-cite-attribution-face'. Text is considered cited if at least `gnus-cite-minimum-match-count' -lines matches `gnus-cite-prefix-regexp' with the same prefix. +lines matches `gnus-cite-prefix-regexp' with the same prefix. Lines matching `gnus-cite-attribution-suffix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." @@ -332,7 +332,7 @@ face (cdr (assoc prefix face-alist))) ;; Add attribution button. (goto-line number) - (when (re-search-forward gnus-cite-attribution-suffix + (when (re-search-forward gnus-cite-attribution-suffix (save-excursion (end-of-line 1) (point)) t) (gnus-article-add-button (match-beginning 1) (match-end 1) @@ -445,8 +445,8 @@ If given a negative prefix, always show; if given a positive prefix, always hide." (interactive (append (gnus-article-hidden-arg) (list 'force))) - (setq gnus-cited-text-button-line-format-spec - (gnus-parse-format gnus-cited-text-button-line-format + (setq gnus-cited-text-button-line-format-spec + (gnus-parse-format gnus-cited-text-button-line-format gnus-cited-text-button-line-format-alist t)) (save-excursion (set-buffer gnus-article-buffer) @@ -468,7 +468,7 @@ end nil) (while (and marks (string= (cdar marks) "")) (setq marks (cdr marks))) - (when marks + (when marks (setq beg (caar marks))) (while (and marks (not (string= (cdar marks) ""))) (setq marks (cdr marks))) @@ -548,7 +548,7 @@ total (cdr total)) (goto-line hiden) (unless (assq hiden gnus-cite-attribution-alist) - (gnus-add-text-properties + (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties)))))))))) @@ -589,7 +589,7 @@ (goto-char (point-min)) (unless (search-forward "\n\n" nil t) (goto-char (point-max))) - (save-excursion + (save-excursion (gnus-cite-parse-attributions)) ;; Try to avoid check citation if there is no reason to believe ;; that article has citations @@ -604,7 +604,7 @@ (defun gnus-cite-parse () ;; Parse and connect citation prefixes and attribution lines. - + ;; Parse current buffer searching for citation prefixes. (let ((line (1+ (count-lines (point-min) (point)))) (case-fold-search t) @@ -634,7 +634,7 @@ prefix (buffer-substring begin end)) (gnus-set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) - (if entry + (if entry (setcdr entry (cons line (cdr entry))) (push (list prefix line) alist)) (goto-char begin)) @@ -659,7 +659,7 @@ ;; Too few lines with this prefix. We keep it a bit ;; longer in case it is an exact match for an attribution ;; line, but we don't remove the line from other - ;; prefixes. + ;; prefixes. (push entry gnus-cite-prefix-alist)) (t (push entry @@ -670,7 +670,7 @@ (while loop (setq current (car loop) loop (cdr loop)) - (setcdr current + (setcdr current (gnus-set-difference (cdr current) numbers))))))))) (defun gnus-cite-parse-attributions () @@ -706,7 +706,7 @@ end))) (if (not (assoc al al-alist)) (progn - (push (list wrote in prefix tag) + (push (list wrote in prefix tag) gnus-cite-loose-attribution-alist) (push (cons al t) al-alist)))))))) @@ -721,8 +721,8 @@ (gnus-cite-match-attributions 'small nil (lambda (prefix tag) (when tag - (concat "\\`" - (regexp-quote prefix) "[ \t]*" + (concat "\\`" + (regexp-quote prefix) "[ \t]*" (regexp-quote tag) ">")))) ;; Find loose supercite citations after attributions. (gnus-cite-match-attributions 'small t @@ -777,8 +777,8 @@ ;; If FUN is non-nil, it will be called with the arguments (WROTE ;; PREFIX TAG) and expected to return a regular expression. Only ;; citations whose prefix matches the regular expression will be - ;; considered. - ;; + ;; considered. + ;; ;; WROTE is the attribution line number. ;; PREFIX is the attribution line prefix. ;; TAG is the Supercite tag on the attribution line. @@ -797,7 +797,7 @@ ((eq sort 'first) nil) (t (< (length (gnus-cite-find-loose prefix)) 2))) limit (if after wrote -1) - smallest 1000000 + smallest 1000000 best nil) (let ((cites gnus-cite-loose-prefix-alist) cite candidate numbers first compare) @@ -882,7 +882,7 @@ gnus-hidden-properties)) ((assq number gnus-cite-attribution-alist)) (t - (gnus-add-text-properties + (gnus-add-text-properties (point) (progn (forward-line 1) (point)) (nconc (list 'article-type 'cite) gnus-hidden-properties))))))))
--- a/lisp/gnus/gnus-cus.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-cus.el Mon Aug 13 09:18:39 2007 +0200 @@ -31,7 +31,7 @@ ;;; Widgets: -;; There should be special validation for this. +;; There should be special validation for this. (define-widget 'gnus-email-address 'string "An email address") @@ -59,7 +59,7 @@ '((to-address (gnus-email-address :tag "To Address") "\ This will be used when doing followups and posts. -This is primarily useful in mail groups that represent closed +This is primarily useful in mail groups that represent closed mailing lists--mailing lists where it's expected that everybody that writes to the mailing list is subscribed to it. Since using this parameter ensures that the mail only goes to the mailing list itself, @@ -73,7 +73,7 @@ address instead.") (to-list (gnus-email-address :tag "To List") "\ -This address will be used when doing a `a' in the group. +This address will be used when doing a `a' in the group. It is totally ignored when doing a followup--except that if it is present in a news group, you'll get mail group semantics when doing @@ -88,7 +88,7 @@ (to-group (string :tag "To Group") "\ All posts will be send to the specified group.") - + (gcc-self (choice :tag "GCC" :value t (const t) @@ -105,11 +105,11 @@ (auto-expire (const :tag "Automatic Expire" t) "\ All articles that are read will be marked as expirable.") - + (total-expire (const :tag "Total Expire" t) "\ All read articles will be put through the expiry process -This happens even if they are not marked as expirable. +This happens even if they are not marked as expirable. Use with caution.") (expiry-wait (choice :tag "Expire Wait" @@ -118,7 +118,7 @@ (const immediate) (number :hide-front-space t :format "%v")) "\ -When to expire. +When to expire. Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' when expiring expirable messages. The value can either be a number of @@ -128,9 +128,9 @@ (score-file (file :tag "Score File") "\ Make the specified file into the current score file. This means that all score commands you issue will end up in this file.") - + (adapt-file (file :tag "Adapt File") "\ -Make the specified file into the current adaptive file. +Make the specified file into the current adaptive file. All adaptive score entries will be put into this file.") (admin-address (gnus-email-address :tag "Admin Address") "\ @@ -145,7 +145,7 @@ :value default (const all) (const default)) "\ -Which articles to display on entering the group. +Which articles to display on entering the group. `all' Display all articles, both read and unread. @@ -156,7 +156,7 @@ (comment (string :tag "Comment") "\ An arbitrary comment on the group.")) - "Alist of valid group parameters. + "Alist of valid group parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and @@ -217,7 +217,7 @@ :tag "Variables" :format "%t:\n%h%v%i\n\n" :doc "\ -Set variables local to the group you are entering. +Set variables local to the group you are entering. If you want to turn threading off in `news.answers', you could put `(gnus-show-threads nil)' in the group parameters of that group. @@ -233,18 +233,18 @@ (symbol :tag "Variable") (sexp :tag "Value"))) - + '(repeat :inline t :tag "Unknown entries" sexp))) (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link + (widget-create 'info-link :tag "select method" :help-echo "Push me to learn more about select methods." "(gnus)Select Methods") (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp + (setq gnus-custom-method + (widget-create 'sexp :tag "Method" :value (gnus-info-method info))) (use-local-map widget-keymap) @@ -253,9 +253,9 @@ (defun gnus-group-customize-done (&rest ignore) "Apply changes and bury the buffer." (interactive) - (gnus-group-edit-group-done 'params gnus-custom-group + (gnus-group-edit-group-done 'params gnus-custom-group (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group + (gnus-group-edit-group-done 'method gnus-custom-group (widget-value gnus-custom-method)) (bury-buffer)) @@ -263,46 +263,46 @@ (defconst gnus-score-parameters '((mark (number :tag "Mark") "\ -The value of this entry should be a number. +The value of this entry should be a number. Any articles with a score lower than this number will be marked as read.") (expunge (number :tag "Expunge") "\ -The value of this entry should be a number. +The value of this entry should be a number. Any articles with a score lower than this number will be removed from the summary buffer.") (mark-and-expunge (number :tag "Mark-and-expunge") "\ -The value of this entry should be a number. +The value of this entry should be a number. Any articles with a score lower than this number will be marked as read and removed from the summary buffer.") (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ -The value of this entry should be a number. +The value of this entry should be a number. All articles that belong to a thread that has a total score below this number will be marked as read and removed from the summary buffer. `gnus-thread-score-function' says how to compute the total score for a thread.") (files (repeat :tag "Files" file) "\ -The value of this entry should be any number of file names. +The value of this entry should be any number of file names. These files are assumed to be score files as well, and will be loaded the same way this one was.") (exclude-files (repeat :tag "Exclude-files" file) "\ -The clue of this entry should be any number of files. +The clue of this entry should be any number of files. These files will not be loaded, even though they would normally be so, for some reason or other.") (eval (sexp :tag "Eval" :value nil) "\ -The value of this entry will be `eval'el. +The value of this entry will be `eval'el. This element will be ignored when handling global score files.") (read-only (boolean :tag "Read-only" :value t) "\ -Read-only score files will not be updated or saved. +Read-only score files will not be updated or saved. Global score files should feature this atom.") (orphan (number :tag "Orphan") "\ -The value of this entry should be a number. +The value of this entry should be a number. Articles that do not have parents will get this number added to their scores. Imagine you follow some high-volume newsgroup, like `comp.lang.c'. Most likely you will only follow a few of the threads, @@ -323,12 +323,12 @@ exist a few interesting threads which can't be found automatically by ordinary scoring rules.") - (adapt (choice :tag "Adapt" + (adapt (choice :tag "Adapt" (const t) (const ignore) (sexp :format "%v" :hide-front-space t)) "\ -This entry controls the adaptive scoring. +This entry controls the adaptive scoring. If it is `t', the default adaptive scoring rules will be used. If it is `ignore', no adaptive scoring will be performed on this group. If it is a list, this list will be used as the adaptive scoring rules. @@ -356,7 +356,7 @@ strange, way of setting variables in some groups if you don't like hooks much.") (touched (sexp :format "Touched\n") "Internal variable.")) - "Alist of valid symbolic score parameters. + "Alist of valid symbolic score parameters. Each entry has the form (NAME TYPE DOC), where NAME is the parameter itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a @@ -395,14 +395,14 @@ (const :tag "default" nil))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag + (concat "Change score based on the " tag " header.\n")) " -You can have an arbitrary number of score entries for this header, +You can have an arbitrary number of score entries for this header, each score entry has four elements: 1. The \"match element\". This should be the string to look for in the - header. + header. 2. The \"score element\". This number should be an integer in the neginf to posinf interval. This number is added to the score @@ -461,7 +461,7 @@ (const <=))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag + (concat "Change score based on the " tag " header."))))) (widget-put widget :args `(,item (repeat :inline t @@ -497,7 +497,7 @@ (const after))) (group `(group ,match ,score ,expire ,type)) (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag + (concat "Change score based on the " tag " header.")) " For the Date header we have three kinda silly match types: `before', @@ -643,7 +643,7 @@ (bury-buffer)) ;;; The End: - + (provide 'gnus-cus) ;;; gnus-cus.el ends here
--- a/lisp/gnus/gnus-demon.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-demon.el Mon Aug 13 09:18:39 2007 +0200 @@ -43,8 +43,8 @@ \(FUNCTION TIME IDLE) -FUNCTION is the function to be called. -TIME is the number of `gnus-demon-timestep's between each call. +FUNCTION is the function to be called. +TIME is the number of `gnus-demon-timestep's between each call. If nil, never call. If t, call each `gnus-demon-timestep'. If IDLE is t, only call if Emacs has been idle for a while. If IDLE is a number, only call when Emacs has been idle more than this number @@ -52,8 +52,8 @@ idleness. If IDLE is a number and TIME is nil, then call once each time Emacs has been idle for IDLE `gnus-demon-timestep's." :group 'gnus-demon - :type '(repeat (list function - (choice :tag "Time" + :type '(repeat (list function + (choice :tag "Time" (const :tag "never" nil) (const :tag "one" t) (integer :tag "steps" 1)) @@ -91,7 +91,7 @@ (defun gnus-demon-remove-handler (function &optional no-init) "Remove the handler FUNCTION from the list of handlers." - (setq gnus-demon-handlers + (setq gnus-demon-handlers (delq (assq function gnus-demon-handlers) gnus-demon-handlers)) (unless no-init @@ -104,12 +104,12 @@ (if (null gnus-demon-handlers) () ; Nothing to do. ;; Set up timer. - (setq gnus-demon-timer - (nnheader-run-at-time + (setq gnus-demon-timer + (nnheader-run-at-time gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) ;; Reset control variables. (setq gnus-demon-handler-state - (mapcar + (mapcar (lambda (handler) (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) (nth 2 handler))) @@ -150,7 +150,7 @@ time (let* ((date (current-time-string)) (dv (timezone-parse-date date)) - (tdate (timezone-make-arpa-date + (tdate (timezone-make-arpa-date (string-to-number (aref dv 0)) (string-to-number (aref dv 1)) (string-to-number (aref dv 2)) time @@ -179,7 +179,7 @@ handler time idle) (while handlers (setq handler (pop handlers)) - (cond + (cond ((numberp (setq time (nth 1 handler))) ;; These handlers use a regular timeout mechanism. We decrease ;; the timer if it hasn't reached zero yet. @@ -201,13 +201,13 @@ (setcar (nthcdr 1 handler) (gnus-demon-time-to-step (nth 1 (assq (car handler) gnus-demon-handlers))))))) - ;; These are only supposed to be called when Emacs is idle. + ;; These are only supposed to be called when Emacs is idle. ((null (setq idle (nth 2 handler))) ;; We do nothing. ) ((not (numberp idle)) ;; We want to call this handler each and every time that - ;; Emacs is idle. + ;; Emacs is idle. (funcall (car handler))) (t ;; We want to call this handler only if Emacs has been idle
--- a/lisp/gnus/gnus-dup.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-dup.el Mon Aug 13 09:18:39 2007 +0200 @@ -83,7 +83,7 @@ ;; Enter all Message-IDs into the hash table. (let ((list gnus-dup-list) (obarray gnus-dup-hashtb)) - (while list + (while list (intern (pop list))))) (defun gnus-dup-read () @@ -125,7 +125,7 @@ (intern msgid gnus-dup-hashtb)))) ;; Chop off excess Message-IDs from the list. (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) - (when end + (when end (setcdr end nil)))) (defun gnus-dup-suppress-articles () @@ -138,7 +138,7 @@ (while (setq header (pop headers)) (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) (gnus-summary-article-unread-p (mail-header-number header))) - (setq gnus-newsgroup-unreads + (setq gnus-newsgroup-unreads (delq (setq number (mail-header-number header)) gnus-newsgroup-unreads)) (push (cons number gnus-duplicate-mark)
--- a/lisp/gnus/gnus-eform.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-eform.el Mon Aug 13 09:18:39 2007 +0200 @@ -117,7 +117,7 @@ (func gnus-edit-form-done-function)) (gnus-edit-form-exit) (funcall func form))) - + (defun gnus-edit-form-exit () "Kill the current buffer." (interactive)
--- a/lisp/gnus/gnus-ems.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-ems.el Mon Aug 13 09:18:39 2007 +0200 @@ -35,7 +35,7 @@ (defvar gnus-mouse-2 [mouse-2]) (defvar gnus-down-mouse-2 [down-mouse-2]) -(eval-and-compile +(eval-and-compile (autoload 'gnus-xmas-define "gnus-xmas") (autoload 'gnus-xmas-redefine "gnus-xmas") (autoload 'appt-select-lowest-window "appt.el")) @@ -71,7 +71,7 @@ valstr)))) (eval-and-compile - (if gnus-xemacs + (if (string-match "XEmacs\\|Lucid" emacs-version) nil (defvar gnus-mouse-face-prop 'mouse-face @@ -83,7 +83,7 @@ If it is a string, the command will be executed in a sub-shell asynchronously. The compressed face will be piped to this command.")) - (cond + (cond ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-define)) @@ -99,7 +99,7 @@ (unless (fboundp 'buffer-substring-no-properties) (defun buffer-substring-no-properties (beg end) (format "%s" (buffer-substring beg end))))) - + ((boundp 'MULE) (provide 'gnusutil)))) @@ -141,13 +141,13 @@ (defvar gnus-tmp-subject-or-nil) (defun gnus-ems-redefine () - (cond + (cond ((string-match "XEmacs\\|Lucid" emacs-version) (gnus-xmas-redefine)) ((featurep 'mule) ;; Mule and new Emacs definitions - + ;; [Note] Now there are three kinds of mule implementations, ;; original MULE, XEmacs/mule and beta version of Emacs including ;; some mule features. Unfortunately these API are different. In @@ -157,35 +157,35 @@ ;; (boundp 'MULE) is t only if MULE (original; anything older than ;; Mule 2.3) is running. ;; (featurep 'mule) is t when every mule variants are running. - + ;; These implementations may be able to share between original ;; MULE and beta version of new Emacs. In addition, it is able to ;; detect XEmacs/mule by (featurep 'mule) and to check variable ;; `emacs-version'. In this case, implementation for XEmacs/mule ;; may be able to share between XEmacs and XEmacs/mule. - + (defalias 'gnus-truncate-string 'truncate-string) (defvar gnus-summary-display-table nil "Display table used in summary mode buffers.") (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) (fset 'gnus-max-width-function 'gnus-mule-max-width-function) - + (when (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines (delq 'control-chars gnus-check-before-posting)))) (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied + (insert gnus-tmp-unread gnus-tmp-replied gnus-tmp-score-char gnus-tmp-indentation) (put-text-property (point) (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines + (insert + gnus-tmp-opening-bracket + (format "%4d: %-20s" + gnus-tmp-lines (if (> (length gnus-tmp-name) 20) (truncate-string gnus-tmp-name 20) gnus-tmp-name))
--- a/lisp/gnus/gnus-gl.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-gl.el Mon Aug 13 09:18:39 2007 +0200 @@ -43,7 +43,7 @@ ;; The copyright holders request that they be notified of ;; modifications of this code. Please send electronic mail to ;; grouplens@cs.umn.edu for more information or to announce derived -;; works. +;; works. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Author: Brad Miller ;; @@ -56,7 +56,7 @@ ;; ;; ---------------- For your .emacs or .gnus file ---------------- ;; -;; As of version 2.5, grouplens now works as a minor mode of +;; As of version 2.5, grouplens now works as a minor mode of ;; gnus-summary-mode. To get make that work you just need a couple of ;; hooks. ;; (setq gnus-use-grouplens t) @@ -76,14 +76,14 @@ ;; Please type M-x gnus-gl-submit-bug-report. This will set up a ;; mail buffer with the state of variables and buffers that will help ;; me debug the problem. A short description up front would help too! -;; +;; ;; How do I display the prediction for an article: ;; If you set the gnus-summary-line-format as shown above, the score ;; (prediction) will be shown automatically. ;; -;; +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Programmer Notes +;; Programmer Notes ;; 10/9/95 ;; gnus-scores-articles contains the articles ;; When scoring is done, the call tree looks something like: @@ -115,7 +115,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; bugs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; +;; ;;; Code: @@ -132,7 +132,7 @@ "*The line format spec in summary GroupLens mode buffers.") (defvar grouplens-pseudonym "" - "User's pseudonym. + "User's pseudonym. This pseudonym is obtained during the registration process") (defvar grouplens-bbb-host "grouplens.cs.umn.edu" @@ -141,7 +141,7 @@ (defvar grouplens-bbb-port 9000 "Port where the bbbd is listening" ) -(defvar grouplens-newsgroups +(defvar grouplens-newsgroups '("comp.groupware" "comp.human-factors" "comp.lang.c++" "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" "comp.os.linux.announce" "comp.os.linux.answers" @@ -154,8 +154,8 @@ "*Groups that are part of the GroupLens experiment.") (defvar grouplens-prediction-display 'prediction-spot - "valid values are: - prediction-spot -- an * corresponding to the prediction between 1 and 5, + "valid values are: + prediction-spot -- an * corresponding to the prediction between 1 and 5, confidence-interval -- a numeric confidence interval prediction-bar -- |##### | the longer the bar, the better the article, confidence-bar -- | ----- } the prediction is in the middle of the bar, @@ -164,7 +164,7 @@ confidence-plus-minus -- prediction +/i confidence") (defvar grouplens-score-offset 0 - "Offset the prediction by this value. + "Offset the prediction by this value. Setting this variable to -2 would have the following effect on GroupLens scores: @@ -173,16 +173,16 @@ 3 --> 0 4 --> 1 5 --> 2 - + The reason is that a user might want to do this is to combine GroupLens predictions with scores calculated by other score methods.") (defvar grouplens-score-scale-factor 1 - "This variable allows the user to magnify the effect of GroupLens scores. + "This variable allows the user to magnify the effect of GroupLens scores. The scale factor is applied after the offset.") (defvar gnus-grouplens-override-scoring 'override - "Tell GroupLens to override the normal Gnus scoring mechanism. + "Tell GroupLens to override the normal Gnus scoring mechanism. GroupLens scores can be combined with gnus scores in one of three ways. 'override -- just use grouplens predictions for grouplens groups 'combine -- combine grouplens scores with gnus scores @@ -255,11 +255,11 @@ ;; open the connection to the server (catch 'done (condition-case error - (setq grouplens-bbb-process + (setq grouplens-bbb-process (open-network-stream "BBBD" grouplens-bbb-buffer host port)) (error (gnus-message 3 "Error: Failed to connect to BBB") nil)) - (and (null grouplens-bbb-process) + (and (null grouplens-bbb-process) (throw 'done nil)) (save-excursion (set-buffer grouplens-bbb-buffer) @@ -338,12 +338,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun bbb-build-mid-scores-alist (groupname) - "this function can be called as part of the function to return the + "this function can be called as part of the function to return the list of score files to use. See the gnus variable -gnus-score-find-score-files-function. +gnus-score-find-score-files-function. *Note:* If you want to use grouplens scores along with calculated scores, -you should see the offset and scale variables. At this point, I don't +you should see the offset and scale variables. At this point, I don't recommend using both scores and grouplens predictions together." (setq grouplens-current-group groupname) (when (member groupname grouplens-newsgroups) @@ -423,14 +423,14 @@ ;; around. Where the first parenthesized expression is the ;; message-id, and the second is the prediction, the third and fourth ;; are the confidence interval -;; +;; ;; Since gnus assumes that scores are integer values?? we round the ;; prediction. (defun bbb-get-mid () (buffer-substring (match-beginning 1) (match-end 1))) (defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring (match-beginning 2) + (let ((tpred (string-to-number (buffer-substring (match-beginning 2) (match-end 2))))) (if (> tpred 0) (round (* grouplens-score-scale-factor @@ -473,7 +473,7 @@ (setq high 0)) (if (and (bbb-valid-score iscore) (not (null mid))) - (cond + (cond ;; prediction-spot ((equal grouplens-prediction-display 'prediction-spot) (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) @@ -522,7 +522,7 @@ ((> pred 5) (setq pred 5)))) ;; If no entry in BBB hash mark rate string as NA and return - (cond + (cond ((null hashent) (aset rate-string 5 ?N) (aset rate-string 6 ?A) @@ -530,10 +530,10 @@ ((equal grouplens-prediction-display 'prediction-spot) (bbb-fmt-prediction-spot rate-string pred)) - + ((equal grouplens-prediction-display 'confidence-interval) (bbb-fmt-confidence-interval pred low high)) - + ((equal grouplens-prediction-display 'prediction-bar) (bbb-fmt-prediction-bar rate-string pred)) @@ -542,14 +542,14 @@ ((equal grouplens-prediction-display 'confidence-spot) (format "| %4.2f |" pred)) - + ((equal grouplens-prediction-display 'prediction-num) (bbb-fmt-prediction-num pred)) - + ((equal grouplens-prediction-display 'confidence-plus-minus) (bbb-fmt-confidence-plus-minus pred low high)) - - (t + + (t (gnus-message 3 "Invalid prediction display type") (aset rate-string 0 ?|) (aset rate-string 11 ?|) @@ -609,19 +609,19 @@ (defun bbb-put-ratings () (if (and grouplens-bbb-token - grouplens-rating-alist + grouplens-rating-alist (member gnus-newsgroup-name grouplens-newsgroups)) - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host + (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)) (rate-command (bbb-build-rate-command grouplens-rating-alist))) (if bbb-process - (save-excursion + (save-excursion (set-buffer (process-buffer bbb-process)) (gnus-message 5 "Sending Ratings...") (bbb-send-command bbb-process rate-command) (if (bbb-read-response bbb-process) (setq grouplens-rating-alist nil) - (gnus-message 1 + (gnus-message 1 "Token timed out: call bbb-login and quit again") (ding)) (gnus-message 5 "Sending Ratings...Done")) @@ -642,7 +642,7 @@ (interactive "nRating: ") (when (member gnus-newsgroup-name grouplens-newsgroups) (let ((mid (or midin (bbb-get-current-id)))) - (if (and rating + (if (and rating (>= rating grplens-minrating) (<= rating grplens-maxrating) mid) @@ -668,8 +668,8 @@ (gnus-summary-best-unread-article)) (defun grouplens-summary-catchup-and-exit (rating) - "Mark all articles not marked as unread in this newsgroup as read, - then exit. If prefix argument ALL is non-nil, all articles are + "Mark all articles not marked as unread in this newsgroup as read, + then exit. If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when rating @@ -689,7 +689,7 @@ (gnus-summary-goto-subject article) (gnus-set-global-variables) (bbb-summary-rate-article score - (mail-header-id + (mail-header-id (gnus-summary-article-header article))))) (setq e (point))) (let ((gnus-summary-check-current t)) @@ -705,7 +705,7 @@ (defun bbb-get-current-id () (if gnus-current-headers - (mail-header-id gnus-current-headers) + (mail-header-id gnus-current-headers) (gnus-message 3 "You must select an article before you rate it"))) (defun bbb-grouplens-group-p (group) @@ -732,7 +732,7 @@ (when (member gnus-newsgroup-name grouplens-newsgroups) (when grouplens-previous-article (let ((elapsed-time (grouplens-elapsed-time)) - (oldrating (assoc grouplens-previous-article + (oldrating (assoc grouplens-previous-article grouplens-rating-alist))) (if (not oldrating) (push `(,grouplens-previous-article . (0 . ,elapsed-time)) @@ -806,7 +806,7 @@ (when (and (eq major-mode 'gnus-summary-mode) (member gnus-newsgroup-name grouplens-newsgroups)) (make-local-variable 'gnus-grouplens-mode) - (setq gnus-grouplens-mode + (setq gnus-grouplens-mode (if (null arg) (not gnus-grouplens-mode) (> (prefix-numeric-value arg) 0))) (when gnus-grouplens-mode @@ -816,28 +816,28 @@ (gnus-add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) (make-local-variable 'gnus-score-find-score-files-function) - (cond + (cond ((eq gnus-grouplens-override-scoring 'combine) ;; either add bbb-buld-mid-scores-alist to a list ;; or make a list (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist + (setq gnus-score-find-score-files-function + (append 'bbb-build-mid-scores-alist gnus-score-find-score-files-function)) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function + (setq gnus-score-find-score-files-function + (list gnus-score-find-score-files-function 'bbb-build-mid-scores-alist)))) ;; leave the gnus-score-find-score-files variable alone ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook + (add-hook 'gnus-select-group-hook (lambda () (bbb-get-predictions (bbb-get-all-mids) gnus-newsgroup-name)))) ;; default is to override - (t - (setq gnus-score-find-score-files-function + (t + (setq gnus-score-find-score-files-function 'bbb-build-mid-scores-alist))) - + ;; Change how summary lines look (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec)
--- a/lisp/gnus/gnus-group.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-group.el Mon Aug 13 09:18:39 2007 +0200 @@ -265,7 +265,7 @@ "gnus-help" (nndoc "gnus-help" (nndoc-article-type mbox) - (eval `(nndoc-address + (eval `(nndoc-address ,(let ((file (nnheader-find-etc-directory "gnus-tut.txt" t))) (unless file @@ -312,13 +312,13 @@ gnus-group-mail-low-empty-face) (t . gnus-group-mail-low-face)) - "Controls the highlighting of group buffer lines. + "Controls the highlighting of group buffer lines. Below is a list of `Form'/`Face' pairs. When deciding how a a particular group line should be displayed, each form is evaluated. The content of the face field after the first true form is used. You can change how those group lines are displayed by -editing the face field. +editing the face field. It is also possible to change and add form fields, but currently that requires an understanding of Lisp expressions. Hopefully this will @@ -603,7 +603,7 @@ ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] ["Global kill file" gnus-group-edit-global-kill t]) )) - + (easy-menu-define gnus-group-group-menu gnus-group-mode-map "" '("Groups" @@ -708,7 +708,7 @@ ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ["Post an article..." gnus-group-post-news t] - ["Check for new news" gnus-group-get-new-news t] + ["Check for new news" gnus-group-get-new-news t] ["Activate all groups" gnus-activate-all-groups t] ["Restart Gnus" gnus-group-restart t] ["Read init file" gnus-group-read-init-file t] @@ -850,7 +850,7 @@ ;; We have some groups displayed. (goto-char (point-max)) (when (or (not gnus-group-goto-next-group-function) - (not (funcall gnus-group-goto-next-group-function + (not (funcall gnus-group-goto-next-group-function group props))) (cond (empty @@ -914,7 +914,7 @@ (>= clevel lowest) (or all ; We list all groups? (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated + gnus-group-list-inactive-groups ; We list unactivated (> unread 0)) ; We list groups with unread articles (and gnus-list-groups-with-ticked-articles (cdr (assq 'tick (gnus-info-marks info)))) @@ -1015,7 +1015,7 @@ nil) nil)))) -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level +(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number gnus-tmp-method) "Insert a group line in the group buffer." @@ -1118,8 +1118,8 @@ (setq list (cdr list))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face + (gnus-put-text-property + beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (gnus-extent-start-open beg))) (goto-char p))) @@ -1143,7 +1143,7 @@ (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) (when (and entry (not (gnus-ephemeral-group-p group))) (gnus-dribble-enter - (concat "(gnus-group-set-info '" + (concat "(gnus-group-set-info '" (gnus-prin1-to-string (nth 2 entry)) ")")))) ;; Find all group instances. If topics are in use, each group @@ -1204,7 +1204,7 @@ (max-len 60) gnus-tmp-header ;Dummy binding for user-defined formats ;; Get the resulting string. - (modified + (modified (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) @@ -1219,7 +1219,7 @@ (when (> (length mode-string) max-len) (setq mode-string (substring mode-string 0 (- max-len 4)))) (prog1 - (setq mode-line-buffer-identification + (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p modified)))))) @@ -1481,7 +1481,7 @@ (- (1+ (cdr active)) (car active))))) (gnus-summary-read-group group (or all (and (numberp number) - (zerop (+ number (gnus-range-length + (zerop (+ number (gnus-range-length (cdr (assq 'tick marked))) (gnus-range-length (cdr (assq 'dormant marked))))))) @@ -1518,7 +1518,7 @@ (defun gnus-group-select-group-ephemerally () "Select the current group without doing any processing whatsoever. You will actually be entered into a group that's a copy of -the current group; no changes you make while in this group will +the current group; no changes you make while in this group will be permanent." (interactive) (require 'gnus-score) @@ -1532,7 +1532,7 @@ `(,(car method) ,(concat (cadr method) "-ephemeral") (,(intern (format "%s-address" (car method))) ,(cadr method)) ,@(cddr method))) - (gnus-group-read-ephemeral-group + (gnus-group-read-ephemeral-group (gnus-group-prefixed-name group method) method))) ;;;###autoload @@ -1548,7 +1548,7 @@ ;; Enter a group that is not in the group buffer. Non-nil is returned ;; if selection was successful. -(defun gnus-group-read-ephemeral-group (group method &optional activate +(defun gnus-group-read-ephemeral-group (group method &optional activate quit-config request-only) "Read GROUP from METHOD as an ephemeral group. If ACTIVATE, request the group first. @@ -1568,7 +1568,7 @@ (gnus-group-prefixed-name group method)))) (gnus-sethash group - `(-1 nil (,group + `(-1 nil (,group ,gnus-level-default-subscribed nil nil ,method ((quit-config . ,(if quit-config quit-config @@ -1581,7 +1581,7 @@ (when activate (gnus-activate-group group 'scan) (unless (gnus-request-group group) - (error "Couldn't request group: %s" + (error "Couldn't request group: %s" (nnheader-get-report (car method))))) (if request-only group @@ -1618,7 +1618,7 @@ (when group (if far (gnus-goto-char - (text-property-any + (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) (beginning-of-line) @@ -1644,7 +1644,7 @@ (t ;; Search through the entire buffer. (gnus-goto-char - (text-property-any + (text-property-any (point-min) (point-max) 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) @@ -1781,7 +1781,7 @@ (gnus-set-active nname (cons 1 0)) (unless (gnus-ephemeral-group-p name) (gnus-dribble-enter - (concat "(gnus-group-set-info '" + (concat "(gnus-group-set-info '" (gnus-prin1-to-string (cdr info)) ")"))) ;; Insert the line. (gnus-group-insert-group-line-info nname) @@ -1844,7 +1844,7 @@ (unless (gnus-check-backend-function 'request-rename-group group) (error "This backend does not support renaming groups")) - (unless group + (unless group (error "No group to rename")) (when (equal (gnus-group-real-name group) new-name) (error "Can't rename to the same name")) @@ -2030,8 +2030,8 @@ 0) 'gnus-group-web-type-history)) (search - (read-string - "Search string: " + (read-string + "Search string: " (cons (or (car gnus-group-web-search-history) "") 0) 'gnus-group-web-search-history)) (method @@ -2168,7 +2168,9 @@ (defun gnus-group-sort-groups (func &optional reverse) "Sort the group buffer according to FUNC. -If REVERSE, reverse the sorting order." +When used interactively, the sorting function used will be +determined by the `gnus-group-sort-function' variable. +If REVERSE (the prefix), reverse the sorting order." (interactive (list gnus-group-sort-function current-prefix-arg)) (funcall gnus-group-sort-alist-function (gnus-make-sort-function func) reverse) @@ -2357,7 +2359,7 @@ (gnus-info-clear-data info))) (gnus-get-unread-articles) (gnus-dribble-enter "") - (when (gnus-y-or-n-p + (when (gnus-y-or-n-p "Move the cache away to avoid problems in the future? ") (call-interactively 'gnus-cache-move-cache))))) @@ -2476,7 +2478,7 @@ (gnus-compress-sequence (if expiry-wait ;; We set the expiry variables to the group - ;; parameter. + ;; parameter. (let ((nnmail-expiry-wait-function nil) (nnmail-expiry-wait expiry-wait)) (gnus-request-expire-articles @@ -2486,6 +2488,7 @@ (gnus-uncompress-sequence (cdr expirable)) group)))) (gnus-close-group group)) (gnus-message 6 "Expiring articles in %s...done" group))) + (gnus-dribble-touch) (gnus-group-position-point)))) (defun gnus-group-expire-all-groups () @@ -2548,7 +2551,7 @@ groups (cdr groups)) (gnus-group-remove-mark group) (gnus-group-unsubscribe-group - group + group (cond ((eq do-sub 'unsubscribe) gnus-level-default-unsubscribed) @@ -2570,7 +2573,7 @@ (list (completing-read "Group: " gnus-active-hashtb nil (gnus-read-active-file-p) - nil + nil 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond @@ -2579,7 +2582,7 @@ (newsrc ;; Toggle subscription flag. (gnus-group-change-level - newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) + newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc)) gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) @@ -2842,7 +2845,7 @@ (gnus-master-read-slave-newsrc)) ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem + (when (and gnus-use-nocem (null arg)) (gnus-nocem-scan-groups)) ;; If ARG is not a number, then we read the active file. @@ -2854,7 +2857,7 @@ ;; If the user wants it, we scan for new groups. (when (eq gnus-check-new-newsgroups 'always) (gnus-find-new-newsgroups))) - + (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) (progn @@ -3036,7 +3039,7 @@ (when (and level (> (prefix-numeric-value level) gnus-level-killed)) (gnus-get-killed-groups)) - (gnus-group-prepare-flat + (gnus-group-prepare-flat (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) (gnus-group-position-point)) @@ -3132,7 +3135,7 @@ "Quit reading news after updating .newsrc.eld and .newsrc. The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) - (when + (when (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation gnus-expert-user
--- a/lisp/gnus/gnus-int.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-int.el Mon Aug 13 09:18:39 2007 +0200 @@ -427,7 +427,7 @@ (let* ((elem (assoc method gnus-opened-servers)) (status (cadr elem))) ;; If this hasn't been opened before, we add it to the list. - (when (eq status 'denied) + (when (eq status 'denied) ;; Set the status of this server. (setcar (cdr elem) 'closed))))
--- a/lisp/gnus/gnus-kill.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-kill.el Mon Aug 13 09:18:39 2007 +0200 @@ -205,36 +205,36 @@ (goto-char (point-max))) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) (gnus-kill-file-apply-string string)))) - + (defun gnus-kill-file-kill-by-subject () "Kill by subject." (interactive) (gnus-kill-file-enter-kill - "Subject" + "Subject" (if (vectorp gnus-current-headers) - (regexp-quote + (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) "") t)) - + (defun gnus-kill-file-kill-by-author () "Kill by author." (interactive) (gnus-kill-file-enter-kill - "From" + "From" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-from gnus-current-headers)) "") t)) - + (defun gnus-kill-file-kill-by-thread () "Kill by author." (interactive) (gnus-kill-file-enter-kill - "References" + "References" (if (vectorp gnus-current-headers) (regexp-quote (mail-header-id gnus-current-headers)) ""))) - + (defun gnus-kill-file-kill-by-xref () "Kill by Xref." (interactive) @@ -245,11 +245,11 @@ (if xref (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) - (when (not (string= - (setq group + (when (not (string= + (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) - (gnus-kill-file-enter-kill + (gnus-kill-file-enter-kill "Xref" (concat " " (regexp-quote group) ":") t))) (gnus-kill-file-enter-kill "Xref" "" t)))) @@ -264,14 +264,14 @@ (setq name (read-string (concat "Add " level " to followup articles to: ") (regexp-quote name))) - (setq + (setq string (format "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" "From" name level)) (insert string) (gnus-kill-file-apply-string string)) - (gnus-message + (gnus-message 6 "Added temporary score file entry for followups to %s." name))) (defun gnus-kill-file-apply-buffer () @@ -387,7 +387,7 @@ (mapcar (lambda (header) (mail-header-number header)) headers)) (while headers - (unless (gnus-member-of-range + (unless (gnus-member-of-range (mail-header-number (car headers)) gnus-newsgroup-killed) (push (mail-header-number (car headers)) @@ -410,8 +410,8 @@ (if (consp (ignore-errors (read (current-buffer)))) (gnus-kill-parse-gnus-kill-file) (gnus-kill-parse-rn-kill-file)) - - (gnus-message + + (gnus-message 6 "Processing kill file %s...done" (car kill-files))) (setq kill-files (cdr kill-files))))) @@ -439,7 +439,7 @@ (goto-char (point-min)) (gnus-kill-file-mode) (let (beg form) - (while (progn + (while (progn (setq beg (point)) (setq form (ignore-errors (read (current-buffer))))) (unless (listp form) @@ -481,14 +481,14 @@ ;; The "f:+" command marks everything *but* the matches as read, ;; so we simply first match everything as read, and then unmark - ;; PATTERN later. + ;; PATTERN later. (when (string-match "\\+" commands) (gnus-kill "from" ".") (setq commands "m")) - (gnus-kill + (gnus-kill (or (cdr (assq modifier mod-to-header)) "subject") - pattern + pattern (if (string-match "m" commands) '(gnus-summary-mark-as-unread nil " ") '(gnus-summary-mark-as-read nil "X")) @@ -496,7 +496,7 @@ (forward-line 1)))) ;; Kill changes and new format by suggested by JWZ and Sudish Joseph -;; <joseph@cis.ohio-state.edu>. +;; <joseph@cis.ohio-state.edu>. (defun gnus-kill (field regexp &optional exe-command all silent) "If FIELD of an article matches REGEXP, execute COMMAND. Optional 1st argument COMMAND is default to @@ -514,7 +514,7 @@ (goto-char (point-min)) ;From the beginning. (let ((kill-list regexp) (date (current-time-string)) - (command (or exe-command '(gnus-summary-mark-as-read + (command (or exe-command '(gnus-summary-mark-as-read nil gnus-kill-file-mark))) kill kdate prev) (if (listp kill-list) @@ -532,7 +532,7 @@ ;; It's a temporary kill. (progn (setq kdate (cdr kill)) - (if (zerop (gnus-execute + (if (zerop (gnus-execute field (car kill) command nil (not all))) (when (> (gnus-days-between date kdate) gnus-kill-expiry-days) @@ -551,7 +551,7 @@ (switch-to-buffer old-buffer) (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) (gnus-pp-gnus-kill - (nconc (list 'gnus-kill field + (nconc (list 'gnus-kill field (if (consp regexp) (list 'quote regexp) regexp)) (when (or exe-command all) (list (list 'quote exe-command))) @@ -576,7 +576,7 @@ (setq klist (cdr klist)))) (insert ")") (and (nth 3 object) - (insert "\n " + (insert "\n " (if (and (consp (nth 3 object)) (not (eq 'quote (car (nth 3 object))))) "'" "") @@ -614,7 +614,7 @@ (gnus-last-article nil) (gnus-break-pages nil) ;No need to break pages. (gnus-mark-article-hook nil)) ;Inhibit marking as read. - (gnus-message + (gnus-message 6 "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) @@ -639,15 +639,15 @@ (save-excursion (let ((killed-no 0) function article header) - (cond + (cond ;; Search body. ((or (null field) (string-equal field "")) (setq function nil)) ;; Get access function of header field. ((fboundp - (setq function - (intern-soft + (setq function + (intern-soft (concat "mail-header-" (downcase field))))) (setq function `(lambda (h) (,function h)))) ;; Signal error. @@ -659,7 +659,7 @@ (and (not article) (setq article (gnus-summary-article-number))) ;; Find later articles. - (setq article + (setq article (gnus-summary-search-forward unread nil backward))) (and (or (null gnus-newsgroup-kill-headers) (memq article gnus-newsgroup-kill-headers)) @@ -679,7 +679,7 @@ the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." (interactive) - (let* ((gnus-newsrc-options-n + (let* ((gnus-newsrc-options-n (gnus-newsrc-parse-options (concat "options -n " (mapconcat 'identity command-line-args-left " "))))
--- a/lisp/gnus/gnus-load.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-load.el Mon Aug 13 09:18:39 2007 +0200 @@ -2,58 +2,108 @@ ;; ;;; Code: -(put 'gnus-visual 'custom-loads '("smiley" "gnus-sum" "gnus-picon" "earcon")) +(put 'nnmail 'custom-loads '("nnmail")) +(put 'gnus-article-emphasis 'custom-loads '("gnus-art")) +(put 'gnus-article-headers 'custom-loads '("gnus-sum" "gnus-art")) +(put 'gnus-newsrc 'custom-loads '("gnus-start")) +(put 'nnmail-procmail 'custom-loads '("nnmail")) +(put 'gnus-score-kill 'custom-loads '("gnus-kill")) +(put 'gnus-visual 'custom-loads '("smiley" "gnus" "gnus-picon" "gnus-art" "earcon")) +(put 'gnus-score-expire 'custom-loads '("gnus-score" "gnus-kill")) +(put 'gnus-exit 'custom-loads '("gnus-group")) (put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) -(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int")) -(put 'gnus-extract-view 'custom-loads '("gnus-sum")) -(put 'article-hiding-headers 'custom-loads '("gnus-sum")) +(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int" "gnus-group")) +(put 'gnus-extract-view 'custom-loads '("gnus-uu" "gnus-sum")) (put 'gnus-various 'custom-loads '("gnus-sum")) -(put 'gnus-meta 'custom-loads '("gnus")) +(put 'gnus-article-washing 'custom-loads '("gnus-art")) +(put 'gnus-score-files 'custom-loads '("gnus-score")) (put 'message-news 'custom-loads '("message")) (put 'gnus-thread 'custom-loads '("gnus-sum")) +(put 'languages 'custom-loads '("cus-edit")) +(put 'development 'custom-loads '("cus-edit")) (put 'gnus-treading 'custom-loads '("gnus-sum")) +(put 'nnmail-various 'custom-loads '("nnmail")) +(put 'extensions 'custom-loads '("wid-edit")) (put 'message-various 'custom-loads '("message")) (put 'gnus-summary-exit 'custom-loads '("gnus-sum")) -(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-sum" "gnus-group" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art")) +(put 'news 'custom-loads '("message" "gnus")) +(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art")) +(put 'gnus-server 'custom-loads '("gnus")) (put 'gnus-summary-visual 'custom-loads '("gnus-sum")) -(put 'gnus-score 'custom-loads '("gnus-sum" "gnus-score" "gnus-nocem" "gnus-kill")) +(put 'gnus-group-listing 'custom-loads '("gnus-group")) +(put 'gnus-score 'custom-loads '("gnus" "gnus-nocem")) (put 'gnus-group-select 'custom-loads '("gnus-sum")) (put 'message-buffers 'custom-loads '("message")) (put 'gnus-threading 'custom-loads '("gnus-sum")) -(put 'article 'custom-loads '("gnus-sum" "gnus-cite" "gnus-art")) +(put 'gnus-score-decay 'custom-loads '("gnus-score")) +(put 'help 'custom-loads '("cus-edit")) (put 'gnus-nocem 'custom-loads '("gnus-nocem")) +(put 'gnus-group-visual 'custom-loads '("gnus-group")) (put 'gnus-cite 'custom-loads '("gnus-cite")) (put 'gnus-demon 'custom-loads '("gnus-demon")) -(put 'gnus-mail 'custom-loads '("nnmail")) +(put 'gnus-message 'custom-loads '("message")) +(put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score")) +(put 'nnmail-duplicate 'custom-loads '("nnmail")) (put 'message-interface 'custom-loads '("message")) +(put 'nnmail-files 'custom-loads '("nnmail")) (put 'gnus-edit-form 'custom-loads '("gnus-eform")) -(put 'emacs 'custom-loads '("custom" "wid-edit" "message" "gnus" "custom-opt")) +(put 'emacs 'custom-loads '("cus-edit")) (put 'gnus-summary-mail 'custom-loads '("gnus-sum")) (put 'gnus-topic 'custom-loads '("gnus-topic")) +(put 'wp 'custom-loads '("cus-edit")) (put 'gnus-summary-choose 'custom-loads '("gnus-sum")) +(put 'widget-browse 'custom-loads '("wid-browse")) +(put 'external 'custom-loads '("cus-edit")) (put 'message-headers 'custom-loads '("message")) (put 'message-forwarding 'custom-loads '("message")) +(put 'environment 'custom-loads '("cus-edit")) +(put 'gnus-article-mime 'custom-loads '("gnus-sum" "gnus-art")) (put 'gnus-duplicate 'custom-loads '("gnus-dup")) -(put 'widgets 'custom-loads '("wid-edit")) +(put 'nnmail-retrieve 'custom-loads '("nnmail")) +(put 'widgets 'custom-loads '("wid-edit" "wid-browse")) (put 'earcon 'custom-loads '("earcon")) +(put 'hypermedia 'custom-loads '("wid-edit")) +(put 'gnus-group-levels 'custom-loads '("gnus-start" "gnus-group")) (put 'gnus-summary-format 'custom-loads '("gnus-sum")) +(put 'gnus-files 'custom-loads '("nnmail" "gnus")) (put 'gnus-windows 'custom-loads '("gnus-win")) -(put 'gnus-summary 'custom-loads '("gnus-sum")) -(put 'gnus-group 'custom-loads '("gnus-topic" "gnus-sum" "gnus-group")) +(put 'gnus-article-buttons 'custom-loads '("gnus-art")) +(put 'gnus-summary 'custom-loads '("gnus" "gnus-sum")) +(put 'gnus-article-hiding 'custom-loads '("gnus-sum" "gnus-art")) +(put 'gnus-group 'custom-loads '("gnus" "gnus-topic")) +(put 'gnus-article-various 'custom-loads '("gnus-sum" "gnus-art")) (put 'gnus-summary-marks 'custom-loads '("gnus-sum")) +(put 'gnus-article-saving 'custom-loads '("gnus-art")) +(put 'nnmail-expire 'custom-loads '("nnmail")) (put 'message-mail 'custom-loads '("message")) +(put 'faces 'custom-loads '("wid-edit" "cus-edit" "gnus")) (put 'gnus-summary-various 'custom-loads '("gnus-sum")) +(put 'applications 'custom-loads '("cus-edit")) +(put 'gnus-start-server 'custom-loads '("gnus-start")) +(put 'gnus-extract-archive 'custom-loads '("gnus-uu")) (put 'message 'custom-loads '("message")) (put 'message-sending 'custom-loads '("message")) +(put 'editing 'custom-loads '("cus-edit")) +(put 'gnus-score-adapt 'custom-loads '("gnus-score")) (put 'message-insertion 'custom-loads '("message")) +(put 'gnus-extract-post 'custom-loads '("gnus-uu")) +(put 'mail 'custom-loads '("message" "gnus")) (put 'gnus-summary-sort 'custom-loads '("gnus-sum")) -(put 'customize 'custom-loads '("custom" "cus-edit")) +(put 'gnus-group-new 'custom-loads '("gnus-start")) +(put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit")) +(put 'nnmail-split 'custom-loads '("nnmail")) (put 'gnus-asynchronous 'custom-loads '("gnus-async")) -(put 'article-mime 'custom-loads '("gnus-sum")) -(put 'gnus-extract 'custom-loads '("gnus-uu" "gnus-sum")) -(put 'article-various 'custom-loads '("gnus-sum")) +(put 'gnus-dribble-file 'custom-loads '("gnus-start")) +(put 'gnus-article-highlight 'custom-loads '("gnus-art")) +(put 'gnus-extract 'custom-loads '("gnus-uu")) +(put 'gnus-article 'custom-loads '("gnus-cite" "gnus-art")) +(put 'gnus-group-foreign 'custom-loads '("gnus-group")) +(put 'programming 'custom-loads '("cus-edit")) (put 'mesage-sending 'custom-loads '("message")) +(put 'nnmail-prepare 'custom-loads '("nnmail")) (put 'picons 'custom-loads '("gnus-picon")) +(put 'gnus-article-signature 'custom-loads '("gnus-art")) +(put 'gnus-group-various 'custom-loads '("gnus-group")) (provide 'gnus-load)
--- a/lisp/gnus/gnus-logic.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-logic.el Mon Aug 13 09:18:39 2007 +0200 @@ -29,7 +29,7 @@ (require 'gnus-score) (require 'gnus-util) -;;; Internal variables. +;;; Internal variables. (defvar gnus-advanced-headers nil) @@ -53,7 +53,7 @@ (eval-and-compile (autoload 'parse-time-string "parse-time")) - + (defun gnus-score-advanced (rule &optional trace) "Apply advanced scoring RULE to all the articles in the current group." (let ((headers gnus-newsgroup-headers) @@ -79,7 +79,7 @@ (defun gnus-advanced-score-rule (rule) "Apply RULE to `gnus-advanced-headers'." (let ((type (car rule))) - (cond + (cond ;; "And" rule. ((or (eq type '&) (eq type 'and)) (pop rule) @@ -106,7 +106,7 @@ ;; This is a `1-'-type redirection rule. ((and (symbolp type) (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) - (let ((gnus-advanced-headers + (let ((gnus-advanced-headers (gnus-parent-headers gnus-advanced-headers (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) @@ -165,7 +165,7 @@ (let ((date (encode-time (parse-time-string (aref gnus-advanced-headers index)))) (match (encode-time (parse-time-string match)))) - (cond + (cond ((eq type 'at) (equal date match)) ((eq type 'before) @@ -188,7 +188,7 @@ ofunc article) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. - (unless (gnus-check-backend-function + (unless (gnus-check-backend-function (intern (concat "request-" header)) gnus-newsgroup-name) (setq ofunc request-func) @@ -210,7 +210,7 @@ (point-max)))) (let* ((case-fold-search (not (eq (downcase (symbol-name type)) (symbol-name type)))) - (search-func + (search-func (cond ((memq type '(r R regexp Regexp)) 're-search-forward) ((memq type '(s S string String))
--- a/lisp/gnus/gnus-mh.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-mh.el Mon Aug 13 09:18:39 2007 +0200 @@ -59,7 +59,7 @@ gnus-newsgroup-last-folder) gnus-newsgroup-last-folder) (folder folder) - (t (mh-prompt-for-folder + (t (mh-prompt-for-folder "Save article in" (funcall gnus-folder-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-folder) @@ -71,7 +71,7 @@ (save-restriction (widen) (unwind-protect - (call-process-region + (call-process-region (point-min) (point-max) "rcvstore" nil errbuf nil folder) (set-buffer errbuf) (if (zerop (buffer-size))
--- a/lisp/gnus/gnus-move.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-move.el Mon Aug 13 09:18:39 2007 +0200 @@ -40,7 +40,7 @@ Update the .newsrc.eld file to reflect the change of nntp server." (interactive (list gnus-select-method (gnus-read-method "Move to method: "))) - + ;; First start Gnus. (let ((gnus-activate-level 0) (nnmail-spool-file nil)) @@ -77,7 +77,7 @@ (goto-char (point-min)) (while (looking-at "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (gnus-sethash + (gnus-sethash (buffer-substring (match-beginning 1) (match-end 1)) (read (current-buffer)) hashtb) @@ -86,7 +86,7 @@ (when (and (gnus-request-group group nil from-server) (gnus-active group) (setq type (gnus-retrieve-headers - (gnus-uncompress-range + (gnus-uncompress-range (gnus-active group)) group from-server))) ;; Make it easier to map marks. @@ -108,8 +108,8 @@ (goto-char (point-min)) (while (looking-at "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (setq to-article - (gnus-gethash + (setq to-article + (gnus-gethash (buffer-substring (match-beginning 1) (match-end 1)) hashtb)) ;; Add this article to the list of read articles. @@ -123,8 +123,8 @@ ;; Now we know what the read articles are and what the ;; article marks are. We transform the information ;; into the Gnus info format. - (setq to-reads - (gnus-range-add + (setq to-reads + (gnus-range-add (gnus-compress-sequence (sort to-reads '<) t) (cons 1 (1- (car to-active))))) (gnus-info-set-read info to-reads) @@ -152,7 +152,7 @@ (interactive (let ((info (gnus-get-info (gnus-group-group-name)))) (list info (gnus-find-method-for-group (gnus-info-group info)) - (gnus-read-method (format "Move group %s to method: " + (gnus-read-method (format "Move group %s to method: " (gnus-info-group info)))))) (save-excursion (gnus-move-group-to-server info from-server to-server) @@ -160,7 +160,7 @@ (gnus-info-set-method info to-server t) ;; We also have to change the name of the group and stuff. (let* ((group (gnus-info-group info)) - (new-name (gnus-group-prefixed-name + (new-name (gnus-group-prefixed-name (gnus-group-real-name group) to-server))) (gnus-info-set-group info new-name) (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb)
--- a/lisp/gnus/gnus-msg.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-msg.el Mon Aug 13 09:18:39 2007 +0200 @@ -48,7 +48,7 @@ "*All outgoing messages will be put in this group. If you want to store all your outgoing mail and articles in the group \"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. +can also be a list of group names. If you want to have greater control over what group to put each message in, you can set this variable to a function that checks the @@ -61,7 +61,7 @@ gatewayed to a newsgroup, and you want to followup to an article in the group.") -(defvar gnus-sent-message-ids-file +(defvar gnus-sent-message-ids-file (nnheader-concat gnus-directory "Sent-Message-IDs") "File where Gnus saves a cache of sent message ids.") @@ -173,7 +173,7 @@ (make-local-variable 'gnus-newsgroup-name) (run-hooks 'gnus-message-setup-hook)) (gnus-configure-windows ,config t)))) - + (defun gnus-inews-add-send-actions (winconf buffer article) (make-local-hook 'message-sent-hook) (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) @@ -227,8 +227,8 @@ (defun gnus-summary-followup (yank &optional force-news) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-set-global-variables) (when yank @@ -239,7 +239,7 @@ (gnus-newsgroup-name gnus-newsgroup-name)) ;; Send a followup. (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer + headers gnus-article-buffer yank nil force-news))) (defun gnus-summary-followup-with-original (n &optional force-news) @@ -249,8 +249,8 @@ (defun gnus-summary-followup-to-mail (&optional arg) "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-followup arg t)) @@ -375,7 +375,7 @@ (t 'message)) (let* ((group (or group gnus-newsgroup-name)) (pgroup group) - to-address to-group mailing-list to-list + to-address to-group mailing-list to-list newsgroup-p) (when group (setq to-address (gnus-group-find-parameter group 'to-address) @@ -389,7 +389,7 @@ (gnus-news-group-p to-group)) newsgroup-p force-news - (and (gnus-news-group-p + (and (gnus-news-group-p (or pgroup gnus-newsgroup-name) (if header (mail-header-number header) gnus-current-article)) @@ -418,8 +418,8 @@ "Return the posting method based on GROUP and ARG. If SILENT, don't prompt the user." (let ((group-method (gnus-find-method-for-group group))) - (cond - ;; If the group-method is nil (which shouldn't happen) we use + (cond + ;; If the group-method is nil (which shouldn't happen) we use ;; the default method. ((null group-method) (or gnus-post-method gnus-select-method message-post-method)) @@ -449,7 +449,7 @@ (push method post-methods))) ;; Create a name-method alist. (setq method-alist - (mapcar + (mapcar (lambda (m) (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) post-methods)) @@ -475,7 +475,7 @@ (widen) (narrow-to-region (goto-char (point-min)) - (or (and (re-search-forward + (or (and (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (match-beginning 0)) (point-max))) @@ -499,12 +499,12 @@ (load t t t))) (if (member message-id gnus-inews-sent-ids) ;; Reject this message. - (not (gnus-yes-or-no-p + (not (gnus-yes-or-no-p (format "Message %s already sent. Send anyway? " message-id))) (push message-id gnus-inews-sent-ids) ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length + (when (setq end (nthcdr gnus-sent-message-ids-length gnus-inews-sent-ids)) (setcdr end nil)) (nnheader-temp-write gnus-sent-message-ids-file @@ -540,8 +540,8 @@ ;; Written by "Mr. Per Persson" <pp@gnu.ai.mit.edu>. (defun gnus-inews-insert-mime-headers () (goto-char (point-min)) - (let ((mail-header-separator - (progn + (let ((mail-header-separator + (progn (goto-char (point-min)) (if (and (search-forward (concat "\n" mail-header-separator "\n") nil t) @@ -565,21 +565,21 @@ ;;; -;;; Gnus Mail Functions +;;; Gnus Mail Functions ;;; ;;; Mail reply commands of Gnus summary mode (defun gnus-summary-reply (&optional yank wide) "Start composing a reply mail to the current message. -If prefix argument YANK is non-nil, the original article is yanked +If prefix argument YANK is non-nil, the original article is yanked automatically." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) - (when yank + (when yank (gnus-summary-goto-subject (car yank))) (let ((gnus-article-reply t)) (gnus-setup-message (if yank 'reply-yank 'reply) @@ -598,10 +598,10 @@ (defun gnus-summary-wide-reply (&optional yank) "Start composing a wide reply mail to the current message. -If prefix argument YANK is non-nil, the original article is yanked +If prefix argument YANK is non-nil, the original article is yanked automatically." - (interactive - (list (and current-prefix-arg + (interactive + (list (and current-prefix-arg (gnus-summary-work-articles 1)))) (gnus-summary-reply yank t)) @@ -640,7 +640,7 @@ (interactive "P") (gnus-summary-mail-forward full-headers t)) -(defvar gnus-nastygram-message +(defvar gnus-nastygram-message "The following article was inappropriately posted to %s.\n\n" "Format string to insert in nastygrams. The current group name will be inserted at \"%s\".") @@ -649,7 +649,7 @@ "Send a nastygram to the author of the current article." (interactive "P") (when (or gnus-expert-user - (gnus-y-or-n-p + (gnus-y-or-n-p "Really send a nastygram to the author of the current article? ")) (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) @@ -705,7 +705,7 @@ (setq beg (point)) (skip-chars-forward "^,") (while (zerop - (save-excursion + (save-excursion (save-restriction (let ((i 0)) (narrow-to-region beg (point)) @@ -729,7 +729,7 @@ (when (and to-address (gnus-alive-p)) ;; This mail group doesn't have a `to-list', so we add one - ;; here. Magic! + ;; here. Magic! (gnus-group-add-parameter group (cons 'to-list to-address))))) (defun gnus-put-message () @@ -738,7 +738,7 @@ (let ((reply gnus-article-reply) (winconf gnus-prev-winconf) (group gnus-newsgroup-name)) - + (or (and group (not (gnus-group-read-only-p group))) (setq group (read-string "Put in group: " nil (gnus-writable-groups)))) @@ -763,7 +763,7 @@ (when (gnus-buffer-exists-p (car-safe reply)) (set-buffer (car reply)) (and (cdr reply) - (gnus-summary-mark-article-as-replied + (gnus-summary-mark-article-as-replied (cdr reply)))) (when winconf (set-window-configuration winconf))))) @@ -772,7 +772,7 @@ "Send a reply to the address near point. If YANK is non-nil, include the original article." (interactive "P") - (let ((address + (let ((address (buffer-substring (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) @@ -890,15 +890,16 @@ (let* ((references (mail-fetch-field "references")) (parent (and references (gnus-parent-id references)))) (message-bounce) - ;; If there are references, we fetch the article we answered to. + ;; If there are references, we fetch the article we answered to. (and fetch parent (gnus-summary-refer-article parent) (gnus-summary-show-all-headers))))) ;;; Gcc handling. -;; Do Gcc handling, which copied the message over to some group. +;; Do Gcc handling, which copied the message over to some group. (defun gnus-inews-do-gcc (&optional gcc) + (interactive) (when (gnus-alive-p) (save-excursion (save-restriction @@ -912,11 +913,11 @@ (setq groups (message-tokenize-header gcc " ,")) ;; Copy the article over to some group(s). (while (setq group (pop groups)) - (gnus-check-server + (gnus-check-server (setq method (cond ((and (null (gnus-get-info group)) (eq (car gnus-message-archive-method) - (car + (car (gnus-server-to-method (gnus-group-method group))))) ;; If the group doesn't exist, we assume @@ -934,12 +935,12 @@ (nnheader-set-temp-buffer " *acc*") (insert-buffer-substring cur) (goto-char (point-min)) - (when (re-search-forward + (when (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (replace-match "" t t )) (unless (gnus-request-accept-article group method t) - (gnus-message 1 "Couldn't store article in group %s: %s" + (gnus-message 1 "Couldn't store article in group %s: %s" group (gnus-status-message method)) (sit-for 2)) (kill-buffer (current-buffer)))))))))) @@ -950,7 +951,7 @@ (save-restriction (gnus-inews-narrow-to-headers) (let* ((group gnus-outgoing-message-group) - (gcc (cond + (gcc (cond ((gnus-functionp group) (funcall group)) ((or (stringp group) (list group)) @@ -968,7 +969,7 @@ result gcc-self-val (groups - (cond + (cond ((null gnus-message-archive-method) ;; Ignore. nil) @@ -989,7 +990,7 @@ (while (and var (not (setq result - (cond + (cond ((stringp (caar var)) ;; Regexp. (when (string-match (caar var) group) @@ -1014,7 +1015,7 @@ (setq gcc-self-val (gnus-group-find-parameter gnus-newsgroup-name 'gcc-self))) - (progn + (progn (insert (if (stringp gcc-self-val) gcc-self-val @@ -1027,7 +1028,7 @@ (while (setq name (pop groups)) (insert (if (string-match ":" name) name - (gnus-group-prefixed-name + (gnus-group-prefixed-name name gnus-message-archive-method))) (when groups (insert " "))) @@ -1038,7 +1039,7 @@ (interactive) (gnus-set-global-variables) (let (buf) - (if (not (setq buf (gnus-request-restore-buffer + (if (not (setq buf (gnus-request-restore-buffer (gnus-summary-article-number) gnus-newsgroup-name))) (error "Couldn't restore the article") (switch-to-buffer buf) @@ -1053,12 +1054,12 @@ (let ((gnus-draft-buffer (current-buffer))) (gnus-configure-windows 'draft t) (goto-char (point)))))) - + (gnus-add-shutdown 'gnus-inews-close 'gnus) (defun gnus-inews-close () (setq gnus-inews-sent-ids nil)) - + ;;; Allow redefinition of functions. (gnus-ems-redefine)
--- a/lisp/gnus/gnus-nocem.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-nocem.el Mon Aug 13 09:18:39 2007 +0200 @@ -35,14 +35,14 @@ "NoCeM pseudo-cancellation treatment" :group 'gnus-score) -(defcustom gnus-nocem-groups +(defcustom gnus-nocem-groups '("news.lists.filters" "news.admin.net-abuse.bulletins" "alt.nocem.misc" "news.admin.net-abuse.announce") "List of groups that will be searched for NoCeM messages." :group 'gnus-nocem :type '(repeat (string :tag "Group"))) -(defcustom gnus-nocem-issuers +(defcustom gnus-nocem-issuers '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] "rbraver@ohww.norman.ok.us" ; Robert Braver "clewis@ferret.ocunix.on.ca;" ; Chris Lewis @@ -54,7 +54,7 @@ :group 'gnus-nocem :type '(repeat string)) -(defcustom gnus-nocem-directory +(defcustom gnus-nocem-directory (nnheader-concat gnus-article-save-directory "NoCeM/") "*Directory where NoCeM files will be stored." :group 'gnus-nocem @@ -110,7 +110,7 @@ (ignore-errors (load (gnus-nocem-active-file) t t t))) ;; Go through all groups and see whether new articles have - ;; arrived. + ;; arrived. (while (setq group (pop groups)) (if (not (setq gactive (gnus-activate-group group))) () ; This group doesn't exist. @@ -126,15 +126,15 @@ (nnheader-temp-write nil (setq headers (if (eq 'nov - (gnus-retrieve-headers + (gnus-retrieve-headers (setq articles (gnus-uncompress-range - (cons + (cons (if active (1+ (cdr active)) (car gactive)) (cdr gactive)))) group)) - (gnus-get-newsgroup-headers-xover + (gnus-get-newsgroup-headers-xover articles nil dependencies) (gnus-get-newsgroup-headers dependencies))) (while (setq header (pop headers)) @@ -167,7 +167,7 @@ (let ((date (mail-header-date header)) issuer b e) (when (or (not date) - (nnmail-time-less + (nnmail-time-less (nnmail-time-since (nnmail-date-to-time date)) (nnmail-days-to-time gnus-nocem-expiry-wait))) (gnus-request-article-this-buffer (mail-header-number header) group) @@ -245,11 +245,11 @@ (interactive) (unless gnus-nocem-alist ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. + ;; cache. (when (file-exists-p (gnus-nocem-cache-file)) (load (gnus-nocem-cache-file) t t t) (gnus-nocem-alist-to-hashtb)))) - + (defun gnus-nocem-save-cache () "Save the NoCeM cache." (when (and gnus-nocem-alist
--- a/lisp/gnus/gnus-picon.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-picon.el Mon Aug 13 09:18:39 2007 +0200 @@ -29,6 +29,8 @@ (require 'xpm) (require 'annotations) (require 'custom) +(require 'gnus-art) +(require 'gnus-win) (defgroup picons nil "Show pictures of people, domains, and newsgroups (XEmacs). @@ -50,7 +52,7 @@ :group 'picons) (defcustom gnus-picons-database "/usr/local/faces" - "Defines the location of the faces database. + "Defines the location of the faces database. For information on obtaining this database of pretty pictures, please see http://www.cs.indiana.edu/picons/ftp/index.html" :type 'directory @@ -67,7 +69,7 @@ :group 'picons) (defcustom gnus-picons-domain-directories '("domains") - "List of directories to search for domain faces. + "List of directories to search for domain faces. Some people may want to add \"unknown\" to this list." :type '(repeat string) :group 'picons) @@ -77,7 +79,7 @@ :type 'boolean :group 'picons) -(defcustom gnus-picons-x-face-file-name +(defcustom gnus-picons-x-face-file-name (format "/tmp/picon-xface.%s.xbm" (user-login-name)) "The name of the file in which to store the converted X-face header." :type 'string @@ -117,7 +119,7 @@ (define-key gnus-picons-map [(button2)] 'gnus-picons-toggle-extent) ;;; Internal variables. - + (defvar gnus-group-annotations nil) (defvar gnus-article-annotations nil) (defvar gnus-x-face-annotations nil) @@ -178,7 +180,7 @@ (sleep-for .1))) ;; display it (save-excursion - (set-buffer (get-buffer-create (gnus-get-buffer-name + (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) (gnus-add-current-to-buffer-list) (goto-char (point-min)) @@ -187,7 +189,7 @@ (push (make-annotation "\n" (point) 'text) gnus-x-face-annotations)) ;; append the annotation to gnus-article-annotations for deletion. - (setq gnus-x-face-annotations + (setq gnus-x-face-annotations (append (gnus-picons-try-to-find-face gnus-picons-x-face-file-name t) gnus-x-face-annotations))) @@ -205,7 +207,7 @@ (when (and (featurep 'xpm) (or (not (fboundp 'device-type)) (equal (device-type) 'x)) (setq from (mail-fetch-field "from")) - (setq from (downcase + (setq from (downcase (or (cadr (mail-extract-address-components from)) ""))) (or (setq at-idx (string-match "@" from)) @@ -217,7 +219,7 @@ (nreverse (message-tokenize-header gnus-local-domain ".")) '("")) - (nreverse (message-tokenize-header + (nreverse (message-tokenize-header (substring from (1+ at-idx)) "."))))) (set-buffer (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) @@ -230,7 +232,7 @@ (unless (eolp) (push (make-annotation "\n" (point) 'text) gnus-article-annotations))) - + (gnus-picons-remove gnus-article-annotations) (setq gnus-article-annotations nil) @@ -241,7 +243,7 @@ (nconc (gnus-picons-insert-face-if-exists (car databases) addrs - "unknown" (or gnus-picons-display-as-address + "unknown" (or gnus-picons-display-as-address gnus-article-annotations) t t) gnus-article-annotations)) (setq databases (cdr databases))) @@ -250,7 +252,7 @@ (when gnus-picons-display-as-address (setq gnus-article-annotations (nconc gnus-article-annotations - (list + (list (make-annotation "@" (point) 'text nil nil nil t))))) ;; then do user directories, @@ -260,23 +262,23 @@ (while databases (setq found (nconc (gnus-picons-insert-face-if-exists - (car databases) addrs username - (or gnus-picons-display-as-address + (car databases) addrs username + (or gnus-picons-display-as-address gnus-article-annotations) nil t) found)) (setq databases (cdr databases))) ;; add their name if no face exists (when (and gnus-picons-display-as-address (not found)) (setq found - (list + (list (make-annotation username (point) 'text nil nil nil t)))) - (setq gnus-article-annotations + (setq gnus-article-annotations (nconc found gnus-article-annotations))) (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) (defun gnus-group-display-picons () - "Display icons for the group in the gnus-picons-display-where buffer." + "Display icons for the group in the gnus-picons-display-where buffer." (interactive) ;; let display catch up so far (when gnus-picons-refresh-before-display @@ -326,8 +328,8 @@ ;; '(gnus-picons-insert-face-if-exists ;; "Database" '("edu" "indiana" "cs") "Name") ;; looks for: - ;; 1. edu/indiana/cs/Name - ;; 2. edu/indiana/Name + ;; 1. edu/indiana/cs/Name + ;; 2. edu/indiana/Name ;; 3. edu/Name ;; '(gnus-picons-insert-face-if-exists ;; "Database/MISC" '("edu" "indiana" "cs") "Name") @@ -337,7 +339,7 @@ ;; picon databases, but otherwise we would always see the MISC/unknown face. (let ((bar (and (not nobar-p) (or gnus-picons-display-as-address - (annotations-in-region + (annotations-in-region (point) (min (point-max) (1+ (point))) (current-buffer))))) (path (concat (file-name-as-directory gnus-picons-database) @@ -350,32 +352,32 @@ (file-accessible-directory-p path)) (setq cur (pop addrs) path (concat path cur "/")) - (if (setq found + (if (setq found (gnus-picons-try-suffixes (concat path filename "/face."))) - (progn + (progn (setq picons (nconc (when (and domainp first rightp) (list (make-annotation - "." (point) 'text + "." (point) 'text nil nil nil rightp) picons)) - (gnus-picons-try-to-find-face + (gnus-picons-try-to-find-face found nil (if domainp cur filename) rightp) (when (and domainp first (not rightp)) (list (make-annotation - "." (point) 'text + "." (point) 'text nil nil nil rightp) picons)) picons))) (when domainp - (setq picons - (nconc (list (make-annotation - (if first (concat (if (not rightp) ".") cur + (setq picons + (nconc (list (make-annotation + (if first (concat (if (not rightp) ".") cur (if rightp ".")) cur) (point) 'text nil nil nil rightp)) picons)))) (when (and bar (or domainp found)) - (setq bar-ann (gnus-picons-try-to-find-face - (concat gnus-xmas-glyph-directory "bar.xbm") + (setq bar-ann (gnus-picons-try-to-find-face + (concat gnus-xmas-glyph-directory "bar.xbm") nil nil t)) (when bar-ann (setq picons (nconc picons bar-ann)) @@ -383,13 +385,13 @@ (setq first t)) (when (and addrs domainp) (let ((it (mapconcat 'downcase (nreverse addrs) "."))) - (make-annotation - (if first (concat (if (not rightp) ".") it (if rightp ".")) it) + (make-annotation + (if first (concat (if (not rightp) ".") it (if rightp ".")) it) (point) 'text nil nil nil rightp))) picons)) (defvar gnus-picons-glyph-alist nil) - + (defun gnus-picons-try-to-find-face (path &optional xface-p part rightp) "If PATH exists, display it as a bitmap. Returns t if succeeded." (let ((glyph (and (not xface-p)
--- a/lisp/gnus/gnus-range.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-range.el Mon Aug 13 09:18:39 2007 +0200 @@ -263,7 +263,7 @@ (defun gnus-range-add (range1 range2) "Add RANGE2 to RANGE1 destructively." - (cond + (cond ;; If either are nil, then the job is quite easy. ((or (null range1) (null range2)) (or range1 range2))
--- a/lisp/gnus/gnus-salt.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-salt.el Mon Aug 13 09:18:39 2007 +0200 @@ -133,7 +133,7 @@ (save-excursion (set-buffer gnus-summary-buffer) gnus-pick-mode)) - (message-add-action + (message-add-action '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill))) (defvar gnus-pick-line-number 1) @@ -153,7 +153,7 @@ (when (or catch-up gnus-mark-unpicked-articles-as-read) (gnus-summary-limit-mark-excluded-as-read)) (gnus-summary-first-article) - (gnus-configure-windows + (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) (if gnus-pick-elegant-flow (progn @@ -315,7 +315,7 @@ (interactive "P") (when (eq major-mode 'gnus-summary-mode) (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode + (setq gnus-binary-mode (if (null arg) (not gnus-binary-mode) (> (prefix-numeric-value arg) 0))) (when gnus-binary-mode @@ -381,7 +381,7 @@ ;;; Internal variables. -(defvar gnus-tree-line-format-alist +(defvar gnus-tree-line-format-alist `((?n gnus-tmp-name ?s) (?f gnus-tmp-from ?s) (?N gnus-tmp-number ?d) @@ -426,11 +426,11 @@ (defun gnus-tree-mode () "Major mode for displaying thread trees." (interactive) - (setq gnus-tree-mode-line-format-spec - (gnus-parse-format gnus-tree-mode-line-format + (setq gnus-tree-mode-line-format-spec + (gnus-parse-format gnus-tree-mode-line-format gnus-summary-mode-line-format-alist)) - (setq gnus-tree-line-format-spec - (gnus-parse-format gnus-tree-line-format + (setq gnus-tree-line-format-spec + (gnus-parse-format gnus-tree-line-format gnus-tree-line-format-alist t)) (when (gnus-visual-p 'tree-menu 'menu) (gnus-tree-make-menu-bar)) @@ -509,7 +509,7 @@ ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start - tree-window (min bottom (save-excursion + tree-window (min bottom (save-excursion (forward-line (- top)) (point))))) (select-window selected)))) @@ -528,7 +528,7 @@ (let ((windows 0) tot-win-height) (walk-windows (lambda (window) (incf windows))) - (setq tot-win-height + (setq tot-win-height (- (frame-height) (* window-min-height (1- windows)) 2)) @@ -613,8 +613,8 @@ (not (eval (caar list)))) (setq list (cdr list))))) (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face + (gnus-put-text-property + beg end 'face (if (boundp face) (symbol-value face) face))))) (defun gnus-tree-indent (level) @@ -757,8 +757,8 @@ (let ((top (save-excursion (set-buffer gnus-summary-buffer) (gnus-cut-thread - (gnus-remove-thread - (mail-header-id + (gnus-remove-thread + (mail-header-id (gnus-summary-article-header article)) t)))) (gnus-tmp-limit gnus-newsgroup-limit) @@ -788,7 +788,7 @@ (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) 'face gnus-selected-tree-face)) ;; Move the overlay to the article. - (gnus-move-overlay + (gnus-move-overlay gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) (gnus-tree-minimize) (gnus-tree-recenter) @@ -809,7 +809,7 @@ (let (region) (when (setq region (gnus-tree-article-region article)) (gnus-put-text-property (car region) (cdr region) 'face face) - (set-window-point + (set-window-point (get-buffer-window (current-buffer) t) (cdr region)))))) ;;; @@ -841,7 +841,7 @@ ("exit" . gnus-group-exit))) (defvar gnus-carpal-summary-buffer-buttons - '("mark" + '("mark" ("read" . gnus-summary-mark-as-read-forward) ("tick" . gnus-summary-tick-article-forward) ("clear" . gnus-summary-clear-mark-forward) @@ -874,7 +874,7 @@ ("exit" . gnus-summary-exit) ("fed-up" . gnus-summary-catchup-and-goto-next-group))) -(defvar gnus-carpal-server-buffer-buttons +(defvar gnus-carpal-server-buffer-buttons '(("add" . gnus-server-add-server) ("browse" . gnus-server-browse-server) ("list" . gnus-server-list-servers) @@ -941,10 +941,10 @@ (save-excursion (set-buffer (get-buffer-create buffer)) (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer + (setq gnus-carpal-attached-buffer (intern (format "gnus-%s-buffer" type))) (gnus-add-current-to-buffer-list) - (let ((buttons (symbol-value + (let ((buttons (symbol-value (intern (format "gnus-carpal-%s-buffer-buttons" type)))) (buffer-read-only nil)
--- a/lisp/gnus/gnus-score.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-score.el Mon Aug 13 09:18:39 2007 +0200 @@ -180,7 +180,7 @@ * A function. If the function returns non-nil, the result will be used - as the home score file. The function will be passed the + as the home score file. The function will be passed the name of the group as its parameter. * A string. Use the string as the home score file. @@ -205,7 +205,7 @@ function)) function)) -(defcustom gnus-default-adaptive-score-alist +(defcustom gnus-default-adaptive-score-alist '((gnus-kill-file-mark) (gnus-unread-mark) (gnus-read-mark (from 3) (subject 30)) @@ -245,7 +245,7 @@ :group 'gnus-score-adapt :type '(repeat string)) -(defcustom gnus-default-adaptive-word-score-alist +(defcustom gnus-default-adaptive-word-score-alist `((,gnus-read-mark . 30) (,gnus-catchup-mark . -10) (,gnus-killed-mark . -20) @@ -387,7 +387,7 @@ (defvar gnus-score-alist nil "Alist containing score information. -The keys can be symbols or strings. The following symbols are defined. +The keys can be symbols or strings. The following symbols are defined. touched: If this alist has been modified. mark: Automatically mark articles below this. @@ -469,7 +469,7 @@ (let* ((nscore (gnus-score-default score)) (prefix (if (< nscore 0) ?L ?I)) (increase (> nscore 0)) - (char-to-header + (char-to-header '((?a "from" nil nil string) (?s "subject" nil nil string) (?b "body" "" nil body-string) @@ -498,21 +498,21 @@ (list (list ?t (current-time-string) "temporary") '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) - (hchar (and gnus-score-default-header + (hchar (and gnus-score-default-header (aref (symbol-name gnus-score-default-header) 0))) (tchar (and gnus-score-default-type (aref (symbol-name gnus-score-default-type) 0))) (pchar (and gnus-score-default-duration (aref (symbol-name gnus-score-default-duration) 0))) entry temporary type match) - + (unwind-protect (progn ;; First we read the header to score. (while (not hchar) (if mimic - (progn + (progn (sit-for 1) (message "%c-" prefix)) (message "%s header (%s?): " (if increase "Increase" "Lower") @@ -532,7 +532,7 @@ (if mimic (message "%c %c" prefix hchar) (message "")) (setq tchar (or tchar ?s) pchar (or pchar ?t))) - + ;; We continue reading - the type. (while (not tchar) (if mimic @@ -593,7 +593,7 @@ (eq tchar 114) (eq (- pchar 4) 111)) (error "You rang?")) - (if mimic + (if mimic (error "%c %c %c %c" prefix hchar tchar pchar) (error "")))) ;; Always kill the score help buffer. @@ -602,15 +602,15 @@ ;; We have all the data, so we enter this score. (setq match (if (string= (nth 2 entry) "") "" (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) - + ;; Modify the match, perhaps. - (cond + (cond ((equal (nth 1 entry) "xref") (when (string-match "^Xref: *" match) (setq match (substring match (match-end 0)))) (when (string-match "^[^:]* +" match) (setq match (substring match (match-end 0)))))) - + (when (memq type '(r R regexp Regexp)) (setq match (regexp-quote match))) @@ -624,7 +624,7 @@ temporary) (not (nth 3 entry))) ; Prompt )) - + (defun gnus-score-insert-help (string alist idx) (setq gnus-score-help-winconf (current-window-configuration)) (save-excursion @@ -646,7 +646,7 @@ (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end (setq n (/ (1- (window-width)) max)) ; items per line (setq width (/ (1- (window-width)) n)) ; width of each item - ;; insert `n' items, each in a field of width `width' + ;; insert `n' items, each in a field of width `width' (while alist (if (< i n) () @@ -665,7 +665,7 @@ (let ((window-min-height 1)) (shrink-window-if-larger-than-buffer)) (select-window (get-buffer-window gnus-summary-buffer)))) - + (defun gnus-summary-header (header &optional no-err) ;; Return HEADER for current articles, or error. (let ((article (gnus-summary-article-number)) @@ -683,7 +683,7 @@ (defun gnus-newsgroup-score-alist () (or - (let ((param-file (gnus-group-find-parameter + (let ((param-file (gnus-group-find-parameter gnus-newsgroup-name 'score-file))) (when param-file (gnus-score-load param-file))) @@ -693,8 +693,8 @@ (defsubst gnus-score-get (symbol &optional alist) ;; Get SYMBOL's definition in ALIST. - (cdr (assoc symbol - (or alist + (cdr (assoc symbol + (or alist gnus-score-alist (gnus-newsgroup-score-alist))))) @@ -734,8 +734,8 @@ (header (format "%s" (downcase header))) new) (when prompt - (setq match (read-string - (format "Match %s on %s, %s: " + (setq match (read-string + (format "Match %s on %s, %s: " (cond ((eq date 'now) "now") ((stringp date) @@ -750,7 +750,7 @@ ;; Get rid of string props. (setq match (format "%s" match)) - ;; If this is an integer comparison, we transform from string to int. + ;; If this is an integer comparison, we transform from string to int. (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) (setq match (string-to-int match))) @@ -761,7 +761,7 @@ (let ((old (gnus-score-get header)) elem) (setq new - (cond + (cond (type (list match score (and date (if (numberp date) date @@ -821,7 +821,7 @@ match) ((eq type 'e) (concat "\\`" (regexp-quote match) "\\'")) - (t + (t (regexp-quote match))))) (while (not (eobp)) (let ((content (gnus-summary-header header 'noerr)) @@ -846,8 +846,8 @@ (error "This article is not crossposted")) (while (string-match " \\([^ \t]+\\):" xref start) (setq start (match-end 0)) - (when (not (string= - (setq group + (when (not (string= + (setq group (substring xref (match-beginning 1) (match-end 1))) gnus-newsgroup-name)) (gnus-summary-score-entry @@ -863,7 +863,7 @@ ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>. (defun gnus-score-set-mark-below (score) "Automatically mark articles with score below SCORE as read." - (interactive + (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Mark below: "))))) (setq score (or score gnus-summary-default-score 0)) @@ -897,7 +897,7 @@ (defun gnus-score-set-expunge-below (score) "Automatically expunge articles with score below SCORE." - (interactive + (interactive (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) (string-to-int (read-string "Set expunge below: "))))) (setq score (or score gnus-summary-default-score 0)) @@ -936,8 +936,8 @@ (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. - (let* ((alist - (or alist + (let* ((alist + (or alist gnus-score-alist (gnus-newsgroup-score-alist))) (entry (assoc symbol alist))) @@ -986,7 +986,7 @@ (defun gnus-score-change-score-file (file) "Change current score alist." - (interactive + (interactive (list (read-file-name "Change to score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) @@ -1006,13 +1006,13 @@ (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys + (gnus-message + 4 (substitute-command-keys "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))) - + (defun gnus-score-edit-file (file) "Edit a score file." - (interactive + (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-make-directory (file-name-directory file)) (when (buffer-name gnus-summary-buffer) @@ -1024,13 +1024,13 @@ (setq gnus-score-edit-exit-function 'gnus-score-edit-done) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys + (gnus-message + 4 (substitute-command-keys "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))) - + (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. - (let* ((file (expand-file-name + (let* ((file (expand-file-name (or (and (string-match (concat "^" (expand-file-name gnus-kill-files-directory)) @@ -1048,7 +1048,7 @@ (setq gnus-score-alist nil) (setq alist (gnus-score-load-score-alist file)) ;; We add '(touched) to the alist to signify that it hasn't been - ;; touched (yet). + ;; touched (yet). (unless (assq 'touched alist) (push (list 'touched nil) alist)) ;; If it is a global score file, we make it read-only. @@ -1084,12 +1084,12 @@ (eval (car (gnus-score-get 'eval alist)))) ;; Perform possible decays. (when (and gnus-decay-scores - (gnus-decay-scores + (gnus-decay-scores alist (or decay (gnus-time-to-day (current-time))))) (gnus-score-set 'touched '(t) alist) (gnus-score-set 'decay (list (gnus-time-to-day (current-time))))) ;; We do not respect eval and files atoms from global score - ;; files. + ;; files. (and files (not global) (setq lists (apply 'append lists (mapcar (lambda (file) @@ -1098,9 +1098,9 @@ files))))) (and eval (not global) (eval eval)) ;; We then expand any exclude-file directives. - (setq gnus-scores-exclude-files - (nconc - (mapcar + (setq gnus-scores-exclude-files + (nconc + (mapcar (lambda (sfile) (expand-file-name sfile (file-name-directory file))) exclude-files) @@ -1130,13 +1130,13 @@ (t ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) - (setq gnus-thread-expunge-below + (setq gnus-thread-expunge-below (or thread-mark-and-expunge gnus-thread-expunge-below)) - (setq gnus-summary-mark-below + (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) - (setq gnus-summary-expunge-below + (setq gnus-summary-expunge-below (or expunge mark-and-expunge gnus-summary-expunge-below)) - (setq gnus-newsgroup-adaptive-score-file + (setq gnus-newsgroup-adaptive-score-file (or adapt-file gnus-newsgroup-adaptive-score-file))) (setq gnus-current-score-file file) (setq gnus-score-alist alist) @@ -1154,7 +1154,7 @@ (push (cons file gnus-score-alist) gnus-score-cache)))) (defun gnus-score-remove-from-cache (file) - (setq gnus-score-cache + (setq gnus-score-cache (delq (assoc file gnus-score-cache) gnus-score-cache))) (defun gnus-score-load-score-alist (file) @@ -1173,7 +1173,7 @@ (setq alist (condition-case () (read (current-buffer)) - (error + (error (gnus-error 3.2 "Problem with score file %s" file)))))) (if (eq (car alist) 'setq) ;; This is an old-style score file. @@ -1185,7 +1185,7 @@ (defun gnus-score-check-syntax (alist file) "Check the syntax of the score ALIST." - (cond + (cond ((null alist) nil) ((not (consp alist)) @@ -1202,14 +1202,14 @@ ((not (listp (car a))) (format "Illegal score element %s in %s" (car a) file)) ((stringp (caar a)) - (cond + (cond ((not (listp (setq sr (cdar a)))) (format "Illegal header match %s in %s" (nth 1 (car a)) file)) (t (setq type (caar a)) (while (and sr (not err)) (setq s (pop sr)) - (setq + (setq err (cond ((if (member (downcase type) '("lines" "chars")) @@ -1255,7 +1255,7 @@ out)) (setq alist (cdr alist))) (cons (list 'touched t) (nreverse out)))) - + (defun gnus-score-save () ;; Save all score information. (let ((cache gnus-score-cache) @@ -1276,7 +1276,7 @@ (setq score (setcdr entry (delq (assq 'touched score) score))) (erase-buffer) (let (emacs-lisp-mode-hook) - (if (string-match + (if (string-match (concat (regexp-quote gnus-adaptive-file-suffix) "$") file) @@ -1285,13 +1285,13 @@ ;; are not meant to be edited by human hands. (gnus-prin1 score) ;; This is a normal score file, so we print it very - ;; prettily. + ;; prettily. (pp score (current-buffer)))) (gnus-make-directory (file-name-directory file)) ;; If the score file is empty, we delete it. (if (zerop (buffer-size)) (delete-file file) - ;; There are scores, so we write the file. + ;; There are scores, so we write the file. (when (file-writable-p file) (gnus-write-buffer file) (when gnus-score-after-write-file-function @@ -1365,8 +1365,8 @@ ;; Set the global variant of this variable. (setq gnus-current-score-file current-score-file) ;; score orphans - (when gnus-orphan-score - (setq gnus-score-index + (when gnus-orphan-score + (setq gnus-score-index (nth 1 (assoc "references" gnus-header-index))) (gnus-score-orphans gnus-orphan-score)) ;; Run each header through the score process. @@ -1401,7 +1401,7 @@ (when (listp (caar score)) (gnus-score-advanced (car score) trace)) (pop score)))) - + (gnus-message 5 "Scoring...done")))))) @@ -1422,7 +1422,7 @@ (defun gnus-score-orphans (score) (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) alike articles art arts this last this-id) - + (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) articles gnus-scores-articles) @@ -1471,7 +1471,7 @@ arts (cdr arts)) (setcdr art (+ score (cdr art)))) (forward-line)))))) - + (defun gnus-score-integer (scores header now expire &optional trace) (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) @@ -1501,10 +1501,10 @@ ;; matches on numbers that any cleverness will take more ;; time than one would gain. (while articles - (when (funcall match-func + (when (funcall match-func (or (aref (caar articles) gnus-score-index) 0) match) - (when trace + (when trace (push (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) (setq found t) @@ -1602,7 +1602,7 @@ (setq last (mail-header-number (caar (last articles)))) ;; Not all backends support partial fetching. In that case, ;; we just fetch the entire article. - (unless (gnus-check-backend-function + (unless (gnus-check-backend-function (and (string-match "^gnus-" (symbol-name request-func)) (intern (substring (symbol-name request-func) (match-end 0)))) @@ -1640,10 +1640,10 @@ gnus-score-interactive-default-score)) (date (nth 2 kill)) (found nil) - (case-fold-search + (case-fold-search (not (or (eq type 'R) (eq type 'S) (eq type 'Regexp) (eq type 'String)))) - (search-func + (search-func (cond ((or (eq type 'r) (eq type 'R) (eq type 'regexp) (eq type 'Regexp)) 're-search-forward) @@ -1665,7 +1665,7 @@ (unless trace (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) + ((and found gnus-update-score-entry-dates) ;; Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) @@ -1695,7 +1695,7 @@ (set-buffer gnus-summary-buffer) (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name + (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) @@ -1716,7 +1716,7 @@ (when last ; Bwadr, duplicate code. (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike)) - + ;; Find matches. (while scores (setq alist (car scores) @@ -1731,10 +1731,10 @@ (date (nth 2 kill)) (found nil) (mt (aref (symbol-name type) 0)) - (case-fold-search + (case-fold-search (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) (dmt (downcase mt)) - (search-func + (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) (t (error "Illegal match type: %s" type)))) @@ -1747,13 +1747,13 @@ (= (progn (end-of-line) (point)) (match-end 0)) (progn - (setq found (setq arts (get-text-property + (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (while arts (setq art (car arts) arts (cdr arts)) - (gnus-score-add-followups + (gnus-score-add-followups (car art) score all-scores thread)))) (end-of-line)) (while (funcall search-func match nil t) @@ -1795,7 +1795,7 @@ (assoc id entry) (setq dont t))) (unless dont - (gnus-summary-score-entry + (gnus-summary-score-entry (if thread "thread" "references") id 's score (current-time-string) nil t))))) @@ -1803,11 +1803,11 @@ ;; Score ARTICLES according to HEADER in SCORE-LIST. ;; Update matching entries to NOW and remove unmatched entries older ;; than EXPIRE. - + ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles + alike last this art entries alist articles fuzzies arts words kill) ;; Sorting the articles costs os O(N*log N) but will allow us to @@ -1855,7 +1855,7 @@ (mt (aref (symbol-name type) 0)) (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) (dmt (downcase mt)) - (search-func + (search-func (cond ((= dmt ?r) 're-search-forward) ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ((= dmt ?w) nil) @@ -1878,14 +1878,14 @@ (= (gnus-point-at-bol) (match-beginning 0)) ;; Yup. (progn - (setq found (setq arts (get-text-property + (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. (if trace (while (setq art (pop arts)) (setcdr art (+ score (cdr art))) (push - (cons + (cons (car-safe (rassq alist gnus-score-cache)) kill) gnus-score-trace)) @@ -1914,7 +1914,7 @@ ;; Update expiry date (if trace (setq entries (cdr entries)) - (cond + (cond ;; Permanent entry. ((null date) (setq entries (cdr entries))) @@ -1953,7 +1953,7 @@ (while (setq art (pop arts)) (setcdr art (+ score (cdr art))) (push (cons - (car-safe (rassq (cdar fuzzies) gnus-score-cache)) + (car-safe (rassq (cdar fuzzies) gnus-score-cache)) kill) gnus-score-trace)) ;; Found a match, update scores. @@ -2024,7 +2024,7 @@ (set-syntax-table gnus-adaptive-word-syntax-table) (while (re-search-forward "\\b\\w+\\b" nil t) (setq val - (gnus-gethash + (gnus-gethash (setq word (downcase (buffer-substring (match-beginning 0) (match-end 0)))) hashtb)) @@ -2047,7 +2047,7 @@ (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) - (if score-file + (if score-file (gnus-short-group-name (file-name-nondirectory score-file)) "none"))) @@ -2057,9 +2057,9 @@ ;; We change the score file to the adaptive score file. (save-excursion (set-buffer gnus-summary-buffer) - (gnus-score-load-file + (gnus-score-load-file (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name + (gnus-score-file-name gnus-newsgroup-name gnus-adaptive-file-suffix)))) ;; Perform ordinary line scoring. (when (or (not (listp gnus-newsgroup-adaptive)) @@ -2085,8 +2085,8 @@ (cdar elem))) (setcar (car elem) `(lambda (h) - (,(intern - (concat "mail-header-" + (,(intern + (concat "mail-header-" (if (eq (caar elem) 'followup) "message-id" (downcase (symbol-name (caar elem)))))) @@ -2100,9 +2100,9 @@ (gnus-data-pseudo-p (car data))) () (when (setq headers (gnus-data-header (car data))) - (while elem + (while elem (setq match (funcall (caar elem) headers)) - (gnus-summary-score-entry + (gnus-summary-score-entry (nth 1 (car elem)) match (cond ((numberp match) @@ -2111,10 +2111,10 @@ 'a) (t ;; Whether we use substring or exact matches is - ;; controlled here. + ;; controlled here. (if (or (not gnus-score-exact-adapt-limit) (< (length match) gnus-score-exact-adapt-limit)) - 'e + 'e (if (equal (nth 1 (car elem)) "subject") 'f 's)))) (nth 2 (car elem)) date nil t) @@ -2138,7 +2138,7 @@ (when (and (not (gnus-data-pseudo-p d)) (setq score - (cdr (assq + (cdr (assq (gnus-data-mark d) gnus-adaptive-word-score-alist)))) ;; This article has a mark that should lead to @@ -2246,7 +2246,7 @@ (setq gnus-newsgroup-scored nil) (gnus-possibly-score-headers) (gnus-score-update-all-lines)) - + (defun gnus-score-flush-cache () "Flush the cache of score files." (interactive) @@ -2325,25 +2325,25 @@ (interactive "P") (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) -;;; Finding score files. +;;; Finding score files. (defun gnus-score-score-files (group) "Return a list of all possible score files." ;; Search and set any global score files. - (when gnus-global-score-files + (when gnus-global-score-files (unless gnus-internal-global-score-files (gnus-score-search-global-directories gnus-global-score-files))) ;; Fix the kill-file dir variable. - (setq gnus-kill-files-directory + (setq gnus-kill-files-directory (file-name-as-directory gnus-kill-files-directory)) ;; If we can't read it, there are no score files. (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) (setq gnus-score-file-list nil) (if (not (gnus-use-long-file-name 'not-score)) ;; We do not use long file names, so we have to do some - ;; directory traversing. - (setq gnus-score-file-list - (cons nil + ;; directory traversing. + (setq gnus-score-file-list + (cons nil (or gnus-short-name-score-file-cache (prog2 (gnus-message 6 "Finding all score files...") @@ -2356,11 +2356,11 @@ (not (car gnus-score-file-list)) (gnus-file-newer-than gnus-kill-files-directory (car gnus-score-file-list))) - (setq gnus-score-file-list + (setq gnus-score-file-list (cons (nth 5 (file-attributes gnus-kill-files-directory)) - (nreverse - (directory-files - gnus-kill-files-directory t + (nreverse + (directory-files + gnus-kill-files-directory t (gnus-score-file-regexp))))))) (cdr gnus-score-file-list))) @@ -2371,7 +2371,7 @@ (case-fold-search nil) seen out file) (while (setq file (pop files)) - (cond + (cond ;; Ignore "." and "..". ((member (file-name-nondirectory file) '("." "..")) nil) @@ -2386,19 +2386,19 @@ (or out ;; Return a dummy value. (list "~/News/this.file.does.not.exist.SCORE")))) - + (defun gnus-score-file-regexp () "Return a regexp that match all score files." (concat "\\(" (regexp-quote gnus-score-file-suffix ) "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) - + (defun gnus-score-find-bnews (group) "Return a list of score files for GROUP. The score files are those files in the ~/News/ directory which matches GROUP using BNews sys file syntax." (let* ((sfiles (append (gnus-score-score-files group) gnus-internal-global-score-files)) - (kill-dir (file-name-as-directory + (kill-dir (file-name-as-directory (expand-file-name gnus-kill-files-directory))) (klen (length kill-dir)) (score-regexp (gnus-score-file-regexp)) @@ -2408,7 +2408,7 @@ (set-buffer (get-buffer-create "*gnus score files*")) (buffer-disable-undo (current-buffer)) ;; Go through all score file names and create regexp with them - ;; as the source. + ;; as the source. (while sfiles (erase-buffer) (insert (car sfiles)) @@ -2495,7 +2495,7 @@ (mapcar 'gnus-score-file-name all))) (if (equal prefix "") all - (mapcar + (mapcar (lambda (file) (concat (file-name-directory file) prefix (file-name-nondirectory file))) @@ -2522,7 +2522,7 @@ (erase-buffer) (setq elems (delete "all" elems)) (length elems)))) - + (defun gnus-sort-score-files (files) "Sort FILES so that the most general files come first." (nnheader-temp-write nil @@ -2556,7 +2556,7 @@ ;; progn used just in case ("regexp") has no files ;; and score-files is still nil. -sj ;; this can be construed as a "stop searching here" feature :> - ;; and used to simplify regexps in the single-alist + ;; and used to simplify regexps in the single-alist (setq score-files (nconc score-files (copy-sequence (cdar alist)))) (setq alist nil)) @@ -2575,7 +2575,7 @@ (not (listp funcs)) (setq funcs (list funcs))) ;; Get the initial score files for this group. - (when funcs + (when funcs (setq score-files (nreverse (gnus-score-find-alist group)))) ;; Add any home adapt files. (let ((home (gnus-home-score-file group t))) @@ -2591,7 +2591,7 @@ ;; scores) and add them to a list. (while funcs (when (gnus-functionp (car funcs)) - (setq score-files + (setq score-files (nconc score-files (nreverse (funcall (car funcs) group))))) (setq funcs (cdr funcs))) ;; Add any home score files. @@ -2621,7 +2621,7 @@ (pop files))) ;; Do the scoring if there are any score files for this group. score-files)) - + (defun gnus-possibly-score-headers (&optional trace) "Do scoring if scoring is required." (let ((score-files (gnus-all-score-files))) @@ -2636,7 +2636,7 @@ ((or (null newsgroup) (string-equal newsgroup "")) ;; The global score file is placed at top of the directory. - (expand-file-name + (expand-file-name suffix gnus-kill-files-directory)) ((gnus-use-long-file-name 'not-score) ;; Append ".SCORE" to newsgroup name. @@ -2657,7 +2657,7 @@ (let (out) (while files (if (string-match "/$" (car files)) - (setq out (nconc (directory-files + (setq out (nconc (directory-files (car files) t (concat (gnus-score-file-regexp) "$")))) (push (car files) out)) @@ -2707,7 +2707,7 @@ ;; Group name without any dots. (concat group (if (gnus-use-long-file-name 'not-score) "." "/") gnus-score-file-suffix))) - + (defun gnus-hierarchial-home-adapt-file (group) "Return the adapt file of the top-level hierarchy of GROUP." (if (string-match "^[^.]+\\." group)
--- a/lisp/gnus/gnus-setup.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-setup.el Mon Aug 13 09:18:39 2007 +0200 @@ -176,7 +176,7 @@ (autoload 'gnus-no-server "gnus" "\ Read network news. If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. +startup level. If ARG is nil, Gnus will be started at level 2. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use. As opposed to `gnus', this command will not connect to the local server." t nil)
--- a/lisp/gnus/gnus-soup.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-soup.el Mon Aug 13 09:18:39 2007 +0200 @@ -143,17 +143,17 @@ (when (setq headers (gnus-summary-article-header (car articles))) ;; Put the article in a buffer. (set-buffer tmp-buf) - (when (gnus-request-article-this-buffer + (when (gnus-request-article-this-buffer (car articles) gnus-newsgroup-name) (save-restriction (message-narrow-to-head) (message-remove-header gnus-soup-ignored-headers t)) (gnus-soup-store gnus-soup-directory prefix headers - gnus-soup-encoding-type + gnus-soup-encoding-type gnus-soup-index-type) - (gnus-soup-area-set-number + (gnus-soup-area-set-number area (1+ (or (gnus-soup-area-number area) 0))))) - ;; Mark article as read. + ;; Mark article as read. (set-buffer gnus-summary-buffer) (gnus-summary-remove-process-mark (car articles)) (gnus-summary-mark-as-read (car articles) gnus-souped-mark) @@ -205,12 +205,12 @@ $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" (interactive) nil) - + ;;; Internal Functions: -;; Store the current buffer. +;; Store the current buffer. (defun gnus-soup-store (directory prefix headers format index) - ;; Create the directory, if needed. + ;; Create the directory, if needed. (gnus-make-directory directory) (let* ((msg-buf (nnheader-find-file-noselect (concat directory prefix ".MSG"))) @@ -222,7 +222,7 @@ from head-line beg type) (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) (buffer-disable-undo msg-buf) - (when idx-buf + (when idx-buf (push idx-buf gnus-soup-buffers) (buffer-disable-undo idx-buf)) (save-excursion @@ -239,9 +239,9 @@ (mail-fetch-field "sender")))) (goto-char (point-min)) ;; Depending on what encoding is supposed to be used, we make - ;; a soup header. + ;; a soup header. (setq head-line - (cond + (cond ((= gnus-soup-encoding-type ?n) (format "#! rnews %d\n" (buffer-size))) ((= gnus-soup-encoding-type ?m) @@ -278,7 +278,7 @@ (and (car entry) (> (car entry) 0)) (and (not not-all) - (gnus-range-length (cdr (assq 'tick (gnus-info-marks + (gnus-range-length (cdr (assq 'tick (gnus-info-marks (nth 2 entry))))))) (when (gnus-summary-read-group group nil t) (setq gnus-newsgroup-processable @@ -299,8 +299,8 @@ (or (mail-header-from header) "(nobody)") (or (mail-header-date header) "") (or (mail-header-id header) - (concat "soup-dummy-id-" - (mapconcat + (concat "soup-dummy-id-" + (mapconcat (lambda (time) (int-to-string time)) (current-time) "-"))) (or (mail-header-references header) "") @@ -341,7 +341,7 @@ (string-match "%d" packer)) (format packer files (string-to-int (gnus-soup-unique-prefix dir))) - (format packer + (format packer (string-to-int (gnus-soup-unique-prefix dir)) files))) (dir (expand-file-name dir))) @@ -349,10 +349,10 @@ (setq gnus-soup-areas nil) (gnus-message 4 "Packing %s..." packer) (if (zerop (call-process shell-file-name - nil nil nil shell-command-switch + nil nil nil shell-command-switch (concat "cd " dir " ; " packer))) (progn - (call-process shell-file-name nil nil nil shell-command-switch + (call-process shell-file-name nil nil nil shell-command-switch (concat "cd " dir " ; rm " files)) (gnus-message 4 "Packing...done" packer)) (error "Couldn't pack packet.")))) @@ -360,7 +360,7 @@ (defun gnus-soup-parse-areas (file) "Parse soup area file FILE. The result is a of vectors, each containing one entry from the AREA file. -The vector contain five strings, +The vector contain five strings, [prefix name encoding description number] though the two last may be nil if they are missing." (let (areas) @@ -419,7 +419,7 @@ area) (while (setq area (pop areas)) (insert - (format + (format "%s\t%s\t%s%s\n" (gnus-soup-area-prefix area) (gnus-soup-area-name area) @@ -429,7 +429,7 @@ (concat "\t" (or (gnus-soup-area-description area) "") (if (gnus-soup-area-number area) - (concat "\t" (int-to-string + (concat "\t" (int-to-string (gnus-soup-area-number area))) "")) "")))))))) @@ -456,7 +456,7 @@ (unless result (setq result (vector (gnus-soup-unique-prefix) - real-group + real-group (format "%c%c%c" gnus-soup-encoding-type gnus-soup-index-type @@ -493,9 +493,9 @@ (gnus-message 4 "Unpacking...done"))) (defun gnus-soup-send-packet (packet) - (gnus-soup-unpack-packet + (gnus-soup-unpack-packet gnus-soup-replies-directory gnus-soup-unpacker packet) - (let ((replies (gnus-soup-parse-replies + (let ((replies (gnus-soup-parse-replies (concat gnus-soup-replies-directory "REPLIES")))) (save-excursion (while replies @@ -506,8 +506,8 @@ (nnheader-find-file-noselect msg-file))) (tmp-buf (get-buffer-create " *soup send*")) beg end) - (cond - ((/= (gnus-soup-encoding-format + (cond + ((/= (gnus-soup-encoding-format (gnus-soup-reply-encoding (car replies))) ?n) (error "Unsupported encoding")) @@ -523,8 +523,8 @@ (error "Bad header.")) (forward-line 1) (setq beg (point) - end (+ (point) (string-to-int - (buffer-substring + end (+ (point) (string-to-int + (buffer-substring (match-beginning 1) (match-end 1))))) (switch-to-buffer tmp-buf) (erase-buffer) @@ -535,7 +535,7 @@ (insert mail-header-separator) (setq message-newsreader (setq message-mailer (gnus-extended-version))) - (cond + (cond ((string= (gnus-soup-reply-kind (car replies)) "news") (gnus-message 5 "Sending news message to %s..." (mail-fetch-field "newsgroups")) @@ -558,7 +558,7 @@ (gnus-message 4 "Sent packet")))) (setq replies (cdr replies))) t))) - + (provide 'gnus-soup) ;;; gnus-soup.el ends here
--- a/lisp/gnus/gnus-spec.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-spec.el Mon Aug 13 09:18:39 2007 +0200 @@ -115,12 +115,12 @@ (defvar gnus-group-line-format-spec (gnus-byte-code 'gnus-group-line-format-spec)) -(defvar gnus-format-specs +(defvar gnus-format-specs `((version . ,emacs-version) (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) (summary-dummy "* %(: :%) %S\n" ,gnus-summary-dummy-line-format-spec) - (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" + (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" ,gnus-summary-line-format-spec)) "Alist of format specs.") @@ -351,7 +351,7 @@ ;; Parse this spec fully. (while - (cond + (cond ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") (setq pad-width (string-to-number (match-string 1))) (when (match-beginning 2) @@ -439,7 +439,7 @@ (insert elem-type) (push (car elem) flist)))) (setq fstring (buffer-string))) - + ;; Do some postprocessing to increase efficiency. (setq result @@ -500,6 +500,8 @@ (defun gnus-compile () "Byte-compile the user-defined format specs." (interactive) + (when gnus-xemacs + (error "Can't compile specs under XEmacs")) (let ((entries gnus-format-specs) (byte-compile-warnings '(unresolved callargs redefine)) entry gnus-tmp-func)
--- a/lisp/gnus/gnus-srvr.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-srvr.el Mon Aug 13 09:18:39 2007 +0200 @@ -55,7 +55,7 @@ (?w where ?s) (?s status ?s))) -(defvar gnus-server-mode-line-format-alist +(defvar gnus-server-mode-line-format-alist `((?S news-server ?s) (?M news-method ?s) (?u user-defined ?s))) @@ -137,8 +137,8 @@ All normal editing commands are switched off. \\<gnus-server-mode-map> -For more in-depth information on this mode, read the manual -(`\\[gnus-info-find-node]'). +For more in-depth information on this mode, read the manual +(`\\[gnus-info-find-node]'). The following commands are available: @@ -189,15 +189,15 @@ (save-excursion (set-buffer (get-buffer-create gnus-server-buffer)) (gnus-server-mode) - (when gnus-carpal + (when gnus-carpal (gnus-carpal-setup-buffer 'server))))) (defun gnus-server-prepare () - (setq gnus-server-mode-line-format-spec - (gnus-parse-format gnus-server-mode-line-format + (setq gnus-server-mode-line-format-spec + (gnus-parse-format gnus-server-mode-line-format gnus-server-mode-line-format-alist)) - (setq gnus-server-line-format-spec - (gnus-parse-format gnus-server-line-format + (setq gnus-server-line-format-spec + (gnus-parse-format gnus-server-line-format gnus-server-line-format-alist t)) (let ((alist gnus-server-alist) (buffer-read-only nil) @@ -209,15 +209,15 @@ (while alist (unless (member (cdar alist) done) (push (cdar alist) done) - (cdr (setq server (pop alist))) + (cdr (setq server (pop alist))) (when (and server (car server) (cdr server)) (gnus-server-insert-server-line (car server) (cdr server))))) ;; Then we insert the list of servers that have been opened in ;; this session. - (while opened + (while opened (unless (member (caar opened) done) (push (caar opened) done) - (gnus-server-insert-server-line + (gnus-server-insert-server-line (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) (caar opened)) (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) @@ -241,7 +241,7 @@ (oentry (assoc (gnus-server-to-method server) gnus-opened-servers))) (when entry - (gnus-dribble-enter + (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string (cdr entry)) ")\n"))) (when (or entry oentry) @@ -252,7 +252,7 @@ (gnus-delete-line)) (if entry (gnus-server-insert-server-line (car entry) (cdr entry)) - (gnus-server-insert-server-line + (gnus-server-insert-server-line (format "%s:%s" (caar oentry) (nth 1 (car oentry))) (car oentry))) (gnus-server-position-point)))))) @@ -260,7 +260,7 @@ (defun gnus-server-set-info (server info) ;; Enter a select method into the virtual server alist. (when (and server info) - (gnus-dribble-enter + (gnus-dribble-enter (concat "(gnus-server-set-info \"" server "\" '" (prin1-to-string info) ")")) (let* ((server (nth 1 info)) @@ -420,7 +420,7 @@ (gnus-server-yank-server))) (defun gnus-server-add-server (how where) - (interactive + (interactive (list (intern (completing-read "Server method: " gnus-valid-select-methods nil t)) (read-string "Server name: "))) @@ -472,7 +472,7 @@ (set-buffer buf) (gnus-server-update-server (gnus-server-server-name)) (gnus-server-position-point))))) - + (defun gnus-server-pick-server (e) (interactive "e") (mouse-set-point e) @@ -731,16 +731,16 @@ "Issue a command to the server to regenerate all its data structures." (interactive) (let ((server (gnus-server-server-name))) - (unless server + (unless server (error "No server on the current line")) - (if (not (gnus-check-backend-function + (if (not (gnus-check-backend-function 'request-regenerate (car (gnus-server-to-method server)))) (error "This backend doesn't support regeneration") (gnus-message 5 "Requesting regeneration of %s..." server) (if (gnus-request-regenerate server) (gnus-message 5 "Requesting regeneration of %s...done" server) (gnus-message 5 "Couldn't regenerate %s" server))))) - + (provide 'gnus-srvr) ;;; gnus-srvr.el ends here.
--- a/lisp/gnus/gnus-start.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-start.el Mon Aug 13 09:18:39 2007 +0200 @@ -48,7 +48,7 @@ (defcustom gnus-site-init-file (ignore-errors - (concat (file-name-directory + (concat (file-name-directory (directory-file-name installation-directory)) "site-lisp/gnus-init")) "The site-wide Gnus elisp startup file. @@ -320,7 +320,7 @@ (const :tag "none" nil))) (defcustom gnus-modtime-botch nil - "*Non-nil means .newsrc should be deleted prior to save. + "*Non-nil means .newsrc should be deleted prior to save. Its use is due to the bogus appearance that .newsrc was modified on disc." :group 'gnus-newsrc @@ -347,7 +347,7 @@ :group 'gnus-group-new :type 'hook) -(defcustom gnus-after-getting-new-news-hook +(defcustom gnus-after-getting-new-news-hook (when (gnus-boundp 'display-time-timer) '(display-time-event-handler)) "A hook run after Gnus checks for new news." @@ -815,7 +815,7 @@ If LEVEL is non-nil, the news will be set up at level LEVEL." (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) - (when init + (when init ;; Clear some variables to re-initialize news information. (setq gnus-newsrc-alist nil gnus-active-hashtb nil) @@ -849,8 +849,8 @@ (gnus-cache-open)) ;; Possibly eval the dribble file. - (and init - (or gnus-use-dribble-file gnus-slave) + (and init + (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) ;; Slave Gnusii should then clear the dribble buffer. @@ -874,7 +874,7 @@ (gnus-find-new-newsgroups)) ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem + (when (and gnus-use-nocem (not level) (not dont-connect)) (gnus-nocem-scan-groups)) @@ -1156,7 +1156,7 @@ ;; Finally we enter (if needed) the list where it is supposed to ;; go, and change the subscription level. If it is to be killed, ;; we enter it into the killed or zombie list. - (cond + (cond ((>= level gnus-level-zombie) ;; Remove from the hash table. (gnus-sethash group nil gnus-newsrc-hashtb) @@ -1283,7 +1283,7 @@ "Alter the ACTIVE info for GROUP to reflect the articles in the cache." (when gnus-cache-active-hashtb (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (and cache-active + (and cache-active (< (car cache-active) (car active)) (setcar active (car cache-active))) (and cache-active @@ -1293,7 +1293,7 @@ (defun gnus-get-unread-articles-in-group (info active &optional update) (when active ;; Allow the backend to update the info in the group. - (when (and update + (when (and update (gnus-request-update-info info (gnus-find-method-for-group (gnus-info-group info)))) (gnus-activate-group (gnus-info-group info) nil t)) @@ -1301,7 +1301,7 @@ (num 0)) ;; 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 + (inline (gnus-cache-possibly-alter-active (gnus-info-group info) active))) ;; Modify the list of read articles according to what articles ;; are available; then tally the unread articles and add the @@ -1552,7 +1552,7 @@ ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file (&optional force) (gnus-group-set-mode-line) - (let ((methods + (let ((methods (append (if (gnus-check-server gnus-select-method) ;; The native server is available. @@ -1590,7 +1590,7 @@ groups info) (while (setq info (pop newsrc)) (when (gnus-server-equal - (gnus-find-method-for-group + (gnus-find-method-for-group (gnus-info-group info) info) gmethod) (push (gnus-group-real-name (gnus-info-group info)) @@ -1628,7 +1628,7 @@ ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)") (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" gnus-ignored-newsgroups)) - + ;; Read an active file and place the results in `gnus-active-hashtb'. (defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) (unless method @@ -1790,7 +1790,7 @@ (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) (gnus-message 5 "Reading %s...done" newsrc-file))) - + ;; Convert old to new. (gnus-convert-old-newsrc)))) @@ -1874,7 +1874,7 @@ (unless (nthcdr 3 info) (nconc info (list nil))) (gnus-info-set-marks - info (list (cons 'tick (gnus-compress-sequence + info (list (cons 'tick (gnus-compress-sequence (sort (cdr m) '<) t)))))) (setq newsrc killed) (while newsrc @@ -1954,7 +1954,7 @@ (point))))) (forward-line -1)) (symbol - ;; Group names can be just numbers. + ;; Group names can be just numbers. (when (numberp symbol) (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) (unless (boundp symbol) @@ -2350,7 +2350,7 @@ ;;; (defun gnus-read-all-descriptions-files () - (let ((methods (cons gnus-select-method + (let ((methods (cons gnus-select-method (nconc (when (gnus-archive-server-wanted-p) (list "archive")) @@ -2440,7 +2440,7 @@ (defun gnus-set-default-directory () "Set the default directory in the current buffer to `gnus-default-directory'. If this variable is nil, don't do anything." - (setq default-directory + (setq default-directory (if (and gnus-default-directory (file-exists-p gnus-default-directory)) (file-name-as-directory (expand-file-name gnus-default-directory))
--- a/lisp/gnus/gnus-sum.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-sum.el Mon Aug 13 09:18:39 2007 +0200 @@ -158,6 +158,7 @@ (defcustom gnus-summary-default-score 0 "*Default article score level. +All scores generated by the score files will be added to this score. If this variable is nil, scoring will be disabled." :group 'gnus-score-default :type '(choice (const :tag "disable") @@ -314,9 +315,6 @@ (cons regexp (repeat string)) sexp))) -;; Mark variables suggested by Thomas Michanek -;; <Thomas.Michanek@telelogic.se>. - (defcustom gnus-unread-mark ? "*Mark used for unread articles." :group 'gnus-summary-marks @@ -613,7 +611,7 @@ :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-parse-headers-hook +(defcustom gnus-parse-headers-hook (list 'gnus-decode-rfc1522) "*A hook called before parsing the headers." :group 'gnus-various @@ -657,7 +655,7 @@ :group 'gnus-summary-visual :type 'face) -(defcustom gnus-summary-highlight +(defcustom gnus-summary-highlight '(((= mark gnus-canceled-mark) . gnus-summary-cancelled-face) ((and (> score default) @@ -683,13 +681,13 @@ . gnus-summary-low-unread-face) ((and (= mark gnus-unread-mark)) . gnus-summary-normal-unread-face) - ((> score default) + ((> score default) . gnus-summary-high-read-face) - ((< score default) + ((< score default) . gnus-summary-low-read-face) - (t + (t . gnus-summary-normal-read-face)) - "Controls the highlighting of summary buffer lines. + "Controls the highlighting of summary buffer lines. A list of (FORM . FACE) pairs. When deciding how a a particular summary line should be displayed, each form is evaluated. The content @@ -700,7 +698,7 @@ score: The articles score default: The default article score. -below: The score below which articles are automatically marked as read. +below: The score below which articles are automatically marked as read. mark: The articles mark." :group 'gnus-summary-visual :type '(repeat (cons (sexp :tag "Form" nil) @@ -711,7 +709,7 @@ (defvar gnus-scores-exclude-files nil) -(defvar gnus-summary-display-table +(defvar gnus-summary-display-table ;; Change the display table. Odd characters have a tendency to mess ;; up nicely formatted displays - we make all possible glyphs ;; display only a single character. @@ -1235,7 +1233,7 @@ "\M-#" gnus-uu-unmark-thread) (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare + "g" gnus-summary-prepare "c" gnus-summary-insert-cached-articles) (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) @@ -1383,51 +1381,51 @@ '(("Default header" ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) - :style radio + :style radio :selected (null gnus-score-default-header)] ["From" (gnus-score-set-default 'gnus-score-default-header 'a) - :style radio + :style radio :selected (eq gnus-score-default-header 'a)] ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) - :style radio + :style radio :selected (eq gnus-score-default-header 's)] ["Article body" (gnus-score-set-default 'gnus-score-default-header 'b) - :style radio + :style radio :selected (eq gnus-score-default-header 'b )] ["All headers" (gnus-score-set-default 'gnus-score-default-header 'h) - :style radio + :style radio :selected (eq gnus-score-default-header 'h )] ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) - :style radio + :style radio :selected (eq gnus-score-default-header 'i )] ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) - :style radio + :style radio :selected (eq gnus-score-default-header 't )] ["Crossposting" (gnus-score-set-default 'gnus-score-default-header 'x) - :style radio + :style radio :selected (eq gnus-score-default-header 'x )] ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) - :style radio + :style radio :selected (eq gnus-score-default-header 'l )] ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) - :style radio + :style radio :selected (eq gnus-score-default-header 'd )] ["Followups to author" (gnus-score-set-default 'gnus-score-default-header 'f) - :style radio + :style radio :selected (eq gnus-score-default-header 'f )]) ("Default type" ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) - :style radio + :style radio :selected (null gnus-score-default-type)] ;; The `:active' key is commented out in the following, ;; because the GNU Emacs hack to support radio buttons use - ;; active to indicate which button is selected. + ;; active to indicate which button is selected. ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) - :style radio + :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 's)] ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) @@ -1439,34 +1437,34 @@ ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'e)] ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) - :style radio + :style radio ;; :active (not (memq gnus-score-default-header '(l d))) :selected (eq gnus-score-default-type 'f)] ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) - :style radio + :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'b)] ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) - :style radio + :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'n)] ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) - :style radio + :style radio ;; :active (eq (gnus-score-default-header 'd)) :selected (eq gnus-score-default-type 'a)] ["Less than number" (gnus-score-set-default 'gnus-score-default-type '<) - :style radio + :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '<)] ["Equal to number" (gnus-score-set-default 'gnus-score-default-type '=) - :style radio + :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '=)] - ["Greater than number" + ["Greater than number" (gnus-score-set-default 'gnus-score-default-type '>) - :style radio + :style radio ;; :active (eq (gnus-score-default-header 'l)) :selected (eq gnus-score-default-type '>)]) ["Default fold" gnus-score-default-fold-toggle @@ -1484,7 +1482,7 @@ (gnus-score-set-default 'gnus-score-default-duration 't) :style radio :selected (eq gnus-score-default-duration 't)] - ["Immediate" + ["Immediate" (gnus-score-set-default 'gnus-score-default-duration 'i) :style radio :selected (eq gnus-score-default-duration 'i)])) @@ -1522,6 +1520,7 @@ ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] ["Quoted-Printable" gnus-article-de-quoted-unreadable t] + ["UnHTMLize" gnus-article-treat-html t] ["Rot 13" gnus-summary-caesar-message t] ["Unix pipe" gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] @@ -1660,7 +1659,7 @@ ["Articles" gnus-summary-limit-to-articles t] ["Pop limit" gnus-summary-pop-limit t] ["Show dormant" gnus-summary-limit-include-dormant t] - ["Hide childless dormant" + ["Hide childless dormant" gnus-summary-limit-exclude-childless-dormant t] ;;["Hide thread" gnus-summary-limit-exclude-thread t] ["Show expunged" gnus-summary-show-all-expunged t]) @@ -1772,8 +1771,8 @@ ("permanent" nil) ("immediate" now))) header) - (list - (apply + (list + (apply 'nconc (list (if (eq type 'lower) @@ -1782,17 +1781,17 @@ (let (outh) (while headers (setq header (car headers)) - (setq outh - (cons - (apply + (setq outh + (cons + (apply 'nconc (list (car header)) (let ((ts (cdr (assoc (nth 2 header) types))) outt) (while ts (setq outt - (cons - (apply + (cons + (apply 'nconc (list (caar ts)) (let ((ps perms) @@ -1810,7 +1809,7 @@ (string= (nth 1 header) "body")) "" - (list 'gnus-summary-header + (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) (list 'gnus-score-default nil) @@ -2050,7 +2049,7 @@ (level (gnus-data-level (car data))) children) (setq data (cdr data)) - (while (and data + (while (and data (= (gnus-data-level (car data)) (1+ level))) (push (gnus-data-number (car data)) children) (setq data (cdr data))) @@ -2322,11 +2321,11 @@ (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - gnus-tmp-unread gnus-tmp-replied +(defun gnus-summary-insert-line (gnus-tmp-header + gnus-tmp-level gnus-tmp-current + gnus-tmp-unread gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score + &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process) (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) @@ -2411,7 +2410,7 @@ (defvar gnus-tmp-new-adopts nil) (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) - "Return the number of articles in THREAD. + "Return the number of articles in THREAD. This may be 0 in some cases -- if none of the articles in the thread are to be displayed." (let* ((number @@ -2534,8 +2533,8 @@ (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) - (setq gnus-newsgroup-limit - (mapcar + (setq gnus-newsgroup-limit + (mapcar (lambda (header) (mail-header-number header)) gnus-newsgroup-headers))) ;; Generate the summary buffer. @@ -2640,7 +2639,7 @@ ;; Just remove the leading "Re:". (t (gnus-simplify-subject-re subject)))) - + (if (and gnus-summary-gather-exclude-subject (string-match gnus-summary-gather-exclude-subject subject)) nil ; This article shouldn't be gathered @@ -2663,7 +2662,7 @@ subject hthread whole-subject) (while threads (setq subject (gnus-general-simplify-subject - (setq whole-subject (mail-header-subject + (setq whole-subject (mail-header-subject (caar threads))))) (when subject (if (setq hthread (gnus-gethash subject hashtb)) @@ -2766,7 +2765,7 @@ ;; Deal with self-referencing References loops. (when (and (car (symbol-value refs)) (not (zerop - (apply + (apply '+ (mapcar (lambda (thread) @@ -2785,9 +2784,9 @@ (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) (deps gnus-newsgroup-dependencies) - header references generation relations + header references generation relations cthread subject child end pthread relation) - ;; First we create an alist of generations/relations, where + ;; First we create an alist of generations/relations, where ;; generations is how much we trust the relation, and the relation ;; is parent/child. (gnus-message 7 "Making sparse threads...") @@ -2817,7 +2816,7 @@ (unless (car (symbol-value cthread)) ;; Make this article the parent of these threads. (setcar (symbol-value cthread) - (vector gnus-reffed-article-number + (vector gnus-reffed-article-number (cadddr relation) "" "" (cadr relation) @@ -2920,7 +2919,7 @@ (condition-case () (mail-header-subject (gnus-data-header - (cadr + (cadr (gnus-data-find-list article (gnus-data-list t))))) @@ -2932,7 +2931,7 @@ (when length (gnus-data-update-list (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) - + (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." (set-buffer gnus-summary-buffer) @@ -2943,7 +2942,7 @@ (references (mail-header-references header)) (parent (gnus-id-to-thread - (or (gnus-parent-id + (or (gnus-parent-id (when (and references (not (equal "" references))) references)) @@ -3016,7 +3015,7 @@ (defun gnus-parent-headers (headers &optional generation) "Return the headers of the GENERATIONeth parent of HEADERS." - (unless generation + (unless generation (setq generation 1)) (let (references parent) (while (and headers (not (zerop generation))) @@ -3047,7 +3046,7 @@ (let ((level (gnus-summary-thread-level article)) (refs (mail-header-references (gnus-summary-article-header article))) particle) - (cond + (cond ((null level) nil) ((zerop level) t) ((null refs) t) @@ -3060,7 +3059,7 @@ (defun gnus-root-id (id) "Return the id of the root of the thread where ID appears." (let (last-id prev) - (while (and id (setq prev (car (gnus-gethash + (while (and id (setq prev (car (gnus-gethash id gnus-newsgroup-dependencies)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) @@ -3129,7 +3128,7 @@ (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) - (gnus-data-remove + (gnus-data-remove number (- (gnus-point-at-bol) (prog1 @@ -3151,7 +3150,7 @@ (gnus-message 7 "Sorting articles...") (prog1 (setq gnus-newsgroup-headers - (sort articles (gnus-make-sort-function + (sort articles (gnus-make-sort-function gnus-article-sort-functions))) (gnus-message 7 "Sorting articles...done")))) @@ -3564,7 +3563,7 @@ articles fetched-articles cached) (unless (gnus-check-server - (setq gnus-current-select-method + (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) @@ -3604,7 +3603,7 @@ (gnus-update-read-articles group gnus-newsgroup-unreads) (unless (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group)) - + (setq articles (gnus-articles-to-read group read-all)) (cond @@ -3630,7 +3629,7 @@ (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) (> (length articles) 1)))))) - (gnus-get-newsgroup-headers-xover + (gnus-get-newsgroup-headers-xover articles nil nil gnus-newsgroup-name t) (gnus-get-newsgroup-headers))) (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) @@ -3828,7 +3827,7 @@ (car type)))))) (push (cons (cdr type) (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence + (gnus-compress-sequence (set symbol (sort list '<)) t))) newmarked))) @@ -3905,7 +3904,7 @@ ;; Pad the mode string a bit. (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) ;; Update the mode line. - (setq mode-line-buffer-identification + (setq mode-line-buffer-identification (gnus-mode-line-buffer-identification (list mode-string))) (set-buffer-modified-p t)))) @@ -4160,18 +4159,14 @@ (if (boundp (setq id-dep (intern id dependencies))) (if (and (car (symbol-value id-dep)) (not force-new)) - ;; An article with this Message-ID has already - ;; been seen, so we ignore this one, except we add - ;; any additional Xrefs (in case the two articles - ;; came from different servers). + ;; An article with this Message-ID has already been seen, + ;; so we rename the Message-ID. (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) + (set + (setq id-dep (intern (setq id (nnmail-message-id)) + dependencies)) + (list header)) + (mail-header-set-id header id)) (setcar (symbol-value id-dep) header)) (set id-dep (list header))) (when header @@ -4242,8 +4237,7 @@ (gnus-nov-read-integer) ; lines (if (= (following-char) ?\n) nil - (gnus-nov-field)) ; misc - ))) + (gnus-nov-field))))) ; misc (widen)) @@ -4255,17 +4249,13 @@ (if (and (car (symbol-value id-dep)) (not force-new)) ;; An article with this Message-ID has already been seen, - ;; so we ignore this one, except we add any additional - ;; Xrefs (in case the two articles came from different - ;; servers. + ;; so we rename the Message-ID. (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) + (set + (setq id-dep (intern (setq id (nnmail-message-id)) + dependencies)) + (list header)) + (mail-header-set-id header id)) (setcar (symbol-value id-dep) header)) (set id-dep (list header))) (when header @@ -4277,7 +4267,7 @@ header)) ;; Goes through the xover lines and returns a list of vectors -(defun gnus-get-newsgroup-headers-xover (sequence &optional +(defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) "Parse the news overview data in the server buffer, and return a @@ -4364,7 +4354,7 @@ old-header) (when (setq d (gnus-data-find (mail-header-number old-header))) (goto-char (gnus-data-pos d)) - (gnus-data-remove + (gnus-data-remove number (- (gnus-point-at-bol) (prog1 @@ -4591,7 +4581,7 @@ ;; possible valid number, or the second line from the top, ;; whichever is the least. (set-window-start - window (min bottom (save-excursion + window (min bottom (save-excursion (forward-line (- top)) (point))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) @@ -4714,7 +4704,7 @@ (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) (gnus-summary-exit) - ;; We have to adjust the point of group mode buffer because + ;; We have to adjust the point of group mode buffer because ;; point was moved to the next unread newsgroup by exiting. (gnus-summary-jump-to-group group) (when rescan @@ -5363,7 +5353,7 @@ (defun gnus-summary-next-unread-article () "Select unread article after current one." (interactive) - (gnus-summary-next-article + (gnus-summary-next-article (or (not (eq gnus-summary-goto-unread 'never)) (gnus-summary-last-article-p (gnus-summary-article-number))) (and gnus-auto-select-same @@ -5594,7 +5584,7 @@ If given a prefix, remove all limits." (interactive "P") (gnus-set-global-variables) - (when total + (when total (setq gnus-newsgroup-limits (list (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers)))) @@ -5624,7 +5614,7 @@ (gnus-summary-limit-to-subject from "from")) (defun gnus-summary-limit-to-age (age &optional younger-p) - "Limit the summary buffer to articles that are older than (or equal) AGE days. + "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." (interactive "nTime in days: \nP") @@ -5674,7 +5664,7 @@ Returns how many articles were removed." (interactive "sMarks: ") (gnus-summary-limit-to-marks marks t)) - + (defun gnus-summary-limit-to-marks (marks &optional reverse) "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). If REVERSE (the prefix), limit the summary buffer to articles that are @@ -5742,7 +5732,7 @@ ;; children. (while (setq d (pop data)) (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) - (and (setq children + (and (setq children (gnus-article-children (gnus-data-number d))) (let (found) (while children @@ -5959,7 +5949,7 @@ (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))) (progn - (setq gnus-newsgroup-reads + (setq gnus-newsgroup-reads (delq number gnus-newsgroup-unreads)) t)))) ;; Nope, invisible article. @@ -6064,17 +6054,17 @@ (setq message-id (concat message-id ">"))) (let* ((header (gnus-id-to-header message-id)) (sparse (and header - (gnus-summary-article-sparse-p + (gnus-summary-article-sparse-p (mail-header-number header))))) (if header (prog1 ;; The article is present in the buffer, to we just go to it. - (gnus-summary-goto-article + (gnus-summary-goto-article (mail-header-number header) nil header) (when sparse (gnus-summary-update-article (mail-header-number header)))) ;; We fetch the article - (let ((gnus-override-method + (let ((gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) gnus-refer-article-method)) number) @@ -6123,7 +6113,7 @@ (unwind-protect (if (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type + (nndoc-article-type ,(if force 'digest 'guess))) t) ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) @@ -6184,7 +6174,7 @@ (cons (current-buffer) 'summary))) (t (error "Couldn't select virtual nndoc group"))))) - + (defun gnus-summary-isearch-article (&optional regexp-p) "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." @@ -6489,7 +6479,7 @@ (gnus-remove-text-with-property 'gnus-prev) (gnus-remove-text-with-property 'gnus-next))))) -(defun gnus-summary-move-article (&optional n to-newsgroup +(defun gnus-summary-move-article (&optional n to-newsgroup select-method action) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. @@ -6539,10 +6529,10 @@ (symbol-value (intern (format "gnus-current-%s-group" action))) articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) - (setq to-method (or select-method + (setq to-method (or select-method (gnus-group-name-to-method to-newsgroup))) ;; Check the method we are to move this article to... - (unless (gnus-check-backend-function + (unless (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (unless (gnus-check-server to-method) @@ -6580,20 +6570,29 @@ " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) ":" article)) - (unless xref + (unless xref (setq xref (list (system-name)))) (setq new-xref (concat - (mapconcat 'identity + (mapconcat 'identity (delete "Xref:" (delete new-xref xref)) " ") - new-xref)) + " " new-xref)) (save-excursion (set-buffer copy-buf) + ;; First put the article in the destination group. (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header "xref" new-xref) - (gnus-request-accept-article - to-newsgroup select-method (not articles))))))) + (setq art-group + (gnus-request-accept-article + to-newsgroup select-method (not articles))) + (setq new-xref (concat new-xref " " (car art-group) + ":" (cdr art-group))) + ;; Now we have the new Xrefs header, so we insert + ;; it and replace the new article. + (nnheader-replace-header "Xref" new-xref) + (gnus-request-replace-article + (cdr art-group) to-newsgroup (current-buffer)) + art-group))))) (if (not art-group) (gnus-message 1 "Couldn't %s article %s" (cadr (assq action names)) article) @@ -6603,7 +6602,7 @@ (gnus-gethash (gnus-group-prefixed-name (car art-group) - (or select-method + (or select-method (gnus-find-method-for-group to-newsgroup))) gnus-newsrc-hashtb))) (info (nth 2 entry)) @@ -6641,7 +6640,7 @@ (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) (setcdr (gnus-active to-group) to-article) (setcdr gnus-newsgroup-active to-article)) - + (while marks (when (memq article (symbol-value (intern (format "gnus-newsgroup-%s" @@ -6665,9 +6664,7 @@ (save-excursion (set-buffer copy-buf) (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header - "xref" (concat new-xref " " (car art-group) - ":" (cdr art-group))) + (nnheader-replace-header "Xref" new-xref) (gnus-request-replace-article article gnus-newsgroup-name (current-buffer))))) @@ -6678,7 +6675,7 @@ ;; Re-activate all groups that have been moved to. (while to-groups (gnus-activate-group (pop to-groups))) - + (gnus-kill-buffer copy-buf) (gnus-summary-position-point) (gnus-set-mode-line 'summary))) @@ -6697,7 +6694,7 @@ (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil - "Default method for respooling an article. + "Default method for respooling an article. If nil, use to the current newsgroup method." :type 'gnus-select-method-name :group 'gnus-summary-mail) @@ -6716,7 +6713,7 @@ In the former case, the articles in question will be moved from the current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." - (interactive + (interactive (list current-prefix-arg (let* ((methods (gnus-methods-using 'respool)) (methname @@ -6724,12 +6721,12 @@ (car (gnus-find-method-for-group gnus-newsgroup-name))))) (method - (gnus-completing-read + (gnus-completing-read methname "What backend do you want to use when respooling?" methods nil t nil 'gnus-mail-method-history)) ms) (cond - ((zerop (length (setq ms (gnus-servers-using-backend + ((zerop (length (setq ms (gnus-servers-using-backend (intern method))))) (list (intern method) "")) ((= 1 (length ms)) @@ -6889,7 +6886,9 @@ ;; after all. (unless (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (setq articles (cdr articles)))) + (setq articles (cdr articles))) + (when not-deleted + (gnus-message 4 "Couldn't delete articles %s" not-deleted))) (gnus-summary-position-point) (gnus-set-mode-line 'summary) not-deleted)) @@ -6898,7 +6897,7 @@ "Edit the current article. This will have permanent effect only in mail groups. If FORCE is non-nil, allow editing of articles even in read-only -groups." +groups." (interactive "P") (save-excursion (set-buffer gnus-summary-buffer) @@ -6972,7 +6971,7 @@ (defun gnus-summary-edit-wash (key) "Perform editing command in the article buffer." - (interactive + (interactive (list (progn (message "%s" (concat (this-command-keys) "- ")) @@ -6991,9 +6990,9 @@ (let (gnus-mark-article-hook) (gnus-summary-select-article) (save-excursion - (set-buffer gnus-article-buffer) + (set-buffer gnus-original-article-buffer) (save-restriction - (gnus-narrow-to-body) + (message-narrow-to-head) (message "This message would go to %s" (mapconcat 'car (nnmail-article-group 'identity) ", ")))))) @@ -7512,7 +7511,7 @@ (save-excursion (set-buffer gnus-summary-buffer) (goto-char (point-min)) - (while + (while (progn (and (< (gnus-summary-article-score) score) (gnus-summary-mark-article nil mark)) @@ -7578,7 +7577,7 @@ (defun gnus-summary-catchup (&optional all quietly to-here not-mark) "Mark all unread articles in this newsgroup as read. -If prefix argument ALL is non-nil, ticked and dormant articles will +If prefix argument ALL is non-nil, ticked and dormant articles will also be marked as read. If QUIETLY is non-nil, no questions will be asked. If TO-HERE is non-nil, it should be a point in the buffer. All @@ -7739,7 +7738,7 @@ (error "Beginning of summary buffer.")))))) (unless (not (eq current-article parent-article)) (error "An article may not be self-referential.")) - (let ((message-id (mail-header-id + (let ((message-id (mail-header-id (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent.")) @@ -7872,7 +7871,7 @@ (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) (decf n)) - (unless silent + (unless silent (gnus-summary-position-point)) (when (and (not silent) (/= 0 n)) (gnus-message 7 "No more threads")) @@ -8041,7 +8040,7 @@ (interactive "P") (gnus-set-global-variables) (let* ((articles (gnus-summary-work-articles n)) - (save-buffer (save-excursion + (save-buffer (save-excursion (nnheader-set-temp-buffer " *Gnus Save*"))) (num (length articles)) header article file) @@ -8221,7 +8220,7 @@ nil nil 'gnus-group-history)) (t - (gnus-completing-read nil prom + (gnus-completing-read nil prom (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil @@ -8229,12 +8228,14 @@ (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) - (setq to-newsgroup (or default ""))) + (setq to-newsgroup default)) + (unless to-newsgroup + (error "No group name entered")) (or (gnus-active to-newsgroup) (gnus-activate-group to-newsgroup) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) - (or (and (gnus-request-create-group + (or (and (gnus-request-create-group to-newsgroup (gnus-group-name-to-method to-newsgroup)) (gnus-activate-group to-newsgroup nil nil (gnus-group-name-to-method @@ -8327,7 +8328,7 @@ (setq buffer-read-only nil) (let ((command (if automatic command (read-string "Command: " command))) ;; Just binding this here doesn't help, because there might - ;; be output from the process after exiting the scope of + ;; be output from the process after exiting the scope of ;; this `let'. ;; (buffer-read-only nil) ) @@ -8361,7 +8362,7 @@ (defun gnus-read-header (id &optional header) "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) - (gnus-override-method + (gnus-override-method (and (gnus-news-group-p gnus-newsgroup-name) gnus-refer-article-method)) where) @@ -8438,7 +8439,7 @@ ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>. (from (if (get-text-property beg gnus-mouse-face-prop) beg - (or (next-single-property-change + (or (next-single-property-change beg gnus-mouse-face-prop nil end) beg))) (to @@ -8482,8 +8483,8 @@ (setq list (cdr list)))) (let ((face (cdar list))) (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face + (gnus-put-text-property + beg end 'face (setq face (if (boundp face) (symbol-value face) face))) (when gnus-summary-highlight-line-function (funcall gnus-summary-highlight-line-function article face))))
--- a/lisp/gnus/gnus-topic.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-topic.el Mon Aug 13 09:18:39 2007 +0200 @@ -199,7 +199,7 @@ (- (1+ (cdr active)) (car active)))) clevel (or (gnus-info-level info) (if (member group gnus-zombie-list) 8 9)))) - (and + (and unread ; nil means that the group is dead. (<= clevel level) (>= clevel lowest) ; Is inside the level we want. @@ -236,14 +236,14 @@ result found) (while (and topology (not (setq found (equal (caaar topology) topic))) - (not (setq result (gnus-topic-parent-topic topic + (not (setq result (gnus-topic-parent-topic topic (car topology))))) (setq topology (cdr topology))) (or result (and found parent)))) (defun gnus-topic-next-topic (topic &optional previous) "Return the next sibling of TOPIC." - (let ((parentt (cddr (gnus-topic-find-topology + (let ((parentt (cddr (gnus-topic-find-topology (gnus-topic-parent-topic topic)))) prev) (while (and parentt @@ -278,7 +278,7 @@ (defun gnus-topic-list (&optional topology) "Return a list of all topics in the topology." (unless topology - (setq topology gnus-topic-topology + (setq topology gnus-topic-topology gnus-tmp-topics nil)) (push (caar topology) gnus-tmp-topics) (mapcar 'gnus-topic-list (cdr topology)) @@ -354,18 +354,18 @@ (not gnus-topology-checked-p)) (gnus-topic-check-topology)) - (unless list-topic + (unless list-topic (erase-buffer)) - + ;; List dead groups? (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) - (gnus-group-prepare-flat-list-dead + (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) - + (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) - (gnus-group-prepare-flat-list-dead + (gnus-group-prepare-flat-list-dead (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) @@ -379,7 +379,7 @@ (or topic-level level) all)) (gnus-topic-prepare-topic gnus-topic-topology 0 (or topic-level level) all))) - + (gnus-group-set-mode-line) (setq gnus-group-list-mode (cons level all)) (run-hooks 'gnus-group-prepare-hook)))) @@ -391,7 +391,7 @@ (let* ((type (pop topicl)) (entries (gnus-topic-find-groups (car type) list-level all)) (visiblep (and (eq (nth 1 type) 'visible) (not silent))) - (gnus-group-indentation + (gnus-group-indentation (make-string (* gnus-topic-indent-level level) ? )) (beg (progn (beginning-of-line) (point))) (topicl (reverse topicl)) @@ -403,14 +403,14 @@ ;; Insert any sub-topics. (while topicl (incf unread - (gnus-topic-prepare-topic + (gnus-topic-prepare-topic (pop topicl) (1+ level) list-level all (not visiblep)))) (setq end (point)) (goto-char beg) ;; Insert all the groups that belong in this topic. (while (setq entry (pop entries)) - (when visiblep + (when visiblep (if (stringp entry) ;; Dead groups. (gnus-group-insert-group-line @@ -420,7 +420,7 @@ nil) ;; Living groups. (when (setq info (nth 2 entry)) - (gnus-group-insert-group-line + (gnus-group-insert-group-line (gnus-info-group info) (gnus-info-level info) (gnus-info-marks info) (car entry) (gnus-info-method info))))) @@ -437,10 +437,10 @@ (when (and (not silent) (or gnus-topic-display-empty-topics ;We want empty topics (not (zerop unread)) ;Non-empty - tick ;Ticked articles + tick ;Ticked articles (/= point-max (point-max)))) ;Unactivated groups (gnus-extent-start-open (point)) - (gnus-topic-insert-topic-line + (gnus-topic-insert-topic-line (car type) visiblep (not (eq (nth 2 type) 'hidden)) level all-entries unread)) @@ -473,10 +473,10 @@ (defun gnus-topic-insert-topic (topic &optional level) "Insert TOPIC." - (gnus-group-prepare-topics + (gnus-group-prepare-topics (car gnus-group-list-mode) (cdr gnus-group-list-mode) nil nil topic level)) - + (defun gnus-topic-fold (&optional insert) "Remove/insert the current topic." (let ((topic (gnus-group-topic-name))) @@ -492,7 +492,7 @@ (or insert (not (gnus-topic-visible-p))) nil nil 9) (gnus-topic-enter-dribble))))))) -(defun gnus-topic-insert-topic-line (name visiblep shownp level entries +(defun gnus-topic-insert-topic-line (name visiblep shownp level entries &optional unread) (let* ((visible (if visiblep "" "...")) (indentation (make-string (* gnus-topic-indent-level level) ? )) @@ -501,7 +501,7 @@ (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) (beginning-of-line) ;; Insert the text. - (gnus-add-text-properties + (gnus-add-text-properties (point) (prog1 (1+ (point)) (eval gnus-topic-line-format-spec) @@ -534,7 +534,7 @@ gnus-topic-mode) (let ((group (gnus-group-group-name)) (buffer-read-only nil)) - (when (and group + (when (and group (gnus-get-info group) (gnus-topic-goto-topic (gnus-current-topic))) (gnus-topic-update-topic-line (gnus-group-topic-name)) @@ -565,7 +565,7 @@ (let* ((top (gnus-topic-find-topology topic-name)) (type (cadr top)) (children (cddr top)) - (entries (gnus-topic-find-groups + (entries (gnus-topic-find-groups (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (parent (gnus-topic-parent-topic topic-name)) @@ -583,7 +583,7 @@ (incf unread (car entry))))) (setq old-unread (gnus-group-topic-unread)) ;; Insert the topic line. - (gnus-topic-insert-topic-line + (gnus-topic-insert-topic-line (car type) (gnus-topic-visible-p) (not (eq (nth 2 type) 'hidden)) (gnus-group-topic-level) all-entries unread) @@ -595,7 +595,7 @@ unread)) (defun gnus-topic-group-indentation () - (make-string + (make-string (* gnus-topic-indent-level (or (save-excursion (forward-line -1) @@ -697,7 +697,7 @@ "Run when changing levels to enter/remove groups from topics." (save-excursion (set-buffer gnus-group-buffer) - (when (and gnus-topic-mode + (when (and gnus-topic-mode gnus-topic-alist (not gnus-topic-inhibit-change-level)) ;; Remove the group from the topics. @@ -713,7 +713,7 @@ (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation - (make-string + (make-string (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) @@ -723,7 +723,7 @@ (yanked (list group)) alist talist end) ;; Then we enter the yanked groups into the topics they belong - ;; to. + ;; to. (when (setq alist (assoc (save-excursion (forward-line -1) (or @@ -764,7 +764,7 @@ ;; Then try to put point on a group before point. (unless after (setq after (cdr (member group (reverse (cdr list))))) - (while (and after + (while (and after (not (gnus-group-goto-group (car after)))) (setq after (cdr after)))) ;; Finally, just put point on the topic. @@ -779,7 +779,7 @@ (defun gnus-topic-grok-active (&optional force) "Parse all active groups and create topic structures for them." - ;; First we make sure that we have really read the active file. + ;; First we make sure that we have really read the active file. (when (or force (not gnus-topic-active-alist)) (let (groups) @@ -809,8 +809,8 @@ ;; topic. (push (pop groups) tgroups) ;; New sub-hierarchy, so we add it to the topology. - (nconc topology (list (setq ntopology - (list (list (substring + (nconc topology (list (setq ntopology + (list (list (substring group 0 (match-end 0)) 'invisible))))) ;; Descend the hierarchy. @@ -902,15 +902,15 @@ (interactive (list current-prefix-arg t)) (when (eq major-mode 'gnus-group-mode) (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode + (setq gnus-topic-mode (if (null arg) (not gnus-topic-mode) (> (prefix-numeric-value arg) 0))) ;; Infest Gnus with topics. (when gnus-topic-mode (when (gnus-visual-p 'topic-menu 'menu) (gnus-topic-make-menu-bar)) - (setq gnus-topic-line-format-spec - (gnus-parse-format gnus-topic-line-format + (setq gnus-topic-line-format-spec + (gnus-parse-format gnus-topic-line-format gnus-topic-line-format-alist t)) (unless (assq 'gnus-topic-mode minor-mode-alist) (push '(gnus-topic-mode " Topic") minor-mode-alist)) @@ -943,14 +943,14 @@ ;; Remove topic infestation. (unless gnus-topic-mode (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (remove-hook 'gnus-group-change-level-function + (remove-hook 'gnus-group-change-level-function 'gnus-topic-change-level) (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) (setq gnus-group-prepare-function 'gnus-group-prepare-flat) (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) (when redisplay (gnus-group-list-groups)))) - + (defun gnus-topic-select-group (&optional all) "Select this newsgroup. No article is selected automatically. @@ -960,7 +960,7 @@ If performed over a topic line, toggle folding the topic." (interactive "P") (if (gnus-group-topic-p) - (let ((gnus-group-list-mode + (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) (gnus-topic-fold all)) (gnus-group-select-group all))) @@ -982,13 +982,13 @@ If performed over a topic line, toggle folding the topic." (interactive "P") (if (gnus-group-topic-p) - (let ((gnus-group-list-mode + (let ((gnus-group-list-mode (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) (gnus-topic-fold all)) (gnus-group-read-group all no-article group))) (defun gnus-topic-create-topic (topic parent &optional previous full-topic) - (interactive + (interactive (list (read-string "New topic: ") (gnus-current-topic))) @@ -1025,7 +1025,7 @@ (start-group (progn (forward-line 1) (gnus-group-group-name))) (start-topic (gnus-group-topic-name)) entry) - (mapcar + (mapcar (lambda (g) (gnus-group-remove-mark g) (when (and @@ -1043,7 +1043,7 @@ (defun gnus-topic-remove-group (&optional arg) "Remove the current group from the topic." (interactive "P") - (gnus-group-iterate arg + (gnus-group-iterate arg (lambda (group) (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) (buffer-read-only nil)) @@ -1065,7 +1065,7 @@ (interactive "P") (if (gnus-group-topic-p) (let ((topic (gnus-group-topic-name))) - (push (cons + (push (cons (gnus-topic-find-topology topic) (assoc topic gnus-topic-alist)) gnus-topic-killed-topics) @@ -1074,12 +1074,12 @@ (gnus-topic-enter-dribble)) (gnus-group-kill-group n discard) (gnus-topic-update-topic))) - + (defun gnus-topic-yank-group (&optional arg) "Yank the last topic." (interactive "p") (if gnus-topic-killed-topics - (let* ((previous + (let* ((previous (or (gnus-group-topic-name) (gnus-topic-next-topic (gnus-current-topic)))) (data (pop gnus-topic-killed-topics)) @@ -1094,7 +1094,7 @@ (let* ((prev (gnus-group-group-name)) (gnus-topic-inhibit-change-level t) (gnus-group-indentation - (make-string + (make-string (* gnus-topic-indent-level (or (save-excursion (gnus-topic-goto-topic (gnus-current-topic)) @@ -1105,7 +1105,7 @@ ;; We first yank the groups the normal way... (setq yanked (gnus-group-yank-group arg)) ;; Then we enter the yanked groups into the topics they belong - ;; to. + ;; to. (setq alist (assoc (save-excursion (forward-line -1) (gnus-current-topic)) @@ -1210,7 +1210,7 @@ (entry (assoc old-name gnus-topic-alist))) (when top (setcar (cadr top) new-name)) - (when entry + (when entry (setcar entry new-name)) (forward-line -1) (gnus-dribble-touch)
--- a/lisp/gnus/gnus-util.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-util.el Mon Aug 13 09:18:39 2007 +0200 @@ -36,6 +36,9 @@ (require 'timezone) (require 'message) +(eval-and-compile + (autoload 'nnmail-date-to-time "nnmail")) + (defun gnus-boundp (variable) "Return non-nil if VARIABLE is bound and non-nil." (and (boundp variable) @@ -317,7 +320,7 @@ (defun gnus-completing-read (default prompt &rest args) ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default + (let* ((prompt (if default (concat prompt " (default " default ") ") (concat prompt " "))) (answer (apply 'completing-read prompt args))) @@ -372,7 +375,7 @@ (defsubst gnus-time-iso8601 (time) "Return a string of TIME in YYMMDDTHHMMSS format." (format-time-string "%Y%m%dT%H%M%S" time)) - + (defun gnus-date-iso8601 (header) "Convert the date field in HEADER to YYMMDDTHHMMSS" (condition-case () @@ -478,7 +481,7 @@ (goto-char orig) ;; Scroll horizontally to center (sort of) the point. (if (> max (window-width)) - (set-window-hscroll + (set-window-hscroll (get-buffer-window (current-buffer) t) (min (- (current-column) (/ (window-width) 3)) (+ 2 (- max (window-width))))) @@ -496,8 +499,8 @@ Timezone package is used." (condition-case () (progn - (setq date (inline (timezone-fix-time - date nil + (setq date (inline (timezone-fix-time + date nil (aref (inline (timezone-parse-date date)) 4)))) (inline (timezone-make-sortable-date @@ -506,7 +509,7 @@ (timezone-make-time-string (aref date 3) (aref date 4) (aref date 5)))))) (error ""))) - + (defun gnus-copy-file (file &optional to) "Copy FILE to TO." (interactive @@ -549,7 +552,7 @@ (defun gnus-make-sort-function (funs) "Return a composite sort condition based on the functions in FUNC." - (cond + (cond ((not (listp funs)) funs) ((null funs) funs) ((cdr funs) @@ -704,6 +707,7 @@ ;;; Functions for saving to babyl/mail files. +(defvar rmail-default-rmail-file) (defun gnus-output-to-rmail (filename &optional ask) "Append the current article to an Rmail file named FILENAME." (require 'rmail)
--- a/lisp/gnus/gnus-uu.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-uu.el Mon Aug 13 09:18:39 2007 +0200 @@ -24,7 +24,7 @@ ;;; Commentary: -;;; Code: +;;; Code: (require 'gnus) (require 'gnus-art) @@ -51,13 +51,13 @@ ;; Default viewing action rules -(defcustom gnus-uu-default-view-rules +(defcustom gnus-uu-default-view-rules '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") ("\\.pas$" "cat %s | sed s/\r//g") ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") ("\\.tga$" "tgatoppm %s | xv -") - ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" + ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") ("\\.midi?$" "playmidi -f") @@ -67,9 +67,9 @@ ("\\.html$" "xmosaic") ("\\.mpe?g$" "mpeg_play") ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") - ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" + ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" "gnus-uu-archive")) - "Default actions to be taken when the user asks to view a file. + "Default actions to be taken when the user asks to view a file. To change the behaviour, you can either edit this variable or set `gnus-uu-user-view-rules' to something useful. @@ -100,24 +100,24 @@ :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) -(defcustom gnus-uu-user-view-rules nil +(defcustom gnus-uu-user-view-rules nil "What actions are to be taken to view a file. -See the documentation on the `gnus-uu-default-view-rules' variable for +See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) -(defcustom gnus-uu-user-view-rules-end +(defcustom gnus-uu-user-view-rules-end '(("" "file")) "What actions are to be taken if no rule matched the file name. -See the documentation on the `gnus-uu-default-view-rules' variable for +See the documentation on the `gnus-uu-default-view-rules' variable for details." :group 'gnus-extract-view :type '(repeat (group regexp (string :tag "Command")))) ;; Default unpacking commands -(defcustom gnus-uu-default-archive-rules +(defcustom gnus-uu-default-archive-rules '(("\\.tar$" "tar xf") ("\\.zip$" "unzip -o") ("\\.ar$" "ar x") @@ -131,14 +131,14 @@ :group 'gnus-extract-archive :type '(repeat (group regexp (string :tag "Command")))) -(defvar gnus-uu-destructive-archivers +(defvar gnus-uu-destructive-archivers (list "uncompress" "gunzip")) (defcustom gnus-uu-user-archive-rules nil "A list that can be set to override the default archive unpacking commands. To use, for instance, 'untar' to unpack tar files and 'zip -x' to unpack zip files, say the following: - (setq gnus-uu-user-archive-rules + (setq gnus-uu-user-archive-rules '((\"\\\\.tar$\" \"untar\") (\"\\\\.zip$\" \"zip -x\")))" :group 'gnus-extract-archive @@ -146,7 +146,7 @@ (defcustom gnus-uu-ignore-files-by-name nil "*A regular expression saying what files should not be viewed based on name. -If, for instance, you want gnus-uu to ignore all .au and .wav files, +If, for instance, you want gnus-uu to ignore all .au and .wav files, you could say something like (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") @@ -159,7 +159,7 @@ (defcustom gnus-uu-ignore-files-by-type nil "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. -If, for instance, you want gnus-uu to ignore all audio files and all mpegs, +If, for instance, you want gnus-uu to ignore all audio files and all mpegs, you could say something like (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") @@ -211,16 +211,16 @@ ("\\.rsrc$" "video/rsrc") ("\\..*$" "unknown/unknown"))) -;; Various variables users may set +;; Various variables users may set -(defcustom gnus-uu-tmp-dir "/tmp/" +(defcustom gnus-uu-tmp-dir "/tmp/" "*Variable saying where gnus-uu is to do its work. Default is \"/tmp/\"." :group 'gnus-extract :type 'directory) -(defcustom gnus-uu-do-not-unpack-archives nil - "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. +(defcustom gnus-uu-do-not-unpack-archives nil + "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. Default is nil." :group 'gnus-extract-archive :type 'boolean) @@ -234,14 +234,14 @@ (defcustom gnus-uu-grabbed-file-functions nil "Functions run on each file after successful decoding. They will be called with the name of the file as the argument. -Likely functions you can use in this list are `gnus-uu-grab-view' +Likely functions you can use in this list are `gnus-uu-grab-view' and `gnus-uu-grab-move'." :group 'gnus-extract :options '(gnus-uu-grab-view gnus-uu-grab-move) :type 'hook) -(defcustom gnus-uu-ignore-default-archive-rules nil - "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. +(defcustom gnus-uu-ignore-default-archive-rules nil + "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. Only the user unpacking commands will be consulted. Default is nil." :group 'gnus-extract-archive :type 'boolean) @@ -261,27 +261,27 @@ :type 'boolean) (defcustom gnus-uu-unmark-articles-not-decoded nil - "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. + "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-correct-stripped-uucode nil - "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. + "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. Default is nil." :group 'gnus-extract :type 'boolean) (defcustom gnus-uu-save-in-digest nil "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. -If this variable is nil, gnus-uu will just save everything in a +If this variable is nil, gnus-uu will just save everything in a file without any embellishments. The digesting almost conforms to RFC1153 - -no easy way to specify any meaningful volume and issue numbers were found, +no easy way to specify any meaningful volume and issue numbers were found, so I simply dropped them." :group 'gnus-extract :type 'boolean) -(defcustom gnus-uu-digest-headers +(defcustom gnus-uu-digest-headers '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" "^Summary:" "^References:") "List of regexps to match headers included in digested messages. @@ -371,7 +371,7 @@ "p" gnus-uu-decode-postscript "P" gnus-uu-decode-postscript-and-save) -(gnus-define-keys +(gnus-define-keys (gnus-uu-extract-view-map "v" gnus-uu-extract-map) "u" gnus-uu-decode-uu-view "U" gnus-uu-decode-uu-and-save-view @@ -421,7 +421,7 @@ "Saves the current article." (interactive (list current-prefix-arg - (read-file-name + (read-file-name (if gnus-uu-save-separate-articles "Save articles is dir: " "Save articles in file: ") @@ -438,12 +438,12 @@ (read-file-name "Unbinhex and save in dir: " gnus-uu-default-dir gnus-uu-default-dir)))) - (setq gnus-uu-binhex-article-name + (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) (defun gnus-uu-decode-uu-view (&optional n) - "Uudecodes and views the current article." + "Uudecodes and views the current article." (interactive "P") (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-uu n))) @@ -491,7 +491,7 @@ (list current-prefix-arg (read-file-name "Unbinhex, view and save in dir: " gnus-uu-default-dir gnus-uu-default-dir))) - (setq gnus-uu-binhex-article-name + (setq gnus-uu-binhex-article-name (make-temp-name (concat gnus-uu-work-dir "binhex"))) (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) (gnus-uu-decode-binhex n file))) @@ -528,7 +528,7 @@ (setq fs (cdr fs)))) (unless subject (setq subject "Digested Articles")) - (unless from + (unless from (setq from (if (gnus-news-group-p gnus-newsgroup-name) gnus-newsgroup-name @@ -603,12 +603,12 @@ "Set the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max))) - + (defun gnus-uu-unmark-buffer () "Remove the process mark on all articles in the buffer." (interactive) (gnus-uu-mark-region (point-min) (point-max) t)) - + (defun gnus-uu-mark-thread () "Marks all articles downwards in this thread." (interactive) @@ -668,10 +668,10 @@ (setq gnus-newsgroup-processable nil) (save-excursion (while marked - (and (vectorp (setq headers + (and (vectorp (setq headers (gnus-summary-article-header (car marked)))) (setq subject (mail-header-subject headers) - articles (gnus-uu-find-articles-matching + articles (gnus-uu-find-articles-matching (gnus-uu-reginize-string subject)) total (nconc total articles))) (while articles @@ -699,7 +699,7 @@ (setq data (cdr data))))) (gnus-summary-position-point)) -;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. +;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. (defun gnus-uu-decode-postscript (&optional n) "Gets postscript of the current article." @@ -720,7 +720,7 @@ (read-file-name "Save in dir: " gnus-uu-default-dir gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article + (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir nil nil t)) (defun gnus-uu-decode-postscript-and-save-view (n dir) @@ -736,7 +736,7 @@ ;; Internal functions. -(defun gnus-uu-decode-with-method (method n &optional save not-insert +(defun gnus-uu-decode-with-method (method n &optional save not-insert scan cdir) (gnus-uu-initialize scan) (when save @@ -770,7 +770,7 @@ out) (when (file-directory-p file) (setq out (nconc (gnus-uu-scan-directory file t) out))))) - (if rec + (if rec out (nreverse out)))) @@ -799,14 +799,14 @@ ;; Function called by gnus-uu-grab-articles to treat each article. (defun gnus-uu-save-article (buffer in-state) - (cond + (cond (gnus-uu-save-separate-articles (save-excursion (set-buffer buffer) (gnus-write-buffer (concat gnus-uu-saved-article-name gnus-current-article)) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name + ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) @@ -815,7 +815,7 @@ (set-buffer buffer) (write-region (point-min) (point-max) gnus-uu-saved-article-name t) (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name + ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) ((eq in-state 'last) (list 'end)) (t (list 'middle))))) @@ -829,14 +829,14 @@ beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) (eq in-state 'first-and-last)) - (progn + (progn (setq state (list 'begin)) (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) (erase-buffer)) - (save-excursion + (save-excursion (set-buffer (get-buffer-create "*gnus-uu-pre*")) (erase-buffer) - (insert (format + (insert (format "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" (current-time-string) name name)))) (when (not (eq in-state 'end)) @@ -869,9 +869,9 @@ (setq headers (cdr headers)) (goto-char (point-min)) (while (re-search-forward headline nil t) - (setq sorthead + (setq sorthead (concat sorthead - (buffer-substring + (buffer-substring (match-beginning 0) (or (and (re-search-forward "^[^ \t]" nil t) (1- (point))) @@ -883,7 +883,7 @@ (goto-char beg) (when (re-search-forward "^Subject: \\(.*\\)$" nil t) (setq subj (buffer-substring (match-beginning 1) (match-end 1))) - (save-excursion + (save-excursion (set-buffer (get-buffer "*gnus-uu-pre*")) (insert (format " %s\n" subj))))) (when (or (eq in-state 'last) @@ -895,7 +895,7 @@ (save-excursion (set-buffer (get-buffer "*gnus-uu-body*")) (goto-char (point-max)) - (insert + (insert (concat (setq end-string (format "End of %s Digest" name)) "\n")) (insert (concat (make-string (length end-string) ?*) "\n")) @@ -908,11 +908,11 @@ (cons gnus-uu-saved-article-name state) state))))) -;; Binhex treatment - not very advanced. +;; Binhex treatment - not very advanced. -(defconst gnus-uu-binhex-body-line +(defconst gnus-uu-binhex-body-line "^[^:]...............................................................$") -(defconst gnus-uu-binhex-begin-line +(defconst gnus-uu-binhex-begin-line "^:...............................................................$") (defconst gnus-uu-binhex-end-line ":$") @@ -937,7 +937,7 @@ (write-region 1 1 gnus-uu-binhex-article-name)) (setq state (list 'middle))) (goto-char (point-max)) - (re-search-backward (concat gnus-uu-binhex-body-line "\\|" + (re-search-backward (concat gnus-uu-binhex-body-line "\\|" gnus-uu-binhex-end-line) nil t) (when (looking-at gnus-uu-binhex-end-line) @@ -974,7 +974,7 @@ (write-region (point-min) (point-max) file-name) (setq state (list file-name 'begin 'end))))) state)) - + ;; Find actions. @@ -983,7 +983,7 @@ action name) (while files (setq name (cdr (assq 'name (car files)))) - (and + (and (setq action (gnus-uu-get-action name)) (setcar files (nconc (list (if (string= action "gnus-uu-archive") (cons 'action "file") @@ -996,18 +996,18 @@ (defun gnus-uu-get-action (file-name) (let (action) - (setq action - (gnus-uu-choose-action + (setq action + (gnus-uu-choose-action file-name - (append + (append gnus-uu-user-view-rules - (if gnus-uu-ignore-default-view-rules - nil + (if gnus-uu-ignore-default-view-rules + nil gnus-uu-default-view-rules) gnus-uu-user-view-rules-end))) (when (and (not (string= (or action "") "gnus-uu-archive")) gnus-uu-view-with-metamail) - (when (setq action + (when (setq action (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) (setq action (format "metamail -d -b -c \"%s\"" action)))) action)) @@ -1050,7 +1050,7 @@ (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" nil t) (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) - + (goto-char beg) (while (re-search-forward "[ \t]+" nil t) (replace-match "[ \t]*" t t)) @@ -1061,11 +1061,11 @@ ;; If N is non-nil, the article numbers of the N next articles ;; will be returned. ;; If any articles have been marked as processable, they will be - ;; returned. + ;; returned. ;; Failing that, articles that have subjects that are part of the ;; same "series" as the current will be returned. (let (articles) - (cond + (cond (n (setq n (prefix-numeric-value n)) (let ((backward (< n 0)) @@ -1085,13 +1085,13 @@ (defun gnus-uu-string< (l1 l2) (string< (car l1) (car l2))) -(defun gnus-uu-find-articles-matching +(defun gnus-uu-find-articles-matching (&optional subject only-unread do-not-translate) ;; Finds all articles that matches the regexp SUBJECT. If it is ;; nil, the current article name will be used. If ONLY-UNREAD is ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is ;; non-nil, article names are not equalized before sorting. - (let ((subject (or subject + (let ((subject (or subject (gnus-uu-reginize-string (gnus-summary-article-subject)))) list-of-subjects) (save-excursion @@ -1117,7 +1117,7 @@ ;; Expand numbers, sort, and return the list of article ;; numbers. (mapcar (lambda (sub) (cdr sub)) - (sort (gnus-uu-expand-numbers + (sort (gnus-uu-expand-numbers list-of-subjects (not do-not-translate)) 'gnus-uu-string<)))))) @@ -1142,15 +1142,15 @@ (replace-match " ")) ;; Translate all characters to "a". (goto-char (point-min)) - (when translate + (when translate (while (re-search-forward "[A-Za-z]" nil t) (replace-match "a" t t))) ;; Expand numbers. (goto-char (point-min)) (while (re-search-forward "[0-9]+" nil t) - (replace-match - (format "%06d" - (string-to-int (buffer-substring + (replace-match + (format "%06d" + (string-to-int (buffer-substring (match-beginning 0) (match-end 0)))))) (setq string (buffer-substring 1 (point-max))) (setcar (car string-list) string) @@ -1199,11 +1199,11 @@ (setq gnus-uu-has-been-grabbed (list art)))))) ;; This function takes a list of articles and a function to apply to -;; each article grabbed. -;; +;; each article grabbed. +;; ;; This function returns a list of files decoded if the grabbing and ;; the process-function has been successful and nil otherwise. -(defun gnus-uu-grab-articles (articles process-function +(defun gnus-uu-grab-articles (articles process-function &optional sloppy limit no-errors) (let ((state 'first) (gnus-asynchronous nil) @@ -1211,8 +1211,8 @@ gnus-summary-display-article-function gnus-article-display-hook gnus-article-prepare-hook article-series files) - - (while (and articles + + (while (and articles (not (memq 'error process-state)) (or sloppy (not (memq 'end process-state)))) @@ -1220,29 +1220,29 @@ (setq article (pop articles)) (push article article-series) - (unless articles + (unless articles (if (eq state 'first) (setq state 'first-and-last) (setq state 'last))) (let ((part (gnus-uu-part-number article))) - (gnus-message 6 "Getting article %d%s..." + (gnus-message 6 "Getting article %d%s..." article (if (string= part "") "" (concat ", " part)))) (gnus-summary-display-article article) - + ;; Push the article to the processing function. (save-excursion (set-buffer gnus-original-article-buffer) (let ((buffer-read-only nil)) (save-excursion (set-buffer gnus-summary-buffer) - (setq process-state + (setq process-state (funcall process-function gnus-original-article-buffer state))))) (gnus-summary-remove-process-mark article) - ;; If this is the beginning of a decoded file, we push it + ;; If this is the beginning of a decoded file, we push it ;; on to a list. (when (or (memq 'begin process-state) (and (or (eq state 'first) @@ -1251,7 +1251,7 @@ (when has-been-begin ;; If there is a `result-file' here, that means that the ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file + (when (and result-file (file-exists-p result-file) (not gnus-uu-be-dangerous) (or (eq gnus-uu-be-dangerous t) @@ -1292,14 +1292,14 @@ ;; the partially decoded file. (and (or (eq state 'last) (eq state 'first-and-last)) (not (memq 'end process-state)) - result-file + result-file (file-exists-p result-file) (not gnus-uu-be-dangerous) (or (eq gnus-uu-be-dangerous t) (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) (delete-file result-file)) - ;; If this was a file of the wrong sort, then + ;; If this was a file of the wrong sort, then (when (and (or (memq 'wrong-type process-state) (memq 'error process-state)) gnus-uu-unmark-articles-not-decoded) @@ -1355,7 +1355,7 @@ (defun gnus-uu-part-number (article) (let* ((header (gnus-summary-article-header article)) (subject (and header (mail-header-subject header)))) - (if (and subject + (if (and subject (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) (match-string 0 subject) ""))) @@ -1368,7 +1368,7 @@ (save-excursion (set-buffer process-buffer) (let ((state (list 'wrong-type)) - process-connection-type case-fold-search buffer-read-only + process-connection-type case-fold-search buffer-read-only files start-char) (goto-char (point-min)) @@ -1389,7 +1389,7 @@ (setq state (list 'middle)) ;; This is the beginning of an uuencoded article. ;; We replace certain characters that could make things messy. - (setq gnus-uu-file-name + (setq gnus-uu-file-name (let ((nnheader-file-name-translation-alist '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) (nnheader-translate-file-chars (match-string 1)))) @@ -1414,24 +1414,24 @@ (progn (cd gnus-uu-work-dir) (setq gnus-uu-uudecode-process - (start-process - "*uudecode*" + (start-process + "*uudecode*" (get-buffer-create gnus-uu-output-buffer-name) shell-file-name shell-command-switch (format "cd %s %s uudecode" gnus-uu-work-dir gnus-shell-command-separator)))) (cd cdir))) - (set-process-sentinel + (set-process-sentinel gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) (setq state (list 'begin)) (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) - + ;; We look for the end of the thing to be decoded. (if (re-search-forward gnus-uu-end-string nil t) (push 'end state) (goto-char (point-max)) (re-search-backward gnus-uu-body-line nil t)) - + (forward-line 1) (when gnus-uu-uudecode-process @@ -1444,8 +1444,8 @@ (condition-case nil (process-send-region gnus-uu-uudecode-process start-char (point)) - (error - (progn + (error + (progn (delete-process gnus-uu-uudecode-process) (gnus-message 2 "gnus-uu: Couldn't uudecode") (setq state (list 'wrong-type))))) @@ -1479,11 +1479,11 @@ (setq state (list 'wrong-type)) (beginning-of-line) (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch - (concat "cd " gnus-uu-work-dir " " + (call-process-region + start-char (point-max) shell-file-name nil + (get-buffer-create gnus-uu-output-buffer-name) nil + shell-command-switch + (concat "cd " gnus-uu-work-dir " " gnus-shell-command-separator " sh")))) state)) @@ -1504,15 +1504,15 @@ (let ((action-list (copy-sequence file-action-list)) (case-fold-search t) rule action) - (and - (unless no-ignore - (and (not + (and + (unless no-ignore + (and (not (and gnus-uu-ignore-files-by-name (string-match gnus-uu-ignore-files-by-name file-name))) - (not + (not (and gnus-uu-ignore-files-by-type - (string-match gnus-uu-ignore-files-by-type - (or (gnus-uu-choose-action + (string-match gnus-uu-ignore-files-by-type + (or (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list t) "")))))) (while (not (or (eq action-list ()) action)) @@ -1526,7 +1526,7 @@ ;; Unpacks an archive. Returns t if unpacking is successful. (let ((did-unpack t) action command dir) - (setq action (gnus-uu-choose-action + (setq action (gnus-uu-choose-action file-path (append gnus-uu-user-archive-rules (if gnus-uu-ignore-default-archive-rules nil @@ -1549,7 +1549,7 @@ (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - (if (= 0 (call-process shell-file-name nil + (if (= 0 (call-process shell-file-name nil (get-buffer-create gnus-uu-output-buffer-name) nil shell-command-switch command)) (message "") @@ -1572,7 +1572,7 @@ files)) (defun gnus-uu-unpack-files (files &optional ignore) - ;; Go through FILES and look for files to unpack. + ;; Go through FILES and look for files to unpack. (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) (ofiles files) file did-unpack) @@ -1594,7 +1594,7 @@ (setq nfiles (cdr nfiles))) (setq totfiles newfiles))) (setq files (cdr files))) - (if did-unpack + (if did-unpack (gnus-uu-unpack-files ofiles (append did-unpack ignore)) ofiles))) @@ -1636,9 +1636,9 @@ (when (looking-at "\n") (replace-match "")) (forward-line 1)))) - + (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" + (if (looking-at (concat gnus-uu-begin-string "\\|" gnus-uu-end-string)) () (when (not found) @@ -1665,15 +1665,15 @@ (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) nil))) t - (setq gnus-uu-tmp-dir (file-name-as-directory + (setq gnus-uu-tmp-dir (file-name-as-directory (expand-file-name gnus-uu-tmp-dir))) (if (not (file-directory-p gnus-uu-tmp-dir)) (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) (when (not (file-writable-p gnus-uu-tmp-dir)) - (error "Temp directory %s can't be written to" + (error "Temp directory %s can't be written to" gnus-uu-tmp-dir))) - (setq gnus-uu-work-dir + (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) (gnus-make-directory gnus-uu-work-dir) (set-file-modes gnus-uu-work-dir 448) @@ -1750,8 +1750,8 @@ "Function used for encoding binary files. There are three functions supplied with gnus-uu for encoding files: `gnus-uu-post-encode-uuencode', which does straight uuencoding; -`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME -headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with +`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME +headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with uuencode and adds MIME headers." :group 'gnus-extract-post :type '(radio (function-item gnus-uu-post-encode-uuencode) @@ -1777,7 +1777,7 @@ "Non-nil means that gnus-uu will post the encoded file in a thread. This may not be smart, as no other decoder I have seen are able to follow threads when collecting uuencoded articles. (Well, I have seen -one package that does that - gnus-uu, but somehow, I don't think that +one package that does that - gnus-uu, but somehow, I don't think that counts...) Default is nil." :group 'gnus-extract-post :type 'boolean) @@ -1785,8 +1785,8 @@ (defcustom gnus-uu-post-separate-description t "Non-nil means that the description will be posted in a separate article. The first article will typically be numbered (0/x). If this variable -is nil, the description the user enters will be included at the -beginning of the first article, which will be numbered (1/x). Default +is nil, the description the user enters will be included at the +beginning of the first article, which will be numbered (1/x). Default is t." :group 'gnus-extract-post :type 'boolean) @@ -1809,16 +1809,16 @@ (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) - + (when gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name + (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))) (defun gnus-uu-post-insert-binary-in-article () "Inserts an encoded file in the buffer. The user will be asked for a file name." (interactive) - (save-excursion + (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) ;; Encodes with uuencode and substitutes all spaces with backticks. @@ -1845,7 +1845,7 @@ ;; Adds MIME headers. (defun gnus-uu-post-make-mime (file-name encoding) (goto-char (point-min)) - (insert (format "Content-Type: %s; name=\"%s\"\n" + (insert (format "Content-Type: %s; name=\"%s\"\n" (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) file-name)) (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) @@ -1863,7 +1863,7 @@ ;; Encodes a file PATH with COMMAND, leaving the result in the ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) - (= 0 (call-process shell-file-name nil t nil shell-command-switch + (= 0 (call-process shell-file-name nil t nil shell-command-switch (format "%s %s %s" command path file-name)))) (defun gnus-uu-post-news-inews () @@ -1876,9 +1876,9 @@ (if gnus-uu-post-inserted-file-name (setq file-name gnus-uu-post-inserted-file-name) (setq file-name (gnus-uu-post-insert-binary))) - + (if gnus-uu-post-threaded - (let ((message-required-news-headers + (let ((message-required-news-headers (if (memq 'Message-ID message-required-news-headers) message-required-news-headers (cons 'Message-ID message-required-news-headers))) @@ -1892,8 +1892,8 @@ (save-excursion (goto-char (point-min)) (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) - (setq gnus-uu-post-message-id - (buffer-substring + (setq gnus-uu-post-message-id + (buffer-substring (match-beginning 1) (match-end 1))) (setq gnus-uu-post-message-id nil)))) gnus-inews-article-hook) @@ -1902,21 +1902,21 @@ (setq gnus-uu-post-inserted-file-name nil) (when gnus-uu-winconf-post-news (set-window-configuration gnus-uu-winconf-post-news))) - + ;; Asks for a file to encode, encodes it and inserts the result in ;; the current buffer. Returns the file name the user gave. (defun gnus-uu-post-insert-binary () (let ((uuencode-buffer-name "*uuencode buffer*") file-path uubuf file-name) - (setq file-path (read-file-name + (setq file-path (read-file-name "What file do you want to encode? ")) (when (not (file-exists-p file-path)) (error "%s: No such file" file-path)) (goto-char (point-max)) (insert (format "\n%s\n" gnus-uu-post-binary-separator)) - + (when (string-match "^~/" file-path) (setq file-path (concat "$HOME" (substring file-path 1)))) (if (string-match "/[^/]*$" file-path) @@ -1925,7 +1925,7 @@ (unwind-protect (if (save-excursion - (set-buffer (setq uubuf + (set-buffer (setq uubuf (get-buffer-create uuencode-buffer-name))) (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) @@ -1946,8 +1946,8 @@ (setq post-buf (current-buffer)) (goto-char (point-min)) - (when (not (re-search-forward - (if gnus-uu-post-separate-description + (when (not (re-search-forward + (if gnus-uu-post-separate-description (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") (concat "^" (regexp-quote mail-header-separator) "$")) @@ -1958,7 +1958,7 @@ (setq beg-binary (point)) (setq end-binary (point-max)) - (save-excursion + (save-excursion (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) (erase-buffer) (insert-buffer-substring post-buf beg-binary end-binary) @@ -1973,7 +1973,7 @@ (kill-region (point) (point-max)) (goto-char (point-min)) - (re-search-forward + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (setq header (buffer-substring 1 (point))) @@ -2000,12 +2000,12 @@ (- 62 (length (format top-string "" file-name i parts "")))) (when (> 1 (setq minlen (/ whole-len 2))) (setq minlen 1)) - (setq - beg-line + (setq + beg-line (format top-string (make-string minlen ?-) file-name i parts - (make-string + (make-string (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) (goto-char (point-min)) @@ -2018,7 +2018,7 @@ (when (or (and (= i 2) gnus-uu-post-separate-description) (and (= i 1) (not gnus-uu-post-separate-description))) (replace-match "Subject: Re: ")))) - + (goto-char (point-max)) (save-excursion (set-buffer uubuf) @@ -2039,7 +2039,7 @@ (concat "^" (regexp-quote mail-header-separator) "$") nil t) (beginning-of-line) (forward-line 2) - (when (re-search-forward + (when (re-search-forward (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") nil t) (replace-match "")
--- a/lisp/gnus/gnus-vm.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-vm.el Mon Aug 13 09:18:39 2007 +0200 @@ -23,9 +23,9 @@ ;;; Commentary: -;; Major contributors: +;; Major contributors: ;; Christian Limpach <Christian.Limpach@nice.ch> -;; Some code stolen from: +;; Some code stolen from: ;; Rick Sladkey <jrs@world.std.com> ;;; Code: @@ -74,7 +74,7 @@ (insert "\n") (vm-mode) tmp-folder)) - + (defun gnus-summary-save-article-vm (&optional arg) "Append the current article to a vm folder. If N is a positive number, save the N next articles. @@ -93,7 +93,7 @@ (setq folder (cond ((eq folder 'default) default-name) (folder folder) - (t (gnus-read-save-file-name + (t (gnus-read-save-file-name "Save %s in VM folder:" default-name)))) (gnus-make-directory (file-name-directory folder)) (set-buffer gnus-original-article-buffer)
--- a/lisp/gnus/gnus-win.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-win.el Mon Aug 13 09:18:39 2007 +0200 @@ -64,8 +64,8 @@ (summary 1.0 point) (if gnus-carpal '(summary-carpal 4)))) (article - (cond - ((and gnus-use-picons + (cond + ((and gnus-use-picons (eq gnus-picons-display-where 'picons)) '(frame 1.0 (vertical 1.0 @@ -198,7 +198,7 @@ "Kill all frames Gnus has created." (while gnus-created-frames (when (frame-live-p (car gnus-created-frames)) - ;; We slap a condition-case around this `delete-frame' to ensure + ;; We slap a condition-case around this `delete-frame' to ensure ;; against errors if we try do delete the single frame that's left. (ignore-errors (delete-frame (car gnus-created-frames)))) @@ -225,7 +225,7 @@ (memq setting '(group summary article))))) setting (let* ((elem - (cond + (cond ((eq setting 'group) (gnus-window-configuration-element '(group newsgroups ExitNewsgroup))) @@ -417,7 +417,7 @@ ;; We want to remove all other windows. (if (not gnus-frame-split-p) ;; This is not a `frame' split, so we ignore the - ;; other frames. + ;; other frames. (delete-other-windows) ;; This is a `frame' split, so we delete all windows ;; on all frames. @@ -439,10 +439,10 @@ (when (and (boundp (cdr elem)) (symbol-value (cdr elem))) (get-buffer (symbol-value (cdr elem)))) - (when (cdr elem) + (when (cdr elem) (get-buffer (cdr elem))))) gnus-window-to-buffer))) - (mapcar + (mapcar (lambda (frame) (unless (eq (cdr (assq 'minibuffer (frame-parameters frame)))
--- a/lisp/gnus/gnus-xmas.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus-xmas.el Mon Aug 13 09:18:39 2007 +0200 @@ -120,7 +120,7 @@ (if (stringp buffer) nil (map-extents (lambda (extent ignored) - (remove-text-properties + (remove-text-properties start end (list (extent-property extent 'text-prop) nil) buffer)) @@ -132,7 +132,7 @@ (when gnus-summary-selected-face (when gnus-newsgroup-selected-overlay (delete-extent gnus-newsgroup-selected-overlay)) - (setq gnus-newsgroup-selected-overlay + (setq gnus-newsgroup-selected-overlay (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) (set-extent-face gnus-newsgroup-selected-overlay gnus-summary-selected-face))) @@ -195,7 +195,7 @@ (map-extents (lambda (extent arg) (set-extent-property extent 'start-open t)) nil point (min (1+ (point)) (point-max)))) - + (defun gnus-xmas-article-push-button (event) "Check text under the mouse pointer for a callback function. If the text under the mouse pointer has a `gnus-callback' property, @@ -217,7 +217,7 @@ (when gnus-article-button-face (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) - (gnus-add-text-properties + (gnus-add-text-properties from to (nconc (and gnus-article-mouse-face @@ -255,8 +255,8 @@ (window-search t)) (while window-search (let* ((this-window (next-window)) - (next-bottom-edge (car (cdr (cdr (cdr - (window-pixel-edges + (next-bottom-edge (car (cdr (cdr (cdr + (window-pixel-edges this-window))))))) (when (< bottom-edge next-bottom-edge) (setq bottom-edge next-bottom-edge) @@ -332,23 +332,23 @@ (button-press-event-p event))) (dispatch-event event) (setq event (next-command-event))) - (cons (and (key-press-event-p event) - (event-to-character event)) + (cons (and (key-press-event-p event) + (event-to-character event)) event))) (defun gnus-xmas-group-remove-excess-properties () (let ((end (point)) (beg (progn (forward-line -1) (point)))) (remove-text-properties (1+ beg) end '(gnus-group nil)) - (remove-text-properties - beg end + (remove-text-properties + beg end '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil)) (goto-char end) - (map-extents + (map-extents (lambda (e ma) (set-extent-property e 'start-closed t)) (current-buffer) beg end))) - + (defun gnus-xmas-topic-remove-excess-properties () (let ((end (point)) (beg (progn (forward-line -1) (point)))) @@ -365,9 +365,9 @@ (aref (timezone-parse-date date) 3)))) (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) (timezone-parse-date "Jan 1 12:00:00 1970"))) - (tday (- (timezone-absolute-from-gregorian + (tday (- (timezone-absolute-from-gregorian (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) - (timezone-absolute-from-gregorian + (timezone-absolute-from-gregorian (nth 1 edate) (nth 2 edate) (nth 0 edate))))) (+ (nth 2 ttime) (* (nth 1 ttime) 60) @@ -401,7 +401,7 @@ (fset 'gnus-extent-detached-p 'extent-detached-p) (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties) (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) - + (require 'text-props) (if (and (<= emacs-major-version 19) (< emacs-minor-version 14)) @@ -419,12 +419,12 @@ (defun encode-time (sec minute hour day month year &optional zone) (let ((seconds (gnus-xmas-seconds-since-epoch - (timezone-make-arpa-date + (timezone-make-arpa-date year month day (timezone-make-time-string hour minute sec) zone)))) (list (floor (/ seconds (expt 2 16))) (round (mod seconds (expt 2 16))))))) - + (defun gnus-byte-code (func) "Return a form that can be `eval'ed based on FUNC." (let ((fval (symbol-function func))) @@ -432,7 +432,7 @@ (list 'funcall fval) (cons 'progn (cdr (cdr fval)))))) - (fset 'gnus-x-color-values + (fset 'gnus-x-color-values (if (fboundp 'x-color-values) 'x-color-values (lambda (color) @@ -451,7 +451,7 @@ (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) - (fset 'gnus-appt-select-lowest-window + (fset 'gnus-appt-select-lowest-window 'gnus-xmas-appt-select-lowest-window) (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) (fset 'gnus-add-hook 'gnus-xmas-add-hook) @@ -460,7 +460,7 @@ 'gnus-xmas-mode-line-buffer-identification) (fset 'gnus-key-press-event-p 'key-press-event-p) (fset 'gnus-region-active-p 'region-active-p) - + (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) @@ -502,11 +502,11 @@ (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (erase-buffer) (let ((logo (and gnus-xmas-glyph-directory - (concat + (concat (file-name-as-directory gnus-xmas-glyph-directory) "gnus." (if (featurep 'xpm) "xpm" "xbm")))) - (xpm-color-symbols + (xpm-color-symbols (and (featurep 'xpm) (append `(("thing" ,(car gnus-xmas-logo-colors)) ("shadow" ,(cadr gnus-xmas-logo-colors))) @@ -532,25 +532,25 @@ (insert (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ + _ ___ _ _ + _ ___ __ ___ __ _ ___ + __ _ ___ __ ___ + _ ___ _ + _ _ __ _ + ___ __ _ + __ _ + _ _ _ + _ _ _ + _ _ _ + __ ___ + _ _ _ _ + _ _ + _ _ + _ _ + _ + __ -" +" "")) ;; And then hack it. (gnus-indent-rigidly (point-min) (point-max) @@ -565,7 +565,7 @@ (goto-char (point-min)) (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) (goto-char (point-min)) - (setq modeline-buffer-identification + (setq modeline-buffer-identification (list (concat gnus-version ": *Group*"))) (set-buffer-modified-p t))) @@ -580,13 +580,13 @@ `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") -(defvar gnus-group-toolbar +(defvar gnus-group-toolbar '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"] - [gnus-group-get-new-news-this-group + [gnus-group-get-new-news-this-group gnus-group-get-new-news-this-group t "Get new news in this group"] - [gnus-group-catchup-current + [gnus-group-catchup-current gnus-group-catchup-current t "Catchup group"] - [gnus-group-describe-group + [gnus-group-describe-group gnus-group-describe-group t "Describe group"] [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] @@ -595,21 +595,21 @@ ) "The group buffer toolbar.") -(defvar gnus-summary-toolbar - '([gnus-summary-prev-unread +(defvar gnus-summary-toolbar + '([gnus-summary-prev-unread gnus-summary-prev-unread-article t "Prev unread article"] - [gnus-summary-next-unread + [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] - [gnus-summary-post-news + [gnus-summary-post-news gnus-summary-post-news t "Post an article"] [gnus-summary-followup-with-original - gnus-summary-followup-with-original t + gnus-summary-followup-with-original t "Post a followup and yank the original"] - [gnus-summary-followup + [gnus-summary-followup gnus-summary-followup t "Post a followup"] [gnus-summary-reply-with-original gnus-summary-reply-with-original t "Mail a reply and yank the original"] - [gnus-summary-reply + [gnus-summary-reply gnus-summary-reply t "Mail a reply"] [gnus-summary-caesar-message gnus-summary-caesar-message t "Rot 13"] @@ -619,7 +619,7 @@ gnus-summary-save-article-file t "Save article in file"] [gnus-summary-save-article gnus-summary-save-article t "Save article"] - [gnus-uu-post-news + [gnus-uu-post-news gnus-uu-post-news t "Post an uuencoded article"] [gnus-summary-cancel-article gnus-summary-cancel-article t "Cancel article"] @@ -633,9 +633,9 @@ (defvar gnus-summary-mail-toolbar '( - [gnus-summary-prev-unread + [gnus-summary-prev-unread gnus-summary-prev-unread-article t "Prev unread article"] - [gnus-summary-next-unread + [gnus-summary-next-unread gnus-summary-next-unread-article t "Next unread article"] [gnus-summary-mail-reply gnus-summary-reply t "Reply"] ; [gnus-summary-mail-get gnus-mail-get t "Message get"] @@ -699,7 +699,7 @@ (let (xface-glyph) (if (featurep 'xface) (setq xface-glyph - (make-glyph (vector 'xface :data + (make-glyph (vector 'xface :data (concat "X-Face: " (buffer-substring beg end))))) (let ((cur (current-buffer))) @@ -717,21 +717,21 @@ (set-glyph-face xface-glyph 'gnus-x-face) (goto-char (point-min)) (re-search-forward "^From:" nil t) - (set-extent-begin-glyph + (set-extent-begin-glyph (make-extent (point) (1+ (point))) xface-glyph)))) -(defvar gnus-xmas-pointer-glyph +(defvar gnus-xmas-pointer-glyph (progn (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) (make-pointer-glyph (concat gnus-xmas-glyph-directory "gnus-pointer." (if (featurep 'xpm) "xpm" "xbm"))))) -(defvar gnus-xmas-modeline-left-extent +(defvar gnus-xmas-modeline-left-extent (let ((ext (copy-extent modeline-buffer-id-left-extent))) ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph) ext)) - -(defvar gnus-xmas-modeline-right-extent + +(defvar gnus-xmas-modeline-right-extent (let ((ext (copy-extent modeline-buffer-id-right-extent))) ;(set-extent-property ext 'pointer gnus-xmas-pointer-glyph) ext)) @@ -761,7 +761,7 @@ ;; We have a standard line, so we colorize and glyphize it a bit. (t (setq chop (match-end 0)) - (list + (list (if gnus-xmas-modeline-glyph (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) (cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
--- a/lisp/gnus/gnus.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/gnus.el Mon Aug 13 09:18:39 2007 +0200 @@ -30,6 +30,7 @@ (require 'custom) (require 'gnus-load) +(require 'message) (defgroup gnus nil "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." @@ -225,7 +226,7 @@ :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "5.4.17" +(defconst gnus-version-number "5.4.23" "Version number for this version of Gnus.") (defconst gnus-version (format "Gnus v%s" gnus-version-number) @@ -307,7 +308,7 @@ ;; We define these group faces here to avoid the display ;; update forced when creating new faces. -(defface gnus-group-news-1-face +(defface gnus-group-news-1-face '((((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -329,7 +330,7 @@ ())) "Level 1 empty newsgroup face.") -(defface gnus-group-news-2-face +(defface gnus-group-news-2-face '((((class color) (background dark)) (:foreground "turquoise" :bold t)) @@ -351,7 +352,7 @@ ())) "Level 2 empty newsgroup face.") -(defface gnus-group-news-3-face +(defface gnus-group-news-3-face '((((class color) (background dark)) (:bold t)) @@ -373,7 +374,7 @@ ())) "Level 3 empty newsgroup face.") -(defface gnus-group-news-low-face +(defface gnus-group-news-low-face '((((class color) (background dark)) (:foreground "DarkTurquoise" :bold t)) @@ -395,7 +396,7 @@ ())) "Low level empty newsgroup face.") -(defface gnus-group-mail-1-face +(defface gnus-group-mail-1-face '((((class color) (background dark)) (:foreground "aquamarine1" :bold t)) @@ -417,7 +418,7 @@ (:italic t :bold t))) "Level 1 empty mailgroup face.") -(defface gnus-group-mail-2-face +(defface gnus-group-mail-2-face '((((class color) (background dark)) (:foreground "aquamarine2" :bold t)) @@ -439,7 +440,7 @@ (:bold t))) "Level 2 empty mailgroup face.") -(defface gnus-group-mail-3-face +(defface gnus-group-mail-3-face '((((class color) (background dark)) (:foreground "aquamarine3" :bold t)) @@ -461,7 +462,7 @@ ())) "Level 3 empty mailgroup face.") -(defface gnus-group-mail-low-face +(defface gnus-group-mail-low-face '((((class color) (background dark)) (:foreground "aquamarine4" :bold t)) @@ -485,11 +486,11 @@ ;; Summary mode faces. -(defface gnus-summary-selected-face '((t +(defface gnus-summary-selected-face '((t (:underline t))) "Face used for selected articles.") -(defface gnus-summary-cancelled-face +(defface gnus-summary-cancelled-face '((((class color)) (:foreground "yellow" :background "black"))) "Face used for cancelled articles.") @@ -501,7 +502,7 @@ (((class color) (background light)) (:foreground "firebrick" :bold t)) - (t + (t (:bold t))) "Face used for high interest ticked articles.") @@ -512,7 +513,7 @@ (((class color) (background light)) (:foreground "firebrick" :italic t)) - (t + (t (:italic t))) "Face used for low interest ticked articles.") @@ -523,10 +524,10 @@ (((class color) (background light)) (:foreground "firebrick")) - (t + (t ())) "Face used for normal interest ticked articles.") - + (defface gnus-summary-high-ancient-face '((((class color) (background dark)) @@ -534,7 +535,7 @@ (((class color) (background light)) (:foreground "RoyalBlue" :bold t)) - (t + (t (:bold t))) "Face used for high interest ancient articles.") @@ -545,7 +546,7 @@ (((class color) (background light)) (:foreground "RoyalBlue" :italic t)) - (t + (t (:italic t))) "Face used for low interest ancient articles.") @@ -556,25 +557,25 @@ (((class color) (background light)) (:foreground "RoyalBlue")) - (t + (t ())) "Face used for normal interest ancient articles.") - + (defface gnus-summary-high-unread-face - '((t + '((t (:bold t))) "Face used for high interest unread articles.") (defface gnus-summary-low-unread-face - '((t + '((t (:italic t))) "Face used for low interest unread articles.") (defface gnus-summary-normal-unread-face - '((t + '((t ())) "Face used for normal interest unread articles.") - + (defface gnus-summary-high-read-face '((((class color) (background dark)) @@ -584,7 +585,7 @@ (background light)) (:foreground "DarkGreen" :bold t)) - (t + (t (:bold t))) "Face used for high interest read articles.") @@ -597,7 +598,7 @@ (background light)) (:foreground "DarkGreen" :italic t)) - (t + (t (:italic t))) "Face used for low interest read articles.") @@ -608,7 +609,7 @@ (((class color) (background light)) (:foreground "DarkGreen")) - (t + (t ())) "Face used for normal interest read articles.") @@ -620,7 +621,7 @@ (eval-and-compile (autoload 'gnus-play-jingle "gnus-audio")) -(defface gnus-splash-face +(defface gnus-splash-face '((((class color) (background dark)) (:foreground "red")) @@ -796,11 +797,11 @@ :group 'gnus-server :type 'gnus-select-method) -(defcustom gnus-message-archive-method +(defcustom gnus-message-archive-method `(nnfolder "archive" (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file + (nnfolder-active-file ,(nnheader-concat message-directory "archive/active")) (nnfolder-get-new-mail nil) (nnfolder-inhibit-expiry t)) @@ -816,7 +817,7 @@ (defcustom gnus-message-archive-group nil "*Name of the group in which to save the messages you've written. -This can either be a string, a list of strings; or an alist +This can either be a string; a list of strings; or an alist of regexps/functions/forms to be evaluated to return a string (or a list of strings). The functions are called with the name of the current group (or nil) as a parameter. @@ -824,9 +825,9 @@ If you want to save your mail in one group and the news articles you write in another group, you could say something like: - \(setq gnus-message-archive-group + \(setq gnus-message-archive-group '((if (message-news-p) - \"misc-news\" + \"misc-news\" \"misc-mail\"))) Normally the group names returned by this variable should be @@ -879,19 +880,9 @@ :type '(choice (const :tag "default" nil) string)) -(defcustom gnus-local-organization nil +(defvar gnus-local-organization nil "String with a description of what organization (if any) the user belongs to. -The ORGANIZATION environment variable is used instead if it is defined. -If this variable contains a function, this function will be called -with the current newsgroup name as the argument. The function should -return a string. - -In any case, if the string (either in the variable, in the environment -variable, or returned by the function) is a file name, the contents of -this file will be used as the organization." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) +Obsolete variable; use `message-user-organization' instead.") ;; Customization variables @@ -1047,7 +1038,7 @@ :group 'gnus-meta :type '(choice (const :tag "off" nil) integer - (sexp :format "all" + (sexp :format "all" :value t))) (defcustom gnus-use-nocem nil @@ -1075,7 +1066,7 @@ :group 'gnus-meta :type 'boolean) -(defcustom gnus-summary-prepare-exit-hook +(defcustom gnus-summary-prepare-exit-hook '(gnus-summary-expire-articles) "A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default." @@ -1172,7 +1163,7 @@ (string :tag "Address") (editable-list :inline t (list :format "%v" - variable + variable (sexp :tag "Value"))))) (defcustom gnus-updated-mode-lines '(group article summary tree) @@ -1261,8 +1252,8 @@ ;;; Face thingies. -(defcustom gnus-visual - '(summary-highlight group-highlight article-highlight +(defcustom gnus-visual + '(summary-highlight group-highlight article-highlight mouse-face summary-menu group-menu article-menu tree-highlight menu highlight @@ -1369,8 +1360,12 @@ gnus-article-strip-leading-blank-lines gnus-article-strip-multiple-blank-lines gnus-article-strip-blank-lines - gnus-article-treat-overstrike - )) + gnus-article-treat-overstrike)) + +(defcustom gnus-article-save-directory gnus-directory + "*Name of the directory articles will be saved in (default \"~/News\")." + :group 'gnus-article-saving + :type 'directory) ;;; Internal variables @@ -1618,7 +1613,7 @@ ("gnus-picon" :interactive t gnus-article-display-picons gnus-group-display-picons gnus-picons-article-display-x-face gnus-picons-display-x-face) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p + ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p gnus-grouplens-mode) ("smiley" :interactive t gnus-smiley-display) ("gnus-win" gnus-configure-windows gnus-add-configuration) @@ -1637,7 +1632,8 @@ gnus-article-prepare gnus-article-set-window-start gnus-article-next-page gnus-article-prev-page gnus-request-article-this-buffer gnus-article-mode - gnus-article-setup-buffer gnus-narrow-to-page) + gnus-article-setup-buffer gnus-narrow-to-page + gnus-article-delete-invisible-text) ("gnus-art" :interactive t gnus-article-hide-headers gnus-article-hide-boring-headers gnus-article-treat-overstrike gnus-article-word-wrap @@ -1647,7 +1643,7 @@ gnus-article-hide-pem gnus-article-hide-signature gnus-article-strip-leading-blank-lines gnus-article-date-local gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers + gnus-article-show-all-headers gnus-article-edit-mode gnus-article-edit-article gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522) ("gnus-int" gnus-request-type) @@ -1737,7 +1733,7 @@ (defun gnus-suppress-keymap (keymap) (suppress-keymap keymap) - (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 + (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 (while keys (define-key keymap (pop keys) 'undefined)))) @@ -1745,7 +1741,7 @@ (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) -(defvar gnus-summary-mode-map +(defvar gnus-summary-mode-map (let ((keymap (make-keymap))) (gnus-suppress-keymap keymap) keymap)) @@ -1946,7 +1942,7 @@ (string-to-number (if (zerop major) (format "%s00%02d%02d" - (cond + (cond ((member alpha '("(ding)" "d")) "4.99") ((member alpha '("September" "s")) "5.01") ((member alpha '("Red" "r")) "5.03")) @@ -2060,7 +2056,7 @@ (let ((method-name (symbol-name (car method)))) (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) (not (assq (intern (concat method-name "-address")) method)) - (memq 'physical-address (assq (car method) + (memq 'physical-address (assq (car method) gnus-valid-select-methods))) (append method (list (list (intern (concat method-name "-address")) (nth 1 method)))) @@ -2083,7 +2079,7 @@ (defun gnus-server-to-method (server) "Map virtual server names to select methods." - (or + (or ;; Is this a method, perhaps? (and server (listp server) server) ;; Perhaps this is the native server? @@ -2134,7 +2130,7 @@ (defun gnus-archive-server-wanted-p () "Say whether the user wants to use the archive server." - (cond + (cond ((or (not gnus-message-archive-method) (not gnus-message-archive-group)) nil) @@ -2350,7 +2346,7 @@ (defun gnus-newsgroup-kill-file (newsgroup) "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." - (cond + (cond ;; The global KILL file is placed at top of the directory. ((or (null newsgroup) (string-equal newsgroup "")) @@ -2486,7 +2482,7 @@ prompt (append gnus-valid-select-methods gnus-predefined-server-alist gnus-server-alist) nil t nil 'gnus-method-history))) - (cond + (cond ((equal method "") (setq method gnus-select-method)) ((assoc method gnus-valid-select-methods)
--- a/lisp/gnus/lpath.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/lpath.el Mon Aug 13 09:18:39 2007 +0200 @@ -3,29 +3,51 @@ (defvar byte-compile-default-warnings) (defun maybe-fbind (args) - (while args + (while args (or (fboundp (car args)) (fset (car args) 'ignore)) (setq args (cdr args)))) +(defun maybe-bind (args) + (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) + (if (string-match "XEmacs" emacs-version) - (progn + (progn (defvar track-mouse nil) - (maybe-fbind '(posn-point event-start x-popup-menu - facemenu-get-face window-at - coordinates-in-window-p compute-motion - x-defined-colors easy-menu-create-keymaps)) - ;; XEmacs thinks writting compatible code is obsolete. - (require 'bytecomp) - (setq byte-compile-default-warnings - (delq 'obsolete byte-compile-default-warnings))) + (maybe-fbind '(posn-point + event-start x-popup-menu + facemenu-get-face window-at coordinates-in-window-p + compute-motion x-defined-colors easy-menu-create-keymaps + read-event internal-find-face internal-next-face-id + make-face-internal set-frame-face-alist frame-face-alist + facemenu-add-new-face make-face-x-resource-internal + set-font-size set-font-family posn-window + run-with-idle-timer mouse-minibuffer-check window-edges + event-click-count track-mouse read-event mouse-movement-p + event-end mouse-scroll-subr overlay-lists delete-overlay + set-face-stipple mail-abbrevs-setup char-int + make-char-table set-char-table-range font-create-object + x-color-values widget-make-intangible error-message-string + w3-form-encode-xwfu + )) + (maybe-bind '(global-face-data + mark-active transient-mark-mode mouse-selection-click-count + mouse-selection-click-count-buffer buffer-display-table + font-lock-defaults user-full-name user-login-name + gnus-newsgroup-name gnus-article-x-face-too-ugly))) (defvar browse-url-browser-function nil) - (maybe-fbind '(color-instance-rgb-components make-color-instance - color-instance-name specifier-instance device-type - device-class get-popup-menu-response event-object + (maybe-fbind '(color-instance-rgb-components + make-color-instance color-instance-name specifier-instance + device-type device-class get-popup-menu-response event-object x-defined-colors read-color add-submenu set-font-family font-create-object set-font-size frame-device find-face - set-extent-property make-extent characterp display-error))) + set-extent-property make-extent characterp display-error + set-face-doc-string frame-property face-doc-string + button-press-event-p next-command-event + widget-make-intangible glyphp make-glyph set-glyph-image + set-glyph-property event-glyph glyph-property event-point + device-on-window-system-p make-gui-button Info-goto-node + pp-to-string color-name))) (setq load-path (cons "." load-path)) (require 'custom)
--- a/lisp/gnus/mailheader.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/mailheader.el Mon Aug 13 09:18:39 2007 +0200 @@ -62,7 +62,7 @@ (> (skip-chars-forward "^\0- :") 0) (= (following-char) ?:) (setq end (point)) - (progn (forward-char) + (progn (forward-char) (> (skip-chars-forward " \t") 0))) (let ((header (intern (downcase (buffer-substring start end)))) (value (list (buffer-substring
--- a/lisp/gnus/md5.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/md5.el Mon Aug 13 09:18:39 2007 +0200 @@ -11,7 +11,7 @@ ;; This is a direct translation into Emacs LISP of the reference C ;; implementation of the MD5 Message-Digest Algorithm written by RSA ;; Data Security, Inc. -;; +;; ;; The algorithm takes a message (that is, a string of bytes) and ;; computes a 16-byte checksum or "digest" for the message. This digest ;; is supposed to be cryptographically strong in the sense that if you @@ -20,7 +20,7 @@ ;; space of messages. However, the robustness of the algorithm has not ;; been proven, and a similar algorithm (MD4) was shown to be unsound, ;; so treat with caution! -;; +;; ;; The C algorithm uses 32-bit integers; because GNU Emacs ;; implementations provide 28-bit integers (with 24-bit integers on ;; versions prior to 19.29), the code represents a 32-bit integer as the @@ -33,12 +33,12 @@ ;; To compute the MD5 Message Digest for a message M (represented as a ;; string or as a vector of bytes), call -;; +;; ;; (md5-encode M) -;; +;; ;; which returns the message digest as a vector of 16 bytes. If you ;; need to supply the message in pieces M1, M2, ... Mn, then call -;; +;; ;; (md5-init) ;; (md5-update M1) ;; (md5-update M2) @@ -50,17 +50,17 @@ ;; Copyright (C) 1995 by Gareth Rees ;; Derived from the RSA Data Security, Inc. MD5 Message-Digest Algorithm -;; +;; ;; md5.el 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. -;; +;; ;; md5.el 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. -;; +;; ;; The original copyright notice is given below, as required by the ;; licence for the original code. This code is distributed under *both* ;; RSA's original licence and the GNU General Public Licence. (There @@ -155,9 +155,9 @@ ;; for rounds 1, 2, 3 and 4 respectively. Each function follows this ;; pattern of computation (where ROTATE(x,y) means rotate 32-bit value x ;; by y bits to the left): -;; +;; ;; FF(a,b,c,d,x,s,ac) = ROTATE(a + F(b,c,d) + x + ac,s) + b -;; +;; ;; so we use the macro `md5-make-step' to construct each one. The ;; helper functions F, G, H and I operate on 16-bit numbers; the full ;; operation splits its inputs, operates on the halves separately and @@ -369,40 +369,42 @@ ;;; Here begins the merger with the XEmacs API and the md5.el from the URL ;;; package. Courtesy wmperry@spry.com ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun md5 (object &optional start end) - "Return the MD5 (a secure message digest algorithm) of an object. +(eval-and-compile + (unless (fboundp 'md5) + (defun md5 (object &optional start end) + "Return the MD5 (a secure message digest algorithm) of an object. OBJECT is either a string or a buffer. Optional arguments START and END denote buffer positions for computing the hash of a portion of OBJECT." - (let ((buffer nil)) - (unwind-protect - (save-excursion - (setq buffer (generate-new-buffer " *md5-work*")) - (set-buffer buffer) - (cond - ((bufferp object) - (insert-buffer-substring object start end)) - ((stringp object) - (insert (if (or start end) - (substring object start end) - object))) - (t nil)) - (prog1 - (if (<= (point-max) md5-maximum-internal-length) - (mapconcat - (function (lambda (node) (format "%02x" node))) - (md5-encode (buffer-string)) - "") - (call-process-region (point-min) (point-max) - (or shell-file-name "/bin/sh") - t buffer nil - "-c" md5-program) - ;; MD5 digest is 32 chars long - ;; mddriver adds a newline to make neaten output for tty - ;; viewing, make sure we leave it behind. - (buffer-substring (point-min) (+ (point-min) 32))) - (kill-buffer buffer))) - (and buffer (kill-buffer buffer) nil)))) + (let ((buffer nil)) + (unwind-protect + (save-excursion + (setq buffer (generate-new-buffer " *md5-work*")) + (set-buffer buffer) + (cond + ((bufferp object) + (insert-buffer-substring object start end)) + ((stringp object) + (insert (if (or start end) + (substring object start end) + object))) + (t nil)) + (prog1 + (if (<= (point-max) md5-maximum-internal-length) + (mapconcat + (function (lambda (node) (format "%02x" node))) + (md5-encode (buffer-string)) + "") + (call-process-region (point-min) (point-max) + (or shell-file-name "/bin/sh") + t buffer nil + "-c" md5-program) + ;; MD5 digest is 32 chars long + ;; mddriver adds a newline to make neaten output for tty + ;; viewing, make sure we leave it behind. + (buffer-substring (point-min) (+ (point-min) 32))) + (kill-buffer buffer))) + (and buffer (kill-buffer buffer) nil)))))) (provide 'md5)
--- a/lisp/gnus/message.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/message.el Mon Aug 13 09:18:39 2007 +0200 @@ -29,8 +29,7 @@ ;;; Code: -(eval-when-compile - (require 'cl)) +(require 'cl) (require 'mailheader) (require 'rmail) (require 'nnheader) @@ -167,8 +166,8 @@ :group 'message-news) (defcustom message-required-news-headers - '(From Newsgroups Subject Date Message-ID - (optional . Organization) Lines + '(From Newsgroups Subject Date Message-ID + (optional . Organization) Lines (optional . X-Newsreader)) "Headers to be generated or prompted for when posting an article. RFC977 and RFC1036 require From, Date, Newsgroups, Subject, @@ -179,7 +178,7 @@ :group 'message-headers :type '(repeat sexp)) -(defcustom message-required-mail-headers +(defcustom message-required-mail-headers '(From Subject Date (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer)) "Headers to be generated or prompted for when mailing a message. @@ -194,7 +193,7 @@ :group 'message-headers :type 'sexp) -(defcustom message-ignored-news-headers +(defcustom message-ignored-news-headers "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:" "*Regexp of headers to be removed unconditionally before posting." :group 'message-news @@ -223,7 +222,7 @@ (defcustom message-elide-elipsis "\n[...]\n\n" "*The string which is inserted for elided text.") -(defcustom message-interactive nil +(defcustom message-interactive nil "Non-nil means when sending a message wait for and display errors. nil means let mailer mail back a message to report errors." :group 'message-sending @@ -246,7 +245,7 @@ :type 'boolean) (defvar gnus-local-organization) -(defcustom message-user-organization +(defcustom message-user-organization (or (and (boundp 'gnus-local-organization) (stringp gnus-local-organization) gnus-local-organization) @@ -271,7 +270,7 @@ :group 'message-buffers :type 'directory) -(defcustom message-forward-start-separator +(defcustom message-forward-start-separator "------- Start of forwarded message -------\n" "*Delimiter inserted before forwarded messages." :group 'message-forwarding @@ -288,7 +287,7 @@ :group 'message-forwarding :type 'boolean) -(defcustom message-included-forward-headers +(defcustom message-included-forward-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" "*Regexp matching headers to be included in forwarded messages." :group 'message-forwarding @@ -390,7 +389,7 @@ (defvar gnus-post-method) (defvar gnus-select-method) -(defcustom message-post-method +(defcustom message-post-method (cond ((and (boundp 'gnus-post-method) gnus-post-method) gnus-post-method) @@ -417,7 +416,7 @@ (defcustom message-signature-setup-hook nil "Normal hook, run each time a new outgoing message is initialized. -It is run after the headers have been inserted and before +It is run after the headers have been inserted and before the signature is inserted." :group 'message-various :type 'hook) @@ -556,7 +555,7 @@ ;; Note: could use /usr/ucb/mail instead of sendmail; ;; options -t, and -v if not interactive. (defcustom message-mailer-swallows-blank-line - (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" + (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration) (file-readable-p "/etc/sendmail.cf") (let ((buffer (get-buffer-create " *temp*"))) @@ -582,7 +581,7 @@ (ignore-errors (define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit + 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook)) (defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) @@ -591,7 +590,7 @@ ;;; Internal variables. ;;; Well, not really internal. -(defvar message-mode-syntax-table +(defvar message-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) (modify-syntax-entry ?% ". " table) table) @@ -600,27 +599,153 @@ (defvar message-mode-abbrev-table text-mode-abbrev-table "Abbrev table used in Message mode buffers. Defaults to `text-mode-abbrev-table'.") +(defgroup message-headers nil + "Message headers." + :link '(custom-manual "(message)Variables") + :group 'message) + +(defface message-header-to-face + '((((class color) + (background dark)) + (:foreground "green2" :bold t)) + (((class color) + (background light)) + (:foreground "MidnightBlue" :bold t)) + (t + (:bold t :italic t))) + "Face used for displaying From headers." + :group 'message-headers) + +(defface message-header-cc-face + '((((class color) + (background dark)) + (:foreground "green4" :bold t)) + (((class color) + (background light)) + (:foreground "MidnightBlue")) + (t + (:bold t))) + "Face used for displaying Cc headers." + :group 'message-headers) + +(defface message-header-subject-face + '((((class color) + (background dark)) + (:foreground "green3")) + (((class color) + (background light)) + (:foreground "navy blue" :bold t)) + (t + (:bold t))) + "Face used for displaying subject headers." + :group 'message-headers) + +(defface message-header-newsgroups-face + '((((class color) + (background dark)) + (:foreground "yellow" :bold t :italic t)) + (((class color) + (background light)) + (:foreground "blue4" :bold t :italic t)) + (t + (:bold t :italic t))) + "Face used for displaying newsgroups headers." + :group 'message-headers) + +(defface message-header-other-face + '((((class color) + (background dark)) + (:foreground "red4")) + (((class color) + (background light)) + (:foreground "steel blue")) + (t + (:bold t :italic t))) + "Face used for displaying newsgroups headers." + :group 'message-headers) + +(defface message-header-name-face + '((((class color) + (background dark)) + (:foreground "DarkGreen")) + (((class color) + (background light)) + (:foreground "cornflower blue")) + (t + (:bold t))) + "Face used for displaying header names." + :group 'message-headers) + +(defface message-header-xheader-face + '((((class color) + (background dark)) + (:foreground "blue")) + (((class color) + (background light)) + (:foreground "blue")) + (t + (:bold t))) + "Face used for displaying X-Header headers." + :group 'message-headers) + +(defface message-separator-face + '((((class color) + (background dark)) + (:foreground "blue4")) + (((class color) + (background light)) + (:foreground "brown")) + (t + (:bold t))) + "Face used for displaying the separator." + :group 'message-headers) + +(defface message-cited-text-face + '((((class color) + (background dark)) + (:foreground "red")) + (((class color) + (background light)) + (:foreground "red")) + (t + (:bold t))) + "Face used for displaying cited text names." + :group 'message-headers) (defvar message-font-lock-keywords - (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-"))) - (list '("^To:" . font-lock-function-name-face) - '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face) - '("^\\(Subject:\\)[ \t]*\\(.+\\)?" - (1 font-lock-comment-face) (2 font-lock-type-face nil t)) - (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$") - 1 'font-lock-comment-face) - (cons (concat "^[ \t]*" - "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - "[>|}].*") - 'font-lock-reference-face) - '("^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):.*" - . font-lock-string-face))) + (let* ((cite-prefix "A-Za-z") + (cite-suffix (concat cite-prefix "0-9_.@-")) + (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)")) + `((,(concat "^\\(To:\\)" content) + (1 'message-header-name-face) + (2 'message-header-to-face nil t)) + (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^Reply-To:\\)" content) + (1 'message-header-name-face) + (2 'message-header-cc-face nil t)) + (,(concat "^\\(Subject:\\)" content) + (1 'message-header-name-face) + (2 'message-header-subject-face nil t)) + (,(concat "^\\(Newsgroups:\\|Followup-to:\\)" content) + (1 'message-header-name-face) + (2 'message-header-newsgroups-face nil t)) + (,(concat "^\\([^: \n\t]+:\\)" content) + (1 'message-header-name-face) + (2 'message-header-other-face nil t)) + (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) + (1 'message-header-name-face) + (2 'message-header-name-face)) + (,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") + 1 'message-separator-face) + (,(concat "^[ \t]*" + "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" + "[>|}].*") + (0 'message-cited-text-face)))) "Additional expressions to highlight in Message mode.") (defvar message-face-alist '((bold . bold-region) (underline . underline-region) - (default . (lambda (b e) + (default . (lambda (b e) (unbold-region b e) (ununderline-region b e)))) "Alist of mail and news faces for facemenu. @@ -658,7 +783,7 @@ (defvar gnus-read-active-file) ;;; Regexp matching the delimiter of messages in UNIX mail format -;;; (UNIX From lines), minus the initial ^. +;;; (UNIX From lines), minus the initial ^. (defvar message-unix-mail-delimiter (let ((time-zone-regexp (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" @@ -706,9 +831,9 @@ "^|? *---+ +Message text follows: +---+ *|?$") "A regexp that matches the separator before the text of a failed message.") -(defvar message-header-format-alist +(defvar message-header-format-alist `((Newsgroups) - (To . message-fill-address) + (To . message-fill-address) (Cc . message-fill-address) (Subject) (In-Reply-To) @@ -731,11 +856,12 @@ (autoload 'gnus-point-at-eol "gnus-util") (autoload 'gnus-point-at-bol "gnus-util") (autoload 'gnus-output-to-mail "gnus-util") - (autoload 'gnus-output-to-rmail "gnus-util")) + (autoload 'gnus-output-to-rmail "gnus-util") + (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")) -;;; +;;; ;;; Utility functions. ;;; @@ -782,6 +908,16 @@ (setq paren nil)))) (nreverse elems))))) +(defun message-mail-file-mbox-p (file) + "Say whether FILE looks like a Unix mbox file." + (when (and (file-exists-p file) + (file-readable-p file) + (file-regular-p file)) + (nnheader-temp-write nil + (nnheader-insert-file-contents file) + (goto-char (point-min)) + (looking-at message-unix-mail-delimiter)))) + (defun message-fetch-field (header &optional not-all) "The same as `mail-fetch-field', only remove all newlines." (let ((value (mail-fetch-field header nil (not not-all)))) @@ -896,12 +1032,12 @@ (not (if (re-search-forward "^[^ \t]" nil t) (beginning-of-line) (goto-char (point-max))))) - + (defun message-sort-headers-1 () "Sort the buffer as headers using `message-rank' text props." (goto-char (point-min)) - (sort-subr - nil 'message-next-header + (sort-subr + nil 'message-next-header (lambda () (message-next-header) (unless (bobp) @@ -961,7 +1097,7 @@ (define-key message-mode-map "\C-c\C-t" 'message-insert-to) (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - + (define-key message-mode-map "\C-c\C-y" 'message-yank-original) (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) @@ -978,7 +1114,7 @@ (define-key message-mode-map "\t" 'message-tab)) -(easy-menu-define +(easy-menu-define message-mode-menu message-mode-map "Message Menu." '("Message" ["Sort Headers" message-sort-headers t] @@ -994,7 +1130,7 @@ ["Send Message" message-send-and-exit t] ["Abort Message" message-dont-send t])) -(easy-menu-define +(easy-menu-define message-mode-field-menu message-mode-map "" '("Field" ["Fetch To" message-insert-to t] @@ -1177,7 +1313,7 @@ "Insert a To header that points to the author of the article being replied to." (interactive) (let ((co (message-fetch-field "courtesy-copies-to"))) - (when (and co + (when (and co (equal (downcase co) "never")) (error "The user has requested not to have copies sent via mail"))) (when (and (message-position-on-field "To") @@ -1203,7 +1339,7 @@ (defun message-insert-signature (&optional force) "Insert a signature. See documentation for the `message-signature' variable." (interactive (list 0)) - (let* ((signature + (let* ((signature (cond ((and (null message-signature) (eq force 0)) @@ -1266,17 +1402,17 @@ (/= (aref message-caesar-translation-table ?a) (+ ?a n))) (setq message-caesar-translation-table (message-make-caesar-translation-table n))) - ;; Then we translate the region. Do it this way to retain + ;; Then we translate the region. Do it this way to retain ;; text properties. (while (< b e) - (subst-char-in-region + (subst-char-in-region b (1+ b) (char-after b) (aref message-caesar-translation-table (char-after b))) (incf b)))) (defun message-make-caesar-translation-table (n) "Create a rot table with offset N." - (let ((i -1) + (let ((i -1) (table (make-string 256 0))) (while (< (incf i) 256) (aset table i i)) @@ -1313,17 +1449,17 @@ (unless (equal 0 (call-process-region (point-min) (point-max) program t t)) (insert body) - (gnus-message 1 "%s failed." program)))))) + (message "%s failed." program)))))) (defun message-rename-buffer (&optional enter-string) - "Rename the *message* buffer to \"*message* RECIPIENT\". + "Rename the *message* buffer to \"*message* RECIPIENT\". If the function is run with a prefix, it will ask for a new buffer name, rather than giving an automatic name." (interactive "Pbuffer name: ") (save-excursion (save-restriction (goto-char (point-min)) - (narrow-to-region (point) + (narrow-to-region (point) (search-forward mail-header-separator nil 'end)) (let* ((mail-to (or (if (message-news-p) (message-fetch-field "Newsgroups") @@ -1362,7 +1498,7 @@ ;; Remove unwanted headers. (when message-ignored-cited-headers (save-restriction - (narrow-to-region + (narrow-to-region (goto-char start) (if (search-forward "\n\n" nil t) (1- (point)) @@ -1417,7 +1553,7 @@ (defun message-cite-original () "Cite function in the standard Message manner." (let ((start (point)) - (functions + (functions (when message-indent-citation-function (if (listp message-indent-citation-function) message-indent-citation-function @@ -1441,7 +1577,7 @@ (narrow-to-region (goto-char (point-min)) (progn - (re-search-forward + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (match-beginning 0))) (goto-char (point-min)) @@ -1452,7 +1588,7 @@ (skip-chars-backward "\n") t) (while (and afters - (not (re-search-forward + (not (re-search-forward (concat "^" (regexp-quote (car afters)) ":") nil t))) (pop afters)) @@ -1515,9 +1651,10 @@ (defun message-kill-buffer () "Kill the current buffer." (interactive) - (let ((actions message-kill-actions)) - (kill-buffer (current-buffer)) - (message-do-actions actions))) + (when (yes-or-no-p "Kill the buffer? ") + (let ((actions message-kill-actions)) + (kill-buffer (current-buffer)) + (message-do-actions actions)))) (defun message-bury (buffer) "Bury this mail buffer." @@ -1594,7 +1731,7 @@ ;; Now perform actions on successful sending. (while actions (ignore-errors - (cond + (cond ;; A simple function. ((message-functionp (car actions)) (funcall (car actions))) @@ -1622,7 +1759,7 @@ (set-buffer tembuf) (erase-buffer) ;; Avoid copying text props. - (insert (format + (insert (format "%s" (save-excursion (set-buffer mailbuf) (buffer-string)))) @@ -1732,7 +1869,7 @@ ;; ;; qmail also has the advantage of not having been raped by ;; various vendors, so we don't have to allow for that, either -- - ;; compare this with message-send-mail-with-sendmail and weep + ;; compare this with message-send-mail-with-sendmail and weep ;; for sendmail's lost innocence. ;; ;; all this is way cool coz it lets us keep the arguments entirely @@ -1752,7 +1889,7 @@ "Send the prepared message buffer with mh." (let ((mh-previous-window-config nil) (name (make-temp-name - (concat (file-name-as-directory + (concat (file-name-as-directory (expand-file-name message-autosave-directory)) "msg.")))) (setq buffer-file-name name) @@ -1760,8 +1897,8 @@ (when message-mh-deletable-headers (let ((headers message-mh-deletable-headers)) (while headers - (goto-char (point-min)) - (and (re-search-forward + (goto-char (point-min)) + (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (message-delete-line)) (pop headers)))) @@ -1797,9 +1934,9 @@ (save-excursion (set-buffer tembuf) (buffer-disable-undo (current-buffer)) - (erase-buffer) + (erase-buffer) ;; Avoid copying text props. - (insert (format + (insert (format "%s" (save-excursion (set-buffer messbuf) (buffer-string)))) @@ -1859,7 +1996,7 @@ (save-excursion (save-restriction (widen) - (and + (and ;; We narrow to the headers and check them first. (save-excursion (save-restriction @@ -1869,7 +2006,7 @@ (message-check-news-body-syntax))))) (defun message-check-news-header-syntax () - (and + (and ;; Check for commands in Subject. (message-check 'subject-cmsg (if (string-match "^cmsg " (message-fetch-field "subject")) @@ -1879,11 +2016,11 @@ ;; Check for multiple identical headers. (message-check 'multiple-headers (let (found) - (while (and (not found) + (while (and (not found) (re-search-forward "^[^ \t:]+: " nil t)) (save-excursion - (or (re-search-forward - (concat "^" + (or (re-search-forward + (concat "^" (regexp-quote (setq found (buffer-substring @@ -1899,7 +2036,7 @@ (if (re-search-forward "^Sendsys:\\|^Version:" nil t) (y-or-n-p (format "The article contains a %s command. Really post? " - (buffer-substring (match-beginning 0) + (buffer-substring (match-beginning 0) (1- (match-end 0))))) t)) ;; See whether we can shorten Followup-To. @@ -1913,11 +2050,11 @@ (not (zerop (length - (setq to (completing-read - "Followups to: (default all groups) " + (setq to (completing-read + "Followups to: (default all groups) " (mapcar (lambda (g) (list g)) - (cons "poster" - (message-tokenize-header + (cons "poster" + (message-tokenize-header newsgroups))))))))) (goto-char (point-min)) (insert "Followup-To: " to "\n")) @@ -1951,7 +2088,7 @@ (and subject (not (string-match "\\`[ \t]*\\'" subject))) (ignore - (message + (message "The subject field is empty or missing. Posting is denied."))))) ;; Check the Newsgroups & Followup-To headers. (message-check 'existing-newsgroups @@ -1991,12 +2128,12 @@ (while (and headers (not error)) (when (setq header (mail-fetch-field (car headers))) (if (or - (not + (not (string-match "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" header)) - (memq - nil (mapcar + (memq + nil (mapcar (lambda (g) (not (string-match "\\.\\'\\|\\.\\." g))) (message-tokenize-header header ",")))) @@ -2059,7 +2196,7 @@ ;; Check for control characters. (message-check 'control-chars (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) - (y-or-n-p + (y-or-n-p "The article contains control characters. Really post? ") t)) ;; Check excessive size. @@ -2140,7 +2277,7 @@ (rmail-output file 1 nil t) (let ((mail-use-rfc822 t)) (rmail-output file 1 t t)))))) - + (kill-buffer (current-buffer))))) (defun message-output (filename) @@ -2184,19 +2321,19 @@ (defun message-make-date () "Make a valid data header." (let ((now (current-time))) - (timezone-make-date-arpa-standard + (timezone-make-date-arpa-standard (current-time-string now) (current-time-zone now)))) (defun message-make-message-id () "Make a unique Message-ID." - (concat "<" (message-unique-id) + (concat "<" (message-unique-id) (let ((psubject (save-excursion (message-fetch-field "subject")))) (if (and message-reply-headers (mail-header-references message-reply-headers) (mail-header-subject message-reply-headers) psubject (mail-header-subject message-reply-headers) - (not (string= + (not (string= (message-strip-subject-re (mail-header-subject message-reply-headers)) (message-strip-subject-re psubject)))) @@ -2225,7 +2362,7 @@ (aset user (match-beginning 0) ?_)) user) (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) + (message-number-base36 (+ (car tm) (lsh (% message-unique-id-char 25) 16)) 4) (message-number-base36 (+ (nth 1 tm) (lsh (/ message-unique-id-char 25) 16)) 4) @@ -2245,7 +2382,7 @@ (defun message-make-organization () "Make an Organization header." - (let* ((organization + (let* ((organization (or (getenv "ORGANIZATION") (when message-user-organization (if (message-functionp message-user-organization) @@ -2271,7 +2408,7 @@ (save-restriction (widen) (goto-char (point-min)) - (re-search-forward + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (int-to-string (count-lines (point) (point-max)))))) @@ -2282,10 +2419,10 @@ (let ((from (mail-header-from message-reply-headers)) (date (mail-header-date message-reply-headers))) (when from - (let ((stop-pos + (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of " + "'s message of " (if (or (not date) (string= date "")) "(unknown date)" date))))))) @@ -2304,7 +2441,7 @@ (setcar current (+ (car current) (round (/ future (expt 2 16))))) (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) ;; Return the date in the future in UT. - (timezone-make-date-arpa-standard + (timezone-make-date-arpa-standard (current-time-string current) (current-time-zone current) '(0 "UT")))) (defun message-make-path () @@ -2320,7 +2457,7 @@ (defun message-make-from () "Make a From header." (let* ((login (message-make-address)) - (fullname + (fullname (or (and (boundp 'user-full-name) user-full-name) (user-full-name)))) @@ -2328,7 +2465,7 @@ (setq fullname (user-login-name))) (save-excursion (message-set-work-buffer) - (cond + (cond ((or (null message-from-style) (equal fullname "")) (insert login)) @@ -2367,7 +2504,7 @@ ;; ... then undo escaping of matching parentheses, ;; including matching nested parentheses. (goto-char fullname-start) - (while (re-search-forward + (while (re-search-forward "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" nil 1) (replace-match "\\1(\\3)" t) @@ -2377,7 +2514,7 @@ (defun message-make-sender () "Return the \"real\" user address. -This function tries to ignore all user modifications, and +This function tries to ignore all user modifications, and give as trustworthy answer as possible." (concat (user-login-name) "@" (system-name))) @@ -2397,7 +2534,7 @@ "Return user's fully qualified domain name." (let ((system-name (system-name)) (user-mail (message-user-mail-address))) - (cond + (cond ((string-match "[^.]\\.[^.]" system-name) ;; `system-name' returned the right result. system-name) @@ -2451,7 +2588,7 @@ (let ((headers message-deletable-headers)) (while headers (goto-char (point-min)) - (and (re-search-forward + (and (re-search-forward (concat "^" (symbol-name (car headers)) ": *") nil t) (get-text-property (1+ (match-beginning 0)) 'message-deletable) (message-delete-line)) @@ -2459,7 +2596,7 @@ ;; Go through all the required headers and see if they are in the ;; articles already. If they are not, or are empty, they are ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. + ;; Distribution. (while headers (goto-char (point-min)) (setq elem (pop headers)) @@ -2468,8 +2605,8 @@ (setq header (cdr elem)) (setq header (car elem))) (setq header elem)) - (when (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") + (when (or (not (re-search-forward + (concat "^" (downcase (symbol-name header)) ":") nil t)) (progn ;; The header was found. We insert a space after the @@ -2479,7 +2616,7 @@ (looking-at "[ \t]*$"))) ;; So we find out what value we should insert. (setq value - (cond + (cond ((and (consp elem) (eq (car elem) 'optional)) ;; This is an optional header. If the cdr of this ;; is something that is nil, then we do not insert @@ -2504,7 +2641,7 @@ (read-from-minibuffer (format "Empty header for %s; enter value: " header))))) ;; Finally insert the header. - (when (and value + (when (and value (not (equal value ""))) (save-excursion (if (bolp) @@ -2520,26 +2657,26 @@ ;; Add the deletable property to the headers that require it. (and (memq header message-deletable-headers) (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties + (add-text-properties (point) (match-end 0) '(message-deletable t face italic) (current-buffer))))))) - ;; Insert new Sender if the From is strange. + ;; Insert new Sender if the From is strange. (let ((from (message-fetch-field "from")) (sender (message-fetch-field "sender")) (secure-sender (message-make-sender))) - (when (and from + (when (and from (not (message-check-element 'sender)) (not (string= (downcase (cadr (mail-extract-address-components from))) (downcase secure-sender))) (or (null sender) - (not + (not (string= (downcase (cadr (mail-extract-address-components sender))) (downcase secure-sender))))) - (goto-char (point-min)) + (goto-char (point-min)) ;; Rename any old Sender headers to Original-Sender. (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) (beginning-of-line) @@ -2563,7 +2700,7 @@ (insert (format message-courtesy-message newsgroups))) (t (insert message-courtesy-message))))))) - + ;;; ;;; Setting up a message buffer ;;; @@ -2622,7 +2759,7 @@ (defun message-position-point () "Move point to where the user probably wants to find it." (message-narrow-to-headers) - (cond + (cond ((re-search-forward "^[^:]+:[ \t]*$" nil t) (search-backward ":" ) (widen) @@ -2641,7 +2778,7 @@ (defun message-buffer-name (type &optional to group) "Return a new (unique) buffer name based on TYPE and TO." (cond - ;; Check whether `message-generate-new-buffers' is a function, + ;; Check whether `message-generate-new-buffers' is a function, ;; and if so, call it. ((message-functionp message-generate-new-buffers) (funcall message-generate-new-buffers type to group)) @@ -2692,11 +2829,11 @@ (if message-send-rename-function (funcall message-send-rename-function) (when (string-match "\\`\\*" (buffer-name)) - (rename-buffer + (rename-buffer (concat "*sent " (substring (buffer-name) (match-end 0))) t))) ;; Push the current buffer onto the list. (when message-max-buffers - (setq message-buffer-list + (setq message-buffer-list (nconc message-buffer-list (list (current-buffer)))))) (defvar mc-modes-alist) @@ -2711,7 +2848,7 @@ (setq message-reply-buffer replybuffer) (goto-char (point-min)) ;; Insert all the headers. - (mail-header-format + (mail-header-format (let ((h headers) (alist message-header-format-alist)) (while h @@ -2789,7 +2926,7 @@ (interactive) (let ((message-this-is-mail t)) (message-pop-to-buffer (message-buffer-name "mail" to)) - (message-setup + (message-setup (nconc `((To . ,(or to "")) (Subject . ,(or subject ""))) (when other-headers other-headers))))) @@ -2800,7 +2937,7 @@ (interactive) (let ((message-this-is-news t)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) - (message-setup `((Newsgroups . ,(or newsgroups "")) + (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject "")))))) ;;;###autoload @@ -2809,7 +2946,7 @@ (interactive) (let ((cur (current-buffer)) from subject date reply-to to cc - references message-id follow-to + references message-id follow-to (inhibit-point-motion-hooks t) mct never-mct gnus-warning) (save-restriction @@ -2826,7 +2963,7 @@ (funcall message-wide-reply-to-function))))) ;; Find all relevant headers we need. (setq from (message-fetch-field "from") - date (message-fetch-field "date") + date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") to (message-fetch-field "to") cc (message-fetch-field "cc") @@ -2843,7 +2980,7 @@ (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) (string-match "<[^>]+>" gnus-warning)) (setq message-id (match-string 0 gnus-warning))) - + ;; Handle special values of Mail-Copies-To. (when mct (cond ((equal (downcase mct) "never") @@ -2864,7 +3001,7 @@ (insert (if (bolp) "" ", ") (or to "")) (insert (if mct (concat (if (bolp) "" ", ") mct) "")) (insert (if cc (concat (if (bolp) "" ", ") cc) "")) - ;; Remove addresses that match `rmail-dont-reply-to-names'. + ;; Remove addresses that match `rmail-dont-reply-to-names'. (insert (prog1 (rmail-dont-reply-to (buffer-string)) (erase-buffer))) (goto-char (point-min)) @@ -2881,7 +3018,7 @@ (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) (setq follow-to (list (cons 'To (cdr (pop ccalist))))) (when ccalist - (let ((ccs (cons 'Cc (mapconcat + (let ((ccs (cons 'Cc (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")))) (when (string-match "^ +" (cdr ccs)) (setcdr ccs (substring (cdr ccs) (match-end 0)))) @@ -2897,7 +3034,7 @@ (message-setup `((Subject . ,subject) - ,@follow-to + ,@follow-to ,@(if (or references message-id) `((References . ,(concat (or references "") (and references " ") (or message-id "")))) @@ -2917,7 +3054,7 @@ (interactive) (let ((cur (current-buffer)) from subject date reply-to mct - references message-id follow-to + references message-id follow-to (inhibit-point-motion-hooks t) (message-this-is-news t) followup-to distribution newsgroups gnus-warning posted-to) @@ -2931,7 +3068,7 @@ (setq follow-to (funcall message-followup-to-function))) (setq from (message-fetch-field "from") - date (message-fetch-field "date") + date (message-fetch-field "date") subject (or (message-fetch-field "subject") "none") references (message-fetch-field "references") message-id (message-fetch-field "message-id" t) @@ -2960,13 +3097,13 @@ (message-setup `((Subject . ,subject) - ,@(cond + ,@(cond (to-newsgroups (list (cons 'Newsgroups to-newsgroups))) (follow-to follow-to) ((and followup-to message-use-followup-to) (list - (cond + (cond ((equal (downcase followup-to) "poster") (if (or (eq message-use-followup-to 'use) (message-y-or-n-p "Obey Followup-To: poster? " t "\ @@ -3068,7 +3205,7 @@ header line with the old Message-ID." (interactive) (let ((cur (current-buffer))) - ;; Check whether the user owns the article that is to be superseded. + ;; Check whether the user owns the article that is to be superseded. (unless (string-equal (downcase (cadr (mail-extract-address-components (message-fetch-field "from")))) @@ -3116,14 +3253,14 @@ (save-restriction (current-buffer) (message-narrow-to-head) - (concat "[" (or (message-fetch-field + (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from")) "(nowhere)") "] " (or (message-fetch-field "Subject") ""))))) ;;;###autoload (defun message-forward (&optional news) - "Forward the current message via mail. + "Forward the current message via mail. Optional NEWS will use news to forward instead of mail." (interactive "P") (let ((cur (current-buffer)) @@ -3131,7 +3268,7 @@ art-beg) (if news (message-news nil subject) (message-mail nil subject)) ;; Put point where we want it before inserting the forwarded - ;; message. + ;; message. (if message-signature-before-forwarded-message (goto-char (point-max)) (message-goto-body)) @@ -3234,7 +3371,7 @@ (and (search-forward "\n\n" nil t) (re-search-forward "^Return-Path:.*\n" nil t))) ;; We remove everything before the bounced mail. - (delete-region + (delete-region (point-min) (if (re-search-forward "^[^ \n\t]+:" nil t) (match-beginning 0) @@ -3284,7 +3421,7 @@ (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) + (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) ;;;###autoload @@ -3297,12 +3434,12 @@ (same-window-buffer-names nil) (same-window-regexps nil)) (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) + (message-setup `((Newsgroups . ,(or newsgroups "")) (Subject . ,(or subject ""))))) ;;; underline.el -;; This code should be moved to underline.el (from which it is stolen). +;; This code should be moved to underline.el (from which it is stolen). ;;;###autoload (defun bold-region (start end) @@ -3329,7 +3466,7 @@ (save-excursion (let ((end1 (make-marker))) (move-marker end1 (max start end)) - (goto-char (min start end)) + (goto-char (min start end)) (while (re-search-forward "\b" end1 t) (if (eq (following-char) (char-after (- (point) 2))) (delete-char -2)))))) @@ -3343,7 +3480,7 @@ ;;; Group name completion. (defvar message-newgroups-header-regexp - "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):" + "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" "Regexp that match headers that lists groups.") (defun message-tab () @@ -3357,9 +3494,9 @@ (defvar gnus-active-hashtb) (defun message-expand-group () - (let* ((b (save-excursion + (let* ((b (save-excursion (save-restriction - (narrow-to-region + (narrow-to-region (save-excursion (beginning-of-line) (skip-chars-forward "^:") @@ -3373,7 +3510,7 @@ (cur (current-buffer)) comp) (delete-region b (point)) - (cond + (cond ((= (length completions) 1) (if (string= (car completions) string) (progn @@ -3399,7 +3536,7 @@ ;;; Help stuff. (defun message-talkative-question (ask question show &rest text) - "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. + "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. The following arguments may contain lists of values." (if (and show (setq text (message-flatten-list text))) @@ -3417,7 +3554,7 @@ \(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) => (1 2 3 4 5 6 7)" - (cond ((consp list) + (cond ((consp list) (apply 'append (mapcar 'message-flatten-list list))) (list (list list))))
--- a/lisp/gnus/messagexmas.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/messagexmas.el Mon Aug 13 09:18:39 2007 +0200 @@ -43,7 +43,7 @@ `default-toolbar', `top-toolbar', `bottom-toolbar', `right-toolbar', and `left-toolbar'.") -(defvar message-toolbar +(defvar message-toolbar '([message-spell ispell-message t "Spell"] [message-help (Info-goto-node "(Message)Top") t "Message help"]) "The message buffer toolbar.") @@ -99,7 +99,7 @@ (defun message-xmas-make-caesar-translation-table (n) "Create a rot table with offset N." - (let ((i -1) + (let ((i -1) (table (make-string 256 0)) (a (char-int ?a)) (A (char-int ?A)))
--- a/lisp/gnus/messcompat.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/messcompat.el Mon Aug 13 09:18:39 2007 +0200 @@ -24,7 +24,7 @@ ;;; Commentary: ;; This file tries to provide backward compatability with sendmail.el -;; for Message mode. It should be used by simply adding +;; for Message mode. It should be used by simply adding ;; ;; (require 'messcompat) ;; @@ -59,7 +59,7 @@ (defvar message-mode-hook mail-mode-hook "Hook run in message mode buffers.") -(defvar message-indentation-spaces mail-indentation-spaces +(defvar message-indentation-spaces mail-indentation-spaces "*Number of spaces to insert at the beginning of each cited line. Used by `message-yank-original' via `message-yank-cite'.")
--- a/lisp/gnus/nnbabyl.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnbabyl.el Mon Aug 13 09:18:39 2007 +0200 @@ -25,7 +25,7 @@ ;;; Commentary: ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -119,7 +119,7 @@ (deffoo nnbabyl-open-server (server &optional defs) (nnoo-change-server 'nnbabyl server defs) (nnbabyl-create-mbox) - (cond + (cond ((not (file-exists-p nnbabyl-mbox-file)) (nnbabyl-close-server) (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) @@ -165,7 +165,7 @@ (while (and (not (looking-at ".+:")) (zerop (forward-line 1)))) (setq start (point)) - (or (when (re-search-forward + (or (when (re-search-forward (concat "^" nnbabyl-mail-delimiter) nil t) (beginning-of-line) t) @@ -177,7 +177,7 @@ (insert-buffer-substring nnbabyl-mbox-buffer start stop) (goto-char (point-min)) ;; If there is an EOOH header, then we have to remove some - ;; duplicated headers. + ;; duplicated headers. (setq summary-line (looking-at "Summary-line:")) (when (search-forward "\n*** EOOH ***" nil t) (if summary-line @@ -196,7 +196,7 @@ (deffoo nnbabyl-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnbabyl-group-alist)))) (save-excursion - (cond + (cond ((or (null active) (null (nnbabyl-possibly-change-newsgroup group server))) (nnheader-report 'nnbabyl "No such group: %s" group)) @@ -205,15 +205,15 @@ (nnheader-insert "")) (t (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" + (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr active) (car active))) (car active) (cdr active) group)))))) (deffoo nnbabyl-request-scan (&optional group server) (nnbabyl-possibly-change-newsgroup group server) (nnbabyl-read-mbox) - (nnmail-get-new-mail - 'nnbabyl + (nnmail-get-new-mail + 'nnbabyl (lambda () (save-excursion (set-buffer nnbabyl-mbox-buffer) @@ -263,7 +263,7 @@ rest) (nnmail-activate 'nnbabyl) - (save-excursion + (save-excursion (set-buffer nnbabyl-mbox-buffer) (gnus-set-text-properties (point-min) (point-max) nil) (while (and articles is-old) @@ -272,10 +272,10 @@ (if (setq is-old (nnmail-expired-article-p newsgroup - (buffer-substring + (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn - (nnheader-message 5 "Deleting article %d in %s..." + (nnheader-message 5 "Deleting article %d in %s..." (car articles) newsgroup) (nnbabyl-delete-mail)) (push (car articles) rest))) @@ -292,18 +292,18 @@ (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) (nconc rest articles)))) -(deffoo nnbabyl-request-move-article +(deffoo nnbabyl-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnbabyl move*")) result) - (and + (and (nnbabyl-request-article article group server) (save-excursion (set-buffer buf) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" + (while (re-search-forward + "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) @@ -324,7 +324,7 @@ (nnmail-check-syntax) (let ((buf (current-buffer)) result beg) - (and + (and (nnmail-activate 'nnbabyl) (save-excursion (goto-char (point-min)) @@ -333,6 +333,7 @@ (save-excursion (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) (delete-region (point) (progn (forward-line 1) (point))))) + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (car (nnbabyl-save-mail (if (stringp group) (list (cons group (nnbabyl-active-number group))) @@ -343,6 +344,7 @@ (goto-char (match-end 0)) (insert-buffer-substring buf) (when last + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (save-buffer) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) @@ -376,7 +378,7 @@ (when found (save-buffer))))) ;; Remove the group from all structures. - (setq nnbabyl-group-alist + (setq nnbabyl-group-alist (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) nnbabyl-current-group nil) ;; Save the active file. @@ -438,7 +440,7 @@ (delete-region (point-min) (point-max)))))) (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) - (when (and server + (when (and server (not (nnbabyl-server-opened server))) (nnbabyl-open-server server)) (when (or (not nnbabyl-mbox-buffer) @@ -454,7 +456,7 @@ (defun nnbabyl-article-string (article) (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" + (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) @@ -478,7 +480,7 @@ (search-forward "\n\n" nil t)) (setq chars (- (point-max) (point)) lines (max (- (count-lines (point) (point-max)) 1) 0)) - ;; Move back to the end of the headers. + ;; Move back to the end of the headers. (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-char -1) @@ -513,7 +515,7 @@ (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" + (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) @@ -556,11 +558,11 @@ (let ((delim (concat "^" nnbabyl-mail-delimiter)) (alist nnbabyl-group-alist) start end number) - (set-buffer (setq nnbabyl-mbox-buffer - (nnheader-find-file-noselect + (set-buffer (setq nnbabyl-mbox-buffer + (nnheader-find-file-noselect nnbabyl-mbox-file nil 'raw))) ;; Save previous buffer mode. - (setq nnbabyl-previous-buffer-mode + (setq nnbabyl-previous-buffer-mode (cons (cons (point-min) (point-max)) major-mode)) @@ -578,14 +580,14 @@ (caar alist)) nil t) (> (setq number - (string-to-number + (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) (cdadar alist))) (setcdr (cadar alist) number)) (setq alist (cdr alist))) - - ;; We go through the mbox and make sure that each and + + ;; We go through the mbox and make sure that each and ;; every mail belongs to some group or other. (goto-char (point-min)) (if (looking-at "\^L") @@ -599,7 +601,7 @@ (save-excursion (save-restriction (narrow-to-region (goto-char start) end) - (nnbabyl-save-mail + (nnbabyl-save-mail (nnmail-article-group 'nnbabyl-active-number)) (setq end (point-max))))) (goto-char (setq start end)))
--- a/lisp/gnus/nndb.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nndb.el Mon Aug 13 09:18:39 2007 +0200 @@ -179,7 +179,7 @@ server t)) result)) - + (deffoo nndb-request-accept-article (group server &optional last) "The article in the current buffer is put into GROUP." (nntp-possibly-change-group group server) ;;- @@ -198,7 +198,7 @@ (list art)))) (deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced + "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER." (set-buffer buffer) (let (art statmsg)
--- a/lisp/gnus/nndir.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nndir.el Mon Aug 13 09:18:39 2007 +0200 @@ -73,12 +73,12 @@ defs) (nnoo-change-server 'nndir server defs) (let (err) - (cond + (cond ((not (condition-case arg (file-exists-p nndir-directory) (ftp-error (setq err (format "%s" arg))))) (nndir-close-server) - (nnheader-report + (nnheader-report 'nndir (or err "No such file or directory: %s" nndir-directory))) ((not (file-directory-p (file-truename nndir-directory))) (nndir-close-server)
--- a/lisp/gnus/nndoc.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nndoc.el Mon Aug 13 09:18:39 2007 +0200 @@ -43,8 +43,8 @@ (defvoo nndoc-post-type 'mail "*Whether the nndoc group is `mail' or `post'.") -(defvar nndoc-type-alist - `((mmdf +(defvar nndoc-type-alist + `((mmdf (article-begin . "^\^A\^A\^A\^A\n") (body-end . "^\^A\^A\^A\^A\n")) (news @@ -52,10 +52,10 @@ (rnews (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") (body-end-function . nndoc-rnews-body-end)) - (mbox + (mbox (article-begin-function . nndoc-mbox-article-begin) (body-end-function . nndoc-mbox-body-end)) - (babyl + (babyl (article-begin . "\^_\^L *\n") (body-end . "\^_") (body-begin-function . nndoc-babyl-body-begin) @@ -108,7 +108,7 @@ (generate-head-function . nndoc-generate-lanl-gov-head) (article-transform-function . nndoc-transform-lanl-gov-announce) (subtype preprints guess)) - (guess + (guess (guess . t) (subtype nil)) (digest @@ -190,11 +190,11 @@ (when entry (if (stringp article) nil - (insert-buffer-substring + (insert-buffer-substring nndoc-current-buffer (car entry) (nth 1 entry)) (insert "\n") (setq beg (point)) - (insert-buffer-substring + (insert-buffer-substring nndoc-current-buffer (nth 2 entry) (nth 3 entry)) (goto-char beg) (when nndoc-prepare-body-function @@ -206,7 +206,7 @@ (deffoo nndoc-request-group (group &optional server dont-check) "Select news GROUP." (let (number) - (cond + (cond ((not (nndoc-possibly-change-buffer group server)) (nnheader-report 'nndoc "No such file or buffer: %s" nndoc-address)) @@ -250,24 +250,24 @@ (defun nndoc-possibly-change-buffer (group source) (let (buf) - (cond + (cond ;; The current buffer is this group's buffer. ((and nndoc-current-buffer (buffer-name nndoc-current-buffer) - (eq nndoc-current-buffer + (eq nndoc-current-buffer (setq buf (cdr (assoc group nndoc-group-alist)))))) ;; We change buffers by taking an old from the group alist. - ;; `source' is either a string (a file name) or a buffer object. + ;; `source' is either a string (a file name) or a buffer object. (buf (setq nndoc-current-buffer buf)) - ;; It's a totally new group. + ;; It's a totally new group. ((or (and (bufferp nndoc-address) (buffer-name nndoc-address)) (and (stringp nndoc-address) (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) - (push (cons group (setq nndoc-current-buffer - (get-buffer-create + (push (cons group (setq nndoc-current-buffer + (get-buffer-create (concat " *nndoc " group "*")))) nndoc-group-alist) (setq nndoc-dissection-alist nil) @@ -296,8 +296,8 @@ (defun nndoc-set-delims () "Set the nndoc delimiter variables according to the type of the document." - (let ((vars '(nndoc-file-begin - nndoc-first-article + (let ((vars '(nndoc-file-begin + nndoc-first-article nndoc-article-end nndoc-head-begin nndoc-head-end nndoc-file-end nndoc-article-begin nndoc-body-begin nndoc-body-end-function nndoc-body-end @@ -308,7 +308,7 @@ (set (pop vars) nil))) (let (defs) ;; Guess away until we find the real file type. - (while (assq 'guess (setq defs (cdr (assq nndoc-article-type + (while (assq 'guess (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)))) (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) ;; Set the nndoc variables. @@ -324,7 +324,7 @@ (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) (goto-char (point-min)) (when (numberp (setq result (funcall (intern - (format "nndoc-%s-type-p" + (format "nndoc-%s-type-p" (car entry)))))) (push (cons result entry) results) (setq result nil)))) @@ -334,7 +334,7 @@ (car entry) (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2)))))))) -;;; +;;; ;;; Built-in type predicates and functions ;;; @@ -351,7 +351,7 @@ len end) (when (save-excursion - (and (re-search-backward + (and (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq end (point)) (search-forward "\n\n" beg t) @@ -472,7 +472,7 @@ (defun nndoc-standard-digest-type-p () (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) - (re-search-forward + (re-search-forward (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) t)) @@ -495,7 +495,7 @@ ;; (when (re-search-backward "^\\\\\\\\$" nil t) ;; (replace-match "" t t)) ) - + (defun nndoc-generate-lanl-gov-head (article) (let ((entry (cdr (assq article nndoc-dissection-alist))) (e-mail "no address given") @@ -518,7 +518,7 @@ (setq from (replace-match "" t t from))) (insert "From: " (or from "unknown") "\nSubject: " (or subject "(no subject)") "\n"))) - + ;;; @@ -549,7 +549,7 @@ (setq first nil) (cond (nndoc-head-begin-function (funcall nndoc-head-begin-function)) - (nndoc-head-begin + (nndoc-head-begin (nndoc-search nndoc-head-begin))) (if (or (>= (point) (point-max)) (and nndoc-file-end
--- a/lisp/gnus/nndraft.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nndraft.el Mon Aug 13 09:18:39 2007 +0200 @@ -63,7 +63,7 @@ 'headers (while articles (set-buffer buf) - (when (nndraft-request-article + (when (nndraft-request-article (setq article (pop articles)) group server (current-buffer)) (goto-char (point-min)) (if (search-forward "\n\n" nil t) @@ -83,7 +83,7 @@ (nnoo-change-server 'nndraft server defs) (unless (assq 'nndraft-directory defs) (setq nndraft-directory server)) - (cond + (cond ((not (file-exists-p nndraft-directory)) (nndraft-close-server) (nnheader-report 'nndraft "No such file or directory: %s" @@ -98,7 +98,7 @@ (deffoo nndraft-request-article (id &optional group server buffer) (when (numberp id) - ;; We get the newest file of the auto-saved file and the + ;; We get the newest file of the auto-saved file and the ;; "real" file. (let* ((file (nndraft-article-filename id)) (auto (nndraft-auto-save-file-name file)) @@ -106,10 +106,10 @@ (nntp-server-buffer (or buffer nntp-server-buffer))) (when (and (file-exists-p newest) (nnmail-find-file newest)) - (save-excursion + (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) - ;; If there's a mail header separator in this file, + ;; If there's a mail header separator in this file, ;; we remove it. (when (re-search-forward (concat "^" mail-header-separator "$") nil t) @@ -163,7 +163,7 @@ (nndraft-execute-nnmh-command `(nnmh-request-newgroups ,date ,server))) -(deffoo nndraft-request-expire-articles +(deffoo nndraft-request-expire-articles (articles group &optional server force) (let ((res (nndraft-execute-nnmh-command `(nnmh-request-expire-articles
--- a/lisp/gnus/nneething.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nneething.el Mon Aug 13 09:18:39 2007 +0200 @@ -26,7 +26,7 @@ ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>. ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -50,7 +50,7 @@ -;;; Internal variables. +;;; Internal variables. (defconst nneething-version "nneething 1.0" "nneething version.") @@ -137,7 +137,7 @@ (if (> (car nneething-active) (cdr nneething-active)) (nnheader-insert "211 0 1 0 %s\n" group) (nnheader-insert - "211 %d %d %d %s\n" + "211 %d %d %d %s\n" (- (1+ (cdr nneething-active)) (car nneething-active)) (car nneething-active) (cdr nneething-active) group))) @@ -180,7 +180,7 @@ nneething-group-alist)))))) (defun nneething-map-file () - ;; We make sure that the .nneething directory exists. + ;; We make sure that the .nneething directory exists. (gnus-make-directory nneething-map-file-directory) ;; We store it in a special directory under the user's home dir. (concat (file-name-as-directory nneething-map-file-directory) @@ -202,7 +202,7 @@ (setq nneething-map (mapcar (lambda (n) (list (cdr n) (car n) - (nth 5 (file-attributes + (nth 5 (file-attributes (nneething-file-name (car n)))))) nneething-map))) ;; Remove files matching the exclusion regexp. @@ -243,7 +243,7 @@ (nneething-file-name (car files))))) nneething-map)) (setq files (cdr files))) - (when (and touched + (when (and touched (not nneething-read-only)) (nnheader-temp-write map-file (insert "(setq nneething-map '") @@ -261,15 +261,15 @@ (defun nneething-make-head (file &optional buffer) "Create a head by looking at the file attributes of FILE." (let ((atts (file-attributes file))) - (insert + (insert "Subject: " (file-name-nondirectory file) "\n" - "Message-ID: <nneething-" + "Message-ID: <nneething-" (int-to-string (incf nneething-message-id-number)) "@" (system-name) ">\n" (if (equal '(0 0) (nth 5 atts)) "" (concat "Date: " (current-time-string (nth 5 atts)) "\n")) (or (when buffer - (save-excursion + (save-excursion (set-buffer buffer) (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) (concat "From: " (match-string 0) "\n")))) @@ -277,10 +277,10 @@ (if (> (string-to-int (int-to-string (nth 7 atts))) 0) (concat "Chars: " (int-to-string (nth 7 atts)) "\n") "") - (if buffer + (if buffer (save-excursion (set-buffer buffer) - (concat "Lines: " (int-to-string + (concat "Lines: " (int-to-string (count-lines (point-min) (point-max))) "\n")) "") @@ -288,20 +288,20 @@ (defun nneething-from-line (uid &optional file) "Return a From header based of UID." - (let* ((login (condition-case nil + (let* ((login (condition-case nil (user-login-name uid) - (error + (error (cond ((= uid (user-uid)) (user-login-name)) ((zerop uid) "root") (t (int-to-string uid)))))) - (name (condition-case nil + (name (condition-case nil (user-full-name uid) - (error + (error (cond ((= uid (user-uid)) (user-full-name)) ((zerop uid) "Ms. Root"))))) (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) (prog1 - (substring file + (substring file (match-beginning 1) (match-end 1)) (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) @@ -310,7 +310,7 @@ (match-end 2)) name nil))) (system-name)))) - (concat "From: " login "@" host + (concat "From: " login "@" host (if name (concat " (" name ")") "") "\n"))) (defun nneething-get-head (file) @@ -320,19 +320,19 @@ (setq case-fold-search nil) (buffer-disable-undo (current-buffer)) (erase-buffer) - (cond + (cond ((not (file-exists-p file)) - ;; The file do not exist. + ;; The file do not exist. nil) ((or (file-directory-p file) (file-symlink-p file)) ;; It's a dir, so we fudge a head. (nneething-make-head file) t) - (t + (t ;; We examine the file. (nnheader-insert-head file) (if (nnheader-article-p) - (delete-region + (delete-region (progn (goto-char (point-min)) (or (and (search-forward "\n\n" nil t)
--- a/lisp/gnus/nnfolder.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnfolder.el Mon Aug 13 09:18:39 2007 +0200 @@ -39,7 +39,7 @@ (defvoo nnfolder-directory (expand-file-name message-directory) "The name of the nnfolder directory.") -(defvoo nnfolder-active-file +(defvoo nnfolder-active-file (nnheader-concat nnfolder-directory "active") "The name of the active file.") @@ -49,7 +49,7 @@ (defvoo nnfolder-ignore-active-file nil "If non-nil, causes nnfolder to do some extra work in order to determine the true active ranges of an mbox file. Note that the active file is still -saved, but it's values are not used. This costs some extra time when +saved, but it's values are not used. This costs some extra time when scanning an mbox when opening it.") (defvoo nnfolder-distrust-mbox nil @@ -59,7 +59,7 @@ When nil, scans occur forward from the last marked message, a huge time saver for large mailboxes.") -(defvoo nnfolder-newsgroups-file +(defvoo nnfolder-newsgroups-file (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") @@ -89,6 +89,7 @@ (defvoo nnfolder-group-alist nil) (defvoo nnfolder-buffer-alist nil) (defvoo nnfolder-scantime-alist nil) +(defvoo nnfolder-active-timestamp nil) @@ -134,9 +135,9 @@ (deffoo nnfolder-open-server (server &optional defs) (nnoo-change-server 'nnfolder server defs) - (when (not (file-exists-p nnfolder-directory)) - (gnus-make-directory nnfolder-directory)) - (cond + (nnmail-activate 'nnfolder t) + (gnus-make-directory nnfolder-directory) + (cond ((not (file-exists-p nnfolder-directory)) (nnfolder-close-server) (nnheader-report 'nnfolder "Couldn't create directory: %s" @@ -145,6 +146,7 @@ (nnfolder-close-server) (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) (t + (nnmail-activate 'nnfolder) (nnheader-report 'nnfolder "Opened server %s using directory %s" server nnfolder-directory) t))) @@ -186,44 +188,44 @@ (goto-char (point-min)) (search-forward (concat "\n" nnfolder-article-marker)) (cons nnfolder-current-group - (string-to-int - (buffer-substring + (string-to-int + (buffer-substring (point) (progn (end-of-line) (point))))))))))) (deffoo nnfolder-request-group (group &optional server dont-check) + (nnfolder-possibly-change-group group server) (save-excursion (nnmail-activate 'nnfolder) (if (not (assoc group nnfolder-group-alist)) (nnheader-report 'nnfolder "No such group: %s" group) - (nnfolder-possibly-change-group group server) (if dont-check - (progn + (progn (nnheader-report 'nnfolder "Selected group %s" group) t) (let* ((active (assoc group nnfolder-group-alist)) (group (car active)) (range (cadr active))) - (cond + (cond ((null active) (nnheader-report 'nnfolder "No such group: %s" group)) ((null nnfolder-current-group) (nnheader-report 'nnfolder "Empty group: %s" group)) (t (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" + (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr range) (car range))) (car range) (cdr range) group)))))))) (deffoo nnfolder-request-scan (&optional group server) (nnfolder-possibly-change-group group server t) (nnmail-get-new-mail - 'nnfolder + 'nnfolder (lambda () (let ((bufs nnfolder-buffer-alist)) (save-excursion (while bufs (if (not (buffer-name (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist + (setq nnfolder-buffer-alist (delq (car bufs) nnfolder-buffer-alist)) (set-buffer (nth 1 (car bufs))) (nnfolder-save-buffer) @@ -269,7 +271,7 @@ (deffoo nnfolder-request-create-group (group &optional server args) (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) - (when group + (when group (unless (assoc group nnfolder-group-alist) (push (list group (cons 1 0)) nnfolder-group-alist) (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) @@ -291,26 +293,26 @@ (save-excursion (nnmail-find-file nnfolder-newsgroups-file))) -(deffoo nnfolder-request-expire-articles +(deffoo nnfolder-request-expire-articles (articles newsgroup &optional server force) (nnfolder-possibly-change-group newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnfolder) - (save-excursion + (save-excursion (set-buffer nnfolder-current-buffer) (while (and articles is-old) (goto-char (point-min)) (when (search-forward (nnfolder-article-string (car articles)) nil t) (if (setq is-old - (nnmail-expired-article-p + (nnmail-expired-article-p newsgroup - (buffer-substring + (buffer-substring (point) (progn (end-of-line) (point))) force nnfolder-inhibit-expiry)) (progn - (nnheader-message 5 "Deleting article %d..." + (nnheader-message 5 "Deleting article %d..." (car articles) newsgroup) (nnfolder-delete-mail)) (push (car articles) rest))) @@ -338,7 +340,7 @@ (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnfolder move*")) result) - (and + (and (nnfolder-request-article article group server) (save-excursion (set-buffer buf) @@ -346,7 +348,7 @@ (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward (concat "^" nnfolder-article-marker) (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) @@ -367,11 +369,11 @@ (nnfolder-possibly-change-group group server) (nnmail-check-syntax) (let ((buf (current-buffer)) - result) + result art-group) (goto-char (point-min)) (when (looking-at "X-From-Line: ") (replace-match "From ")) - (and + (and (nnfolder-request-list) (save-excursion (set-buffer buf) @@ -380,14 +382,18 @@ (forward-line -1) (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (car (nnfolder-save-mail (if (stringp group) (list (cons group (nnfolder-active-number group))) - (nnmail-article-group 'nnfolder-active-number)))))) - (save-excursion - (set-buffer nnfolder-current-buffer) - (and last (nnfolder-save-buffer)))) + (setq art-group + (nnmail-article-group 'nnfolder-active-number))))))) + (when last + (save-excursion + (nnfolder-possibly-change-folder (or (caar art-group) group)) + (nnfolder-save-buffer) + (nnmail-cache-close)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) (unless result (nnheader-report 'nnfolder "Couldn't store article")) @@ -414,7 +420,7 @@ (ignore-errors (delete-file (nnfolder-group-pathname group)))) ;; Remove the group from all structures. - (setq nnfolder-group-alist + (setq nnfolder-group-alist (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) nnfolder-current-group nil nnfolder-current-buffer nil) @@ -428,7 +434,7 @@ (set-buffer nnfolder-current-buffer) (and (file-writable-p buffer-file-name) (ignore-errors - (rename-file + (rename-file buffer-file-name (nnfolder-group-pathname new-name)) t) @@ -467,65 +473,51 @@ (point)) (point-max)))))) -;; When scanning, we're not looking t immediately switch into the group - if -;; we know our information is up to date, don't even bother reading the file. (defun nnfolder-possibly-change-group (group &optional server scanning) + ;; Change servers. (when (and server (not (nnfolder-server-opened server))) (nnfolder-open-server server)) - (when (and group (or nnfolder-current-buffer - (not (equal group nnfolder-current-group)))) - (gnus-make-directory (directory-file-name nnfolder-directory)) - (nnfolder-possibly-activate-groups nil) - (or (assoc group nnfolder-group-alist) - (not (file-exists-p - (nnfolder-group-pathname group))) - (progn - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) + ;; Change group. + (when (and group + (not (equal group nnfolder-current-group))) + (nnmail-activate 'nnfolder) + (when (and (not (assoc group nnfolder-group-alist)) + (not (file-exists-p + (nnfolder-group-pathname group)))) + ;; The group doesn't exist, so we create a new entry for it. + (push (list group (cons 1 0)) nnfolder-group-alist) + (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) + (let (inf file) - (if (and (equal group nnfolder-current-group) - nnfolder-current-buffer - (buffer-name nnfolder-current-buffer)) - () - (setq nnfolder-current-group group) - - ;; If we have to change groups, see if we don't already have the mbox - ;; in memory. If we do, verify the modtime and destroy the mbox if - ;; needed so we can rescan it. - (when (setq inf (assoc group nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (nth 1 inf))) + ;; If we have to change groups, see if we don't already have the + ;; folder in memory. If we do, verify the modtime and destroy + ;; the folder if needed so we can rescan it. + (when (setq inf (assoc group nnfolder-buffer-alist)) + (setq nnfolder-current-buffer (nth 1 inf))) - ;; If the buffer is not live, make sure it isn't in the alist. If it - ;; is live, verify that nobody else has touched the file since last - ;; time. - (when (or (not (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer))) - (not (and (bufferp nnfolder-current-buffer) - (verify-visited-file-modtime - nnfolder-current-buffer)))) - (when (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer) - (bufferp nnfolder-current-buffer)) - (kill-buffer nnfolder-current-buffer)) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)) - (setq inf nil)) - - (unless inf - (save-excursion - (setq file (nnfolder-group-pathname group)) - (unless (file-directory-p (file-truename file)) - (unless (file-exists-p file) - (gnus-make-directory (file-name-directory file)) - (nnmail-write-region 1 1 file t 'nomesg)) - (setq nnfolder-current-group group) - (setq nnfolder-current-buffer - (nnfolder-read-folder file scanning)) - (when nnfolder-current-buffer - (set-buffer nnfolder-current-buffer) - (push (list group nnfolder-current-buffer) - nnfolder-buffer-alist))))))) - (setq nnfolder-current-group group))) + ;; If the buffer is not live, make sure it isn't in the alist. If it + ;; is live, verify that nobody else has touched the file since last + ;; time. + (when (and nnfolder-current-buffer + (not (gnus-buffer-live-p nnfolder-current-buffer))) + (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) + nnfolder-current-buffer nil)) + + (setq nnfolder-current-group group) + + (when (or (not nnfolder-current-buffer) + (not (verify-visited-file-modtime nnfolder-current-buffer))) + (save-excursion + (setq file (nnfolder-group-pathname group)) + ;; See whether we need to create the new file. + (unless (file-exists-p file) + (gnus-make-directory (file-name-directory file)) + (nnmail-write-region 1 1 file t 'nomesg)) + (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) + (set-buffer nnfolder-current-buffer) + (push (list group nnfolder-current-buffer) + nnfolder-buffer-alist))))))) (defun nnfolder-save-mail (group-art-list) "Called narrowed to an article." @@ -534,7 +526,7 @@ ;; The From line may have been quoted by movemail. (when (looking-at (concat ">" message-unix-mail-delimiter)) (delete-char 1)) - ;; This might come from somewhere else. + ;; This might come from somewhere else. (unless (looking-at message-unix-mail-delimiter) (insert "From nobody " (current-time-string) "\n") (goto-char (point-min))) @@ -550,35 +542,28 @@ (run-hooks 'nnfolder-prepare-save-mail-hook) ;; Insert the mail into each of the destination groups. - (while group-art-list - (setq group-art (car group-art-list) - group-art-list (cdr group-art-list)) - - ;; Kill the previous newsgroup markers. + (while (setq group-art (pop group-art-list)) + ;; Kill any previous newsgroup markers. (goto-char (point-min)) (search-forward "\n\n" nil t) (forward-line -1) (while (search-backward (concat "\n" nnfolder-article-marker) nil t) (delete-region (1+ (point)) (progn (forward-line 2) (point)))) - (nnfolder-possibly-change-group (car group-art)) ;; Insert the new newsgroup marker. (nnfolder-insert-newsgroup-line group-art) - (unless nnfolder-current-buffer - (nnfolder-close-group (car group-art)) - (nnfolder-request-create-group (car group-art)) - (nnfolder-possibly-change-group (car group-art))) - (let ((beg (point-min)) - (end (point-max)) - (obuf (current-buffer))) - (set-buffer nnfolder-current-buffer) - (goto-char (point-max)) - (unless (eolp) - (insert "\n")) - (unless (bobp) - (insert "\n")) - (insert-buffer-substring obuf beg end) - (set-buffer obuf))) + + (save-excursion + (let ((beg (point-min)) + (end (point-max)) + (obuf (current-buffer))) + (nnfolder-possibly-change-folder (car group-art)) + (goto-char (point-max)) + (unless (eolp) + (insert "\n")) + (unless (bobp) + (insert "\n")) + (insert-buffer-substring obuf beg end)))) ;; Did we save it anywhere? save-list)) @@ -591,15 +576,6 @@ (insert (format (concat nnfolder-article-marker "%d %s\n") (cdr group-art) (current-time-string)))))) -(defun nnfolder-possibly-activate-groups (&optional group) - (save-excursion - ;; If we're looking for the activation of a specific group, find out - ;; its real name and switch to it. - (when group - (nnfolder-possibly-change-group group)) - ;; If the group alist isn't active, activate it now. - (nnmail-activate 'nnfolder))) - (defun nnfolder-active-number (group) ;; Find the next article number in GROUP. (let ((active (cadr (assoc group nnfolder-group-alist)))) @@ -612,6 +588,17 @@ nnfolder-group-alist)) (cdr active))) +(defun nnfolder-possibly-change-folder (group) + (let ((inf (assoc group nnfolder-buffer-alist))) + (if (and inf + (gnus-buffer-live-p (cadr inf))) + (set-buffer (cadr inf)) + (when inf + (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))) + (when nnfolder-group-alist + (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) + (push (list group (nnfolder-read-folder group)) + nnfolder-buffer-alist)))) ;; This method has a problem if you've accidentally let the active list get ;; out of sync with the files. This could happen, say, if you've @@ -628,36 +615,27 @@ ;; shouldn't cost us much extra time at all, but will be a lot less ;; vulnerable to glitches between the mbox and the active file. -(defun nnfolder-read-folder (file &optional scanning) - ;; This is an attempt at a serious shortcut - don't even read in the file - ;; if we know we've seen it since the last time it was touched. - (let ((scantime (cadr (assoc nnfolder-current-group - nnfolder-scantime-alist))) - (modtime (nth 5 (file-attributes file)))) - (if (and scanning scantime - (eq (car scantime) (car modtime)) - (eq (cdr scantime) (cadr modtime))) - nil +(defun nnfolder-read-folder (group) + (let* ((file (nnfolder-group-pathname group)) + (buffer (set-buffer (nnheader-find-file-noselect file)))) + (if (equal (cadr (assoc group nnfolder-scantime-alist)) + (nth 5 (file-attributes file))) + ;; This looks up-to-date, so we don't do any scanning. + buffer + ;; Parse the damn thing. (save-excursion - (nnfolder-possibly-activate-groups nil) + (nnmail-activate 'nnfolder) ;; Read in the file. - (set-buffer (setq nnfolder-current-buffer - (nnheader-find-file-noselect file))) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only nil) - ;; If the file hasn't been touched since the last time we scanned it, - ;; don't bother doing anything with it. (let ((delim (concat "^" message-unix-mail-delimiter)) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") - (active (or (cadr (assoc nnfolder-current-group - nnfolder-group-alist)) - (cons 1 0))) - (scantime (assoc nnfolder-current-group nnfolder-scantime-alist)) + (active (cadr (assoc group nnfolder-group-alist))) + (scantime (assoc group nnfolder-scantime-alist)) (minid (lsh -1 -1)) - maxid start end newscantime) - - (setq maxid (or (cdr active) 0)) + maxid start end newscantime + buffer-read-only) + (buffer-disable-undo (current-buffer)) + (setq maxid (cdr active)) (goto-char (point-min)) ;; Anytime the active number is 1 or 0, it is suspect. In that @@ -692,20 +670,19 @@ ;; Keep track of the active number on our own, and insert it back ;; into the active list when we're done. Also, prime the pump to ;; cut down on the number of searches we do. + (unless (nnmail-search-unix-mail-delim) + (goto-char (point-max))) (setq end (point-marker)) - (set-marker end (or (and (nnmail-search-unix-mail-delim) - (point)) - (point-max))) (while (not (= end (point-max))) (setq start (marker-position end)) (goto-char end) ;; There may be more than one "From " line, so we skip past - ;; them. + ;; them. (while (looking-at delim) (forward-line 1)) - (set-marker end (or (and (nnmail-search-unix-mail-delim) - (point)) - (point-max))) + (set-marker end (if (nnmail-search-unix-mail-delim) + (point) + (point-max))) (goto-char start) (when (not (search-forward marker end t)) (narrow-to-region start end) @@ -714,6 +691,7 @@ (cons nil (nnfolder-active-number nnfolder-current-group))) (widen))) + (set-marker end nil) ;; Make absolutely sure that the active list reflects reality! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ;; Set the scantime for this group. @@ -733,7 +711,7 @@ file) (while (setq file (pop files)) (when (and (not (backup-file-name-p file)) - (nnheader-mail-file-mbox-p + (message-mail-file-mbox-p (concat nnfolder-directory file))) (nnheader-message 5 "Adding group %s..." file) (push (list file (cons 1 0)) nnfolder-group-alist) @@ -745,7 +723,7 @@ "Make pathname for GROUP." (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) ;; If this file exists, we use it directly. - (if (or nnmail-use-long-file-names + (if (or nnmail-use-long-file-names (file-exists-p (concat dir group))) (concat dir group) ;; If not, we translate dots into slashes.
--- a/lisp/gnus/nngateway.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nngateway.el Mon Aug 13 09:18:39 2007 +0200 @@ -74,7 +74,7 @@ "@" gateway "\n"))) (nnoo-define-skeleton nngateway) - + (provide 'nngateway) ;;; nngateway.el ends here
--- a/lisp/gnus/nnheader.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnheader.el Mon Aug 13 09:18:39 2007 +0200 @@ -56,7 +56,9 @@ (autoload 'nnmail-message-id "nnmail") (autoload 'mail-position-on-field "sendmail") (autoload 'message-remove-header "message") - (autoload 'cancel-function-timers "timers")) + (autoload 'cancel-function-timers "timers") + (autoload 'gnus-point-at-eol "gnus-util") + (autoload 'gnus-buffer-live-p "gnus-util")) ;;; Header access macros. @@ -142,7 +144,7 @@ references chars lines xref) "Create a new mail header structure initialized with the parameters given." (vector number subject from date id references chars lines xref)) - + ;; fake message-ids: generation and detection (defvar nnheader-fake-message-id 1) @@ -281,7 +283,7 @@ (defun nnheader-insert-nov (header) (princ (mail-header-number header) (current-buffer)) - (insert + (insert "\t" (or (mail-header-subject header) "(none)") "\t" (or (mail-header-from header) "(nobody)") "\t" @@ -313,7 +315,7 @@ ;; First we find the first wanted line. (nnheader-find-nov-line beg) (delete-region (point-min) (point)) - ;; Then we find the last wanted line. + ;; Then we find the last wanted line. (when (nnheader-find-nov-line end) (forward-line 1)) (delete-region (point) (point-max))) @@ -529,7 +531,7 @@ (defvar jka-compr-compression-info-list) (defvar nnheader-numerical-files (if (boundp 'jka-compr-compression-info-list) - (concat "\\([0-9]+\\)\\(" + (concat "\\([0-9]+\\)\\(" (mapconcat (lambda (i) (aref i 0)) jka-compr-compression-info-list "\\|") "\\)?") @@ -552,7 +554,7 @@ (defun nnheader-directory-files-safe (&rest args) ;; It has been reported numerous times that `directory-files' ;; fails with an alarming frequency on NFS mounted file systems. - ;; This function executes that function twice and returns + ;; This function executes that function twice and returns ;; the longest result. (let ((first (apply 'directory-files args)) (second (apply 'directory-files args))) @@ -579,7 +581,7 @@ (defun nnheader-translate-file-chars (file) (if (null nnheader-file-name-translation-alist) ;; No translation is necessary. - file + file ;; We translate -- but only the file name. We leave the directory ;; alone. (let* ((i 0) @@ -627,19 +629,6 @@ (apply 'insert format args)) t)) -(defun nnheader-mail-file-mbox-p (file) - "Say whether FILE looks like an Unix mbox file." - (when (and (file-exists-p file) - (file-readable-p file) - (file-regular-p file)) - (save-excursion - (nnheader-set-temp-buffer " *mail-file-mbox-p*") - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (prog1 - (looking-at message-unix-mail-delimiter) - (kill-buffer (current-buffer)))))) - (defun nnheader-replace-chars-in-string (string from to) "Replace characters in STRING from FROM to TO." (let ((string (substring string 0)) ;Copy string. @@ -654,12 +643,12 @@ (defun nnheader-file-to-group (file &optional top) "Return a group name based on FILE and TOP." - (nnheader-replace-chars-in-string + (nnheader-replace-chars-in-string (if (not top) file (condition-case () (substring (expand-file-name file) - (length + (length (expand-file-name (file-name-as-directory top)))) (error ""))) @@ -723,7 +712,7 @@ (setq dir (concat (file-name-directory (directory-file-name (car path))) - "etc/" package + "etc/" package (if file "" "/")))) (or file (file-directory-p dir))) (setq result dir @@ -792,13 +781,13 @@ (goto-char (point-min)) (while (,(if regexp 're-search-forward 'search-forward) ,from nil t) - (insert-buffer-substring + (insert-buffer-substring cur start (prog1 (match-beginning 0) (set-buffer new))) (goto-char (point-max)) ,(when to `(insert ,to)) (set-buffer cur) (setq start (point))) - (insert-buffer-substring + (insert-buffer-substring cur start (prog1 (point-max) (set-buffer new))) (copy-to-buffer cur (point-min) (point-max)) (kill-buffer (current-buffer))
--- a/lisp/gnus/nnheaderxm.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnheaderxm.el Mon Aug 13 09:18:39 2007 +0200 @@ -25,6 +25,9 @@ ;;; Code: +(eval-and-compile + (autoload 'nnheader-insert-file-contents "nnheader")) + (defun nnheader-xmas-run-at-time (time repeat function &rest args) (start-itimer "nnheader-run-at-time"
--- a/lisp/gnus/nnkiboze.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnkiboze.el Mon Aug 13 09:18:39 2007 +0200 @@ -193,7 +193,7 @@ (while (setq info (pop newsrc)) (when (string-match "nnkiboze" (gnus-info-group info)) ;; For each kiboze group, we call this function to generate - ;; it. + ;; it. (nnkiboze-generate-group (gnus-info-group info)))))) (defun nnkiboze-score-file (group) @@ -214,8 +214,8 @@ (gnus-large-newsgroup nil) (gnus-score-find-score-files-function 'nnkiboze-score-file) (gnus-verbose (min gnus-verbose 3)) - gnus-select-group-hook gnus-summary-prepare-hook - gnus-thread-sort-functions gnus-show-threads + gnus-select-group-hook gnus-summary-prepare-hook + gnus-thread-sort-functions gnus-show-threads gnus-visual gnus-suppress-duplicates) (unless info (error "No such group: %s" group)) @@ -226,7 +226,7 @@ (when (file-exists-p nov-file) (insert-file-contents nov-file)) (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the + ;; Go through the active hashtb and add new all groups that match the ;; kiboze regexp. (mapatoms (lambda (group) @@ -248,13 +248,13 @@ ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) (while newsrc - (if (not (setq active (gnus-gethash + (if (not (setq active (gnus-gethash (caar newsrc) gnus-active-hashtb))) ;; This group isn't active after all, so we remove it from ;; the list of component groups. (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) (setq lowest (cdar newsrc)) - ;; Ok, we have a valid component group, so we jump to it. + ;; Ok, we have a valid component group, so we jump to it. (switch-to-buffer gnus-group-buffer) (gnus-group-jump-to-group (caar newsrc)) (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) @@ -268,19 +268,19 @@ (when (nth 3 ginfo) (setcar (nthcdr 3 ginfo) nil)) ;; We set the list of read articles to be what we expect for - ;; this kiboze group -- either nil or `(1 . LOWEST)'. + ;; this kiboze group -- either nil or `(1 . LOWEST)'. (when ginfo (setcar (nthcdr 2 ginfo) (and (not (= lowest 1)) (cons 1 lowest)))) (when (and (or (not ginfo) - (> (length (gnus-list-of-unread-articles + (> (length (gnus-list-of-unread-articles (car ginfo))) 0)) (progn (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode))) ;; We are now in the group where we want to be. - (setq method (gnus-find-method-for-group + (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (when (eq method gnus-select-method) (setq method nil)) @@ -289,9 +289,9 @@ (when (> (caar gnus-newsgroup-scored) lowest) ;; If it has a good score, then we enter this article ;; into the kiboze group. - (nnkiboze-enter-nov + (nnkiboze-enter-nov nov-buffer - (gnus-summary-article-header + (gnus-summary-article-header (caar gnus-newsgroup-scored)) gnus-newsgroup-name)) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) @@ -309,7 +309,7 @@ (gnus-prin1 nnkiboze-newsrc) (insert ")\n")) t)) - + (defun nnkiboze-enter-nov (buffer header group) (save-excursion (set-buffer buffer) @@ -333,7 +333,7 @@ ;; The first Xref has to be the group this article ;; really came for - this is the article nnkiboze ;; will request when it is asked for the article. - (insert group ":" + (insert group ":" (int-to-string (mail-header-number header)) " ") (while (re-search-forward " [^ ]+:[0-9]+" nil t) (goto-char (1+ (match-beginning 0)))
--- a/lisp/gnus/nnmail.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnmail.el Mon Aug 13 09:18:39 2007 +0200 @@ -28,9 +28,12 @@ (require 'nnheader) (require 'timezone) (require 'message) -(eval-when-compile (require 'cl)) +(require 'cl) (require 'custom) +(eval-and-compile + (autoload 'gnus-error "gnus-util")) + (defgroup nnmail nil "Reading mail with Gnus." :group 'gnus) @@ -109,7 +112,7 @@ ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defcustom nnmail-keep-last-article nil - "If non-nil, nnmail will never delete the last expired article in a directory. + "If non-nil, nnmail will never delete the last expired article in a directory. You may need to set this variable if other programs are putting new mail into folder numbers that Gnus has marked as expired." :group 'nnmail-procmail @@ -157,7 +160,7 @@ :type '(choice (const :tag "nnmail-expiry-wait" nil) (function :format "%v" nnmail-))) -(defcustom nnmail-spool-file +(defcustom nnmail-spool-file (or (getenv "MAIL") (concat "/usr/spool/mail/" (user-login-name))) "Where the mail backends will look for incoming mail. @@ -230,7 +233,7 @@ :group 'nnmail-retrieve :type 'boolean) -(defcustom nnmail-read-incoming-hook +(defcustom nnmail-read-incoming-hook (if (eq system-type 'windows-nt) '(nnheader-ms-strip-cr) nil) @@ -243,13 +246,13 @@ Eg. -\(add-hook 'nnmail-read-incoming-hook +\(add-hook 'nnmail-read-incoming-hook (lambda () - (start-process \"mailsend\" nil + (start-process \"mailsend\" nil \"/local/bin/mailsend\" \"read\" \"mbox\"))) If you have xwatch running, this will alert it that mail has been -read. +read. If you use `display-time', you could use something like this: @@ -330,14 +333,14 @@ The format is this variable is SPLIT, where SPLIT can be one of the following: -GROUP: Mail will be stored in GROUP (a string). +GROUP: Mail will be stored in GROUP (a string). \(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains VALUE (a regexp), store the messages as specified by SPLIT. \(| SPLIT...): Process each SPLIT expression until one of them matches. A SPLIT expression is said to match if it will cause the mail - message to be stored in one or more groups. + message to be stored in one or more groups. \(& SPLIT...): Process each SPLIT expression. @@ -347,7 +350,7 @@ FIELD must match a complete field name. VALUE must match a complete word according to the `nnmail-split-fancy-syntax-table' syntax table. -You can use .* in the regexps to match partial field names or words. +You can use \".*\" in the regexps to match partial field names or words. FIELD and VALUE can also be lisp symbols, in that case they are expanded as specified in `nnmail-split-abbrev-alist'. @@ -471,7 +474,7 @@ (concat (let ((dir (file-name-as-directory (expand-file-name dir)))) ;; If this directory exists, we use it directly. - (if (or nnmail-use-long-file-names + (if (or nnmail-use-long-file-names (file-directory-p (concat dir group))) (concat dir group "/") ;; If not, we translate dots into slashes. @@ -563,7 +566,7 @@ (message "Getting mail from %s..." inbox))) ;; Set TOFILE if have not already done so, and ;; rename or copy the file INBOX to TOFILE if and as appropriate. - (cond + (cond ((file-exists-p tofile) ;; The crash box exists already. t) @@ -581,13 +584,21 @@ (buffer-disable-undo errors) (let ((default-directory "/")) (if (nnheader-functionp nnmail-movemail-program) - (funcall nnmail-movemail-program inbox tofile) + (condition-case err + (progn + (funcall nnmail-movemail-program inbox tofile) + (setq result 0)) + (error + (save-excursion + (set-buffer errors) + (insert (prin1-to-string err)) + (setq result 255)))) (setq result - (apply + (apply 'call-process (append (list - (expand-file-name + (expand-file-name nnmail-movemail-program exec-directory) nil errors nil inbox tofile) (when nnmail-internal-password @@ -637,7 +648,7 @@ (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) - (while (re-search-forward + (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) ;; We create an alist with `(GROUP (LOW . HIGH))' elements. (push (list (match-string 1) @@ -676,7 +687,7 @@ (let ((procmail-group (substring (expand-file-name file) (match-beginning 1) (match-end 1)))) - (if group + (if group (if (string-equal group procmail-group) group nil) @@ -723,10 +734,10 @@ "\n"))) ;; Look for a Content-Length header. (if (not (save-excursion - (and (re-search-backward + (and (re-search-backward "^Content-Length:[ \t]*\\([0-9]+\\)" start t) (setq content-length (string-to-int - (buffer-substring + (buffer-substring (match-beginning 1) (match-end 1)))) ;; We destroy the header, since none of @@ -746,7 +757,7 @@ (setq do-search t))) (widen) ;; Go to the beginning of the next article - or to the end - ;; of the buffer. + ;; of the buffer. (when do-search (if (re-search-forward "^ " nil t) (goto-char (match-beginning 0)) @@ -832,7 +843,7 @@ end nil) ;; Find the end of the head. (narrow-to-region - start + start (if (search-forward "\n\n" nil t) (1- (point)) ;; This will never happen, but just to be on the safe side -- @@ -858,7 +869,7 @@ "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) (setq content-length nil) (setq content-length (string-to-int (match-string 1))) - ;; We destroy the header, since none of the backends ever + ;; We destroy the header, since none of the backends ever ;; use it, and we do not want to confuse other mailers by ;; having a (possibly) faulty header. (beginning-of-line) @@ -888,7 +899,7 @@ (t (setq end nil)))) (if end (goto-char end) - ;; No Content-Length, so we find the beginning of the next + ;; No Content-Length, so we find the beginning of the next ;; article or the end of the buffer. (goto-char head-end) (or (nnmail-search-unix-mail-delim) @@ -916,7 +927,7 @@ (setq start (point)) ;; Find the end of the head. (narrow-to-region - start + start (if (search-forward "\n\n" nil t) (1- (point)) ;; This will never happen, but just to be on the safe side -- @@ -988,7 +999,7 @@ (funcall exit-func)) (kill-buffer (current-buffer))))) -;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>. +;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>. (defun nnmail-article-group (func) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." @@ -1023,12 +1034,12 @@ (or (funcall nnmail-split-methods) '("bogus")) (error - (message + (message "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) (unless (equal split '(junk)) - ;; `nnmail-split-methods' is a function, so we just call + ;; `nnmail-split-methods' is a function, so we just call ;; this function here and use the result. (setq group-art (mapcar @@ -1046,15 +1057,15 @@ (re-search-backward (cadr method) nil t) ;; Function to say whether this is a match. (funcall (nth 1 method) (car method)))) - ;; Don't enter the article into the same + ;; Don't enter the article into the same ;; group twice. (not (assoc (car method) group-art))) (push (cons (car method) (funcall func (car method))) group-art)) - ;; This is the final group, which is used as a + ;; This is the final group, which is used as a ;; catch-all. (unless group-art - (setq group-art + (setq group-art (list (cons (car method) (funcall func (car method))))))))) ;; See whether the split methods returned `junk'. @@ -1259,14 +1270,14 @@ (if (null nnmail-spool-file) ;; No spool file whatsoever. nil - (let* ((procmails + (let* ((procmails ;; If procmail is used to get incoming mail, the files ;; are stored in this directory. (and (file-exists-p nnmail-procmail-directory) (or (eq nnmail-spool-file 'procmail) nnmail-use-procmail) - (directory-files - nnmail-procmail-directory + (directory-files + nnmail-procmail-directory t (concat (if group (concat "^" group) "") nnmail-procmail-suffix "$")))) (p procmails) @@ -1276,13 +1287,13 @@ 0)) (list nnmail-crash-box)))) ;; Remove any directories that inadvertently match the procmail - ;; suffix, which might happen if the suffix is "". + ;; suffix, which might happen if the suffix is "". (while p (when (file-directory-p (car p)) (setq procmails (delete (car p) procmails))) (setq p (cdr p))) ;; Return the list of spools. - (append + (append crash (cond ((and group (or (eq nnmail-spool-file 'procmail) @@ -1294,9 +1305,9 @@ nil) ((listp nnmail-spool-file) (nconc - (apply + (apply 'nconc - (mapcar + (mapcar (lambda (file) (if (and (not (string-match "^po:" file)) (file-directory-p file)) @@ -1307,7 +1318,7 @@ ((stringp nnmail-spool-file) (if (and (not (string-match "^po:" nnmail-spool-file)) (file-directory-p nnmail-spool-file)) - (nconc + (nconc (nnheader-directory-regular-files nnmail-spool-file) procmails) (cons nnmail-spool-file procmails))) @@ -1316,22 +1327,22 @@ (t procmails)))))) -;; Activate a backend only if it isn't already activated. -;; If FORCE, re-read the active file even if the backend is +;; Activate a backend only if it isn't already activated. +;; If FORCE, re-read the active file even if the backend is ;; already activated. (defun nnmail-activate (backend &optional force) (let (file timestamp file-time) (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) force (and (setq file (ignore-errors - (symbol-value (intern (format "%s-active-file" + (symbol-value (intern (format "%s-active-file" backend))))) (setq file-time (nth 5 (file-attributes file))) (or (not (setq timestamp (condition-case () (symbol-value (intern - (format "%s-active-timestamp" + (format "%s-active-timestamp" backend))) (error 'none)))) (not (consp timestamp)) @@ -1341,20 +1352,9 @@ (> (nth 1 file-time) (nth 1 timestamp)))))) (save-excursion (or (eq timestamp 'none) - (set (intern (format "%s-active-timestamp" backend)) -;;; dmoore@ucsd.edu 25.10.96 -;;; it's not always the case that current-time -;;; does correspond to changes in the file's time. So just compare -;;; the file's new time against its own previous time. -;;; (current-time) - file-time - )) - (funcall (intern (format "%s-request-list" backend))) -;;; dmoore@ucsd.edu 25.10.96 -;;; BACKEND-request-list already does this itself! -;;; (set (intern (format "%s-group-alist" backend)) -;;; (nnmail-get-active)) - )) + (set (intern (format "%s-active-timestamp" backend)) + file-time)) + (funcall (intern (format "%s-request-list" backend))))) t)) (defun nnmail-message-id () @@ -1372,8 +1372,8 @@ (buffer-name nnmail-cache-buffer))) () ; The buffer is open. (save-excursion - (set-buffer - (setq nnmail-cache-buffer + (set-buffer + (setq nnmail-cache-buffer (get-buffer-create " *nnmail message-id cache*"))) (buffer-disable-undo (current-buffer)) (when (file-exists-p nnmail-message-id-cache-file) @@ -1402,11 +1402,12 @@ nnmail-message-id-cache-file nil 'silent) (set-buffer-modified-p nil) (setq nnmail-cache-buffer nil) - ;;(kill-buffer (current-buffer)) - ))) + (kill-buffer (current-buffer))))) (defun nnmail-cache-insert (id) (when nnmail-treat-duplicates + (unless (gnus-buffer-live-p nnmail-cache-buffer) + (nnmail-cache-open)) (save-excursion (set-buffer nnmail-cache-buffer) (goto-char (point-max)) @@ -1419,6 +1420,12 @@ (goto-char (point-max)) (search-backward id nil t)))) +(defun nnmail-fetch-field (header) + (save-excursion + (save-restriction + (message-narrow-to-head) + (message-fetch-field header)))) + (defun nnmail-check-duplication (message-id func artnum-func) (run-hooks 'nnmail-prepare-incoming-message-hook) ;; If this is a duplicate message, then we do not save it. @@ -1443,17 +1450,12 @@ (setq group-art nil)) ((eq action 'warn) ;; We insert a warning. - (let ((case-fold-search t) - (newid (nnmail-message-id))) + (let ((case-fold-search t)) (goto-char (point-min)) - (when (re-search-forward "^message-id[ \t]*:" nil t) - (beginning-of-line) - (insert "Original-")) + (re-search-forward "^message-id[ \t]*:" nil t) (beginning-of-line) - (insert - "Message-ID: " newid "\n" + (insert "Gnus-Warning: This is a duplicate of message " message-id "\n") - (nnmail-cache-insert newid) (funcall func (setq group-art (nreverse (nnmail-article-group artnum-func)))))) (t @@ -1505,24 +1507,24 @@ ;; is supposed to go to some specific group. (setq group (nnmail-get-split-group spool group-in)) ;; We split the mail - (nnmail-split-incoming + (nnmail-split-incoming nnmail-crash-box (intern (format "%s-save-mail" method)) spool-func group (intern (format "%s-active-number" method))) - ;; Check whether the inbox is to be moved to the special tmp dir. + ;; Check whether the inbox is to be moved to the special tmp dir. (setq incoming - (nnmail-make-complex-temp-name - (expand-file-name + (nnmail-make-complex-temp-name + (expand-file-name (if nnmail-tmp-directory - (concat + (concat (file-name-as-directory nnmail-tmp-directory) (file-name-nondirectory (concat (file-name-as-directory temp) "Incoming"))) (concat (file-name-as-directory temp) "Incoming"))))) (rename-file nnmail-crash-box incoming t) (push incoming incomings)))) - ;; If we did indeed read any incoming spools, we save all info. + ;; If we did indeed read any incoming spools, we save all info. (when incomings - (nnmail-save-active + (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) (when exit-func @@ -1677,15 +1679,17 @@ his nil))) found)) +(eval-and-compile + (autoload 'pop3-movemail "pop3")) + (defun nnmail-pop3-movemail (inbox crashbox) "Function to move mail from INBOX on a pop3 server to file CRASHBOX." - (require 'pop3) (let ((pop3-maildrop (substring inbox (match-end (string-match "^po:" inbox))))) (pop3-movemail crashbox))) (run-hooks 'nnmail-load-hook) - + (provide 'nnmail) ;;; nnmail.el ends here
--- a/lisp/gnus/nnmbox.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnmbox.el Mon Aug 13 09:18:39 2007 +0200 @@ -25,7 +25,7 @@ ;;; Commentary: ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -85,9 +85,9 @@ (when (or (search-forward art-string nil t) (progn (goto-char (point-min)) (search-forward art-string nil t))) - (setq start + (setq start (save-excursion - (re-search-backward + (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (point))) (search-forward "\n\n" nil t) @@ -116,7 +116,7 @@ (deffoo nnmbox-open-server (server &optional defs) (nnoo-change-server 'nnmbox server defs) (nnmbox-create-mbox) - (cond + (cond ((not (file-exists-p nnmbox-mbox-file)) (nnmbox-close-server) (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) @@ -152,7 +152,7 @@ (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (setq start (point)) (forward-line 1) - (or (and (re-search-forward + (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (forward-line -1)) (goto-char (point-max))) @@ -172,7 +172,7 @@ (deffoo nnmbox-request-group (group &optional server dont-check) (let ((active (cadr (assoc group nnmbox-group-alist)))) - (cond + (cond ((or (null active) (null (nnmbox-possibly-change-newsgroup group server))) (nnheader-report 'nnmbox "No such group: %s" group)) @@ -181,15 +181,15 @@ (nnheader-insert "")) (t (nnheader-report 'nnmbox "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" + (nnheader-insert "211 %d %d %d %s\n" (1+ (- (cdr active) (car active))) (car active) (cdr active) group))))) (deffoo nnmbox-request-scan (&optional group server) (nnmbox-possibly-change-newsgroup group server) (nnmbox-read-mbox) - (nnmail-get-new-mail - 'nnmbox + (nnmail-get-new-mail + 'nnmbox (lambda () (save-excursion (set-buffer nnmbox-mbox-buffer) @@ -219,14 +219,14 @@ (deffoo nnmbox-request-list-newsgroups (&optional server) (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) -(deffoo nnmbox-request-expire-articles +(deffoo nnmbox-request-expire-articles (articles newsgroup &optional server force) (nnmbox-possibly-change-newsgroup newsgroup server) (let* ((is-old t) rest) (nnmail-activate 'nnmbox) - (save-excursion + (save-excursion (set-buffer nnmbox-mbox-buffer) (while (and articles is-old) (goto-char (point-min)) @@ -234,7 +234,7 @@ (if (setq is-old (nnmail-expired-article-p newsgroup - (buffer-substring + (buffer-substring (point) (progn (end-of-line) (point))) force)) (progn (nnheader-message 5 "Deleting article %d in %s..." @@ -258,7 +258,7 @@ (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmbox move*")) result) - (and + (and (nnmbox-request-article article group server) (save-excursion (set-buffer buf) @@ -266,8 +266,8 @@ (erase-buffer) (insert-buffer-substring nntp-server-buffer) (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" + (while (re-search-forward + "^X-Gnus-Newsgroup:" (save-excursion (search-forward "\n\n" nil t) (point)) t) (delete-region (progn (beginning-of-line) (point)) (progn (forward-line 1) (point)))) @@ -295,7 +295,7 @@ (if (looking-at "X-From-Line: ") (replace-match "From ") (insert "From nobody " (current-time-string) "\n")) - (and + (and (nnmail-activate 'nnmbox) (progn (set-buffer buf) @@ -304,6 +304,7 @@ (forward-line -1) (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) (delete-region (point) (progn (forward-line 1) (point)))) + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (setq result (nnmbox-save-mail (if (stringp group) (list (cons group (nnmbox-active-number group))) @@ -312,9 +313,10 @@ (set-buffer nnmbox-mbox-buffer) (goto-char (point-max)) (insert-buffer-substring buf) - (and last (save-buffer)) - result) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)) + (when last + (nnmail-cache-close) + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + (save-buffer)))) (car result))) (deffoo nnmbox-request-replace-article (article group buffer) @@ -346,7 +348,7 @@ (when found (save-buffer))))) ;; Remove the group from all structures. - (setq nnmbox-group-alist + (setq nnmbox-group-alist (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) nnmbox-current-group nil) ;; Save the active file. @@ -408,13 +410,13 @@ (delete-region (point-min) (point-max)))))) (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) - (when (and server + (when (and server (not (nnmbox-server-opened server))) (nnmbox-open-server server)) (when (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) (save-excursion - (set-buffer (setq nnmbox-mbox-buffer + (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)))) @@ -427,7 +429,7 @@ (defun nnmbox-article-string (article) (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" + (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" (int-to-string article) " ") (concat "\nMessage-ID: " article))) @@ -466,7 +468,7 @@ (when (search-forward "\n\n" nil t) (forward-char -1) (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" + (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art)))) @@ -501,7 +503,7 @@ (let ((delim (concat "^" message-unix-mail-delimiter)) (alist nnmbox-group-alist) start end number) - (set-buffer (setq nnmbox-mbox-buffer + (set-buffer (setq nnmbox-mbox-buffer (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) @@ -514,18 +516,18 @@ (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " (caar alist)) nil t) (>= (setq number - (string-to-number + (string-to-number (buffer-substring (match-beginning 1) (match-end 1)))) (cdadar alist))) (setcdr (cadar alist) (1+ number))) (setq alist (cdr alist))) - + (goto-char (point-min)) (while (re-search-forward delim nil t) (setq start (match-beginning 0)) - (when (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion + (when (not (search-forward "\nX-Gnus-Newsgroup: " + (save-excursion (setq end (or (and @@ -536,7 +538,7 @@ (save-excursion (save-restriction (narrow-to-region start end) - (nnmbox-save-mail + (nnmbox-save-mail (nnmail-article-group 'nnmbox-active-number))))) (goto-char end))))))
--- a/lisp/gnus/nnmh.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnmh.el Mon Aug 13 09:18:39 2007 +0200 @@ -26,7 +26,7 @@ ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>. ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -82,8 +82,8 @@ (if (stringp (car articles)) 'headers (while articles - (when (and (file-exists-p - (setq file (concat (file-name-as-directory + (when (and (file-exists-p + (setq file (concat (file-name-as-directory nnmh-current-directory) (int-to-string (setq article (pop articles)))))) @@ -117,7 +117,7 @@ (condition-case () (make-directory nnmh-directory t) (error t))) - (cond + (cond ((not (file-exists-p nnmh-directory)) (nnmh-close-server) (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) @@ -144,13 +144,13 @@ (deffoo nnmh-request-group (group &optional server dont-check) (let ((pathname (nnmail-group-pathname group nnmh-directory)) dir) - (cond + (cond ((not (file-directory-p pathname)) - (nnheader-report + (nnheader-report 'nnmh "Can't select group (no such directory): %s" group)) (t (setq nnmh-current-directory pathname) - (and nnmh-get-new-mail + (and nnmh-get-new-mail nnmh-be-safe (nnmh-update-gnus-unreads group)) (cond @@ -160,12 +160,12 @@ (t ;; Re-scan the directory if it's on a foreign system. (nnheader-re-read-dir pathname) - (setq dir + (setq dir (sort (mapcar (lambda (name) (string-to-int name)) (directory-files pathname nil "^[0-9]+$" t)) '<)) - (cond + (cond (dir (nnheader-report 'nnmh "Selected group %s" group) (nnheader-insert @@ -210,13 +210,13 @@ (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-max)) - (insert - (format - "%s %d %d y\n" + (insert + (format + "%s %d %d y\n" (progn - (string-match + (string-match (regexp-quote - (file-truename (file-name-as-directory + (file-truename (file-name-as-directory (expand-file-name nnmh-toplev)))) dir) (nnheader-replace-chars-in-string @@ -231,7 +231,7 @@ (deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) (nnmh-possibly-change-directory newsgroup server) - (let* ((active-articles + (let* ((active-articles (mapcar (function (lambda (name) @@ -242,14 +242,14 @@ (nnmail-activate 'nnmh) (while (and articles is-old) - (setq article (concat nnmh-current-directory + (setq article (concat nnmh-current-directory (int-to-string (car articles)))) (when (setq mod-time (nth 5 (file-attributes article))) (if (and (nnmh-deletable-article-p newsgroup (car articles)) (setq is-old (nnmail-expired-article-p newsgroup mod-time force))) (progn - (nnheader-message 5 "Deleting article %s in %s..." + (nnheader-message 5 "Deleting article %s in %s..." article newsgroup) (condition-case () (funcall nnmail-delete-file-function article) @@ -265,11 +265,11 @@ (deffoo nnmh-close-group (group &optional server) t) -(deffoo nnmh-request-move-article +(deffoo nnmh-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) - (and + (and (nnmh-deletable-article-p group article) (nnmh-request-article article group server) (save-excursion @@ -290,16 +290,19 @@ (deffoo nnmh-request-accept-article (group &optional server last noinsert) (nnmh-possibly-change-directory group server) (nnmail-check-syntax) + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (if (stringp group) - (and + (and (nnmail-activate 'nnmh) - (car (nnmh-save-mail + (car (nnmh-save-mail (list (cons group (nnmh-active-number group))) noinsert))) (and (nnmail-activate 'nnmh) (car (nnmh-save-mail (nnmail-article-group 'nnmh-active-number) - noinsert))))) + noinsert)))) + (when last + (nnmail-cache-close))) (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) @@ -307,7 +310,7 @@ (set-buffer buffer) (nnmh-possibly-create-directory group) (ignore-errors - (nnmail-write-region + (nnmail-write-region (point-min) (point-max) (concat nnmh-current-directory (int-to-string article)) nil (if (nnheader-be-verbose 5) nil 'nomesg)) @@ -324,7 +327,7 @@ (let ((articles (mapcar (lambda (file) (string-to-int file)) - (directory-files + (directory-files nnmh-current-directory nil "^[0-9]+$")))) (when articles (setcar active (apply 'min articles)) @@ -337,7 +340,7 @@ (if (not force) () ; Don't delete the articles. (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) - (while articles + (while articles (when (file-writable-p (car articles)) (nnheader-message 5 "Deleting article %s in %s..." (car articles) group) @@ -347,7 +350,7 @@ (ignore-errors (delete-directory nnmh-current-directory))) ;; Remove the group from all structures. - (setq nnmh-group-alist + (setq nnmh-group-alist (delq (assoc group nnmh-group-alist) nnmh-group-alist) nnmh-current-directory nil) t) @@ -364,7 +367,7 @@ ;; One might be more clever, I guess. (let ((files (nnheader-article-to-file-alist old-dir))) (while files - (rename-file + (rename-file (concat old-dir (cdar files)) (concat new-dir (cdar files))) (pop files))) @@ -384,7 +387,7 @@ ;;; Internal functions. (defun nnmh-possibly-change-directory (newsgroup &optional server) - (when (and server + (when (and server (not (nnmh-server-opened server))) (nnmh-open-server server)) (when newsgroup @@ -404,7 +407,7 @@ (error "Could not create directory %s" (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) - + (defun nnmh-save-mail (group-art &optional noinsert) "Called narrowed to an article." (unless noinsert @@ -421,7 +424,7 @@ first) (while ga (nnmh-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname + (let ((file (concat (nnmail-group-pathname (caar ga) nnmh-directory) (int-to-string (cdar ga))))) (if first @@ -438,7 +441,7 @@ (let ((active (cadr (assoc group nnmh-group-alist)))) (unless active ;; The group wasn't known to nnmh, so we just create an active - ;; entry for it. + ;; entry for it. (setq active (cons 1 0)) (push (list group active) nnmh-group-alist) ;; Find the highest number in the group. @@ -465,14 +468,14 @@ ;; marked as unread by Gnus. (let* ((dir nnmh-current-directory) (files (sort (mapcar (function (lambda (name) (string-to-int name))) - (directory-files nnmh-current-directory + (directory-files nnmh-current-directory nil "^[0-9]+$" t)) '<)) (nnmh-file (concat dir ".nnmh-articles")) new articles) ;; Load the .nnmh-articles file. (when (file-exists-p nnmh-file) - (setq articles + (setq articles (let (nnmh-newsgroup-articles) (ignore-errors (load nnmh-file nil t t)) nnmh-newsgroup-articles))) @@ -494,7 +497,7 @@ art) (while (setq art (pop arts)) (when (not (equal - (nth 5 (file-attributes + (nth 5 (file-attributes (concat dir (int-to-string (car art))))) (cdr art))) (setq articles (delq art articles)) @@ -511,7 +514,7 @@ new))) ;; Make Gnus mark all new articles as unread. (when new - (gnus-make-articles-unread + (gnus-make-articles-unread (gnus-group-prefixed-name group (list 'nnmh "")) (setq new (sort new '<)))) ;; Sort the article list with highest numbers first. @@ -528,7 +531,7 @@ "Say whether ARTICLE in GROUP can be deleted." (let ((path (concat nnmh-current-directory (int-to-string article)))) ;; Writable. - (and (file-writable-p path) + (and (file-writable-p path) ;; We can never delete the last article in the group. (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) article)))))
--- a/lisp/gnus/nnml.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnml.el Mon Aug 13 09:18:39 2007 +0200 @@ -26,7 +26,7 @@ ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>. ;; For an overview of what the interface functions do, please see the -;; Gnus sources. +;; Gnus sources. ;;; Code: @@ -40,11 +40,11 @@ (defvoo nnml-directory message-directory "Mail spool directory.") -(defvoo nnml-active-file +(defvoo nnml-active-file (concat (file-name-as-directory nnml-directory) "active") "Mail active file.") -(defvoo nnml-newsgroups-file +(defvoo nnml-newsgroups-file (concat (file-name-as-directory nnml-directory) "newsgroups") "Mail newsgroups description file.") @@ -140,7 +140,7 @@ (condition-case () (make-directory nnml-directory t) (error))) - (cond + (cond ((not (file-exists-p nnml-directory)) (nnml-close-server) (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory)) @@ -172,7 +172,7 @@ nnml-directory)))))) (setq path (concat gpath (int-to-string (cdr group-num))))) (setq path (nnml-article-to-file id))) - (cond + (cond ((not path) (nnheader-report 'nnml "No such article: %s" id)) ((not (file-exists-p path)) @@ -188,7 +188,7 @@ (string-to-int (file-name-nondirectory path))))))) (deffoo nnml-request-group (group &optional server dont-check) - (cond + (cond ((not (nnml-possibly-change-directory group server)) (nnheader-report 'nnml "Invalid group (no such directory)")) ((not (file-exists-p nnml-current-directory)) @@ -196,7 +196,7 @@ nnml-current-directory)) ((not (file-directory-p nnml-current-directory)) (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) - (dont-check + (dont-check (nnheader-report 'nnml "Group %s selected" group) t) (t @@ -206,7 +206,7 @@ (if (not active) (nnheader-report 'nnml "No such group: %s" group) (nnheader-report 'nnml "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" + (nnheader-insert "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group)))))) @@ -250,7 +250,7 @@ (deffoo nnml-request-expire-articles (articles group &optional server force) (nnml-possibly-change-directory group server) - (let* ((active-articles + (let* ((active-articles (nnheader-directory-articles nnml-current-directory)) (is-old t) article rest mod-time number) @@ -260,7 +260,7 @@ (when (setq article (nnml-article-to-file (setq number (pop articles)))) (when (setq mod-time (nth 5 (file-attributes article))) (if (and (nnml-deletable-article-p group number) - (setq is-old + (setq is-old (nnmail-expired-article-p group mod-time force nnml-inhibit-expiry))) (progn @@ -282,13 +282,13 @@ (nnml-save-nov) (nconc rest articles))) -(deffoo nnml-request-move-article +(deffoo nnml-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnml move*")) result) (nnml-possibly-change-directory group server) (nnml-update-file-alist) - (and + (and (nnml-deletable-article-p group article) (nnml-request-article article group server) (save-excursion @@ -313,10 +313,11 @@ (nnml-possibly-change-directory group server) (nnmail-check-syntax) (let (result) + (nnmail-cache-insert (nnmail-fetch-field "message-id")) (if (stringp group) - (and + (and (nnmail-activate 'nnml) - (setq result (car (nnml-save-mail + (setq result (car (nnml-save-mail (list (cons group (nnml-active-number group)))))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) @@ -325,9 +326,10 @@ (nnmail-activate 'nnml) (setq result (car (nnml-save-mail (nnmail-article-group 'nnml-active-number)))) - (progn + (when last (nnmail-save-active nnml-group-alist nnml-active-file) - (and last (nnml-save-nov))))) + (nnmail-cache-close) + (nnml-save-nov)))) result)) (deffoo nnml-request-replace-article (article group buffer) @@ -340,7 +342,7 @@ headers) (when (condition-case () (progn - (nnmail-write-region + (nnmail-write-region (point-min) (point-max) (or (nnml-article-to-file article) (concat nnml-current-directory @@ -350,7 +352,7 @@ (error nil)) (setq headers (nnml-parse-head chars article)) ;; Replace the NOV line in the NOV file. - (save-excursion + (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-min)) (if (or (looking-at art) @@ -362,8 +364,8 @@ ;; we should insert it. (This situation should never ;; occur, but one likes to make sure...) (while (and (looking-at "[0-9]+\t") - (< (string-to-int - (buffer-substring + (< (string-to-int + (buffer-substring (match-beginning 0) (match-end 0))) article) (zerop (forward-line 1))))) @@ -376,13 +378,13 @@ (nnml-possibly-change-directory group server) (when force ;; Delete all articles in GROUP. - (let ((articles - (directory-files + (let ((articles + (directory-files nnml-current-directory t (concat nnheader-numerical-short-files "\\|" (regexp-quote nnml-nov-file-name) "$"))) article) - (while articles + (while articles (setq article (pop articles)) (when (file-writable-p article) (nnheader-message 5 "Deleting article %s in %s..." article group) @@ -392,7 +394,7 @@ (delete-directory nnml-current-directory) (error nil))) ;; Remove the group from all structures. - (setq nnml-group-alist + (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist) nnml-current-group nil nnml-current-directory nil) @@ -414,7 +416,7 @@ ;; One might be more clever, I guess. (let ((files (nnheader-article-to-file-alist old-dir))) (while files - (rename-file + (rename-file (concat old-dir (cdar files)) (concat new-dir (cdar files))) (pop files))) @@ -466,7 +468,7 @@ (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) article))))))) -;; Find an article number in the current group given the Message-ID. +;; Find an article number in the current group given the Message-ID. (defun nnml-find-group-number (id) (save-excursion (set-buffer (get-buffer-create " *nnml id*")) @@ -475,7 +477,7 @@ number) ;; We want to look through all .overview files, but we want to ;; start with the one in the current directory. It seems most - ;; likely that the article we are looking for is in that group. + ;; likely that the article we are looking for is in that group. (if (setq number (nnml-find-id nnml-current-group id)) (cons nnml-current-group number) ;; It wasn't there, so we look through the other groups as well. @@ -551,7 +553,7 @@ (make-directory (directory-file-name (car dirs))) (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) - + (defun nnml-save-mail (group-art) "Called narrowed to an article." (let (chars headers) @@ -568,20 +570,20 @@ first) (while ga (nnml-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname + (let ((file (concat (nnmail-group-pathname (caar ga) nnml-directory) (int-to-string (cdar ga))))) (if first ;; It was already saved, so we just make a hard link. (funcall nnmail-crosspost-link-function first file t) ;; Save the article. - (nnmail-write-region (point-min) (point-max) file nil + (nnmail-write-region (point-min) (point-max) file nil (if (nnheader-be-verbose 5) nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) ;; Generate a nov line for this article. We generate the nov ;; line after saving, because nov generation destroys the - ;; header. + ;; header. (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. (let ((ga group-art)) @@ -594,7 +596,7 @@ "Compute the next article number in GROUP." (let ((active (cadr (assoc group nnml-group-alist)))) ;; The group wasn't known to nnml, so we just create an active - ;; entry for it. + ;; entry for it. (unless active ;; Perhaps the active file was corrupt? See whether ;; there are any articles in this group. @@ -620,7 +622,7 @@ (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." - (save-excursion + (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-max)) (mail-header-set-number headers article) @@ -634,7 +636,7 @@ (save-excursion (save-restriction (goto-char (point-min)) - (narrow-to-region + (narrow-to-region (point) (1- (or (search-forward "\n\n" nil t) (point-max)))) ;; Fold continuation lines. @@ -650,7 +652,7 @@ (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) - (let ((buffer (nnheader-find-file-noselect + (let ((buffer (nnheader-find-file-noselect (concat (nnmail-group-pathname group nnml-directory) nnml-nov-file-name)))) (save-excursion @@ -674,7 +676,7 @@ (defun nnml-generate-nov-databases () "Generate nov databases in all nnml directories." (interactive) - ;; Read the active file to make sure we don't re-use articles + ;; Read the active file to make sure we don't re-use articles ;; numbers in empty groups. (nnmail-activate 'nnml) (nnml-open-server (or (nnoo-current-server 'nnml) "")) @@ -707,7 +709,7 @@ (defvar files) (defun nnml-generate-active-info (dir) ;; Update the active info for this group. - (let ((group (nnheader-file-to-group + (let ((group (nnheader-file-to-group (directory-file-name dir) nnml-directory))) (setq nnml-group-alist (delq (assoc group nnml-group-alist) nnml-group-alist)) @@ -736,7 +738,7 @@ (unless (file-directory-p (setq file (concat dir (cdar files)))) (erase-buffer) (nnheader-insert-file-contents file) - (narrow-to-region + (narrow-to-region (goto-char (point-min)) (progn (search-forward "\n\n" nil t)
--- a/lisp/gnus/nnoo.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnoo.el Mon Aug 13 09:18:39 2007 +0200 @@ -58,7 +58,7 @@ (defmacro nnoo-declare (backend &rest parents) `(eval-and-compile - (push (list ',backend + (push (list ',backend (mapcar (lambda (p) (list p)) ',parents) nil nil) nnoo-definition-alist) @@ -126,7 +126,7 @@ (&rest args) (nnoo-parent-function ',backend ',(car m) ,(cons 'list (nreverse margs)))))))) - + (defun nnoo-backend (symbol) (string-match "^[^-]+-" (symbol-name symbol)) (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) @@ -180,8 +180,8 @@ (symbol-value (car def))))))) (set (car def) (cadr def)))) (while parents - (nnoo-change-server - (caar parents) server + (nnoo-change-server + (caar parents) server (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) (cdar parents))) (pop parents)))) @@ -192,7 +192,7 @@ (defs (nnoo-variables backend))) ;; Remove the old definition. (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) - ;; If this is the first time we push the server (i. e., this is + ;; If this is the first time we push the server (i. e., this is ;; the nil server), then we update the default values of ;; all the variables to reflect the current values. (when (equal current "*internal-non-initialized-backend*")
--- a/lisp/gnus/nnsoup.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnsoup.el Mon Aug 13 09:18:39 2007 +0200 @@ -113,7 +113,7 @@ (setq this-area-seq nil) ;; We take note whether this MSG has a corresponding IDX ;; for later use. - (when (or (= (gnus-soup-encoding-index + (when (or (= (gnus-soup-encoding-index (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) (not (file-exists-p (nnsoup-file @@ -128,7 +128,7 @@ (car useful-areas))))) ;; We now have a list of article numbers and corresponding - ;; areas. + ;; areas. (setq useful-areas (nreverse useful-areas)) ;; Two different approaches depending on whether all the MSG @@ -163,7 +163,7 @@ useful-areas (cdr useful-areas)) (while articles (when (setq msg-buf - (nnsoup-narrow-to-article + (nnsoup-narrow-to-article (car articles) (cdar useful-areas) 'head)) (goto-char (point-max)) (insert (format "221 %d Article retrieved.\n" (car articles))) @@ -181,7 +181,7 @@ (condition-case () (make-directory nnsoup-directory t) (error t))) - (cond + (cond ((not (file-exists-p nnsoup-directory)) (nnsoup-close-server) (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) @@ -225,13 +225,13 @@ (deffoo nnsoup-request-group (group &optional server dont-check) (nnsoup-possibly-change-group group) - (if dont-check + (if dont-check t (let ((active (cadr (assoc group nnsoup-group-alist)))) (if (not active) (nnheader-report 'nnsoup "No such group: %s" group) - (nnheader-insert - "211 %d %d %d %s\n" + (nnheader-insert + "211 %d %d %d %s\n" (max (1+ (- (cdr active) (car active))) 0) (car active) (cdr active) group))))) @@ -243,7 +243,7 @@ (cdaar (cddr (assoc group nnsoup-group-alist))))) (if (not article) 'unknown - (let ((kind (gnus-soup-encoding-kind + (let ((kind (gnus-soup-encoding-kind (gnus-soup-area-encoding (nth 1 (nnsoup-article-to-area article nnsoup-current-group)))))) @@ -312,16 +312,16 @@ (setq mod-time (nth 5 (file-attributes (nnsoup-file prefix t))))) (gnus-sublist-p articles range-list) - ;; This file is old enough. + ;; This file is old enough. (nnmail-expired-article-p group mod-time force)) ;; Ok, we delete this file. (when (ignore-errors - (nnheader-message + (nnheader-message 5 "Deleting %s in group %s..." (nnsoup-file prefix) group) (when (file-exists-p (nnsoup-file prefix)) (delete-file (nnsoup-file prefix))) - (nnheader-message + (nnheader-message 5 "Deleting %s in group %s..." (nnsoup-file prefix t) group) (when (file-exists-p (nnsoup-file prefix t)) @@ -369,7 +369,7 @@ (defun nnsoup-write-active-file (&optional force) (when (and nnsoup-group-alist - (or force + (or force nnsoup-group-alist-touched)) (setq nnsoup-group-alist-touched nil) (nnheader-temp-write nnsoup-active-file @@ -381,7 +381,7 @@ (defun nnsoup-next-prefix () "Return the next free prefix." (let (prefix) - (while (or (file-exists-p + (while (or (file-exists-p (nnsoup-file (setq prefix (int-to-string nnsoup-current-prefix)))) (file-exists-p (nnsoup-file prefix t))) @@ -414,12 +414,12 @@ ;; Change the name to the permanent name and move the files. (setq cur-prefix (nnsoup-next-prefix)) (message "Incorporating file %s..." cur-prefix) - (when (file-exists-p + (when (file-exists-p (setq file (concat nnsoup-tmp-directory (gnus-soup-area-prefix area) ".IDX"))) (rename-file file (nnsoup-file cur-prefix))) - (when (file-exists-p - (setq file (concat nnsoup-tmp-directory + (when (file-exists-p + (setq file (concat nnsoup-tmp-directory (gnus-soup-area-prefix area) ".MSG"))) (rename-file file (nnsoup-file cur-prefix t)) (gnus-soup-set-area-prefix area cur-prefix) @@ -428,7 +428,7 @@ (if (not (setq entry (assoc (gnus-soup-area-name area) nnsoup-group-alist))) ;; If this is a new area (group), we just add this info to - ;; the group alist. + ;; the group alist. (push (list (gnus-soup-area-name area) (cons 1 number) (list (cons 1 number) area)) @@ -444,7 +444,7 @@ (defun nnsoup-number-of-articles (area) (save-excursion - (cond + (cond ;; If the number is in the area info, we just return it. ((gnus-soup-area-number area) (gnus-soup-area-number area)) @@ -453,12 +453,12 @@ (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) (count-lines (point-min) (point-max))) ;; We do it the hard way - re-searching through the message - ;; buffer. + ;; buffer. (t (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist) (nnsoup-dissect-buffer area)) - (length (cdr (assoc (gnus-soup-area-prefix area) + (length (cdr (assoc (gnus-soup-area-prefix area) nnsoup-article-alist))))))) (defun nnsoup-dissect-buffer (area) @@ -467,7 +467,7 @@ (i 0) alist len) (goto-char (point-min)) - (cond + (cond ;; rnews batch format ((= format ?n) (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") @@ -482,7 +482,7 @@ ((= format ?m) (while (looking-at mbox-delim) (forward-line 1) - (push (list + (push (list (incf i) (point) (progn (if (re-search-forward mbox-delim nil t) @@ -494,7 +494,7 @@ ((= format ?M) (while (looking-at "\^A\^A\^A\^A\n") (forward-line 1) - (push (list + (push (list (incf i) (point) (progn (if (search-forward "\n\^A\^A\^A\^A\n" nil t) @@ -545,7 +545,7 @@ packet) (while (setq packet (pop packets)) (message "nnsoup: unpacking %s..." packet) - (if (not (gnus-soup-unpack-packet + (if (not (gnus-soup-unpack-packet nnsoup-tmp-directory nnsoup-unpacker packet)) (message "Couldn't unpack %s" packet) (delete-file packet) @@ -563,9 +563,9 @@ ;; There is no MSG file. ((null msg-buf) nil) - ;; We use the index file to find out where the article - ;; begins and ends. - ((and (= (gnus-soup-encoding-index + ;; We use the index file to find out where the article + ;; begins and ends. + ((and (= (gnus-soup-encoding-index (gnus-soup-area-encoding (nth 1 area))) ?c) (file-exists-p (nnsoup-file prefix))) @@ -697,8 +697,8 @@ (when (eval message-mailer-swallows-blank-line) (newline)) (let ((msg-buf - (gnus-soup-store - nnsoup-replies-directory + (gnus-soup-store + nnsoup-replies-directory (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type nnsoup-replies-index-type)) (num 0)) @@ -715,16 +715,16 @@ (defun nnsoup-kind-to-prefix (kind) (unless nnsoup-replies-list (setq nnsoup-replies-list - (gnus-soup-parse-replies + (gnus-soup-parse-replies (concat nnsoup-replies-directory "REPLIES")))) (let ((replies nnsoup-replies-list)) - (while (and replies + (while (and replies (not (string= kind (gnus-soup-reply-kind (car replies))))) (setq replies (cdr replies))) (if replies (gnus-soup-reply-prefix (car replies)) (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory) - kind + kind (format "%c%c%c" nnsoup-replies-format-type nnsoup-replies-index-type @@ -756,7 +756,7 @@ (setq lines (count-lines (point-min) (point-max))) (setq ident (progn (string-match "/\\([0-9]+\\)\\." (car files)) - (substring + (substring (car files) (match-beginning 1) (match-end 1)))) (if (not (setq elem (assoc group active))) @@ -778,7 +778,7 @@ (defun nnsoup-delete-unreferenced-message-files () "Delete any *.MSG and *.IDX files that aren't known by nnsoup." (interactive) - (let* ((known (apply 'nconc (mapcar + (let* ((known (apply 'nconc (mapcar (lambda (ga) (mapcar (lambda (area)
--- a/lisp/gnus/nnspool.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnspool.el Mon Aug 13 09:18:39 2007 +0200 @@ -119,7 +119,7 @@ (if (stringp article) ;; This is a Message-ID. (setq ag (nnspool-find-id article) - file (and ag (nnspool-article-pathname + file (and ag (nnspool-article-pathname (car ag) (cdr ag))) article (cdr ag)) ;; This is an article in the current group. @@ -137,22 +137,22 @@ (forward-char -1) (insert ".\n") (delete-region (point) (point-max))) - + (and do-message (zerop (% (incf count) 20)) (message "nnspool: Receiving headers... %d%%" (/ (* count 100) number)))) - + (when do-message (message "nnspool: Receiving headers...done")) - + ;; Fold continuation lines. (nnheader-fold-continuation-lines) 'headers))))) (deffoo nnspool-open-server (server &optional defs) (nnoo-change-server 'nnspool server defs) - (cond + (cond ((not (file-exists-p nnspool-spool-directory)) (nnspool-close-server) (nnheader-report 'nnspool "Spool directory doesn't exist: %s" @@ -163,7 +163,7 @@ (nnspool-close-server) (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) ((not (file-exists-p nnspool-active-file)) - (nnheader-report 'nnspool "The active file doesn't exist: %s" + (nnheader-report 'nnspool "The active file doesn't exist: %s" nnspool-active-file)) (t (nnheader-report 'nnspool "Opened server %s using directory %s" @@ -176,7 +176,7 @@ (let ((nntp-server-buffer (or buffer nntp-server-buffer)) file ag) (if (stringp id) - ;; This is a Message-ID. + ;; This is a Message-ID. (when (setq ag (nnspool-find-id id)) (setq file (nnspool-article-pathname (car ag) (cdr ag)))) (setq file (nnspool-article-pathname nnspool-current-group id))) @@ -188,7 +188,7 @@ (if (numberp id) (cons nnspool-current-group id) ag)))) - + (deffoo nnspool-request-body (id &optional group server) "Select article body by message ID (or number)." (nnspool-possibly-change-directory group) @@ -219,7 +219,7 @@ (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) - (nnheader-report + (nnheader-report 'nnspool "Invalid group name (no such directory): %s" group) (setq nnspool-current-directory pathname) (nnheader-report 'nnspool "Selected group %s" group) @@ -230,7 +230,7 @@ ;; Yes, completely empty spool directories *are* possible. ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu> (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) - (setq dir + (setq dir (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) (if dir (nnheader-insert @@ -256,14 +256,14 @@ "List newsgroups (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-newsgroups-file) - (nnheader-report 'nnspool (nnheader-file-error + (nnheader-report 'nnspool (nnheader-file-error nnspool-newsgroups-file))))) (deffoo nnspool-request-list-distributions (&optional server) "List distributions (defined in NNTP2)." (save-excursion (or (nnspool-find-file nnspool-distributions-file) - (nnheader-report 'nnspool (nnheader-file-error + (nnheader-report 'nnspool (nnheader-file-error nnspool-distributions-file))))) ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>. @@ -273,7 +273,7 @@ (save-excursion ;; Find the last valid line. (goto-char (point-max)) - (while (and (not (looking-at + (while (and (not (looking-at "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) (zerop (forward-line -1)))) (let ((seconds (nnspool-seconds-since-epoch date)) @@ -283,7 +283,7 @@ (progn ;; We insert a .0 to make the list reader ;; interpret the number as a float. It is far - ;; too big to be stored in a lisp integer. + ;; too big to be stored in a lisp integer. (goto-char (1- (match-end 0))) (insert ".0") (> (progn @@ -306,7 +306,7 @@ (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) - (proc + (proc (condition-case err (apply 'start-process "*nnspool inews*" inews-buffer nnspool-inews-program nnspool-inews-switches) @@ -346,7 +346,7 @@ (defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil - (let ((nov (nnheader-group-pathname + (let ((nov (nnheader-group-pathname nnspool-current-group nnspool-nov-directory ".overview")) (arts articles) last) @@ -369,7 +369,7 @@ (car (last articles))) ;; If the buffer is empty, this wasn't very successful. (unless (zerop (buffer-size)) - ;; We check what the last article number was. + ;; We check what the last article number was. ;; The NOV file may be out of sync with the articles ;; in the group. (forward-line -1) @@ -405,12 +405,12 @@ (let ((first (car articles)) (last (progn (while (cdr articles) (setq articles (cdr articles))) (car articles)))) - (call-process "awk" nil t nil + (call-process "awk" nil t nil (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" (1- first) (1+ last)) file))) -;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). +;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ;; Find out what group an article identified by a Message-ID is in. (defun nnspool-find-id (id) (save-excursion
--- a/lisp/gnus/nntp.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nntp.el Mon Aug 13 09:18:39 2007 +0200 @@ -43,7 +43,7 @@ "Port number on the physical nntp server.") (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) - "*Hook used for sending commands to the server at startup. + "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd server spawn an nnrpd server. Another useful function to put in this hook might be `nntp-send-authinfo', which will prompt for a password @@ -53,10 +53,10 @@ (defvoo nntp-authinfo-function 'nntp-send-authinfo "Function used to send AUTHINFO to the server.") -(defvoo nntp-server-action-alist - '(("nntpd 1\\.5\\.11t" +(defvoo nntp-server-action-alist + '(("nntpd 1\\.5\\.11t" (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) - ("NNRP server Netscape" + ("NNRP server Netscape" (setq nntp-server-list-active-group nil))) "Alist of regexps to match on server types and actions to be taken. For instance, if you want Gnus to beep every time you connect @@ -188,7 +188,7 @@ ;; We successfully retrieved the headers via XOVER. 'nov ;; XOVER didn't work, so we do it the hard, slow and inefficient - ;; way. + ;; way. (let ((number (length articles)) (count 0) (received 0) @@ -197,7 +197,7 @@ (nntp-inhibit-erase t)) ;; Send HEAD command. (while articles - (nntp-send-command + (nntp-send-command nil "HEAD" (if (numberp (car articles)) (int-to-string (car articles)) @@ -254,7 +254,7 @@ (save-excursion (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) ;; The first time this is run, this variable is `try'. So we - ;; try. + ;; try. (when (eq nntp-server-list-active-group 'try) (nntp-try-list-active (car groups))) (erase-buffer) @@ -326,7 +326,7 @@ (erase-buffer) ;; Send HEAD command. (while (setq article (pop articles)) - (nntp-send-command + (nntp-send-command nil "ARTICLE" (if (numberp article) (int-to-string article) @@ -379,7 +379,7 @@ (defun nntp-next-result-arrived-p () (let ((point (point))) - (cond + (cond ((looking-at "2") (if (re-search-forward "\n.\r?\n" nil t) t @@ -501,7 +501,7 @@ (format "%s%02d%02d %s%s%s" (substring (aref date 0) 2) (string-to-int (aref date 1)) (string-to-int (aref date 2)) (substring (aref date 3) 0 2) - (substring + (substring (aref date 3) 3 5) (substring (aref date 3) 6 8)))) (prog1 (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) @@ -514,7 +514,7 @@ (deffoo nntp-request-type (group article) 'news) - + (deffoo nntp-asynchronous-p () t) @@ -531,11 +531,11 @@ "Send the AUTHINFO to the nntp server. This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." - (nntp-send-command + (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (read-string (format "NNTP (%s) user name: " nntp-address))) - (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" + (nntp-send-command + "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd "NNTP (%s) password: " nntp-address))) (defun nntp-send-authinfo () @@ -544,7 +544,7 @@ It will prompt for a password." (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" + "^.*\r?\n" "AUTHINFO PASS" (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address)))) (defun nntp-send-authinfo-from-file () @@ -555,8 +555,8 @@ (insert-file-contents "~/.nntp-authinfo") (goto-char (point-min)) (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" + (nntp-send-command + "^.*\r?\n" "AUTHINFO PASS" (buffer-substring (point) (progn (end-of-line) (point))))))) ;;; Internal functions. @@ -636,7 +636,7 @@ (defun nntp-make-process-buffer (buffer) "Create a new, fresh buffer usable for nntp process connections." (save-excursion - (set-buffer + (set-buffer (generate-new-buffer (format " *server %s %s %s*" nntp-address nntp-port-number @@ -744,23 +744,23 @@ (erase-buffer))) (when command (nntp-send-string process command)) - (cond + (cond ((eq callback 'ignore) t) ((and callback wait-for) (save-excursion (set-buffer (process-buffer process)) - (unless nntp-inside-change-function + (unless nntp-inside-change-function (erase-buffer)) (setq nntp-process-decode decode nntp-process-to-buffer buffer nntp-process-wait-for wait-for nntp-process-callback callback nntp-process-start-point (point-max) - after-change-functions + after-change-functions (list 'nntp-after-change-function-callback))) t) - (wait-for + (wait-for (nntp-wait-for process wait-for buffer decode)) (t t))))) @@ -788,7 +788,7 @@ (goto-char (point-max)) (let ((limit (point-min))) (while (not (re-search-backward wait-for limit t)) - ;; We assume that whatever we wait for is less than 1000 + ;; We assume that whatever we wait for is less than 1000 ;; characters long. (setq limit (max (- (point-max) 1000) (point-min))) (nntp-accept-process-output process) @@ -820,7 +820,8 @@ (save-excursion (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) nntp-server-buffer)) - (let ((len (/ (point-max) 1024))) + (let ((len (/ (point-max) 1024)) + message-log-max) (unless (< len 10) (setq nntp-have-messaged t) (nnheader-message 7 "nntp read: %dk" len))) @@ -887,7 +888,7 @@ (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (set-buffer nntp-server-buffer) (erase-buffer) - (cond + (cond ;; This server does not talk NOV. ((not nntp-server-xover) @@ -896,7 +897,7 @@ ;; We don't care about gaps. ((or (not nntp-nov-gap) fetch-old) - (nntp-send-xover-command + (nntp-send-xover-command (if fetch-old (if (numberp fetch-old) (max 1 (- (car articles) fetch-old)) @@ -932,7 +933,7 @@ (while (and nntp-server-xover articles) (setq first (car articles)) ;; Search forward until we find a gap, or until we run out of - ;; articles. + ;; articles. (while (and (cdr articles) (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) (setq articles (cdr articles))) @@ -949,7 +950,7 @@ ;; On some Emacs versions the preceding function has ;; a tendency to change the buffer. Perhaps. It's ;; quite difficult to reproduce, because it only - ;; seems to happen once in a blue moon. + ;; seems to happen once in a blue moon. (set-buffer buf) (while (progn (goto-char last-point) @@ -971,7 +972,7 @@ (forward-line -1) (not (looking-at "^\\.\r?\n"))) (nntp-accept-response))) - + ;; We remove any "." lines and status lines. (goto-char (point-min)) (while (search-forward "\r" nil t) @@ -991,13 +992,13 @@ ;; If `nntp-server-xover' is a string, then we just send this ;; command. (if wait-for-reply - (nntp-send-command-nodelete + (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. - ;; We try them all until we get at positive response. + ;; We try them all until we get at positive response. (while (and commands (eq nntp-server-xover 'try)) (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range) (save-excursion @@ -1105,7 +1106,7 @@ (and number (zerop number) (setq number nil)) ;; Then we find the group name. (setq group - (cond + (cond ;; If there is only one group in the Newsgroups header, ;; then it seems quite likely that this article comes ;; from that group, I'd say. @@ -1118,7 +1119,7 @@ ;; article number in the Xref header is the one we are ;; looking for. This might very well be wrong if this ;; article happens to have the same number in several - ;; groups, but that's life. + ;; groups, but that's life. ((and (setq xref (mail-fetch-field "xref")) number (string-match (format "\\([^ :]+\\):%d" number) xref))
--- a/lisp/gnus/nnvirtual.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnvirtual.el Mon Aug 13 09:18:39 2007 +0200 @@ -100,7 +100,7 @@ (erase-buffer) (if (stringp (car articles)) 'headers - (let ((vbuf (nnheader-set-temp-buffer + (let ((vbuf (nnheader-set-temp-buffer (get-buffer-create " *virtual headers*"))) (carticles (nnvirtual-partition-sequence articles)) (system-name (system-name)) @@ -143,7 +143,7 @@ ;; component group below. They should be coming up ;; generally in order, so this shouldn't be slow. (setq articles (delq carticle articles)) - + (setq article (nnvirtual-reverse-map-article cgroup carticle)) (if (null article) ;; This line has no reverse mapping, that means it @@ -158,7 +158,7 @@ prefix system-name) (forward-line 1)) ) - + (set-buffer vbuf) (goto-char (point-max)) (insert-buffer-substring nntp-server-buffer)) @@ -196,7 +196,7 @@ 'nnvirtual "Don't know what server to request from")) (t (save-excursion - (when buffer + (when buffer (set-buffer buffer)) (let ((method (gnus-find-method-for-group nnvirtual-last-accessed-component-group))) @@ -215,7 +215,7 @@ (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) (t (setq nnvirtual-last-accessed-component-group cgroup) - (if buffer + (if buffer (save-excursion (set-buffer buffer) (gnus-request-article-this-buffer (cdr amap) cgroup)) @@ -262,7 +262,7 @@ nnvirtual-always-rescan) (nnvirtual-create-mapping)) (setq nnvirtual-current-group group) - (nnheader-insert "211 %d 1 %d %s\n" + (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) @@ -284,13 +284,13 @@ (setq mark gnus-expirable-mark))) mark) - + (deffoo nnvirtual-close-group (group &optional server) (when (and (nnvirtual-possibly-change-server server) (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) (nnvirtual-update-read-and-marked t t)) t) - + (deffoo nnvirtual-request-list (&optional server) (nnheader-report 'nnvirtual "LIST is not implemented.")) @@ -317,7 +317,7 @@ (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))) (setq nnvirtual-info-installed t)) t)) - + (deffoo nnvirtual-catchup-group (group &optional server all) (when (and (nnvirtual-possibly-change-server server) @@ -409,8 +409,8 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (when nnvirtual-current-group (let ((unreads (and read-p - (nnvirtual-partition-sequence - (gnus-list-of-unread-articles + (nnvirtual-partition-sequence + (gnus-list-of-unread-articles (nnvirtual-current-group))))) (type-marks (mapcar (lambda (ml) (cons (car ml) @@ -434,7 +434,7 @@ (when (and (setq info (gnus-get-info (pop groups))) (gnus-info-marks info)) (gnus-info-set-marks info nil))) - + ;; Ok, currently type-marks is an assq list with keys of a mark type, ;; with data of an assq list with keys of component group names ;; and the articles which correspond to that key/group pair. @@ -442,9 +442,9 @@ (setq type (car mark)) (setq groups (cdr mark)) (while (setq carticles (pop groups)) - (gnus-add-marked-articles (car carticles) type (cdr carticles) + (gnus-add-marked-articles (car carticles) type (cdr carticles) nil t)))) - + ;; possibly update the display, it is really slow (when update-p (setq groups nnvirtual-component-groups) @@ -632,7 +632,7 @@ (defun nnvirtual-create-mapping () - "Build the tables necessary to map between component (group, article) to virtual article. + "Build the tables necessary to map between component (group, article) to virtual article. Generate the set of read messages and marks for the virtual group based on the marks on the component groups." (let ((cnt 0) @@ -678,7 +678,7 @@ ;; We want the actives list sorted by size, to build the tables. (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2))))) - + ;; Build the offset table. Largest sized groups are at the front. (setq nnvirtual-mapping-offsets (vconcat @@ -687,7 +687,7 @@ (cons (nth 0 entry) (- (nth 2 entry) M))) actives)))) - + ;; Build the mapping table. (setq nnvirtual-mapping-table nil) (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
--- a/lisp/gnus/nnweb.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/nnweb.el Mon Aug 13 09:18:39 2007 +0200 @@ -34,6 +34,7 @@ (require 'gnus) (require 'w3) (require 'url) +(require 'nnmail) (ignore-errors (require 'w3-forms)) @@ -108,7 +109,7 @@ (deffoo nnweb-request-group (group &optional server dont-check) (nnweb-possibly-change-server nil server) - (when (and group + (when (and group (not (equal group nnweb-group)) (not nnweb-ephemeral-p)) (let ((info (assoc group nnweb-group-alist))) @@ -199,7 +200,7 @@ (gnus-delete-assoc group nnweb-group-alist) (gnus-delete-file (nnweb-overview-file group)) t) - + (nnoo-define-skeleton nnweb) ;;; Internal functions @@ -250,7 +251,7 @@ (defun nnweb-read-active () "Read the active file." (load (nnheader-concat nnweb-directory "active") t t t)) - + (defun nnweb-definition (type &optional noerror) "Return the definition of TYPE." (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition))))) @@ -322,7 +323,7 @@ (defun nnweb-encode-www-form-urlencoded (pairs) "Return PAIRS encoded for forms." - (mapconcat + (mapconcat (function (lambda (data) (concat (w3-form-encode-xwfu (car data)) "=" @@ -332,7 +333,7 @@ (defun nnweb-fetch-form (url pairs) (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs)) (url-request-method "POST") - (url-request-extra-headers + (url-request-extra-headers '(("Content-type" . "application/x-www-form-urlencoded")))) (url-insert-file-contents url) (setq buffer-file-name nil)) @@ -379,7 +380,7 @@ (nnweb-decode-entities) (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region + (narrow-to-region (point) (cond ((re-search-forward "^ +[0-9]+\\." nil t) (match-beginning 0)) @@ -444,7 +445,7 @@ (replace-match "\n" t t)))) (defun nnweb-dejanews-search (search) - (nnweb-fetch-form + (nnweb-fetch-form (nnweb-definition 'address) `(("query" . ,search) ("defaultOp" . "AND") @@ -488,7 +489,7 @@ ;(nnweb-decode-entities) (goto-char (point-min)) (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region + (narrow-to-region (point) (if (re-search-forward "^$" nil t) (match-beginning 0) @@ -564,10 +565,10 @@ (defun nnweb-reference-search (search) (prog1 (url-insert-file-contents - (concat + (concat (nnweb-definition 'address) "?" - (nnweb-encode-www-form-urlencoded + (nnweb-encode-www-form-urlencoded `(("search" . "advanced") ("querytext" . ,search) ("subj" . "") @@ -670,10 +671,10 @@ (defun nnweb-altavista-search (search &optional part) (prog1 (url-insert-file-contents - (concat + (concat (nnweb-definition 'address) "?" - (nnweb-encode-www-form-urlencoded + (nnweb-encode-www-form-urlencoded `(("pg" . "aq") ("what" . "news") ,@(when part `(("stq" . ,(int-to-string (* part 30)))))
--- a/lisp/gnus/parse-time.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/parse-time.el Mon Aug 13 09:18:39 2007 +0200 @@ -142,7 +142,7 @@ ,#'(lambda () (car val)) ,#'(lambda () (cadr val))) ((8) - ,#'(lambda () + ,#'(lambda () (and (stringp elt) (= 5 (length elt)) (or (= (aref elt 0) ?+) (= (aref elt 0) ?-))))
--- a/lisp/gnus/smiley.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/gnus/smiley.el Mon Aug 13 09:18:39 2007 +0200 @@ -33,7 +33,7 @@ ;; (require 'smiley) ;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) -;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>. +;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>. (require 'annotations) (require 'messagexmas) @@ -49,14 +49,15 @@ :type 'directory :group 'smiley) -;; Notice the subtle differences in the regular expressions in the two alists below +;; Notice the subtle differences in the regular expressions in the +;; two alists below. (defcustom smiley-deformed-regexp-alist '(("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*[/\\\"]\\)[^/]" 1 "FaceIronic.xpm") + ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") @@ -65,10 +66,10 @@ ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") + ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) "Normal and deformed faces for smilies." - :type '(repeat (list regexp + :type '(repeat (list regexp (integer :tag "Match") (string :tag "Image"))) :group 'smiley) @@ -92,21 +93,21 @@ ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) "Smileys with noses. These get less false matches." - :type '(repeat (list regexp + :type '(repeat (list regexp (integer :tag "Match") (string :tag "Image"))) :group 'smiley) (defcustom smiley-regexp-alist smiley-deformed-regexp-alist "A list of regexps to map smilies to real images. -Defaults to the content of smiley-deformed-regexp-alist. -An alternative smiley-nosey-regexp-alist that -matches less aggressively is available. +Defaults to the contents of `smiley-deformed-regexp-alist'. +An alternative is `smiley-nosey-regexp-alist' that matches less +aggressively. If this is a symbol, take its value." :type '(radio (variable-item smiley-deformed-regexp-alist) (variable-item smiley-nosey-regexp-alist) - symbol - (repeat (list regexp + symbol + (repeat (list regexp (integer :tag "Match") (string :tag "Image")))) :group 'smiley) @@ -144,7 +145,7 @@ (defvar smiley-running-xemacs (string-match "XEmacs" emacs-version)) (defvar smiley-map (make-sparse-keymap "smiley-keys") - "keymap to toggle smiley states") + "Keymap to toggle smiley states.") (define-key smiley-map [(button2)] 'smiley-toggle-extent) @@ -153,7 +154,7 @@ smiley-running-xemacs (or (cdr-safe (assoc pixmap smiley-glyph-cache)) - (let* ((xpm-color-symbols + (let* ((xpm-color-symbols (and (featurep 'xpm) (append `(("flesh" ,smiley-flesh-color) ("features" ,smiley-features-color) @@ -185,7 +186,7 @@ (hide-annotation ant)) (when pt (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) - (when (annotationp (setq ant + (when (annotationp (setq ant (extent-property ext 'smiley-annotation))) (reveal-annotation ant) (set-extent-property ext 'invisible t))))))) @@ -247,7 +248,8 @@ (= (char-after (1- (point))) ?\())) t))) -;;;###autoload +(defvar gnus-article-buffer) +;;;###autoload (defun gnus-smiley-display () (interactive) (save-excursion
--- a/lisp/hyperbole/hui-mini.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/hyperbole/hui-mini.el Mon Aug 13 09:18:39 2007 +0200 @@ -9,7 +9,7 @@ ;; ORG: InfoDock Associates ;; ;; ORIG-DATE: 15-Oct-91 at 20:13:17 -;; LAST-MOD: 20-Feb-97 at 11:30:44 by Bob Weiner +;; LAST-MOD: 6-Mar-97 at 14:08:46 by Bob Weiner ;; ;; This file is part of Hyperbole. ;; Available for use and distribution under the same terms as GNU Emacs. @@ -309,6 +309,7 @@ ;;; Used as autoloaded main entry point to Hyperbole (but hsite.el) is the ;;; file that is autoloaded when this is invoked. ;;; It brings up a menu of commands. +;;;###autoload (defun hyperbole (&optional menu menu-list) "Invokes default Hyperbole menu user interface when not already active. Suitable for binding to a key, e.g. {C-h h}. @@ -325,6 +326,7 @@ (progn (beep) nil) (unwind-protect (progn + (require 'hyperbole) (require 'hsite) ;; Since "hui-mini" may be loaded without loading ;; all of Hyperbole. (hyperb:init-menubar)
--- a/lisp/ilisp/completer.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/ilisp/completer.el Mon Aug 13 09:18:39 2007 +0200 @@ -268,7 +268,7 @@ "Return the best match of STRING in CHOICES with DELIMITERS between words and T if it is unique. A match is unique if it is the only possibility or when USE-WORDS the only possibility with the same -number of words. The shortest string of multiple possiblities will be +number of words. The shortest string of multiple possibilities will be the best match." (or (if (null (cdr choices)) (cons (car choices) t)) (let* ((regexp (concat "[^" delimiters "]*[" delimiters "]"))
--- a/lisp/ilisp/completer.new.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/ilisp/completer.new.el Mon Aug 13 09:18:39 2007 +0200 @@ -259,7 +259,7 @@ "Return the best match of STRING in CHOICES with DELIMITERS between words and T if it is unique. A match is unique if it is the only possibility or when USE-WORDS the only possibility with the same -number of words. The shortest string of multiple possiblities will be +number of words. The shortest string of multiple possibilities will be the best match." (or (if (null (cdr choices)) (cons (car choices) t)) (let* ((regexp (concat "[^" delimiters "]*[" delimiters "]"))
--- a/lisp/ilisp/completer.no-fun.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/ilisp/completer.no-fun.el Mon Aug 13 09:18:39 2007 +0200 @@ -259,7 +259,7 @@ "Return the best match of STRING in CHOICES with DELIMITERS between words and T if it is unique. A match is unique if it is the only possibility or when USE-WORDS the only possibility with the same -number of words. The shortest string of multiple possiblities will be +number of words. The shortest string of multiple possibilities will be the best match." (or (if (null (cdr choices)) (cons (car choices) t)) (let* ((regexp (concat "[^" delimiters "]*[" delimiters "]"))
--- a/lisp/mailcrypt/mc-pgp.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/mailcrypt/mc-pgp.el Mon Aug 13 09:18:39 2007 +0200 @@ -55,7 +55,7 @@ "Regular expression matching a PGP key snarf message") (defconst mc-pgp-nokey-re "Cannot find the public key matching userid '\\(.+\\)'$" - "Regular expression matching a PGP missing-key messsage") + "Regular expression matching a PGP missing-key message") (defconst mc-pgp-key-expected-re "Key matching expected Key ID \\(\\S +\\) not found")
--- a/lisp/mel/mel-g.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/mel/mel-g.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,53 +1,53 @@ -;;; ;;; mel-g.el: Gzip64 encoder/decoder for GNU Emacs -;;; -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; Copyright (C) 1996 Shuhei KOBAYASHI -;;; -;;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> -;;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> -;;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> -;;; Created: 1995/10/25 -;;; Version: -;;; $Id: mel-g.el,v 1.3 1997/03/04 02:29:46 steve Exp $ -;;; Keywords: MIME, base64, gzip -;;; -;;; This file is not part of MEL (MIME Encoding Library) yet. -;;; -;;; This program 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. -;;; -;;; This program 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997 MORIOKA Tomohiko +;; Copyright (C) 1996 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> +;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp> +;; Maintainer: Shuhei KOBAYASHI <shuhei-k@jaist.ac.jp> +;; Created: 1995/10/25 +;; Version: $Id: mel-g.el,v 1.4 1997/03/08 23:26:22 steve Exp $ +;; Keywords: Gzip64, base64, gzip, MIME + +;; This file is not part of MEL (MIME Encoding Library) yet. + +;; This program 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. + +;; This program 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 'emu) +(require 'file-detect) ;;; @ variables ;;; -(defvar gzip64-external-encoder `("sh" "-c" - ,(concat - "gzip -c | " - (expand-file-name "mmencode" - exec-directory))) +(defvar gzip64-external-encoder + (let ((file (file-installed-p "mmencode" exec-path))) + (and file + (` ("sh" "-c" (, (concat "gzip -c | " file)))) + )) "*list of gzip64 encoder program name and its arguments.") -(defvar gzip64-external-decoder `("sh" "-c" - ,(concat - (expand-file-name "mmencode" - exec-directory) - " -u | gzip -dc")) +(defvar gzip64-external-decoder + (let ((file (file-installed-p "mmencode" exec-path))) + (and file + (` ("sh" "-c" (, (concat file " -u | gzip -dc")))) + )) "*list of gzip64 decoder program name and its arguments.")
--- a/lisp/modes/cperl-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/cperl-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -32,7 +32,7 @@ ;;; Corrections made by Ilya Zakharevich ilya@math.mps.ohio-state.edu ;;; XEmacs changes by Peter Arius arius@informatik.uni-erlangen.de -;; $Id: cperl-mode.el,v 1.2 1997/02/08 03:26:07 steve Exp $ +;; $Id: cperl-mode.el,v 1.3 1997/03/08 23:26:24 steve Exp $ ;;; To use this mode put the following into your .emacs file: @@ -385,7 +385,7 @@ Can be overwritten by `cperl-hairy' if nil.") (defvar cperl-electric-lbrace-space nil - "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceeded by ` '. + "*Non-nil (and non-null) means { after $ in CPerl buffers should be preceded by ` '. Can be overwritten by `cperl-hairy' if nil.") (defvar cperl-electric-parens-string "({[<" @@ -2159,7 +2159,7 @@ ;; "\\(\\`\n?\\|\n\n\\)=" (if (looking-at "\n*cut\\>") (progn - (message "=cut is not preceeded by a pod section") + (message "=cut is not preceded by a pod section") (setq err (point))) (beginning-of-line) @@ -2290,7 +2290,7 @@ ;;; (while (re-search-forward "\\(\\`\n?\\|\n\n\\)=" max t) ;;; (if (looking-at "\n*cut\\>") ;;; (progn -;;; (message "=cut is not preceeded by a pod section") +;;; (message "=cut is not preceded by a pod section") ;;; (setq err (point))) ;;; (beginning-of-line)
--- a/lisp/modes/follow.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/follow.el Mon Aug 13 09:18:39 2007 +0200 @@ -49,7 +49,7 @@ ;; side-by-side window are used. The user can, with the help of Follow ;; mode, use two full-height windows as though they would have been ;; one. Imagine yourself editing a large function, or section of text, -;; and beeing able to use 144 lines instead of the normal 72... (your +;; and being able to use 144 lines instead of the normal 72... (your ;; mileage may vary). ;; The latest version, and a demonstration, are avaiable at: @@ -734,7 +734,7 @@ side-by-side window are used. The user can, with the help of Follow mode, use two full-height windows as though they would have been one. Imagine yourself editing a large function, or section of text, -and beeing able to use 144 lines instead of the normal 72... (your +and being able to use 144 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands @@ -2345,8 +2345,8 @@ ;;; called from other places, e.g. `post-command-hook' and ;;; `post-command-idle-hook'. -;; If this function is called it is to late for this window, but -;; we might save other windows from beeing recentered. +;; If this function is called it is too late for this window, but +;; we might save other windows from being recentered. (if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions)) (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
--- a/lisp/modes/ksh-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/ksh-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -24,7 +24,7 @@ ;; LCD Archive Entry: ;; ksh-mode|Gary F. Ellison|Gary.F.Ellison@ATT.COM ;; |Mode for editing sh/ksh/bash scripts -;; |$Date: 1996/12/18 22:42:46 $|$Revision: 1.1.1.1 $|~/modes/ksh-mode.el.Z| +;; |$Date: 1997/03/08 23:26:25 $|$Revision: 1.2 $|~/modes/ksh-mode.el.Z| ;; Author: Gary F. Ellison <Gary.F.Ellison@ATT.COM> ;; AT&T Laboratories @@ -33,10 +33,10 @@ ;; ;; Maintainer: Gary F. Ellison <Gary.F.Ellison@ATT.COM> ;; Created: Fri Jun 19 -;; $Revision: 1.1.1.1 $ +;; $Revision: 1.2 $ ;; Keywords: shell, korn, bourne, sh, ksh, bash ;; -;; Delta On $Date: 1996/12/18 22:42:46 $ +;; Delta On $Date: 1997/03/08 23:26:25 $ ;; Last Modified By: Gary Ellison ;; Last Modified On: Mon Sep 11 12:26:47 1995 ;; Update Count : 35 @@ -231,7 +231,7 @@ ;; Conception of this mode. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst ksh-mode-version "$Revision: 1.1.1.1 $" +(defconst ksh-mode-version "$Revision: 1.2 $" "*Version numbers of this version of ksh-mode") ;; @@ -468,7 +468,7 @@ ;;;###autoload (defun ksh-mode () - "ksh-mode $Revision: 1.1.1.1 $ - Major mode for editing (Bourne, Korn or Bourne again) + "ksh-mode $Revision: 1.2 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -1293,7 +1293,7 @@ (insert completion)) ;; ;; write possible completion in the minibuffer, - ;; use this instead of a seperate buffer (usual) + ;; use this instead of a separate buffer (usual) ;; (t (let ((list (all-completions pattern ksh-completion-list predicate))
--- a/lisp/modes/lisp-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/lisp-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -316,7 +316,7 @@ ;; XEmacs change: emacs-lisp-mode-map is a more appropriate parent. (defvar lisp-interaction-mode-map () - "Keymap for Lisp Interaction moe. + "Keymap for Lisp Interaction mode. All commands in `shared-lisp-mode-map' are inherited by this map.") (if lisp-interaction-mode-map
--- a/lisp/modes/list-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/list-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -113,7 +113,7 @@ (defun next-list-mode-item (n) "Move to the next item in list-mode. -WIth prefix argument N, move N items (negative N means move backward)." +With prefix argument N, move N items (negative N means move backward)." (interactive "p") (while (and (> n 0) (not (eobp))) (let ((prop (get-char-property (point) 'list-mode-item)) @@ -190,7 +190,7 @@ (defvar completion-highlight-first-word-only nil - "*Completion will only hightlight the first blank delimited word if t. + "*Completion will only highlight the first blank delimited word if t. If the variable in not t or nil, the string is taken as a regexp to match for end of highlight")
--- a/lisp/modes/mail-abbrevs.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/mail-abbrevs.el Mon Aug 13 09:18:39 2007 +0200 @@ -88,7 +88,7 @@ ;;; fred, ethyl, larry, curly, moe ;;; ;;; Aliases may also contain forward references; the alias of "everybody" can -;;; preceed the aliases of "group1" and "group2". +;;; precede the aliases of "group1" and "group2". ;;; ;;; This code also understands the "source" .mailrc command, for reading ;;; aliases from some other file as well.
--- a/lisp/modes/pascal.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/pascal.el Mon Aug 13 09:18:39 2007 +0200 @@ -187,7 +187,7 @@ "*Indentation for case statements.") (defvar pascal-auto-newline nil - "*Non-nil means automatically newline after simcolons and the punctation mark + "*Non-nil means automatically newline after semicolons and the punctation mark after an end.") (defvar pascal-tab-always-indent t @@ -302,7 +302,7 @@ pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) - Non-nil means automatically newline after simcolons and the punctation mark + Non-nil means automatically newline after semicolons and the punctation mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, @@ -311,7 +311,7 @@ Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. pascal-auto-lineup (default t) - List of contexts where auto lineup of :'s or ='s hould be done. + List of contexts where auto lineup of :'s or ='s should be done. See also the user variables pascal-type-keywords, pascal-start-keywords and pascal-separator-keywords.
--- a/lisp/modes/perl-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/perl-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -34,7 +34,7 @@ ;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") ;; to your .emacs file and change the first line of your perl script to: ;; #!/usr/bin/perl -- # -*-Perl-*- -;; With argments to perl: +;; With arguments to perl: ;; #!/usr/bin/perl -P- # -*-Perl-*- ;; To handle files included with do 'filename.pl';, add something like ;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
--- a/lisp/modes/rexx-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/rexx-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -25,7 +25,7 @@ ;;; AUTHOR ;;; Anders Lindgren, d91ali@csd.uu.se ;;; -;;; Abbrevationtable due to: +;;; Abbreviation table due to: ;;; Johan Bergkvist, nv91-jbe@nada.kth.se ;;; ;;; USAGE @@ -352,7 +352,7 @@ remap RETURN to rexx-indent-newline-indent. It makes sure that lines indents correctly when you press RETURN. -An extensive abbrevation table consisting of all the keywords of REXX are +An extensive abbreviation table consisting of all the keywords of REXX are supplied. Expanded keywords are converted into upper case making it easier to distinguish them. To use this feature the buffer must be in abbrev-mode. (See example below.) @@ -370,8 +370,8 @@ )) will make the END aligned with the DO/SELECT. It will indent blocks and -IF-statenents four steps and make sure that the END jumps into the -correct position when RETURN is pressed. Finaly it will use the abbrev +IF-statements four steps and make sure that the END jumps into the +correct position when RETURN is pressed. Finally it will use the abbrev table to convert all REXX keywords into upper case." (interactive) (kill-all-local-variables)
--- a/lisp/modes/rsz-minibuf.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/rsz-minibuf.el Mon Aug 13 09:18:39 2007 +0200 @@ -10,7 +10,7 @@ ;;; Keywords: minibuffer, window, frames, display ;;; Status: Known to work in FSF GNU Emacs 19.23 and Lucid Emacs 19.9. -;;; $Id: rsz-minibuf.el,v 1.2 1997/01/23 05:29:30 steve Exp $ +;;; $Id: rsz-minibuf.el,v 1.3 1997/03/08 23:26:27 steve Exp $ ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -112,7 +112,7 @@ minibuffer window should ever be shrunk to make it no larger than needed to display its contents. -When using a window system, it is possible for a minibuffer to tbe the sole +When using a window system, it is possible for a minibuffer to be the sole window in a frame. Since that window is already its maximum size, the only way to make more text visible at once is to increase the size of the frame. The variable `resize-minibuffer-frame' controls whether this should be
--- a/lisp/modes/tcl.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/tcl.el Mon Aug 13 09:18:39 2007 +0200 @@ -319,7 +319,7 @@ ;; middle of a defun, or between defuns. should notice if point is ;; on first line of defun (or maybe even in comments before defun). ;; * Allow continuation lines to be indented under the first argument -;; of the preceeding line, like this: +;; of the preceding line, like this: ;; [list something \ ;; something-else] ;; * There is a request that indentation work like this: @@ -1653,7 +1653,7 @@ "Return t if point is just after the `#' beginning a real comment. Does not check to see if previous char is actually `#'. A real comment is either at the beginning of the buffer, -preceeded only by whitespace on the line, or has a preceeding +preceded only by whitespace on the line, or has a preceding semicolon, opening brace, or opening bracket on the same line." (save-excursion (backward-char)
--- a/lisp/modes/verilog-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/verilog-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -24,7 +24,7 @@ ;;; Commentary: -;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/modes/Attic/verilog-mode.el,v 1.1 1997/02/13 18:52:49 steve Exp $ +;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/modes/Attic/verilog-mode.el,v 1.2 1997/03/08 23:26:28 steve Exp $ ;; For help figuring out what to do with this file, visit ;; <http://www.silicon-sorcery.com/emacs_install.html> @@ -325,7 +325,7 @@ (provide 'verilog-mode) ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "$$Revision: 1.1 $$" +(defconst verilog-mode-version "$$Revision: 1.2 $$" "Version of this verilog mode.") (defvar verilog-indent-level 3 @@ -864,7 +864,7 @@ verilog-case-indent (default 2) Indentation for case statements. verilog-auto-newline (default nil) - Non-nil means automatically newline after simcolons and the punctation mark + Non-nil means automatically newline after semicolons and the punctuation mark after an end. verilog-auto-indent-on-newline (default t) Non-nil means automatically indent line after newline @@ -872,9 +872,9 @@ Non-nil means TAB in Verilog mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. verilog-indent-begin-after-if (default t) - Non-nil means to indent begin statements following a preceeding + Non-nil means to indent begin statements following a preceding if, else, while, for and repeat statements, if any. otherwise, - the begin is lined up with the preceeding token. If t, you get: + the begin is lined up with the preceding token. If t, you get: if (a) begin otherwise you get:
--- a/lisp/modes/vhdl-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/vhdl-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -7,8 +7,8 @@ ;; Author: Rodney J. Whitby <rwhitby@asc.corp.mot.com> ;; Maintainer: Rodney J. Whitby <rwhitby@asc.corp.mot.com> ;; Created: June 1994, adapted from cc-mode.el 4.29 by Barry A. Warsaw. -;; Version: $Revision: 1.1.1.1 $ -;; Last Modified: $Date: 1996/12/18 22:50:39 $ +;; Version: $Revision: 1.2 $ +;; Last Modified: $Date: 1997/03/08 23:26:29 $ ;; Keywords: languages VHDL ;; Archive: ftp.eda.com.au:/pub/emacs/vhdl-mode.tar.gz @@ -69,7 +69,7 @@ ;; LCD Archive Entry: ;; vhdl-mode.el|Rodney J. Whitby|rwhitby@asc.corp.mot.com ;; |Major mode for editing VHDL code -;; |$Date: 1996/12/18 22:50:39 $|$Revision: 1.1.1.1 $ +;; |$Date: 1997/03/08 23:26:29 $|$Revision: 1.2 $ ;; |ftp.eda.com.au:/pub/emacs/vhdl-mode.tar.gz @@ -539,11 +539,11 @@ ;;;###autoload (defun vhdl-mode () "Major mode for editing VHDL code. -vhdl-mode $Revision: 1.1.1.1 $ +vhdl-mode $Revision: 1.2 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the -problem, including a reproducable test case and send the message. +problem, including a reproducible test case and send the message. Note that the details of configuring vhdl-mode will soon be moved to the accompanying texinfo manual. Until then, please read the README file @@ -2593,7 +2593,7 @@ ;; Defuns for submitting bug reports: -(defconst vhdl-version "$Revision: 1.1.1.1 $" +(defconst vhdl-version "$Revision: 1.2 $" "vhdl-mode version number.") (defconst vhdl-mode-help-address "rwhitby@asc.corp.mot.com" "Address accepting submission of bug reports.")
--- a/lisp/modes/view.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/view.el Mon Aug 13 09:18:39 2007 +0200 @@ -36,6 +36,10 @@ ;;; Code: +;; XEmacs (to try to forestall complaints). +(when (featurep 'view-less) + (error "Can't load view.el and view-less.el in same session.")) + (defvar view-highlight-face 'highlight ;; XEmacs change "*The extent face used for highlighting the match found by View mode search.")
--- a/lisp/modes/vrml-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/modes/vrml-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -591,7 +591,7 @@ "Return t if point is just after the `#' beginning a real comment. Does not check to see if previous char is actually `#'. A real comment is either at the beginning of the buffer, -preceeded only by whitespace on the line, or has a preceeding +preceded only by whitespace on the line, or has a preceding semicolon, opening brace, or opening bracket on the same line." (save-excursion (backward-char)
--- a/lisp/mu/std11.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/mu/std11.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,10 +1,10 @@ ;;; std11.el --- STD 11 functions for GNU Emacs -;; Copyright (C) 1995,1996 Free Software Foundation, Inc. +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Keywords: mail, news, RFC 822, STD 11 -;; Version: $Id: std11.el,v 1.1.1.2 1996/12/21 20:50:52 steve Exp $ +;; Version: $Id: std11.el,v 1.2 1997/03/08 23:26:30 steve Exp $ ;; This file is part of MU (Message Utilities). @@ -263,13 +263,14 @@ represents addr-spec of RFC 822. [std11.el]" (mapconcat (function (lambda (token) - (if (let ((name (car token))) - (or (eq name 'spaces) - (eq name 'comment) - )) - "" - (cdr token) - ))) + (let ((name (car token))) + (cond + ((eq name 'spaces) "") + ((eq name 'comment) "") + ((eq name 'quoted-string) + (concat "\"" (cdr token) "\"")) + (t (cdr token))) + ))) seq "") )
--- a/lisp/mule/mule-files.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/mule/mule-files.el Mon Aug 13 09:18:39 2007 +0200 @@ -33,7 +33,15 @@ (setq-default file-coding-system 'iso-2022-8) (put 'file-coding-system 'permanent-local t) -(defvar overriding-file-coding-system nil +(defvar coding-system-for-write nil + "Overriding coding system used when writing a file. +You should *bind* this, not set it. If this is non-nil, it specifies +the coding system that will be used when a file is wrote in, and +overrides `file-coding-system', `insert-file-contents-pre-hook', +etc. Use those variables instead of this one for permanent changes +to the environment.") + +(defvar coding-system-for-read nil "Overriding coding system used when reading a file. You should *bind* this, not set it. If this is non-nil, it specifies the coding system that will be used when a file is read in, and @@ -47,7 +55,7 @@ use `file-coding-system-alist'. From a Lisp program, if you wish to unilaterally specify the coding system used for one particular operation, you should bind the variable -`overriding-file-coding-system' rather than setting this variable, +`coding-system-for-read' rather than setting this variable, which is intended to be used for global environment specification.") (defvar file-coding-system-alist @@ -62,7 +70,7 @@ Each element of the alist is a cons of a regexp, specifying the files to be affected, and a coding system. This overrides the more general specification in `file-coding-system-for-read', but is -overridden by `overriding-file-coding-system'. +overridden by `coding-system-for-read'. Instead of a coding system you may specify a function, and it will be called after the file has been read in to decode the file. It is @@ -279,7 +287,7 @@ The coding system used for decoding the file is determined as follows: -1. `overriding-file-coding-system', if non-nil. +1. `coding-system-for-read', if non-nil. 2. The result of `insert-file-contents-pre-hook', if non-nil. 3. The matching value for this filename from `file-coding-system-alist', if any. @@ -302,7 +310,7 @@ (setq coding-system (or ;; #1. - overriding-file-coding-system + coding-system-for-read ;; #2. (run-special-hook-with-args 'insert-file-contents-pre-hook filename visit) @@ -382,7 +390,7 @@ "A special hook to decide the coding system used for writing out a file. Before writing a file, `write-region' calls the functions on this hook -with arguments START, END, FILENAME, APPEND, VISIT, and CODING-SYTEM, +with arguments START, END, FILENAME, APPEND, VISIT, and CODING-SYSTEM, the same as the corresponding arguments in the call to `write-region'. @@ -431,7 +439,8 @@ See also `write-region-pre-hook' and `write-region-post-hook'." (interactive "r\nFWrite region to file: \ni\ni\ni\nZCoding-system: ") (setq coding-system - (or (run-special-hook-with-args + (or coding-system-for-write + (run-special-hook-with-args 'write-region-pre-hook start end filename append visit lockname) coding-system file-coding-system))
--- a/lisp/mule/mule-misc.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 09:18:39 2007 +0200 @@ -72,8 +72,9 @@ (defun delete-text-in-column (from to) "Delete the text between column FROM and TO (exclusive) of the current line. Nil of FORM or TO means the current column. -If there's a charcter across the borders, the character is replaced with -the same width of spaces before deleting." + +If there's a character across the borders, the character is replaced +with the same width of spaces before deleting." (save-excursion (let (p1 p2) (if from
--- a/lisp/mule/visual-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/mule/visual-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -509,7 +509,7 @@ (backward-char 1))))) (defun delete-direction-forward (dir) - "From current point, delete DIR-direction charaters forward. + "From current point, delete DIR-direction characters forward. Returns the deleted string." (let ((p (point))) (skip-direction-forward dir)
--- a/lisp/packages/bookmark.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/bookmark.el Mon Aug 13 09:18:39 2007 +0200 @@ -1149,7 +1149,7 @@ must pass at least OLD when calling from Lisp. While you are entering the new name, consecutive C-w's insert -consectutive words from the text of the buffer into the new bookmark +consecutive words from the text of the buffer into the new bookmark name." (interactive (bookmark-completing-read "Old bookmark name")) (bookmark-maybe-historicize-string old) @@ -1454,7 +1454,7 @@ (bookmark-maybe-sort-alist) (mapcar (lambda (full-record) - ;; if a bookmark has an annotation, preceed it with a "*" + ;; if a bookmark has an annotation, precede it with a "*" ;; in the list of bookmarks. (let ((annotation (bookmark-get-annotation (bookmark-name-from-full-record full-record)))) @@ -1481,7 +1481,7 @@ "Major mode for editing a list of bookmarks. Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. -Bookmark names preceeded by a \"*\" have annotations. +Bookmark names preceded by a \"*\" have annotations. \\<bookmark-bmenu-mode-map> \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. \\[bookmark-bmenu-select] -- select bookmark of line point is on. @@ -2078,7 +2078,7 @@ is done. You must pass at least OLD-BOOKMARK when calling from Lisp. While you are entering the new name, consecutive C-w's insert -consectutive words from the text of the buffer into the new bookmark +consecutive words from the text of the buffer into the new bookmark name. Warning: this function only takes an EVENT as argument. Use the
--- a/lisp/packages/emerge.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/emerge.el Mon Aug 13 09:18:39 2007 +0200 @@ -2986,7 +2986,7 @@ ;; a list of variables. The argument is a list of symbols (the names of ;; the variables). A list element can also be a list of two functions, ;; the first of which (when called with no arguments) gets the value, and -;; the second (when called with a value as an argment) sets the value. +;; the second (when called with a value as an argument) sets the value. ;; A "function" is anything that funcall can handle as an argument. (defun emerge-save-variables (vars)
--- a/lisp/packages/filladapt.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/filladapt.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,8 +1,5 @@ -;;; filladapt.el --- adaptive fill; replacement for fill commands - -;; Keywords: wp - -;;; Copyright (C) 1989, 1995, 1996 Kyle E. Jones +;;; Adaptive fill +;;; Copyright (C) 1989, 1995, 1996, 1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -19,18 +16,16 @@ ;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA ;;; 02139, USA. ;;; -;;; Send bug reports to kyle@wonderworks.com - -;;; Synched up with: Not in FSF. +;;; Send bug reports to kyle_jones@wonderworks.com ;; LCD Archive Entry: ;; filladapt|Kyle Jones|kyle_jones@wonderworks.com| ;; Minor mode to adaptively set fill-prefix and overload filling functions| -;; 10-June-1996|2.08|~/packages/filladapt.el| +;; 10-June-1996|2.09|~/packages/filladapt.el| ;; These functions enhance the default behavior of Emacs' Auto Fill -;; mode and the commands fill-paragraph, lisp-fill-paragraph and -;; fill-region-as-paragraph. +;; mode and the commands fill-paragraph, lisp-fill-paragraph, +;; fill-region-as-paragraph and fill-region. ;; ;; The chief improvement is that the beginning of a line to be ;; filled is examined and, based on information gathered, an @@ -72,9 +67,12 @@ ;; filladapt-token-match-table ;; filladapt-token-conversion-table +(and (featurep 'filladapt) + (error "filladapt cannot be loaded twice in the same Emacs session.")) + (provide 'filladapt) -(defvar filladapt-version "2.08" +(defvar filladapt-version "2.09" "Version string for filladapt.") (defvar filladapt-mode nil @@ -86,6 +84,28 @@ "*String to display in the modeline when Filladapt mode is active. Set this to nil if you don't want a modeline indicator for Filladapt.") +(defvar filladapt-fill-column-tolerance nil + "*Tolerate filled paragraph lines ending this far from the fill column. +If any lines other than the last paragraph line end at a column +less than fill-column - filladapt-fill-column-tolerance, fill-column will +be adjusted using the filladapt-fill-column-*-fuzz variables and +the paragraph will be re-filled until the tolerance is achieved +or filladapt runs out of fuzz values to try. + +A nil value means behave normally, that is, don't try refilling +paragraphs to make filled line lengths fit within any particular +range.") + +(defvar filladapt-fill-column-forward-fuzz 5 + "*Try values from fill-column to fill-column plus this variable +when trying to make filled paragraph lines fall with the tolerance +range specified by filladapt-fill-column-tolerance.") + +(defvar filladapt-fill-column-backward-fuzz 5 + "*Try values from fill-column to fill-column minus this variable +when trying to make filled paragraph lines fall with the tolerance +range specified by filladapt-fill-column-tolerance.") + ;; install on minor-mode-alist (or (assq 'filladapt-mode minor-mode-alist) (setq minor-mode-alist (cons (list 'filladapt-mode @@ -94,76 +114,82 @@ (defvar filladapt-token-table '( + ;; this must be first + ("^" beginning-of-line) ;; Included text in news or mail replies - (">+" . citation->) + (">+" citation->) ;; Included text generated by SUPERCITE. We can't hope to match all ;; the possible variations, your mileage may vary. - ("[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" . supercite-citation) + ("[A-Za-z0-9][^'`\"< \t\n]*>[ \t]*" supercite-citation) ;; Lisp comments - (";+" . lisp-comment) + (";+" lisp-comment) ;; UNIX shell comments - ("#+" . sh-comment) + ("#+" sh-comment) ;; Postscript comments - ("%+" . postscript-comment) + ("%+" postscript-comment) ;; C++ comments - ("///*" . c++-comment) + ("///*" c++-comment) ;; Texinfo comments - ("@c[ \t]" . texinfo-comment) - ("@comment[ \t]" . texinfo-comment) + ("@c[ \t]" texinfo-comment) + ("@comment[ \t]" texinfo-comment) ;; Bullet types. ;; + ;; LaTex \item + ;; + ("\\\\item[ \t]" bullet) + ;; ;; 1. xxxxx ;; xxxxx ;; - ("[0-9]+\\.[ \t]" . bullet) + ("[0-9]+\\.[ \t]" bullet) ;; ;; 2.1.3 xxxxx xx x xx x ;; xxx ;; - ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" . bullet) + ("[0-9]+\\(\\.[0-9]+\\)+[ \t]" bullet) ;; ;; a. xxxxxx xx ;; xxx xxx ;; - ("[A-Za-z]\\.[ \t]" . bullet) + ("[A-Za-z]\\.[ \t]" bullet) ;; ;; 1) xxxx x xx x xx or (1) xx xx x x xx xx ;; xx xx xxxx xxx xx x x xx x ;; - ("(?[0-9]+)[ \t]" . bullet) + ("(?[0-9]+)[ \t]" bullet) ;; ;; a) xxxx x xx x xx or (a) xx xx x x xx xx ;; xx xx xxxx xxx xx x x xx x ;; - ("(?[A-Za-z])[ \t]" . bullet) + ("(?[A-Za-z])[ \t]" bullet) ;; ;; 2a. xx x xxx x x xxx ;; xxx xx x xx x ;; - ("[0-9]+[A-Za-z]\\.[ \t]" . bullet) + ("[0-9]+[A-Za-z]\\.[ \t]" bullet) ;; ;; 1a) xxxx x xx x xx or (1a) xx xx x x xx xx ;; xx xx xxxx xxx xx x x xx x ;; - ("(?[0-9]+[A-Za-z])[ \t]" . bullet) + ("(?[0-9]+[A-Za-z])[ \t]" bullet) ;; ;; - xx xxx xxxx or * xx xx x xxx xxx ;; xxx xx xx x xxx x xx x x x ;; - ("[-~*+]+[ \t]" . bullet) + ("[-~*+]+[ \t]" bullet) ;; ;; o xx xxx xxxx xx x xx xxx x xxx xx x xxx ;; xxx xx xx ;; - ("o[ \t]" . bullet) + ("o[ \t]" bullet) ;; don't touch - ("[ \t]+" . space) - ("$" . end-of-line) + ("[ \t]+" space) + ("$" end-of-line) ) "Table of tokens filladapt knows about. Format is - ((REGEXP . SYM) ...) + ((REGEXP SYM) ...) filladapt uses this table to build a tokenized representation of the beginning of the current line. Each REGEXP is matched @@ -199,6 +225,7 @@ (texinfo-comment texinfo-comment) (bullet) (space bullet space) + (beginning-of-line beginning-of-line) ) "Table describing what tokens a certain token will match. @@ -261,6 +288,7 @@ (defvar filladapt-function-table (let ((assoc-list (list (cons 'fill-paragraph (symbol-function 'fill-paragraph)) + (cons 'fill-region (symbol-function 'fill-region)) (cons 'fill-region-as-paragraph (symbol-function 'fill-region-as-paragraph)) (cons 'do-auto-fill (symbol-function 'do-auto-fill))))) @@ -349,23 +377,91 @@ fill-prefix retval) (if (filladapt-adapt t nil) (progn - (setq retval (filladapt-funcall function arg)) + (if filladapt-fill-column-tolerance + (let* ((low (- fill-column + filladapt-fill-column-backward-fuzz)) + (high (+ fill-column + filladapt-fill-column-forward-fuzz)) + (old-fill-column fill-column) + (fill-column fill-column) + (lim (- high low)) + (done nil) + (sign 1) + (delta 0)) + (while (not done) + (setq retval (filladapt-funcall function arg)) + (if (filladapt-paragraph-within-fill-tolerance) + (setq done 'success) + (setq delta (1+ delta) + sign (* sign -1) + fill-column (+ fill-column (* delta sign))) + (while (and (<= delta lim) + (or (< fill-column low) + (> fill-column high))) + (setq delta (1+ delta) + sign (* sign -1) + fill-column (+ fill-column + (* delta sign)))) + (setq done (> delta lim)))) + ;; if the paragraph lines never fell + ;; within the tolerances, refill using + ;; the old fill-column. + (if (not (eq done 'success)) + (let ((fill-column old-fill-column)) + (setq retval (filladapt-funcall function arg))))) + (setq retval (filladapt-funcall function arg))) (run-hooks 'filladapt-fill-paragraph-post-hook) (throw 'done retval)))))) ;; filladapt-adapt failed, so do fill-paragraph normally. (filladapt-funcall function arg))) (defun fill-paragraph (arg) + "Fill paragraph at or after point. Prefix arg means justify as well. + +(This function has been overloaded with the `filladapt' version.) + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there. + +If `fill-paragraph-function' is non-nil, we call it (passing our +argument to it), and if it returns non-nil, we simply return its value." (interactive "*P") (let ((filladapt-inside-filladapt t)) (filladapt-fill-paragraph 'fill-paragraph arg))) (defun lisp-fill-paragraph (&optional arg) + "Like \\[fill-paragraph], but handle Emacs Lisp comments. + +(This function has been overloaded with the `filladapt' version.) + +If any of the current line is a comment, fill the comment or the +paragraph of it that point is in, preserving the comment's indentation +and initial semicolons." (interactive "*P") (let ((filladapt-inside-filladapt t)) (filladapt-fill-paragraph 'lisp-fill-paragraph arg))) -(defun fill-region-as-paragraph (beg end &optional justify nosqueeze squeeze-after) +(defun fill-region-as-paragraph (beg end &optional justify + nosqueeze squeeze-after) + "Fill the region as one paragraph. + +(This function has been overloaded with the `filladapt' version.) + +It removes any paragraph breaks in the region and extra newlines at the end, +indents and fills lines between the margins given by the +`current-left-margin' and `current-fill-column' functions. +It leaves point at the beginning of the line following the paragraph. + +Normally performs justification according to the `current-justification' +function, but with a prefix arg, does full justification instead. + +From a program, optional third arg JUSTIFY can specify any type of +justification. Fourth arg NOSQUEEZE non-nil means not to make spaces +between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, +means don't canonicalize spaces before that position. + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there." (interactive "*r\nP") (if (and filladapt-mode (not filladapt-inside-filladapt)) (save-restriction @@ -373,6 +469,8 @@ (let ((filladapt-inside-filladapt t) line-start last-token) (goto-char beg) + (while (equal (char-after (point)) ?\n) + (delete-char 1)) (end-of-line) (while (zerop (forward-line)) (if (setq last-token @@ -405,9 +503,59 @@ ;; four args for Emacs 19.29 (filladapt-funcall 'fill-region-as-paragraph beg end justify nosqueeze) - ;; three args for the rest of the world. + ;; three args for the rest of the world. + (wrong-number-of-arguments + (filladapt-funcall 'fill-region-as-paragraph beg end justify))))))) + +(defun fill-region (beg end &optional justify nosqueeze to-eop) + "Fill each of the paragraphs in the region. + +(This function has been overloaded with the `filladapt' version.) + +Prefix arg (non-nil third arg, if called from program) means justify as well. + +Noninteractively, fourth arg NOSQUEEZE non-nil means to leave +whitespace other than line breaks untouched, and fifth arg TO-EOP +non-nil means to keep filling to the end of the paragraph (or next +hard newline, if `use-hard-newlines' is on). + +If `sentence-end-double-space' is non-nil, then period followed by one +space does not end a sentence, so don't break a line there." + (interactive "*r\nP") + (if (and filladapt-mode (not filladapt-inside-filladapt)) + (save-restriction + (narrow-to-region beg end) + (let ((filladapt-inside-filladapt t) + start) + (goto-char beg) + (while (not (eobp)) + (setq start (point)) + (while (and (not (eobp)) (not (filladapt-parse-prefixes))) + (forward-line 1)) + (if (not (equal start (point))) + (progn + (save-restriction + (narrow-to-region start (point)) + (fill-region start (point) justify nosqueeze to-eop) + (goto-char (point-max))) + (if (and (not (bolp)) (not (eobp))) + (forward-line 1)))) + (if (filladapt-parse-prefixes) + (progn + (save-restriction + ;; for the clipping region + (filladapt-adapt t t) + (fill-paragraph justify) + (goto-char (point-max))) + (if (and (not (bolp)) (not (eobp))) + (forward-line 1))))))) + (condition-case nil + (filladapt-funcall 'fill-region beg end justify nosqueeze to-eop) (wrong-number-of-arguments - (filladapt-funcall 'fill-region-as-paragraph beg end justify))))))) + (condition-case nil + (filladapt-funcall 'fill-region beg end justify nosqueeze) + (wrong-number-of-arguments + (filladapt-funcall 'fill-region beg end justify))))))) (defvar zmacs-region-stays) ; for XEmacs @@ -463,7 +611,7 @@ (done nil) (old-point (point)) (case-fold-search nil) - token-table not-token-table) + token-table not-token-table moved) (catch 'done (while (not done) (setq not-token-table filladapt-not-token-table) @@ -477,14 +625,15 @@ (if (null (looking-at (car (car token-table)))) (setq token-table (cdr token-table)) (goto-char (match-end 0)) - (setq token-list (cons (list (cdr (car token-table)) + (setq token-list (cons (list (nth 1 (car token-table)) (current-column) (buffer-substring (match-beginning 0) (match-end 0))) token-list) - token-table nil - done (eq (point) old-point) + moved (not (eq (point) old-point)) + token-table (if moved nil (cdr token-table)) + done (not moved) old-point (point)))))) (nreverse token-list)))) @@ -584,6 +733,20 @@ (setq list (cdr list))) (apply (function concat) (nreverse prefix-list)) )) +(defun filladapt-paragraph-within-fill-tolerance () + (catch 'done + (save-excursion + (let ((low (- fill-column filladapt-fill-column-tolerance)) + (shortline nil)) + (goto-char (point-min)) + (while (not (eobp)) + (if shortline + (throw 'done nil) + (end-of-line) + (setq shortline (< (current-column) low)) + (forward-line 1))) + t )))) + (defun filladapt-convert-to-spaces (string) "Return a copy of STRING, with all non-tabs and non-space changed to spaces." (let ((i 0) @@ -710,10 +873,6 @@ ;; (interactive) (make-local-variable 'filladapt-debug) (setq filladapt-debug (not filladapt-debug)) - ;; make sure these faces exist at least - (make-face 'filladapt-debug-indentation-face-1) - (make-face 'filladapt-debug-indentation-face-2) - (make-face 'filladapt-debug-paragraph-face) (if (null filladapt-debug) (progn (mapcar (function (lambda (e) (filladapt-set-extent-endpoints e 1 1)))
--- a/lisp/packages/font-lock.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/font-lock.el Mon Aug 13 09:18:39 2007 +0200 @@ -5,6 +5,7 @@ ;; Copyright (C) 1996 Ben Wing. ;; Author: Jamie Zawinski <jwz@lucid.com>, for the LISPM Preservation Society. +;; Minimally merged with FSF 19.34 by Barry Warsaw <bwarsaw@python.org> ;; Then (partially) synched with FSF 19.30, leading to: ;; Next Author: RMS ;; Next Author: Simon Marshall <simon@gnu.ai.mit.edu> @@ -263,11 +264,17 @@ (MATCHER . FACENAME) (MATCHER . HIGHLIGHT) (MATCHER HIGHLIGHT ...) + (eval . FORM) where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. +FORM is an expression, whose value should be a keyword element, +evaluated when the keyword is (first) used in a buffer. This feature +can be used to provide a keyword that can only be generated when Font +Lock mode is actually turned on. + For highlighting single items, typically only MATCH-HIGHLIGHT is required. -However, if an item or (typically) items is to be hightlighted following the +However, if an item or (typically) items is to be highlighted following the instance of another item (the anchor) then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: @@ -483,7 +490,7 @@ ;;; Each time a modification happens to a line, we re-fontify the entire line. ;;; We do this by first removing the extents (text properties) on the line, ;;; and then doing the syntactic and keyword passes again on that line. (More -;;; generally, each modified region is extended to include the preceeding and +;;; generally, each modified region is extended to include the preceding and ;;; following BOL or EOL.) ;;; ;;; This means that, as the user types, we repeatedly go back to the beginning @@ -555,6 +562,8 @@ (t (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (setq font-lock-defaults-computed nil + font-lock-keywords nil) ;; We have no business doing this here, since ;; pre-idle-hook is global. Other buffers may ;; still be in font-lock mode. -dkindred@cs.cmu.edu @@ -1128,10 +1137,6 @@ (eval (nth 1 keywords)) (save-match-data ;; Find an occurrence of `matcher' before `limit'. - (if (and (not (stringp matcher)) - (not (functionp matcher)) - (boundp matcher)) - (setq matcher (symbol-value matcher))) (while (if (stringp matcher) (re-search-forward matcher limit t) (funcall matcher limit)) @@ -1162,10 +1167,6 @@ ;; ;; Find an occurrence of `matcher' from `start' to `end'. (setq keyword (car keywords) matcher (car keyword)) - (if (and (not (stringp matcher)) - (not (functionp matcher)) - (boundp matcher)) - (setq matcher (symbol-value matcher))) (goto-char start) (while (and (< (point) end) (if (stringp matcher) @@ -1210,6 +1211,7 @@ ;; Font Lock mode. So turn the mode back on if necessary. (defalias 'font-lock-revert-cleanup 'turn-on-font-lock) + (defun font-lock-compile-keywords (&optional keywords) ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string. @@ -1217,20 +1219,21 @@ (setq font-lock-keywords (if (eq (car-safe keywords) t) keywords - (cons t - (mapcar - (function (lambda (item) - (cond ((nlistp item) - (list item '(0 font-lock-keyword-face))) - ((numberp (cdr item)) - (list (car item) (list (cdr item) 'font-lock-keyword-face))) - ((symbolp (cdr item)) - (list (car item) (list 0 (cdr item)))) - ((nlistp (nth 1 item)) - (list (car item) (cdr item))) - (t - item)))) - keywords)))))) + (cons t (mapcar 'font-lock-compile-keyword keywords)))))) + +(defun font-lock-compile-keyword (keyword) + (cond ((nlistp keyword) ; Just MATCHER + (list keyword '(0 font-lock-keyword-face))) + ((eq (car keyword) 'eval) ; Specified (eval . FORM) + (font-lock-compile-keyword (eval (cdr keyword)))) + ((numberp (cdr keyword)) ; Specified (MATCHER . MATCH) + (list (car keyword) (list (cdr keyword) 'font-lock-keyword-face))) + ((symbolp (cdr keyword)) ; Specified (MATCHER . FACENAME) + (list (car keyword) (list 0 (cdr keyword)))) + ((nlistp (nth 1 keyword)) ; Specified (MATCHER . HIGHLIGHT) + (list (car keyword) (cdr keyword))) + (t ; Hopefully (MATCHER HIGHLIGHT ...) + keyword))) (defun font-lock-choose-keywords (keywords level) ;; Return LEVELth element of KEYWORDS. A LEVEL of nil is equal to a
--- a/lisp/packages/gnuserv.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 09:18:39 2007 +0200 @@ -241,8 +241,8 @@ ;; give window chance to re-display text (accept-process-output)))) -(defun server-tty-find-file (tty termtype file) - (let ((device (make-tty-device tty termtype))) +(defun server-tty-find-file (tty termtype pid file) + (let ((device (make-tty-device tty termtype pid ))) (select-frame (make-frame nil device)) (if (not file) (switch-to-buffer (get-buffer-create "*scratch*")) @@ -344,7 +344,7 @@ "Type {\\[server-edit]} or select Frame/Delete to finish edit." "When done with a buffer, type \\[server-edit].")))) -(defun server-tty-edit-files (tty termtype list) +(defun server-tty-edit-files (tty termtype pid list) "For each (line-number . file) pair in LIST, edit the file at line-number. Save enough information for (server-kill-buffer) to inform the client when the edit is finished." @@ -352,7 +352,7 @@ (while list (let ((line (car (car list))) (path (cdr (car list)))) - (server-tty-find-file tty termtype path) + (server-tty-find-file tty termtype pid path) (server-make-window-visible) (let ((old-clients (assq current-client server-clients)) (buffer (current-buffer))) @@ -449,14 +449,18 @@ ;; tell it that it is done, and forget it entirely. (if (cdr client) nil - (server-write-to-client (car client) nil) - (setq server-clients (delq client server-clients)))) + (if (buffer-name buffer) + (save-excursion + (set-buffer buffer) + (setq server-buffer-clients nil))) + ; Order is important here -- + ; server-kill-buffer tries to notify clients that + ; they are done, too, but if we try and notify twice, + ; we are h0zed -- Hunter Kelly 3/3/97 + (setq server-clients (delq client server-clients)) + (funcall server-done-function buffer) + (server-write-to-client (car client) nil))) (setq old-clients (cdr old-clients))) - (if (buffer-name buffer) - (save-excursion - (set-buffer buffer) - (setq server-buffer-clients nil))) - (funcall server-done-function buffer) next-buffer))
--- a/lisp/packages/gopher.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/gopher.el Mon Aug 13 09:18:39 2007 +0200 @@ -1310,7 +1310,7 @@ (defun gopher-telnet-object (obj oldbuf) "Start a telnet session to a gopher object. -If gopher-telnet-command is nonnil, then that is a command to start +If gopher-telnet-command is non-nil, then that is a command to start a telnet session in a subprocess. Otherwise, the emacs-lisp telnet package is used."
--- a/lisp/packages/hyper-apropos.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/hyper-apropos.el Mon Aug 13 09:18:39 2007 +0200 @@ -54,6 +54,7 @@ ;; additions by Ben Wing <wing@666.com> July 1995: ;; added support for function aliases, made programmer's apropos be the ;; default, various other hacking. +;; Massive changes by Christoph Wedler <wedler@fmi.uni-passau.de> ;;; Code: @@ -67,6 +68,9 @@ "*If non-nil, `hyper-apropos' will display some documentation in the \"*Hyper Apropos*\" buffer. Setting this to nil will speed up searches.") +(defvar hypropos-shrink-window nil + "*If non-nil, shrink *Hyper Help* buffer if possible.") + (defvar hypropos-prettyprint-long-values t "*If non-nil, then try to beautify the printing of very long values.") @@ -77,6 +81,7 @@ output. If nil, then only functions that are interactive and variables that are user variables are found by `hyper-apropos'.") +(defvar hypropos-ref-buffer) (defvar hypropos-prev-wconfig) ;; #### - move this to subr.el @@ -174,7 +179,7 @@ (defvar hypropos-map (let ((map (make-sparse-keymap))) (set-keymap-name map 'hypropos-map) (set-keymap-parents map (list hypropos-help-map)) - ;; slightly differrent scrolling... + ;; slightly different scrolling... (define-key map " " 'hypropos-scroll-up) (define-key map "b" 'hypropos-scroll-down) ;; act on the current line... @@ -201,6 +206,10 @@ (defvar hypropos-currently-showing nil) ; symbol documented in help buffer now (defvar hypropos-help-history nil) ; chain of symbols followed as links in ; help buffer +(defvar hypropos-face-history nil) +;;;(defvar hypropos-variable-history nil) +;;;(defvar hypropos-function-history nil) +(defvar hypropos-regexp-history nil) (defvar hypropos-last-regexp nil) ; regex used for last apropos (defconst hypropos-apropos-buf "*Hyper Apropos*") (defconst hypropos-help-buf "*Hyper Help*") @@ -211,7 +220,9 @@ in buffer \"*Hyper Apropos*\". If optional prefix arg is given, then the value of `hypropos-programming-apropos' is toggled for this search. See also `hyper-apropos-mode'." - (interactive "sList symbols matching regexp: \nP") + (interactive (list (read-from-minibuffer "List symbols matching regexp: " + nil nil nil 'hypropos-regexp-history) + current-prefix-arg)) (or (memq major-mode '(hyper-apropos-mode hyper-help-mode)) (setq hypropos-prev-wconfig (current-window-configuration))) (if (string= "" regexp) @@ -255,7 +266,7 @@ (hyper-apropos hypropos-last-regexp nil)) (defun hypropos-grok-functions (fns) - (let (fn bind type) + (let (fn bind doc type) (while (setq fn (car fns)) (setq bind (symbol-function fn) type (cond ((subrp bind) ?i) @@ -269,36 +280,30 @@ (insert type (if (commandp fn) "* " " ")) (insert-face (format "%-30S" fn) 'hyperlink) (and hypropos-show-brief-docs - (if (function-obsolete-p fn) - (insert-face " - Obsolete." 'documentation) - (let ((doc (documentation fn))) - (if (not doc) - (insert-face " - Not documented." 'documentation) - (insert-face (concat " - " - (substring doc 0 - (string-match "\n" doc))) - 'documentation))))) + (setq doc (documentation fn)) + (insert-face (if doc + (concat " - " + (substring doc 0 (string-match "\n" doc))) + " Not documented.") + 'documentation)) (insert ?\n) (setq fns (cdr fns)) ))) (defun hypropos-grok-variables (vars) - (let (var userp) + (let (var doc userp) (while (setq var (car vars)) (setq userp (user-variable-p var) vars (cdr vars)) (insert (if userp " * " " ")) (insert-face (format "%-30S" var) 'hyperlink) (and hypropos-show-brief-docs - (if (variable-obsolete-p var) - (insert-face " - Obsolete." 'documentation) - (let ((doc (documentation-property var 'variable-documentation))) - (if (not doc) - (insert-face " - Not documented." 'documentation) - (insert-face (concat " - " - (substring doc (if userp 1 0) - (string-match "\n" doc))) - 'documentation))))) + (setq doc (documentation-property var 'variable-documentation)) + (insert-face (if doc + (concat " - " (substring doc (if userp 1 0) + (string-match "\n" doc))) + " - Not documented.") + 'documentation)) (insert ?\n) ))) @@ -345,66 +350,258 @@ ;; ---------------------------------------------------------------------- ;; +;; similar to `describe-key-briefly', copied from prim/help.el by CW + ;;;###autoload -(defun hyper-describe-variable (symbol) - "Hypertext drop-in replacement for `describe-variable'. +(defun hyper-describe-key (key) + (interactive "kDescribe key: ") + (hyper-describe-key-briefly key t)) + +;;;###autoload +(defun hyper-describe-key-briefly (key &optional show) + (interactive "kDescribe key briefly: \nP") + (let (menup defn interm final msg) + (setq defn (key-or-menu-binding key 'menup)) + (if (or (null defn) (integerp defn)) + (or (numberp show) (message "%s is undefined" (key-description key))) + (cond ((stringp defn) + (setq interm defn + final (key-binding defn))) + ((vectorp defn) + (setq interm (append defn nil)) + (while (and interm + (member (key-binding (vector (car interm))) + '(universal-argument digit-argument))) + (setq interm (cdr interm))) + (while (and interm + (not (setq final (key-binding (vconcat interm))))) + (setq interm (butlast interm))) + (if final + (setq interm (vconcat interm)) + (setq interm defn + final (key-binding defn))))) + (setq msg (format + "%s runs %s%s%s" + ;; This used to say 'This menu item' but it could also + ;; be a scrollbar event. We can't distinguish at the + ;; moment. + (if menup "This item" (key-description key)) + ;;(if (symbolp defn) defn (key-description defn)) + (if (symbolp defn) defn (prin1-to-string defn)) + (if final (concat ", " (key-description interm) " runs ") "") + (if final + (if (symbolp final) final (prin1-to-string final)) + ""))) + (if (numberp show) + (or (not (symbolp defn)) + (memq (symbol-function defn) + '(zkey-init-kbd-macro zkey-init-kbd-fn)) + (progn (princ msg) (princ "\n"))) + (message "%s" msg) + (if final (setq defn final)) + (if (and (or (symbolp defn) (symbolp (setq defn (car-safe defn)))) + defn + show) + (hypropos-get-doc defn t)))))) + +;;;###autoload +(defun hyper-describe-face (symbol &optional this-ref-buffer) + "Describe face.. See also `hyper-apropos' and `hyper-describe-function'." ;; #### - perhaps a prefix arg should suppress the prompt... - (interactive - (let* ((v (variable-at-point)) - (val (let ((enable-recursive-minibuffers t)) + (interactive + (let (v val) + (setq v (hypropos-this-symbol)) ; symbol under point + (or (find-face v) + (setq v (variable-at-point))) + (setq val (let ((enable-recursive-minibuffers t)) (completing-read - (if v - (format "Describe variable (default %s): " v) - "Describe variable: ") - obarray 'boundp t)))) - (list (if (string= val "") v (intern-soft val))))) + (concat (if (hypropos-follow-ref-buffer current-prefix-arg) + "Follow face" + "Describe face") + (if v + (format " (default %s): " v) + ": ")) + (mapcar (function (lambda (x) (list (symbol-name x)))) + (face-list)) + nil t nil 'hypropos-face-history))) + (list (if (string= val "") + (progn (push (symbol-name v) hypropos-face-history) v) + (intern-soft val)) + current-prefix-arg))) (if (null symbol) (message "Sorry, nothing to describe.") (or (memq major-mode '(hyper-apropos-mode hyper-help-mode)) (setq hypropos-prev-wconfig (current-window-configuration))) - (hypropos-get-doc symbol t))) + (hypropos-get-doc symbol t nil this-ref-buffer))) ;;;###autoload -(defun hyper-describe-function (symbol) +(defun hyper-describe-variable (symbol &optional this-ref-buffer) + "Hypertext drop-in replacement for `describe-variable'. +See also `hyper-apropos' and `hyper-describe-function'." + ;; #### - perhaps a prefix arg should suppress the prompt... + (interactive (list (hypropos-read-variable-symbol + (if (hypropos-follow-ref-buffer current-prefix-arg) + "Follow variable" + "Describe variable")) + current-prefix-arg)) + (if (null symbol) + (message "Sorry, nothing to describe.") + (or (memq major-mode '(hyper-apropos-mode hyper-help-mode)) + (setq hypropos-prev-wconfig (current-window-configuration))) + (hypropos-get-doc symbol t nil this-ref-buffer))) + +(defun hyper-where-is (symbol) + "Print message listing key sequences that invoke specified command." + (interactive (list (hypropos-read-function-symbol "Where is function"))) + (if (null symbol) + (message "Sorry, nothing to describe.") + (where-is symbol))) + +;;;###autoload +(defun hyper-describe-function (symbol &optional this-ref-buffer) "Hypertext replacement for `describe-function'. Unlike `describe-function' in that the symbol under the cursor is the default if it is a function. See also `hyper-apropos' and `hyper-describe-variable'." ;; #### - perhaps a prefix arg should suppress the prompt... - (interactive - (let (fn val) - (setq fn (hypropos-this-symbol)) ; symbol under point - (or (fboundp fn) - (setq fn (function-called-at-point))) - (setq val (let ((enable-recursive-minibuffers t)) - (completing-read - (if fn - (format "Describe function (default %s): " fn) - "Describe function: ") - obarray 'fboundp t))) - (list (if (equal val "") fn (intern-soft val))))) + (interactive (list (hypropos-read-function-symbol + (if (hypropos-follow-ref-buffer current-prefix-arg) + "Follow function" + "Describe function")) + current-prefix-arg)) (if (null symbol) (message "Sorry, nothing to describe.") (or (memq major-mode '(hyper-apropos-mode hyper-help-mode)) (setq hypropos-prev-wconfig (current-window-configuration))) - (hypropos-get-doc symbol t))) + (hypropos-get-doc symbol t nil this-ref-buffer))) + +;;;###autoload +(defun hypropos-read-variable-symbol (prompt &optional predicate) + "Hypertext drop-in replacement for `describe-variable'. +See also `hyper-apropos' and `hyper-describe-function'." + ;; #### - perhaps a prefix arg should suppress the prompt... + (or predicate (setq predicate 'boundp)) + (let (v val) + (setq v (hypropos-this-symbol)) ; symbol under point + (or (funcall predicate v) + (setq v (variable-at-point))) + (or (funcall predicate v) + (setq v nil)) + (setq val (let ((enable-recursive-minibuffers t)) + (completing-read + (concat prompt + (if v + (format " (default %s): " v) + ": ")) + obarray predicate t nil 'variable-history))) + (if (string= val "") + (progn (push (symbol-name v) variable-history) v) + (intern-soft val)))) + +(defun hypropos-read-function-symbol (prompt) + "Read function symbol from minibuffer." + (let ((fn (hypropos-this-symbol)) + val) + (or (fboundp fn) + (setq fn (function-called-at-point))) + (setq val (let ((enable-recursive-minibuffers t)) + (completing-read (if fn + (format "%s (default %s): " prompt fn) + (format "%s: " prompt)) + obarray 'fboundp t nil + 'function-history))) + (if (equal val "") + (progn (push (symbol-name fn) function-history) fn) + (intern-soft val)))) (defun hypropos-last-help (arg) "Go back to the last symbol documented in the *Hyper Help* buffer." (interactive "P") - (let ((win (get-buffer-window hypropos-help-buf)) - (n (prefix-numeric-value arg))) - (cond ((and (not win) (not arg)) - ;; don't alter the help-history, just redisplay - ) - ((<= (length hypropos-help-history) n) + (let ((win (get-buffer-window hypropos-help-buf))) + (or arg (setq arg (if win 1 0))) + (cond ((= arg 0)) + ((<= (length hypropos-help-history) arg) ;; go back as far as we can... (setcdr (nreverse hypropos-help-history) nil)) (t - (setq hypropos-help-history (nthcdr n hypropos-help-history)))) - (hypropos-get-doc (car hypropos-help-history) t))) + (setq hypropos-help-history (nthcdr arg hypropos-help-history)))) + (if (or win (> arg 0)) + (hypropos-get-doc (car hypropos-help-history) t) + (display-buffer hypropos-help-buf)))) + +(defun hypropos-insert-face (string &optional face) + "Insert STRING and fontify some parts with face `hyperlink'." + (let ((beg (point)) end) + (insert-face string (or face 'documentation)) + (setq end (point)) + (goto-char beg) + (while (re-search-forward + "`\\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)'" + end 'limit) + (set-extent-face (make-extent (match-beginning 1) (match-end 1)) + 'hyperlink)) + (goto-char beg) + (while (re-search-forward + "M-x \\([-a-zA-Z0-9_][-a-zA-Z0-9_][-a-zA-Z0-9_.]+\\)" + end 'limit) + (set-extent-face (make-extent (match-beginning 1) (match-end 1)) + 'hyperlink)))) + +(defun hypropos-insert-keybinding (keys string) + (if keys + (insert " (" string " bound to \"" + (mapconcat 'key-description + (sort keys #'(lambda (x y) + (< (length x) (length y)))) + "\", \"") + "\")\n"))) -(defun hypropos-get-doc (&optional symbol force type) +(defun hypropos-insert-section-heading (alias-desc &optional desc) + (or desc (setq desc alias-desc + alias-desc nil)) + (if alias-desc + (setq desc (concat alias-desc + (if (memq (aref desc 0) + '(?a ?e ?i ?o ?u)) + ", an " ", a ") + desc))) + (aset desc 0 (upcase (aref desc 0))) ; capitalize + (goto-char (point-max)) + (newline 3) (delete-blank-lines) (newline 2) + (hypropos-insert-face desc 'section-heading)) + +(defun hypropos-insert-value (string symbol val) + (insert-face string 'heading) + (insert (if (symbol-value symbol) + (if (or (null val) (eq val t) (integerp val)) + (prog1 + (symbol-value symbol) + (set symbol nil)) + "see below") + "is void"))) + +(defun hypropos-follow-ref-buffer (this-ref-buffer) + (and (not this-ref-buffer) + (eq major-mode 'hyper-help-mode) + hypropos-ref-buffer + (buffer-live-p hypropos-ref-buffer))) + +(defun hypropos-get-alias (symbol alias-p next-symbol &optional use) + "Return (TERMINAL-SYMBOL . ALIAS-DESC)." + (let (aliases) + (while (funcall alias-p symbol) + (setq aliases (cons (if use (funcall use symbol) symbol) aliases)) + (setq symbol (funcall next-symbol symbol))) + (cons symbol + (and aliases + (concat "an alias for `" + (mapconcat 'symbol-name + (nreverse aliases) + "',\nwhich is an alias for `") + "'"))))) + +;;;###autoload +(defun hypropos-get-doc (&optional symbol force type this-ref-buffer) ;; #### - update this docstring "Toggle display of documentation for the symbol on the current line." ;; SYMBOL is the symbol to document. FORCE, if non-nil, means to @@ -436,167 +633,291 @@ ;; otherwise clear the history because it's a new search. (list symbol)))) (save-excursion - (set-buffer (get-buffer-create hypropos-help-buf)) - (setq buffer-read-only nil) - (erase-buffer) - (let ((standard-output (current-buffer)) - ok beg desc - ftype macrop fndef - keys val doc - obsolete aliases alias-desc) - (insert-face (format "`%s'\n\n" symbol) 'major-heading) + (if (hypropos-follow-ref-buffer this-ref-buffer) + (set-buffer hypropos-ref-buffer) + (setq hypropos-ref-buffer (current-buffer))) + (let (standard-output + ok beg + newsym symtype doc obsolete + (local mode-name) + global local-str global-str + font fore back undl + aliases alias-desc desc) + (save-excursion + (set-buffer (get-buffer-create hypropos-help-buf)) + ;;(setq standard-output (current-buffer)) + (setq buffer-read-only nil) + (erase-buffer) + (insert-face (format "`%s'" symbol) 'major-heading) + (insert (format " (buffer: %s, mode: %s)\n" + (buffer-name hypropos-ref-buffer) + local))) + ;; function ---------------------------------------------------------- (and (memq 'function type) (fboundp symbol) - (progn - (setq ok t - fndef (symbol-function symbol)) - (while (symbolp fndef) - (setq aliases (cons fndef aliases)) - (setq fndef (symbol-function fndef))) - (if (eq 'macro (car-safe fndef)) - (setq macrop t - fndef (cdr fndef))) - (setq aliases (nreverse aliases)) - ;; #### - the gods of internationalization shall strike me down! - (while aliases - (if alias-desc - (setq alias-desc (concat alias-desc ",\nwhich is "))) - (setq alias-desc (concat alias-desc - (format "an alias for `%s'" - (car aliases)))) - (setq aliases (cdr aliases))) - (setq ftype (cond ((subrp fndef) 'subr) - ((compiled-function-p fndef) 'bytecode) - ((eq (car-safe fndef) 'autoload) 'autoload) - ((eq (car-safe fndef) 'lambda) 'lambda)) + (progn + (setq ok t) + (setq aliases (hypropos-get-alias (symbol-function symbol) + 'symbolp + 'symbol-function) + newsym (car aliases) + alias-desc (cdr aliases)) + (if (eq 'macro (car-safe newsym)) + (setq desc "macro" + newsym (cdr newsym)) + (setq desc "function")) + (setq symtype (cond ((subrp newsym) 'subr) + ((compiled-function-p newsym) 'bytecode) + ((eq (car-safe newsym) 'autoload) 'autoload) + ((eq (car-safe newsym) 'lambda) 'lambda)) desc (concat (if (commandp symbol) "interactive ") - (cdr (assq ftype + (cdr (assq symtype '((subr . "built-in ") (bytecode . "compiled Lisp ") (autoload . "autoloaded Lisp ") (lambda . "Lisp ")))) - (if macrop "macro" "function") - )) - (if alias-desc - (setq desc (concat alias-desc - (if (memq (aref desc 0) - '(?a ?e ?i ?o ?u)) - ", an " ", a ") - desc))) - (aset desc 0 (upcase (aref desc 0))) ; capitalize - (insert-face desc 'section-heading) - (and (eq ftype 'autoload) - (insert (format ", (autoloaded from \"%s\")" - (nth 1 fndef)))) - ;; #### - should also show local binding in some other - ;; buffer so that this function can be used in place of - ;; describe-function and describe-variable. - (if (setq keys (where-is-internal symbol (current-global-map) - nil nil nil)) - (insert (format ", (globally bound to %s)" - (mapconcat - #'(lambda (x) - (format "\"%s\"" - (key-description x))) - (sort keys #'(lambda (x y) - (< (length x) (length y)))) - ", ")))) - (insert ":\n\n") - (setq beg (point) + desc) + local (current-local-map) + global (current-global-map) + obsolete (get symbol 'byte-obsolete-info) doc (or (documentation symbol) "function not documented")) - (insert-face "arguments: " 'heading) - (cond ((eq ftype 'lambda) - (princ (or (nth 1 fndef) "()"))) - ((eq ftype 'bytecode) - (princ (or (if (fboundp 'compiled-function-arglist) - (compiled-function-arglist fndef) - (aref fndef 0)) "()"))) - ((and (eq ftype 'subr) - (string-match - "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" - doc)) - (insert (substring doc - (match-beginning 1) - (match-end 1))) - (setq doc (substring doc 0 (match-beginning 0)))) - (t (princ "[not available]"))) - (insert "\n\n") - (let ((new - ;; cookbook from bytecomp.el - (get symbol 'byte-obsolete-info))) - (and new - (insert-face - (format "%s is an obsolete function; %s\n\n" symbol - (if (stringp (car new)) - (car new) - (format "use %s instead." (car new)))) - 'warning))) - (insert-face doc 'documentation) - (indent-rigidly beg (point) 1) - (insert"\n\n") - )) + (save-excursion + (set-buffer hypropos-help-buf) + (goto-char (point-max)) + (setq standard-output (current-buffer)) + (hypropos-insert-section-heading alias-desc desc) + (and (eq symtype 'autoload) + (insert (format ", (autoloaded from \"%s\")" + (nth 1 newsym)))) + (insert ":\n") + (if local + (hypropos-insert-keybinding + (where-is-internal symbol (list local) nil nil nil) + "locally")) + (hypropos-insert-keybinding + (where-is-internal symbol (list global) nil nil nil) + "globally") + (insert "\n") + (if obsolete + (hypropos-insert-face + (format "%s is an obsolete function; %s\n\n" symbol + (if (stringp (car obsolete)) + (car obsolete) + (format "use `%s' instead." (car obsolete)))) + 'warning)) + (setq beg (point)) + (insert-face "arguments: " 'heading) + (cond ((eq symtype 'lambda) + (princ (or (nth 1 newsym) "()"))) + ((eq symtype 'bytecode) + (princ (or (aref newsym 0) "()"))) + ((and (eq symtype 'subr) + (string-match + "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" + doc)) + (insert (substring doc + (match-beginning 1) + (match-end 1))) + (setq doc (substring doc 0 (match-beginning 0)))) + ((and (eq symtype 'subr) + (string-match + "[\n\t ]*([^\n\t )]+[\t ]*\\([^\n)]+\\)?)\\(:[\t ]*\\|\n?\\'\\)" + doc)) + (insert "(" + (if (match-end 1) + (substring doc + (match-beginning 1) + (match-end 1))) + ")") + (setq doc (substring doc (match-end 0)))) + (t (princ "[not available]"))) + (insert "\n\n") + (hypropos-insert-face doc) + (insert "\n") + (indent-rigidly beg (point) 2)))) + ;; variable ---------------------------------------------------------- (and (memq 'variable type) - (boundp symbol) + (or (boundp symbol) (default-boundp symbol)) (progn (setq ok t) - (insert-face (if (user-variable-p symbol) - "User variable" - "Variable") - 'section-heading) - (and (local-variable-p symbol nil t) - (insert ", local when set")) - (insert ":\n\n") - (setq beg (point) - val (prin1-to-string (symbol-value symbol)) - doc (or (documentation-property - symbol 'variable-documentation) + (setq aliases (hypropos-get-alias symbol + 'variable-alias + 'variable-alias + 'variable-alias) + newsym (car aliases) + alias-desc (cdr aliases)) + (setq symtype (or (local-variable-p newsym (current-buffer)) + (and (local-variable-p newsym + (current-buffer) t) + 'auto-local)) + desc (concat (if (user-variable-p newsym) + "user variable" + "variable") + (cond ((eq symtype t) ", buffer-local") + ((eq symtype 'auto-local) + ", local when set"))) + local (and (boundp newsym) + (symbol-value newsym)) + local-str (and (boundp newsym) + (prin1-to-string local)) + global (and (eq symtype t) + (default-boundp newsym) + (default-value newsym)) + global-str (and (eq symtype t) + (default-boundp newsym) + (prin1-to-string global)) + obsolete (get symbol 'byte-obsolete-variable) + doc (or (documentation-property symbol + 'variable-documentation) "variable not documented")) - - (let ((ob (get symbol 'byte-obsolete-variable))) - (setq obsolete - (and ob (format "%s is an obsolete variable; %s\n\n" - symbol - (if (stringp ob) - ob - (format "use %s instead." ob)))))) - ;; generally, the value of the variable is short and the - ;; documentation of the variable long, so it's desirable - ;; to see all of the value and the start of the - ;; documentation. Some variables, though, have huge and - ;; nearly meaningless values that force you to page - ;; forward just to find the doc string. That is - ;; undesirable. - (if (< (length val) 69) ; 80 cols. docstrings assume this. - (progn (insert-face "value: " 'heading) - (insert (format "%s\n\n" val)) - (and obsolete (insert-face obsolete 'warning)) - (insert-face doc 'documentation)) - (insert "(see below for value)\n\n") - (and obsolete (insert-face obsolete 'warning)) - (insert-face doc 'documentation) - (insert "\n\n") - (insert-face "value: " 'heading) - (if hypropos-prettyprint-long-values - (let ((pp-print-readably nil)) - (pprint (symbol-value symbol))) - (insert val))) - (indent-rigidly beg (point) 2) - )) + (save-excursion + (set-buffer hypropos-help-buf) + (goto-char (point-max)) + (setq standard-output (current-buffer)) + (hypropos-insert-section-heading alias-desc desc) + (insert ":\n\n") + (setq beg (point)) + (if obsolete + (hypropos-insert-face + (format "%s is an obsolete function; %s\n\n" symbol + (if (stringp obsolete) + obsolete + (format "use `%s' instead." obsolete))) + 'warning)) + ;; generally, the value of the variable is short and the + ;; documentation of the variable long, so it's desirable + ;; to see all of the value and the start of the + ;; documentation. Some variables, though, have huge and + ;; nearly meaningless values that force you to page + ;; forward just to find the doc string. That is + ;; undesirable. + (if (and (or (null local-str) (< (length local-str) 69)) + (or (null global-str) (< (length global-str) 69))) + ; 80 cols. docstrings assume this. + (progn (insert-face "value: " 'heading) + (insert (or local-str "is void")) + (if (eq symtype t) + (progn + (insert "\n") + (insert-face "default value: " 'heading) + (insert (or global-str "is void")))) + (insert "\n\n") + (hypropos-insert-face doc)) + (hypropos-insert-value "value: " 'local-str local) + (if (eq symtype t) + (progn + (insert ", ") + (hypropos-insert-value "default-value: " + 'global-str global))) + (insert "\n\n") + (hypropos-insert-face doc) + (if local-str + (progn + (newline 3) (delete-blank-lines) (newline 1) + (insert-face "value: " 'heading) + (if hypropos-prettyprint-long-values + (condition-case nil + (let ((pp-print-readably nil)) (pprint local)) + (error (insert local-str))) + (insert local-str)))) + (if global-str + (progn + (newline 3) (delete-blank-lines) (newline 1) + (insert-face "default value: " 'heading) + (if hypropos-prettyprint-long-values + (condition-case nil + (let ((pp-print-readably nil)) (pprint global)) + (error (insert global-str))) + (insert global-str))))) + (indent-rigidly beg (point) 2)))) + ;; face -------------------------------------------------------------- (and (memq 'face type) (find-face symbol) (progn (setq ok t) + (copy-face symbol 'hypropos-temp-face 'global) + (mapcar (function + (lambda (property) + (setq symtype (face-property-instance symbol + property)) + (if symtype + (set-face-property 'hypropos-temp-face + property + symtype)))) + built-in-face-specifiers) + (setq font (cons (face-property-instance symbol 'font nil 0 t) + (face-property-instance symbol 'font)) + fore (cons (face-foreground-instance symbol nil 0 t) + (face-foreground-instance symbol)) + back (cons (face-background-instance symbol nil 0 t) + (face-background-instance symbol)) + undl (cons (face-underline-p symbol nil 0 t) + (face-underline-p symbol)) + doc (face-doc-string symbol)) ;; #### - add some code here - (insert "Face documentation is \"To be implemented.\"\n\n") - ) - ) - (or ok (insert-face "symbol is not currently bound" 'heading))) + (save-excursion + (set-buffer hypropos-help-buf) + (setq standard-output (current-buffer)) + (hypropos-insert-section-heading "Face:\n\n ") + (insert-face "ABCDEFHIJKLMNOPQRSTUVWXYZ abcdefhijklmnopqrstuvwxyz 0123456789" + 'hypropos-temp-face) + (newline 2) + (insert-face " Font: " 'heading) + (insert (format (if (numberp (car font)) "(%s)\n" "%s\n") + (and (cdr font) + (font-instance-name (cdr font))))) + (insert-face " Foreground: " 'heading) + (insert (format (if (numberp (car fore)) "(%s)\n" "%s\n") + (and (cdr fore) + (color-instance-name (cdr fore))))) + (insert-face " Background: " 'heading) + (insert (format (if (numberp (car back)) "(%s)\n" "%s\n") + (and (cdr back) + (color-instance-name (cdr back))))) + (insert-face " Underline: " 'heading) + (insert (format (if (numberp (car undl)) "(%s)\n" "%s\n") + (cdr undl))) + (if doc + (progn + (newline) + (setq beg (point)) + (insert doc) + (indent-rigidly beg (point) 2)))))) + ;; not bound & property list ----------------------------------------- + (or ok + (save-excursion + (set-buffer hypropos-help-buf) + (hypropos-insert-section-heading + "symbol is not currently bound\n"))) + (if (and (setq symtype (symbol-plist symbol)) + (or (> (length symtype) 2) + (not (memq 'variable-documentation symtype)))) + (save-excursion + (set-buffer hypropos-help-buf) + (goto-char (point-max)) + (setq standard-output (current-buffer)) + (hypropos-insert-section-heading "property-list:\n\n") + (while symtype + (if (memq (car symtype) + '(variable-documentation byte-obsolete-info)) + (setq symtype (cdr symtype)) + (insert-face (concat " " (symbol-name (car symtype)) + ": ") + 'heading) + (setq symtype (cdr symtype)) + (indent-to 32) + (insert (prin1-to-string (car symtype)) "\n")) + (setq symtype (cdr symtype))))))) + (save-excursion + (set-buffer hypropos-help-buf) (goto-char (point-min)) ;; pop up window and shrink it if it's wasting space - (shrink-window-if-larger-than-buffer - (display-buffer (current-buffer))) - (hyper-help-mode)) ) - (setq hypropos-currently-showing symbol)) + (if hypropos-shrink-window + (shrink-window-if-larger-than-buffer + (display-buffer (current-buffer))) + (display-buffer (current-buffer))) + (hyper-help-mode)) + (setq hypropos-currently-showing symbol))) ; ----------------------------------------------------------------------------- @@ -737,7 +1058,7 @@ (point))) (en (progn (skip-syntax-forward "w_") - (skip-chars-backward ".") + (skip-chars-backward ".':") ; : for Local Variables (point)))) (and (not (eq st en)) (intern-soft (buffer-substring st en)))))))) @@ -755,35 +1076,69 @@ (t (call-interactively fn)))) ;;;###autoload -(defun hypropos-set-variable (var val) +(defun hyper-set-variable (var val &optional this-ref-buffer) + (interactive + (let ((var (hypropos-read-variable-symbol + (if (hypropos-follow-ref-buffer current-prefix-arg) + "In ref buffer, set user option" + "Set user option") + 'user-variable-p))) + (list var (hypropos-read-variable-value var) current-prefix-arg))) + (hypropos-set-variable var val this-ref-buffer)) + +;;;###autoload +(defun hypropos-set-variable (var val &optional this-ref-buffer) "Interactively set the variable on the current line." (interactive - (let ((var (save-excursion - (and (eq major-mode 'hypropos-help-mode) - (goto-char (point-min))) - (hypropos-this-symbol)))) - (or (boundp var) - (setq var (completing-read "Set variable: " - obarray 'boundp t))) - (hypropos-get-doc var t) - (list var - (let ((prop (get var 'variable-interactive)) - (print-readably t) - (val (symbol-value var))) - (if prop - (call-interactively (list 'lambda '(arg) - (list 'interactive prop) - 'arg)) - (eval-minibuffer - (format "Set `%s' to value (evaluated): " var) - (format (if (or (consp val) - (and (symbolp val) - (not (memq val '(t nil))))) - "'%s" "%s") - (prin1-to-string val)))))) - )) - (set var val) - (hypropos-get-doc var t)) + (let ((var (hypropos-this-symbol))) + (or (and var (boundp var)) + (and (setq var (and (eq major-mode 'hyper-help-mode) + (save-excursion + (goto-char (point-min)) + (hypropos-this-symbol)))) + (boundp var)) + (setq var nil)) + (list var (hypropos-read-variable-value var)))) + (and var + (boundp var) + (progn + (if (hypropos-follow-ref-buffer this-ref-buffer) + (save-excursion + (set-buffer hypropos-ref-buffer) + (set var val)) + (set var val)) + (hypropos-get-doc var t '(variable) this-ref-buffer)))) + +(defun hypropos-read-variable-value (var &optional this-ref-buffer) + (and var + (boundp var) + (let ((prop (get var 'variable-interactive)) + (print-readably t) + val str) + (hypropos-get-doc var t '(variable) current-prefix-arg) + (if prop + (call-interactively (list 'lambda '(arg) + (list 'interactive prop) + 'arg)) + (setq val (if (hypropos-follow-ref-buffer this-ref-buffer) + (save-excursion + (set-buffer hypropos-ref-buffer) + (symbol-value var)) + (symbol-value var)) + str (prin1-to-string val)) + (eval-minibuffer + (format "Set %s `%s' to value (evaluated): " + (if (user-variable-p var) "user option" "Variable") + var) + (condition-case nil + (progn + (read str) + (format (if (or (consp val) + (and (symbolp val) + (not (memq val '(t nil))))) + "'%s" "%s") + str)) + (error nil))))))) ;; ---------------------------------------------------------------------- ;; @@ -886,4 +1241,3 @@ (provide 'hyper-apropos) ;; end of hyper-apropos.el -
--- a/lisp/packages/mic-paren.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/mic-paren.el Mon Aug 13 09:18:39 2007 +0200 @@ -299,7 +299,7 @@ (if paren-delay (add-hook 'post-command-idle-hook 'mic-paren-command-idle-hook) (add-hook 'post-command-hook 'mic-paren-command-hook))) - ;; Check if we (at least) have a post-comand-hook, and use it + ;; Check if we (at least) have a post-command-hook, and use it ;; (Emacs 19.29 and below) ((boundp 'post-command-hook) (add-hook 'post-command-hook 'mic-paren-command-hook))
--- a/lisp/packages/mime-compose.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/mime-compose.el Mon Aug 13 09:18:39 2007 +0200 @@ -594,6 +594,7 @@ (save-excursion (re-search-backward (concat "--" (mime-primary-boundary))) (point)) (- (point) 1)) + (insert "\n") (let ((start (point)) end (seldisp selective-display)) (next-line 1) (save-excursion
--- a/lisp/packages/mode-motion+.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/mode-motion+.el Mon Aug 13 09:18:39 2007 +0200 @@ -160,7 +160,7 @@ ; Minibuffer name matching improved. Made `tcl-boundaries' smarter by ; use of new function `tcl-forward-sexp1'. `tcl-commands' list updated ; -- should be complete now. A message is printed if the syntax scanner -; matched or failed for known tcl/tk commands. Seperated `tcl-commands' +; matched or failed for known tcl/tk commands. Separated `tcl-commands' ; from `tk-commands' -- `tk-commands' not yet complete. New motion ; handler `raise-LaTeX' added, for tex-mode. ; @@ -1313,7 +1313,7 @@ (defun mode-motion-insert-text (text) "Insert TEXT at point. Also insert one space if the -preceeding character is a word constituent or a closing paren." +preceding character is a word constituent or a closing paren." (or text (error "No highlighted text to copy.")) (let ((prec-char-syntax (char-syntax (preceding-char)))) (if (memq prec-char-syntax '(?w ?\))) (insert " "))
--- a/lisp/packages/paren.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/paren.el Mon Aug 13 09:18:39 2007 +0200 @@ -78,7 +78,7 @@ and shell quoting. This variable is global by default, but you can make it buffer-local and -highlight parentheses differrently in different major modes.") +highlight parentheses differently in different major modes.") (make-face 'paren-match) (or (face-differs-from-default-p 'paren-match) @@ -309,7 +309,7 @@ ;;;###autoload (defun paren-set-mode (arg &optional quiet) "Cycles through possible values for `paren-mode', force off with negative arg. -When called from lisp, a symbolic value for `paren-mode' can be pased directly. +When called from lisp, a symbolic value for `paren-mode' can be passed directly. See also `paren-mode' and `paren-highlight'." (interactive "P") (let* ((paren-modes '(blink-paren paren sexp))
--- a/lisp/packages/supercite.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/supercite.el Mon Aug 13 09:18:39 2007 +0200 @@ -218,7 +218,12 @@ "*Value returned by `sc-mail-field' if field isn't in mail headers.") (defvar sc-name-filter-alist - '(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0) + '( + ;; This first item removes any [bracketed] multi-word items in names. + ;; Each word is already split into a separate string when this filter is + ;; applied, hence the complexity of the expression. + ("\\[.*\\]\\|\\[[^\]]*\\|[^\[]*\\]" . any) + ("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0) ("^\\(Jr\\|Sr\\)[.]?$" . last) ("^ASTS$" . 0) ("^[I]+$" . last))
--- a/lisp/packages/time.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/time.el Mon Aug 13 09:18:39 2007 +0200 @@ -2,7 +2,9 @@ ;; Copyright (C) 1985, 86, 87, 93, 94, 1996 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: FSF, XEmacs add-ons (C) by Jens T. Lautenbacher +;; mail <jens@lemming0.lem.uni-karlsruhe.de> +;; for comments/fixes about the enhancements. ;; This file is part of XEmacs. @@ -32,10 +34,19 @@ ;; This uses the XEmacs timeout-event mechanism, via a version ;; of Kyle Jones' itimer package. +;;; JTL: This is in a wide part reworked for XEmacs so it won't use +;;; the old mechanism for specifying what is to be displayed. +;;; The starting variable to look at is `display-time-form-list' + ;;; Code: (require 'itimer) +(defvar display-time-compatible nil + "*This variable may be set to nil to get the old behaviour of display-time. +This means no display of a spiffy mail icon or use of the display-time-form-list +instead of the old display-time-string-form.") + (defvar display-time-mail-file nil "*File name of mail inbox file, for indicating existence of new mail. Non-nil and not a string means don't check for mail. nil means use @@ -45,7 +56,7 @@ (defvar display-time-day-and-date nil "\ *Non-nil means \\[display-time] should display day and date as well as time.") -(defvar display-time-interval 60 +(defvar display-time-interval 20 "*Seconds between updates of time in the mode line.") (defvar display-time-24hr-format nil @@ -77,6 +88,10 @@ ;; if the "display-time" itimer already exists, nuke it first. (let ((old (get-itimer "display-time"))) (if old (delete-itimer old))) + + (if (memq 'display-time-string global-mode-string) + (setq global-mode-string + (remove 'display-time-string global-mode-string))) ;; If we're not displaying the time in the echo area ;; and the global mode string does not have a non-nil value ;; then initialize the global mode string's value. @@ -84,13 +99,11 @@ global-mode-string (setq global-mode-string '(""))) ;; If we're not displaying the time in the echo area - ;; and our display variable is not part of the global-mode-string list - ;; the we add our variable to the list. This will make the time + ;; then we add our variable to the list. This will make the time ;; appear on the modeline. (or display-time-echo-area - (memq 'display-time-string global-mode-string) (setq global-mode-string - (append global-mode-string '(display-time-string)))) + (append global-mode-string '(display-time-string)))) ;; Display the time initially... (display-time-function) ;; ... and start an itimer to do it automatically thereafter. @@ -103,50 +116,266 @@ (start-itimer "display-time" 'display-time-function display-time-interval display-time-interval)) -(defvar display-time-show-load t) +(defvar display-time-show-icons-maybe t + "Use icons to indicate the mail status if possible") -(defvar display-time-show-icons-maybe t - "Use icons to indicate the mail status if we're running under X and -XEmacs was compiled with xpm support") +(defvar display-time-icons-dir (concat data-directory "time/")) -(defun display-time-get-icons-dir () - (let ((path load-path) - dir elem) - (while (setq elem (pop path)) - (setq dir (concat (directory-file-name elem) "/../etc/time/")) - (if (file-directory-p dir) (setq path nil) - nil)) - dir)) +(defvar display-time-mail-sign-string " Mail" + "The string used as mail indicator in the echo area +(and in the modeline if display-time-show-icons-maybe is nil) +if display-time-echo-area is t") -(defvar display-time-icons-dir (display-time-get-icons-dir)) - -(defvar display-time-mail-sign +(defvar display-time-no-mail-sign-string "" + "The string used as no-mail indicator in the echo area +(and in the modeline if display-time-show-icons-maybe is nil) +if display-time-echo-area is t") + +(defvar display-time-mail-sign (progn (let* ((file (concat display-time-icons-dir "letter.xpm")) - (glyph (if (featurep 'xpm) (make-glyph file) nil)) - (display-time-mail-ext (detach-extent (make-extent 1 1)))) - (if (and (featurep 'x) glyph - (file-exists-p file)) - (cons display-time-mail-ext glyph) - " Mail"))) - "A variable holding a string or a cons cell (ext . glyph) which gives -an indicator for unread mail. The default displays a xpm-file (a yellow letter) -if (feturep 'xpm) and (featurep 'x) are both t, a string \" Mail\" otherwise") + (glyph (if (featurep 'xpm) (make-glyph file) + display-time-mail-sign-string)) + (ext (make-extent nil nil))) + (cons ext glyph))) + "A variable holding a cons cell (ext . glyph) +which gives an indicator for new mail in the modeline") (defvar display-time-no-mail-sign (progn (let* ((file (concat display-time-icons-dir "no-letter.xpm")) - (glyph (if (featurep 'xpm) (make-glyph file) nil)) - (display-time-mail-ext (detach-extent (make-extent 1 1)))) - (if (and (featurep 'x) glyph - (file-exists-p file)) - (cons display-time-mail-ext glyph) - ""))) - "A variable holding a string or a cons cell (ext . glyph) which gives -an indicator for `no mail'. The default displays a xpm-file -if (feturep 'xpm) and (featurep 'x) are both t, and nothing otherwise") + (glyph (if (featurep 'xpm) (make-glyph file) + display-time-no-mail-sign-string)) + (ext (make-extent nil nil))) + (cons ext glyph))) + "A variable holding a cons cell (ext . glyph) which gives +an indicator for `no mail' in the modeline") + +(defun display-time-string-to-char-list (str) + (mapcar (function identity) str)) + + +(if (featurep 'xpm) + (progn + (setq display-time-1-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "1.xpm")))) + (setq display-time-2-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "2.xpm")))) + (setq display-time-3-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "3.xpm")))) + (setq display-time-4-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "4.xpm")))) + (setq display-time-5-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "5.xpm")))) + (setq display-time-6-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "6.xpm")))) + (setq display-time-7-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "7.xpm")))) + (setq display-time-8-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "8.xpm")))) + (setq display-time-9-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "9.xpm")))) + (setq display-time-0-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "0.xpm")))) + (setq display-time-:-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "dp.xpm")))) + (setq display-time-load-0.0-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-0.0.xpm")))) + (setq display-time-load-0.5-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-0.5.xpm")))) + (setq display-time-load-1.0-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-1.0.xpm")))) + (setq display-time-load-1.5-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-1.5.xpm")))) + (setq display-time-load-2.0-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-2.0.xpm")))) + (setq display-time-load-2.5-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-2.5.xpm")))) + (setq display-time-load-3.0-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "l-3.0.xpm")))) + (setq display-time-am-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "am.xpm")))) + (setq display-time-pm-glyph + (cons (make-extent nil nil) + (make-glyph (concat display-time-icons-dir "pm.xpm")))) + )) +(defun display-time-convert-num-to-pics (string) + (let ((list (display-time-string-to-char-list string)) + elem result tmp) + (if (not (and display-time-show-icons-maybe + (eq (console-type) 'x) + (not display-time-echo-area))) string + (while (setq elem (pop list)) + (push (eval (intern-soft (concat "display-time-" + (char-to-string elem) + "-glyph"))) tmp)) + (setq result (reverse tmp))))) + +(defvar display-time-load-list + (list 0.2 0.5 0.8 1.1 1.8 2.6) + "*A list giving six thresholds for the load which correspond +to the six different icons to be displayed as a load indicator") + +(defun display-time-convert-load-to-glyph (n) + (let ((load-number (string-to-number n)) + (alist (list (cons 0.0 0.0) + (cons 0.5 (car display-time-load-list)) + (cons 1.0 (cadr display-time-load-list)) + (cons 1.5 (caddr display-time-load-list)) + (cons 2.0 (cadddr display-time-load-list)) + (cons 2.5 (cadr (cdddr display-time-load-list))) + (cons 3.0 (caddr (cdddr display-time-load-list))) + (cons 100000 100000))) + result elem) + (if (not (and display-time-show-icons-maybe + (eq (console-type) 'x) + (not display-time-echo-area))) n + (while (>= load-number (cdr (setq elem (pop alist)))) + (setq result (eval (intern-soft (concat + "display-time-load-" + (number-to-string (car elem)) + "-glyph"))))) + result))) + +(defun display-time-convert-am-pm (n) + (if (not (and display-time-show-icons-maybe + (eq (console-type) 'x) + (not display-time-echo-area))) n + (cond ((equal n "am") display-time-am-glyph) + ((equal n "pm") display-time-pm-glyph)))) + + +(defun display-time-mail-sign () + "*A function giving back the object indicating 'mail' which +is the value of display-time-mail-sign when running under X, +display-time-echo-area is nil and display-time-show-icons-maybe is t. +It is the value of display-time-mail-sign-string otherwise." + (if (or (not (eq (console-type) 'x)) + display-time-echo-area + (not display-time-show-icons-maybe)) + display-time-mail-sign-string + display-time-mail-sign)) + +(defun display-time-no-mail-sign () + "*A function giving back the object indicating 'no mail' which +is the value of display-time-no-mail-sign when running under X, +display-time-echo-area is nil and display-time-show-icons-maybe is t. +It is the value of display-time-no-mail-sign-string otherwise." + (if (or (not (eq (console-type) 'x)) + display-time-echo-area + (not display-time-show-icons-maybe)) + display-time-no-mail-sign-string + display-time-no-mail-sign)) + +(defvar display-time-form-list + (list 'date-compatible 'time-compatible 'load 'mail) + "*This list describes the format of the strings/glyphs which are to be +displayed by display-time. The old variable display-time-string-forms is +only used if display-time-compatible is non-nil. It is a list consisting of +strings or any of the following symbols: + +date-compatible: This prints out the date in a manner compatible to + the default value of the obsolete variable + display-time-string-forms. It respects the variable + display-time-day-and-date. If this is t it will print + out the current date in the form DAYNAME MONTH DAY + otherwise it will print nothing. + +time-compatible: This prints out the time in a manner compatible to + the default value of the obsolete variable + display-time-string-forms. It respects the variable + display-time-24hr-format. If this is t it will print + out the current hours in 24-hour format, if nil the + hours will be printed in 12-hour format and the + minutes will be followed by 'AM' or 'PM'. + +24-hours: This prints the hours in 24-hours format + +12-hours: This prints the hours in 12-hours format + +am-pm: This prints Am or Pm. + +dp: This prints a \":\", maybe as an icon + +minutes: This prints the minutes. + +day: This prints out the current day as a number. + +dayname: This prints out today's name. + +month: This prints out the current month as a number + +monthname: This prints out the current month's name + +load: This prints out the system's load. + +mail: This displays a mail indicator. Under X this will + normally be a small icon which changes depending if + there is new mail or not.") + +(defun display-time-evaluate-list () + "Evalute the variable display-time-form-list" + (let ((list display-time-form-list) elem tmp result) + (while (setq elem (pop list)) + (cond ((stringp elem) (push elem tmp)) + ((eq elem 'date-compatible) + (push (if display-time-day-and-date + (format "%s %s %s " dayname monthname day) "") tmp)) + ((eq elem 'time-compatible) + (progn + (push (display-time-convert-num-to-pics + (format "%s:%s" + (if display-time-24hr-format 24-hours 12-hours) + minutes)) tmp) + (if (not display-time-24hr-format) + (push (display-time-convert-am-pm am-pm) tmp)))) + ((eq elem 'day) (push day tmp)) + ((eq elem 'dayname) (push dayname tmp)) + ((eq elem 'month) (push month tmp)) + ((eq elem 'monthname) (push monthname tmp)) + ((eq elem '24-hours) (push (display-time-convert-num-to-pics 24-hours) + tmp)) + ((eq elem '12-hours) (push (display-time-convert-num-to-pics 12-hours) + tmp)) + ((eq elem 'minutes) (push (display-time-convert-num-to-pics minutes) + tmp)) + ((eq elem 'am-pm) (push am-pm tmp)) + ((eq elem 'dp) (push (display-time-convert-num-to-pics ":") tmp)) + ((eq elem 'load) + (push (display-time-convert-load-to-glyph load) tmp)) + ((eq elem 'mail) (push (if mail (display-time-mail-sign) + (display-time-no-mail-sign)) + tmp)))) + ;; We know that we have a list containing only of strings if + ;; display-time-echo-area is t. So we construct this string from + ;; the list. Else we just reverse the list and give it as result. + (if (not display-time-echo-area) (setq result (reverse tmp)) + (while (setq elem (pop tmp)) + (setq result (concat elem result)))) + result)) + + (defvar display-time-string-forms '((if display-time-day-and-date (format "%s %s %s " dayname monthname day) @@ -155,17 +384,14 @@ (if display-time-24hr-format 24-hours 12-hours) minutes (if display-time-24hr-format "" am-pm)) - (if display-time-show-load load) - (if (and (not display-time-show-icons-maybe) mail) " Mail" "")) - "*A list of expressions governing display of the time in the mode line. + load + (if mail " Mail" "")) + "*THIS IS OBSOLETE! It will only be used if display-time-compatible is t. +A list of expressions governing display of the time in the mode line. This expression is a list of expressions that can involve the keywords `load', `day', `month', and `year', `12-hours', `24-hours', `minutes', `seconds', all numbers in string form, and `monthname', `dayname', `am-pm', and `time-zone' all alphabetic strings and `mail' a true/nil string value. -Beware: if display-time-show-icons-maybe is non-nil, the `mail' spec is also -evaluated after this form and depending on it's result display-time-mail-sign -or display-time-no-mail-sign is appended to the modeline string. -This was made so you can also use xpm-files as mail indicator. For example, the form @@ -222,13 +448,9 @@ ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12"))))) (dayname (substring time 0 3))) (setq display-time-string - (mapconcat 'eval display-time-string-forms "")) - (if (and mail display-time-show-icons-maybe) - (setq display-time-string - (list display-time-string display-time-mail-sign)) - (if display-time-show-icons-maybe - (setq display-time-string - (list display-time-string display-time-no-mail-sign)))) + (if display-time-compatible + (mapconcat 'eval display-time-string-forms "") + (display-time-evaluate-list))) ;; This is inside the let binding, but we are not going to document ;; what variables are available. (run-hooks 'display-time-hook))
--- a/lisp/packages/vc.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/packages/vc.el Mon Aug 13 09:18:39 2007 +0200 @@ -122,6 +122,10 @@ (defvar vc-checkin-hook nil "*List of functions called after a checkin is done. See `run-hooks'.") +;;;###autoload +(defvar vc-before-checkin-hook nil + "*List of functions called before a checkin is done. See `run-hooks'.") + (defvar vc-make-buffer-writable-hook nil "*List of functions called when a buffer is made writable. See `run-hooks.' This hook is only used when the version control system is CVS. It @@ -681,13 +685,19 @@ (delete-window) (kill-buffer (current-buffer)))))) -(defun vc-start-entry (file rev comment msg action &optional after-hook) +(defun vc-start-entry (file rev comment msg action &optional after-hook before-hook) ;; Accept a comment for an operation on FILE revision REV. If COMMENT ;; is nil, pop up a VC-log buffer, emit MSG, and set the ;; action on close to ACTION; otherwise, do action immediately. ;; Remember the file's buffer in vc-parent-buffer (current one if no file). ;; AFTER-HOOK specifies the local value for vc-log-operation-hook. + ;; BEFORE-HOOK specifies a hook to run before even asking for the + ;; checkin comments. (let ((parent (if file (find-file-noselect file) (current-buffer)))) + (when before-hook + (save-excursion + (set-buffer parent) + (run-hooks before-hook))) (if comment (set-buffer (get-buffer-create "*VC-log*")) (pop-to-buffer (get-buffer-create "*VC-log*"))) @@ -718,7 +728,7 @@ (vc-start-entry file rev (or comment (not vc-initial-comment)) "Enter initial comment." 'vc-backend-admin - nil)) + nil 'vc-before-checkin-hook)) (defun vc-checkout (file &optional writable) "Retrieve a copy of the latest version of the given file." @@ -776,7 +786,7 @@ popped up to accept a comment." (vc-start-entry file rev comment "Enter a change comment." 'vc-backend-checkin - 'vc-checkin-hook)) + 'vc-checkin-hook 'vc-before-checkin-hook)) ;;; Here is a checkin hook that may prove useful to sites using the ;;; ChangeLog facility supported by Emacs.
--- a/lisp/prim/about.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:18:39 2007 +0200 @@ -40,6 +40,8 @@ ;;; 19.15 and 20.0 updating done by Steve Baur and Martin Buchholz. (require 'browse-url) +(require 'view-less) + (defvar about-xref-map (let ((map (make-sparse-keymap))) (define-key map 'button1 'about-xemacs-xref) (define-key map 'button2 'about-xemacs-xref) @@ -1136,3 +1138,5 @@ )) (goto-char (point-min)) )))) + +;;; about.el ends here
--- a/lisp/prim/auto-autoloads.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/auto-autoloads.el Mon Aug 13 09:18:39 2007 +0200 @@ -1059,17 +1059,6 @@ ;;;*** -;;;### (autoloads (widget-delete widget-create) "wid-edit" "custom/wid-edit.el") - -(autoload 'widget-create "wid-edit" "\ -Create widget of TYPE. -The optional ARGS are additional keyword arguments." nil nil) - -(autoload 'widget-delete "wid-edit" "\ -Delete WIDGET." nil nil) - -;;;*** - ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec) "edebug" "edebug/edebug.el") (autoload 'def-edebug-spec "edebug" "\ @@ -2248,7 +2237,7 @@ Reread contents of current buffer from its last auto-save file." t nil) (autoload 'message-forward "message" "\ -Forward the current message via mail. +Forward the current message via mail. Optional NEWS will use news to forward instead of mail." t nil) (autoload 'message-resend "message" "\ @@ -2572,6 +2561,21 @@ ;;;*** +;;;### (autoloads (hyperbole) "hui-mini" "hyperbole/hui-mini.el") + +(autoload 'hyperbole "hui-mini" "\ +Invokes default Hyperbole menu user interface when not already active. +Suitable for binding to a key, e.g. {C-h h}. +Non-interactively, returns t if menu is actually invoked by call, else nil. + +Two optional arguments may be given to invoke alternative menus. +MENU (a symbol) specifies the menu to invoke from MENU-LIST, (a +Hyperbole menu list structure). MENU defaults to 'hyperbole and MENU-LIST +to `hui:menus'. See `hui:menus' definition for the format of the menu list +structure." t nil) + +;;;*** + ;;;### (autoloads (var:append) "hvar" "hyperbole/hvar.el") (autoload 'var:append "hvar" "\ @@ -3473,7 +3477,7 @@ side-by-side window are used. The user can, with the help of Follow mode, use two full-height windows as though they would have been one. Imagine yourself editing a large function, or section of text, -and beeing able to use 144 lines instead of the normal 72... (your +and being able to use 144 lines instead of the normal 72... (your mileage may vary). To split one large window into two side-by-side windows, the commands @@ -3754,7 +3758,7 @@ ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.13 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.14 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -4121,7 +4125,7 @@ pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) - Non-nil means automatically newline after simcolons and the punctation mark + Non-nil means automatically newline after semicolons and the punctation mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, @@ -4130,7 +4134,7 @@ Non-nil means a comment { ... } is set after the ends which ends cases and functions. The name of the function or case will be set between the braces. pascal-auto-lineup (default t) - List of contexts where auto lineup of :'s or ='s hould be done. + List of contexts where auto lineup of :'s or ='s should be done. See also the user variables pascal-type-keywords, pascal-start-keywords and pascal-separator-keywords. @@ -4394,7 +4398,7 @@ remap RETURN to rexx-indent-newline-indent. It makes sure that lines indents correctly when you press RETURN. -An extensive abbrevation table consisting of all the keywords of REXX are +An extensive abbreviation table consisting of all the keywords of REXX are supplied. Expanded keywords are converted into upper case making it easier to distinguish them. To use this feature the buffer must be in abbrev-mode. (See example below.) @@ -4412,8 +4416,8 @@ )) will make the END aligned with the DO/SELECT. It will indent blocks and -IF-statenents four steps and make sure that the END jumps into the -correct position when RETURN is pressed. Finaly it will use the abbrev +IF-statements four steps and make sure that the END jumps into the +correct position when RETURN is pressed. Finally it will use the abbrev table to convert all REXX keywords into upper case." t nil) ;;;*** @@ -4463,7 +4467,7 @@ minibuffer window should ever be shrunk to make it no larger than needed to display its contents. -When using a window system, it is possible for a minibuffer to tbe the sole +When using a window system, it is possible for a minibuffer to be the sole window in a frame. Since that window is already its maximum size, the only way to make more text visible at once is to increase the size of the frame. The variable `resize-minibuffer-frame' controls whether this should be @@ -5064,7 +5068,7 @@ verilog-case-indent (default 2) Indentation for case statements. verilog-auto-newline (default nil) - Non-nil means automatically newline after simcolons and the punctation mark + Non-nil means automatically newline after semicolons and the punctuation mark after an end. verilog-auto-indent-on-newline (default t) Non-nil means automatically indent line after newline @@ -5072,9 +5076,9 @@ Non-nil means TAB in Verilog mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. verilog-indent-begin-after-if (default t) - Non-nil means to indent begin statements following a preceeding + Non-nil means to indent begin statements following a preceding if, else, while, for and repeat statements, if any. otherwise, - the begin is lined up with the preceeding token. If t, you get: + the begin is lined up with the preceding token. If t, you get: if (a) begin otherwise you get: @@ -5106,11 +5110,11 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.13 $ +vhdl-mode $Revision: 1.14 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the -problem, including a reproducable test case and send the message. +problem, including a reproducible test case and send the message. Note that the details of configuring vhdl-mode will soon be moved to the accompanying texinfo manual. Until then, please read the README file @@ -5626,7 +5630,7 @@ must pass at least OLD when calling from Lisp. While you are entering the new name, consecutive C-w's insert -consectutive words from the text of the buffer into the new bookmark +consecutive words from the text of the buffer into the new bookmark name." t nil) (autoload 'bookmark-insert "bookmark" "\ @@ -5731,7 +5735,7 @@ is done. You must pass at least OLD-BOOKMARK when calling from Lisp. While you are entering the new name, consecutive C-w's insert -consectutive words from the text of the buffer into the new bookmark +consecutive words from the text of the buffer into the new bookmark name. Warning: this function only takes an EVENT as argument. Use the @@ -6338,11 +6342,17 @@ (MATCHER . FACENAME) (MATCHER . HIGHLIGHT) (MATCHER HIGHLIGHT ...) + (eval . FORM) where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. +FORM is an expression, whose value should be a keyword element, +evaluated when the keyword is (first) used in a buffer. This feature +can be used to provide a keyword that can only be generated when Font +Lock mode is actually turned on. + For highlighting single items, typically only MATCH-HIGHLIGHT is required. -However, if an item or (typically) items is to be hightlighted following the +However, if an item or (typically) items is to be highlighted following the instance of another item (the anchor) then MATCH-ANCHORED may be required. MATCH-HIGHLIGHT should be of the form: @@ -6635,7 +6645,7 @@ ;;;*** -;;;### (autoloads (hypropos-popup-menu hypropos-set-variable hyper-describe-function hyper-describe-variable hyper-apropos) "hyper-apropos" "packages/hyper-apropos.el") +;;;### (autoloads (hypropos-popup-menu hypropos-set-variable hyper-set-variable hypropos-get-doc hypropos-read-variable-symbol hyper-describe-function hyper-describe-variable hyper-describe-face hyper-describe-key-briefly hyper-describe-key hyper-apropos) "hyper-apropos" "packages/hyper-apropos.el") (defvar hypropos-show-brief-docs t "\ *If non-nil, `hyper-apropos' will display some documentation in the @@ -6647,6 +6657,14 @@ of `hypropos-programming-apropos' is toggled for this search. See also `hyper-apropos-mode'." t nil) +(autoload 'hyper-describe-key "hyper-apropos" nil t nil) + +(autoload 'hyper-describe-key-briefly "hyper-apropos" nil t nil) + +(autoload 'hyper-describe-face "hyper-apropos" "\ +Describe face.. +See also `hyper-apropos' and `hyper-describe-function'." t nil) + (autoload 'hyper-describe-variable "hyper-apropos" "\ Hypertext drop-in replacement for `describe-variable'. See also `hyper-apropos' and `hyper-describe-function'." t nil) @@ -6656,6 +6674,15 @@ in that the symbol under the cursor is the default if it is a function. See also `hyper-apropos' and `hyper-describe-variable'." t nil) +(autoload 'hypropos-read-variable-symbol "hyper-apropos" "\ +Hypertext drop-in replacement for `describe-variable'. +See also `hyper-apropos' and `hyper-describe-function'." nil nil) + +(autoload 'hypropos-get-doc "hyper-apropos" "\ +Toggle display of documentation for the symbol on the current line." t nil) + +(autoload 'hyper-set-variable "hyper-apropos" nil t nil) + (autoload 'hypropos-set-variable "hyper-apropos" "\ Interactively set the variable on the current line." t nil) @@ -7167,11 +7194,11 @@ and shell quoting. This variable is global by default, but you can make it buffer-local and -highlight parentheses differrently in different major modes.") +highlight parentheses differently in different major modes.") (autoload 'paren-set-mode "paren" "\ Cycles through possible values for `paren-mode', force off with negative arg. -When called from lisp, a symbolic value for `paren-mode' can be pased directly. +When called from lisp, a symbolic value for `paren-mode' can be passed directly. See also `paren-mode' and `paren-highlight'." t nil) (make-obsolete 'blink-paren 'paren-set-mode) @@ -7591,6 +7618,9 @@ (defvar vc-checkin-hook nil "\ *List of functions called after a checkin is done. See `run-hooks'.") +(defvar vc-before-checkin-hook nil "\ +*List of functions called before a checkin is done. See `run-hooks'.") + (autoload 'vc-file-status "vc" "\ Display the current status of the file being visited. Currently, this is only defined for CVS. The information provided in the @@ -7823,6 +7853,12 @@ ;;;*** +;;;### (autoloads (batch-remove-old-elc) "cleantree" "prim/cleantree.el") + +(autoload 'batch-remove-old-elc "cleantree" nil nil nil) + +;;;*** + ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" "prim/debug.el") (autoload 'debug "debug" "\ @@ -8304,7 +8340,7 @@ Structure editing: \\[sgml-backward-element] Moves backwards over the previous element. -\\[sgml-forward-element] Moves forward over the nex element. +\\[sgml-forward-element] Moves forward over the next element. \\[sgml-down-element] Move forward and down one level in the element structure. \\[sgml-backward-up-element] Move backward out of this element level. \\[sgml-beginning-of-element] Move to after the start tag of the current element. @@ -8348,7 +8384,7 @@ sgml-indent-data If non-nil, indent in data/mixed context also. sgml-set-face If non-nil, psgml will set the face of parsed markup. sgml-markup-faces The faces used when the above variable is non-nil. -sgml-system-path List of directorys used to look for system identifiers. +sgml-system-path List of directories used to look for system identifiers. sgml-public-map Mapping from public identifiers to file names. sgml-offer-save If non-nil, ask about saving modified buffers before \\[sgml-validate] is run. @@ -9325,7 +9361,7 @@ the default choice (it is not, of course, displayed.) If running under X, the keyboard will be grabbed (with XGrabKeyboard()) -to reduce the possibility that evesdropping is occuring. +to reduce the possibility that eavesdropping is occuring. When reading a password, all keys self-insert, except for: \\<read-passwd-map> @@ -9397,13 +9433,13 @@ ;;;### (autoloads (prettyexpand-all-sexp prettyexpand-sexp macroexpand-all-sexp macroexpand-sexp pp-plist pp-variable pp-function) "pretty-print" "utils/pretty-print.el") (autoload 'pp-function "pretty-print" "\ -Pretty print the function definition of SYMBOL in a seperate buffer" t nil) +Pretty print the function definition of SYMBOL in a separate buffer" t nil) (autoload 'pp-variable "pretty-print" "\ -Pretty print the variable value of SYMBOL in a seperate buffer" t nil) +Pretty print the variable value of SYMBOL in a separate buffer" t nil) (autoload 'pp-plist "pretty-print" "\ -Pretty print the property list of SYMBOL in a seperate buffer" t nil) +Pretty print the property list of SYMBOL in a separate buffer" t nil) (autoload 'macroexpand-sexp "pretty-print" "\ Macro expand the sexpression following point. Pretty print expansion in a @@ -9739,7 +9775,23 @@ ;;;*** -;;;### (autoloads (url-cache-expired url-extract-from-cache url-create-cached-filename url-is-cached url-store-in-cache) "url-cache" "w3/url-cache.el") +;;;### (autoloads (x-font-build-cache font-default-size-for-device font-default-family-for-device font-default-object-for-device font-default-font-for-device font-create-object) "font" "w3/font.el") + +(autoload 'font-create-object "font" nil nil nil) + +(autoload 'font-default-font-for-device "font" nil nil nil) + +(autoload 'font-default-object-for-device "font" nil nil nil) + +(autoload 'font-default-family-for-device "font" nil nil nil) + +(autoload 'font-default-size-for-device "font" nil nil nil) + +(autoload 'x-font-build-cache "font" nil nil nil) + +;;;*** + +;;;### (autoloads (url-cache-expired url-cache-extract url-is-cached url-store-in-cache) "url-cache" "w3/url-cache.el") (autoload 'url-store-in-cache "url-cache" "\ Store buffer BUFF in the cache" nil nil) @@ -9747,10 +9799,7 @@ (autoload 'url-is-cached "url-cache" "\ Return non-nil if the URL is cached." nil nil) -(autoload 'url-create-cached-filename "url-cache" "\ -Return a filename in the local cache for URL" nil nil) - -(autoload 'url-extract-from-cache "url-cache" "\ +(autoload 'url-cache-extract "url-cache" "\ Extract FNAM from the local disk cache" nil nil) (autoload 'url-cache-expired "url-cache" "\ @@ -9888,6 +9937,17 @@ ;;;*** +;;;### (autoloads (widget-delete widget-create) "wid-edit" "w3/wid-edit.el") + +(autoload 'widget-create "wid-edit" "\ +Create widget of TYPE. +The optional ARGS are additional keyword arguments." nil nil) + +(autoload 'widget-delete "wid-edit" "\ +Delete WIDGET." nil nil) + +;;;*** + ;;;### (autoloads (font-menu-weight-constructor font-menu-size-constructor font-menu-family-constructor reset-device-font-menus) "x-font-menu" "x11/x-font-menu.el") (defvar font-menu-ignore-scaled-fonts t "\
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/prim/cleantree.el Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,68 @@ +;;; cleantree.el --- Remove out of date .elcs in lisp directories + +;; Copyright (C) 1997 by Free Software Foundation, Inc. + +;; Author: Steven L Baur <steve@altair.xemacs.org> +;; Keywords: internal + +;; This file is part of XEmacs. + +;; XEmacs 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. + +;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not in FSF + +;;; Commentary: + +;; This code is derived from Gnus based on a suggestion by +;; David Moore <dmoore@ucsd.edu> + +;;; Code: + +(defun remove-old-elc-1 (dir &optional seen) + (setq dir (file-name-as-directory dir)) + ;; Only scan this sub-tree if we haven't been here yet. + (unless (member (file-truename dir) seen) + (push (file-truename dir) seen) + ;; We descend recursively + (let ((dirs (directory-files dir t nil t)) + dir) + (while (setq dir (pop dirs)) + (when (and (not (member (file-name-nondirectory dir) '("." ".."))) + (file-directory-p dir)) + (remove-old-elc-1 dir seen)))) + ;; Do this directory. + (let ((files (directory-files dir t ".el$")) + file file-c) + (while (setq file (car files)) + (setq files (cdr files)) + (setq file-c (concat file "c")) + (when (and (file-exists-p file-c) + (file-newer-than-file-p file file-c)) + (message file-c) + (delete-file file-c)))))) + +;;;###autoload +(defun batch-remove-old-elc () + (defvar command-line-args-left) + (unless noninteractive + (error "`batch-remove-old-elc' is to be used only with -batch")) + (let ((dir (car command-line-args-left))) + (message "Cleaning out of date .elcs in directory `%s'..." dir) + (remove-old-elc-1 dir) + (message "Cleaning out of date .elcs in directory `%s'...done" dir)) + (setq command-line-args-left nil)) + +;;; cleantree.el ends here
--- a/lisp/prim/console.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/console.el Mon Aug 13 09:18:39 2007 +0200 @@ -30,3 +30,12 @@ that the information is returned for; nil means the current console." (nth 3 (current-input-mode console))) +(defun resume-pid-console (pid) + "Resume the consoles with a controlling process of PID." + (mapc (lambda (c) + (if (and (eq (console-type c) 'tty) + (= pid (console-tty-controlling-process c))) + (resume-console c))) + (console-list)) + ; documentation for mapc lies! + nil)
--- a/lisp/prim/device.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/device.el Mon Aug 13 09:18:39 2007 +0200 @@ -33,7 +33,7 @@ This is equivalent to the type of the device's console. Value is `tty' for a tty device (a character-only terminal), `x' for a device that is a screen on an X display, -`ns' for a device that is a NeXTstep connection (not yet implemeted), +`ns' for a device that is a NeXTstep connection (not yet implemented), `win32' for a device that is a Windows or Windows NT connection (not yet implemented), `pc' for a device that is a direct-write MS-DOS screen (not yet implemented), @@ -43,15 +43,19 @@ (if (not (device-live-p device)) 'dead (console-type (device-console device)))) -(defun make-tty-device (&optional tty terminal-type) +(defun make-tty-device (&optional tty terminal-type controlling-process) "Create a new device on TTY. TTY should be the name of a tty device file (e.g. \"/dev/ttyp3\" under SunOS et al.), as returned by the `tty' command. A value of nil means use the stdin and stdout as passed to XEmacs from the shell. If TERMINAL-TYPE is non-nil, it should be a string specifying the type of the terminal attached to the specified tty. If it is nil, -the terminal type will be inferred from the TERM environment variable." - (make-device 'tty tty (list 'terminal-type terminal-type))) +the terminal type will be inferred from the TERM environment variable. + If CONTROLLING-PROCESS is non-nil, it should be an integer +specifying the process id of the process in control of the specified tty. If +it is nil, it is assumes to be the value returned by emacs-pid." + (make-device 'tty tty (list 'terminal-type terminal-type + 'controlling-process controlling-process))) (defun make-x-device (&optional display) "Create a new device connected to DISPLAY."
--- a/lisp/prim/faces.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/faces.el Mon Aug 13 09:18:39 2007 +0200 @@ -1068,10 +1068,10 @@ (defvar init-face-from-resources t - "If non-nil, attempt to initialize faces from the reseource database.") + "If non-nil, attempt to initialize faces from the resource database.") (defun make-empty-face (name &optional doc-string temporary) - "Like `make-face', but doesn't query the reseource database." + "Like `make-face', but doesn't query the resource database." (let ((init-face-from-resources nil)) (make-face name doc-string temporary))) @@ -1234,7 +1234,7 @@ (make-face-bold-italic 'bold-italic device) ;; if we couldn't get a bold-italic version, try just bold. (unless (face-differs-from-default-p 'bold-italic device) - (make-face-bold-italic 'bold-italic device) + (make-face-bold 'bold-italic device) ;; if we couldn't get bold or bold-italic, then that's probably because ;; the default font is bold, so make the `bold-italic' face be unbold. (unless (face-differs-from-default-p 'bold-italic device)
--- a/lisp/prim/files.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/files.el Mon Aug 13 09:18:39 2007 +0200 @@ -604,7 +604,7 @@ with a prefix argument, you will be prompted for the coding system." (interactive "FFind file in other window: \nZCoding system: ") (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (switch-to-buffer-other-window (find-file-noselect filename))) (switch-to-buffer-other-window (find-file-noselect filename)))) @@ -616,7 +616,7 @@ with a prefix argument, you will be prompted for the coding system." (interactive "FFind file in other frame: \nZCoding system: ") (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (switch-to-buffer-other-frame (find-file-noselect filename))) (switch-to-buffer-other-frame (find-file-noselect filename)))) @@ -630,7 +630,7 @@ with a prefix argument, you will be prompted for the coding system." (interactive "fFind file read-only: \nZCoding system: ") (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (find-file filename)) (find-file filename)) @@ -646,7 +646,7 @@ with a prefix argument, you will be prompted for the coding system." (interactive "fFind file read-only other window: \nZCoding system: ") (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (find-file-other-window filename)) (find-file-other-window filename)) @@ -662,7 +662,7 @@ with a prefix argument, you will be prompted for the coding system." (interactive "fFind file read-only other frame: \nZCoding system: ") (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (find-file-other-frame filename)) (find-file-other-frame filename)) @@ -733,7 +733,7 @@ (progn (unlock-buffer) (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (find-file filename)) (find-file filename))) @@ -2305,7 +2305,7 @@ filename))) (let ((tem (if codesys - (let ((overriding-file-coding-system + (let ((coding-system-for-read (get-coding-system codesys))) (insert-file-contents filename)) (insert-file-contents filename))))
--- a/lisp/prim/fill.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/fill.el Mon Aug 13 09:18:39 2007 +0200 @@ -204,7 +204,7 @@ function, but with a prefix arg, does full justification instead. From a program, optional third arg JUSTIFY can specify any type of -ustification. Fourth arg NOSQUEEZE non-nil means not to make spaces +justification. Fourth arg NOSQUEEZE non-nil means not to make spaces between words canonical before filling. Fifth arg SQUEEZE-AFTER, if non-nil, means don't canonicalize spaces before that position.
--- a/lisp/prim/frame.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/frame.el Mon Aug 13 09:18:39 2007 +0200 @@ -532,7 +532,7 @@ This is equivalent to the type of the frame's device. Value is `tty' for a tty frame (a character-only terminal), `x' for a frame that is an X window, -`ns' for a frame that is a NeXTstep window (not yet implemeted), +`ns' for a frame that is a NeXTstep window (not yet implemented), `win32' for a frame that is a Windows or Windows NT window (not yet implemented), `pc' for a frame that is a direct-write MS-DOS frame (not yet implemented), @@ -741,9 +741,13 @@ (defun suspend-or-iconify-emacs () "Calls iconify-emacs if frame is an X frame, otherwise calls suspend-emacs" (interactive) - (if (eq (frame-type (selected-frame)) 'x) - (iconify-emacs) - (suspend-emacs))) + (cond + ((eq (frame-type (selected-frame)) 'x) (iconify-emacs)) + ((and (eq (frame-type (selected-frame)) 'tty) + (console-tty-controlling-process (selected-console))) + (suspend-console (selected-console))) + (t + (suspend-emacs)))) ;;; auto-raise and auto-lower @@ -860,6 +864,7 @@ ;; Sort the list so that iconic frames will be found last. They ;; will be used too, but mapped frames take precedence. And ;; fully visible frames come before occluded frames. + ;; Hidden frames come after really visible ones (setq frames (sort (frame-list) #'(lambda (s1 s2) @@ -867,6 +872,8 @@ nil) ((not (frame-visible-p s2)) (frame-visible-p s1)) + ((eq (frame-visible-p s2) 'hidden) + (eq (frame-visible-p s1) t )) ((not (frame-totally-visible-p s2)) (and (frame-visible-p s1) (frame-totally-visible-p s1))))))) @@ -914,6 +921,8 @@ #'(lambda (s1 s2) (cond ((and (frame-visible-p s1) (not (frame-visible-p s2)))) + ((and (eq (frame-visible-p s1) t) + (eq (frame-visible-p s2) 'hidden))) ((and (frame-visible-p s2) (not (frame-visible-p s1))) nil) @@ -1014,7 +1023,7 @@ (setq save-frame next-frame) (and (or (not visible-only) - (eq t (frame-visible-p next-frame))) + (frame-visible-p next-frame)) (setq frames (append frames (list next-frame)))))) (setq list (cdr list)))
--- a/lisp/prim/help.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:18:39 2007 +0200 @@ -56,6 +56,7 @@ (define-key help-map "A" 'command-apropos) (define-key help-map "b" 'describe-bindings) +(define-key help-map "B" 'describe-beta) (define-key help-map "\C-p" 'describe-pointer) (define-key help-map "c" 'describe-key-briefly) @@ -385,7 +386,7 @@ (defun describe-key (key) "Display documentation of the function invoked by KEY. KEY is a string, or vector of events. -When called interactvely, KEY may also be a menu selection." +When called interactively, KEY may also be a menu selection." (interactive "kDescribe key: ") (let ((defn (key-or-menu-binding key))) (if (or (null defn) (integerp defn)) @@ -464,6 +465,13 @@ (find-file-read-only (expand-file-name "DISTRIB" data-directory))) +(defun describe-beta () + "Display info on how to deal with Beta versions of XEmacs." + (interactive) + (find-file-read-only + (expand-file-name "BETA" data-directory)) + (goto-char (point-min))) + (defun describe-copying () "Display info on how you may redistribute copies of XEmacs." (interactive)
--- a/lisp/prim/isearch-mode.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/isearch-mode.el Mon Aug 13 09:18:39 2007 +0200 @@ -1552,7 +1552,7 @@ (defun isearch-no-upper-case-p (string) "Return t if there are no upper case chars in string. -But upper case chars preceeded by \\ do not count since they +But upper case chars preceded by \\ do not count since they have special meaning in a regexp." ;; this incorrectly returns t for "\\\\A" (let ((case-fold-search nil))
--- a/lisp/prim/itimer.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/itimer.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,34 +1,22 @@ -;;; itimer.el -- Interval timers for XEmacs - -;; Copyright (C) 1988, 1991, 1993, 1997 Kyle E. Jones - -;; Author: Kyle Jones <kyle_jones@wonderworks.com> -;; Keywords: extensions - -;; This file is part of XEmacs - -;; XEmacs 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. - -;; XEmacs 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. - -;; A copy of the GNU General Public License can be obtained from this -;; program's author (send electronic mail to kyle@uunet.uu.net) or -;; from the Free Software Foundation, Inc., 59 Temple Place - Suite -;; 330, Boston, MA 02111-1307, USA. - -;;; Synched up with: Not in FSF - -;;; Commentary: - -;; Send bug reports to kyle_jones@wonderworks.com - -;;; Code: +;;; Interval timers for GNU Emacs +;;; Copyright (C) 1988, 1991, 1993, 1997 Kyle E. Jones +;;; +;;; This program 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. +;;; +;;; This program 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. +;;; +;;; A copy of the GNU General Public License can be obtained from this +;;; program's author (send electronic mail to kyle@uunet.uu.net) or from +;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA +;;; 02139, USA. +;;; +;;; Send bug reports to kyle_jones@wonderworks.com (provide 'itimer) @@ -37,16 +25,18 @@ ;; itimer-value ;; itimer-restart ;; itimer-function -;; itimer-function-argument +;; itimer-uses-arguments +;; itimer-function-arguments ;; set-itimer-value ;; set-itimer-restart ;; set-itimer-function -;; set-itimer-uses-argument -;; set-itimer-function-argument +;; set-itimer-uses-arguments +;; set-itimer-function-arguments ;; get-itimer ;; start-itimer ;; read-itimer ;; delete-itimer +;; activate-itimer ;; ;; Interactive users get these commands: ;; edit-itimers @@ -55,7 +45,7 @@ ;; ;; See the doc strings of these functions for more information. -(defvar itimer-version "1.02" +(defvar itimer-version "1.03" "Version number of the itimer package.") (defvar itimer-list nil @@ -167,7 +157,7 @@ (defun itimerp (obj) "Returns non-nil iff OBJ is an itimer." - (and (consp obj) (stringp (car obj)) (eq (length obj) 6))) + (and (consp obj) (eq (length obj) 8))) (defun itimer-name (itimer) "Returns the name of ITIMER." @@ -191,18 +181,31 @@ (check-itimer itimer) (nth 3 itimer)) -(defun itimer-uses-argument (itimer) - "Returns non-nil if the function of ITIMER will be called with an argment. -ITIMER's function is called with this argument each timer ITIMER expires." +(defun itimer-is-idle (itimer) + "Returns non-nil if ITIMER is an idle timer. +Normal timers eexpire after a set interval. Idle timers expire +only after Emacs has been idle for a specific interval. ``Idle'' +means no command events within the interval." (check-itimer itimer) (nth 4 itimer)) -(defun itimer-function-argument (itimer) - "Returns the function argument of ITIMER. -ITIMER's function is called with this argument each timer ITIMER expires." +(defun itimer-uses-arguments (itimer) + "Returns non-nil if the function of ITIMER will be called with arguments. +ITIMER's function is called with the arguments each time ITIMER expires. +The arguments themselves are retrievable with `itimer-function-arguments'." (check-itimer itimer) (nth 5 itimer)) +(defun itimer-function-arguments (itimer) + "Returns the function arguments of ITIMER as a list. +ITIMER's function is called with these argument each timer ITIMER expires." + (check-itimer itimer) + (nth 6 itimer)) + +(defun itimer-recorded-run-time (itimer) + (check-itimer itimer) + (nth 7 itimer)) + (defun set-itimer-value (itimer value) "Set the timeout value of ITIMER to be VALUE. Itimer will expire is this many seconds. @@ -248,23 +251,33 @@ FUNCTION will be called when itimer expires. Returns FUNCTION." (check-itimer itimer) - (setcar (cdr (cdr (cdr itimer))) function)) + (setcar (nthcdr 3 itimer) function)) -(defun set-itimer-uses-argument (itimer flag) - "Sets when the function of ITIMER is called with an argument. +(defun set-itimer-is-idle (itimer flag) + "Sets flag that says whether ITIMER is an idle timer. +If FLAG is non-nil, then ITIMER will eb considered an idle timer. +Returns FLAG." + (check-itimer itimer) + (setcar (nthcdr 4 itimer) flag)) + +(defun set-itimer-uses-arguments (itimer flag) + "Sets flag that says whether the function of ITIMER is called with arguments. If FLAG is non-nil, then the function will be called with one argument, otherwise the function will be called with no arguments. Returns FLAG." (check-itimer itimer) - (setcar (nthcdr 4 itimer) flag)) + (setcar (nthcdr 5 itimer) flag)) -(defun set-itimer-function-argument (itimer argument) - "Set the function of ITIMER to be ARGUMENT. -The function of ITIMER will be called with ARGUMENT as its solt argument -when itimer expires. -Returns ARGUMENT." +(defun set-itimer-function-arguments (itimer &rest arguments) + "Set the function arguments of ITIMER to be ARGUMENTS. +The function of ITIMER will be called with ARGUMENTS when itimer expires. +Returns ARGUMENTS." (check-itimer itimer) - (setcar (nthcdr 5 itimer) argument)) + (setcar (nthcdr 6 itimer) arguments)) + +(defun set-itimer-recorded-run-time (itimer time) + (check-itimer itimer) + (setcar (nthcdr 7 itimer) time)) (defun get-itimer (name) "Return itimer named NAME, or nil if there is none." @@ -284,16 +297,17 @@ (setq itimer-list (delq itimer itimer-list))) (defun start-itimer (name function value &optional restart - with-arg function-argument) + is-idle with-args &rest function-arguments) "Start an itimer. -Args are NAME, FUNCTION, VALUE &optional RESTART, WITH-ARG, FUNCTION-ARGUMENT. +Arguments are + NAME, FUNCTION, VALUE &optional RESTART, IS-IDLE, WITH-ARGS, &rest FUNCTION-ARGUMENTS. NAME is an identifier for the itimer. It must be a string. If an itimer already exists with this name, NAME will be modified slightly to until it is unique. -FUNCTION should be a function (or symbol naming one) of one argument. It - will be called each time the itimer expires with an argument of - FUNCTION-ARGUMENT. The function can access the itimer that - invoked it through the variable `current-itimer'. If WITH-ARG +FUNCTION should be a function (or symbol naming one). It + will be called each time the itimer expires with arguments of + FUNCTION-ARGUMENTS. The function can access the itimer that + invoked it through the variable `current-itimer'. If WITH-ARGS is nil then FUNCTION is called with no arguments. This is for backward compatibility with older versions of the itimer package which always called FUNCTION with no arguments. @@ -306,6 +320,10 @@ is deleted at expiration after its function has returned. If non-nil RESTART should be a number indicating the value at which the itimer should be set at restart time. +Optional fifth arg IS-IDLE specified if this is an idle timer. + Normal timers eexpire after a set interval. Idle timers expire + only after Emacs has been idle for specific interval. ``Idle'' + means no command events within the interval. Returns the newly created itimer." (interactive (list (completing-read "Start itimer: " itimer-list) @@ -331,23 +349,58 @@ (while (get-itimer name) (setq name (concat oname "<" num ">")) (itimer-increment num))) - ;; If there's no itimer process, start one now. - ;; Otherwise wake up the itimer process so that seconds slept before + (activate-itimer (list name value restart function is-idle + with-args function-arguments (list 0 0 0))) + (car itimer-list)) + +(defun make-itimer () + "Create an unactivated itimer. +The itimer will not begin running until activated with `activate-itimer'. +Set the itimer's expire interval with `set-itimer-value'. +Set the itimer's function interval with `set-itimer-function'. +Once this is done, the timer can be activated." + (list nil 0 nil 'ignore nil nil nil (list 0 0 0))) + +(defun activate-itimer (itimer) + "Activate ITIMER, which was previously created with `make-itimer'. +ITIMER will be added to the global list of running itimers, +its FUNCTION will be called when it expires, and so on." + (check-itimer itimer) + (if (memq itimer itimer-list) + (error "itimer already activated")) + (if (not (numberp (itimer-value itimer))) + (error "itimer timeout value not a number: %s" (itimer-value itimer))) + (if (<= (itimer-value itimer) 0) + (error "itimer timeout value not positive: %s" (itimer-value itimer))) + ;; If there's no itimer driver/process, start one now. + ;; Otherwise wake up the itimer driver so that seconds slept before ;; the new itimer is created won't be counted against it. (if (or itimer-process itimer-timer) (itimer-driver-wakeup) (itimer-driver-start)) + ;; Roll a unique name for the timer if it doesn't have a name + ;; already. + (if (not (stringp (car itimer))) + (let ((name "itimer-0") + (oname "itimer-") + (num 1)) + (while (get-itimer name) + (setq name (concat oname "<" num ">")) + (itimer-increment num)) + (setcar itimer name)) + ;; signal an error if the timer's name matches an already + ;; activated timer. + (if (get-itimer (itimer-name itimer)) + (error "itimer named \"%s\" already existing and activated" + (itimer-name itimer)))) (let ((inhibit-quit t)) ;; add the itimer to the global list - (setq itimer-list - (cons (list name value restart function with-arg function-argument) - itimer-list)) - ;; If the itimer process is scheduled to wake up too late for the itimer - ;; we wake it up to calculate a correct wakeup value giving consideration - ;; to the newly added itimer. - (if (< value itimer-next-wakeup) - (itimer-driver-wakeup))) - (car itimer-list)) + (setq itimer-list (cons itimer itimer-list)) + ;; If the itimer process is scheduled to wake up too late for + ;; the itimer we wake it up to calculate a correct wakeup + ;; value giving consideration to the newly added itimer. + (if (< (itimer-value itimer) itimer-next-wakeup) + (itimer-driver-wakeup)))) ;; User level functions to list and modify existing itimers. ;; Itimer Edit major mode, and the editing commands thereof. @@ -367,8 +420,9 @@ (setq buffer-read-only nil) (erase-buffer) (insert -"Name Value Restart Function Argument\n" -"---- ----- ------- -------- --------") +"Name Value Restart Function Idle Arguments" +"\n" +"---- ----- ------- -------- ---- --------") (if (null itimer-edit-start-marker) (setq itimer-edit-start-marker (point))) (while itimers @@ -382,10 +436,14 @@ (format "%5.5s" (itimer-restart (car itimers))) 5)) (tab-to-tab-stop) (insert (itimer-truncate-string - (format "%.26s" (itimer-function (car itimers))) 26)) + (format "%.19s" (itimer-function (car itimers))) 19)) (tab-to-tab-stop) - (if (itimer-uses-argument (car itimers)) - (prin1 (itimer-function-argument (car itimers))) + (if (itimer-is-idle (car itimers)) + (insert "yes") + (insert "no")) + (tab-to-tab-stop) + (if (itimer-uses-arguments (car itimers)) + (prin1 (itimer-function-arguments (car itimers))) (prin1 'NONE)) (setq itimers (cdr itimers))) ;; restore point @@ -416,7 +474,7 @@ ;; no point in making this interactive. (defun itimer-edit-mode () "Major mode for manipulating itimers. -Atrributes of running itimers are changed by moving the cursor to the +Attributes of running itimers are changed by moving the cursor to the desired field and typing `s' to set that field. The field will then be set to the value read from the minibuffer. @@ -432,7 +490,7 @@ (setq major-mode 'itimer-edit-mode mode-name "Itimer Edit" truncate-lines t - tab-stop-list '(22 32 40 67)) + tab-stop-list '(22 32 40 60 67)) (abbrev-mode 0) (auto-fill-mode 0) (buffer-flush-undo (current-buffer)) @@ -478,7 +536,7 @@ ;; and use this info to determine which field the user ;; wants to modify. (beginning-of-line) - (while (and (>= opoint (point)) (< n 5)) + (while (and (>= opoint (point)) (< n 6)) (forward-sexp 2) (backward-sexp) (itimer-increment n)) @@ -486,6 +544,7 @@ ((eq n 2) 'value) ((eq n 3) 'restart) ((eq n 4) 'function) + ((eq n 5) 'is-idle) (t 'function-argument))))) (cond ((eq field 'value) (let ((prompt "Set itimer value: ")) @@ -502,10 +561,16 @@ (memq (car field-value) '(lambda macro))))) (setq field-value (read (completing-read prompt obarray 'fboundp nil)))))) + ((eq field 'is-idle) + (setq field-value (not (itimer-is-idle itimer)))) ((eq field 'function-argument) (let ((prompt "Set itimer function argument: ")) (setq field-value (read-expression prompt)) - (set-itimer-uses-argument itimer t)))) + (cond ((not (listp field-value)) + (setq field-value (list field-value)))) + (if (null field-value) + (set-itimer-uses-arguments itimer nil) + (set-itimer-uses-arguments itimer t))))) ;; set the itimer field (funcall (intern (concat "set-itimer-" (symbol-name field))) itimer field-value) @@ -586,19 +651,44 @@ (let ((itimers (copy-sequence itimer-list)) (itimer) (next-wakeup 600) + (idle-time) + (last-event-time) + (recorded-run-time) ;; process filters can be hit by stray C-g's from the user, ;; so we must protect this stuff appropriately. ;; Quit's are allowed from within itimer functions, but we ;; catch them and print a message. (inhibit-quit t)) (setq next-wakeup 600) + (if (and (boundp 'last-input-time) (consp last-input-time)) + (setq last-event-time (list (car last-input-time) + (cdr last-input-time) + 0) + idle-time (itimer-time-difference (current-time) + last-event-time)) + ;; no way to do this under FSF Emacs yet. + (setq last-event-time '(0 0 0) + idle-time 0)) (while itimers (setq itimer (car itimers)) - (set-itimer-value-internal itimer (max 0 (- (itimer-value itimer) - time-elapsed))) - (if (> (itimer-value itimer) 0) + (if (itimer-is-idle itimer) + (setq recorded-run-time (itimer-recorded-run-time itimer)) + (set-itimer-value-internal itimer (max 0 (- (itimer-value itimer) + time-elapsed)))) + (if (if (itimer-is-idle itimer) + (or (> (itimer-time-difference recorded-run-time + last-event-time) + 0) + (< idle-time (itimer-value itimer))) + (> (itimer-value itimer) 0)) (setq next-wakeup - (min next-wakeup (itimer-value itimer))) + (if (itimer-is-idle itimer) + (if (< idle-time (itimer-value itimer)) + (min next-wakeup (- (itimer-value itimer) idle-time)) + (min next-wakeup (itimer-value itimer))) + (min next-wakeup (itimer-value itimer)))) + (and (itimer-is-idle itimer) + (set-itimer-recorded-run-time itimer (current-time))) ;; itimer has expired, we must call its function. ;; protect our local vars from the itimer function. ;; allow keyboard quit to occur, but catch and report it. @@ -610,9 +700,9 @@ (quit-flag nil) (inhibit-quit nil) itimer itimers time-elapsed) - (if (itimer-uses-argument current-itimer) - (funcall (itimer-function current-itimer) - (itimer-function-argument current-itimer)) + (if (itimer-uses-arguments current-itimer) + (apply (itimer-function current-itimer) + (itimer-function-arguments current-itimer)) (funcall (itimer-function current-itimer))))) (error (message "itimer \"%s\" signaled: %s" (itimer-name itimer) (prin1-to-string condition-data))) @@ -701,7 +791,7 @@ 'itimer-timer-driver nil nil)))) (defun itimer-time-difference (t1 t2) - (let (usecs secs 65536-secs) + (let (usecs secs 65536-secs carry) (setq usecs (- (nth 2 t1) (nth 2 t2))) (if (< usecs 0) (setq carry 1 @@ -709,8 +799,8 @@ (setq carry 0)) (setq secs (- (nth 1 t1) (nth 1 t2) carry)) (if (< secs 0) - (setq carry 1 - secs (+ secs 65536)) + (setq carry 1 + secs (+ secs 65536)) (setq carry 0)) (setq 65536-secs (- (nth 0 t1) (nth 0 t2) carry)) ;; loses for interval larger than the maximum signed Lisp integer. @@ -743,5 +833,3 @@ (if (fboundp 'add-timeout) (itimer-timer-wakeup) (itimer-process-wakeup))) - -;;; itimer.el ends here
--- a/lisp/prim/obsolete.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/obsolete.el Mon Aug 13 09:18:39 2007 +0200 @@ -61,7 +61,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;; device stuff -(make-obsolete-variable 'window-system "use (console-type)") +(make-compatible-variable 'window-system "use (console-type)") (make-obsolete-variable 'meta-flag "use the `set-input-mode' function instead.")
--- a/lisp/prim/paragraphs.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/paragraphs.el Mon Aug 13 09:18:39 2007 +0200 @@ -58,7 +58,7 @@ The variable `paragraph-separate' specifies how to distinguish lines that start paragraphs from lines that separate them. -If the variable `use-hard-newlines' is nonnil, then only lines following a +If the variable `use-hard-newlines' is non-nil, then only lines following a hard newline are considered to match.") ;; paragraph-start requires a hard newline, but paragraph-separate does not:
--- a/lisp/prim/simple.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/simple.el Mon Aug 13 09:18:39 2007 +0200 @@ -480,7 +480,7 @@ ;; XEmacs (defun count-lines-buffer (b) - "Print number of lines and charcters in the specified buffer." + "Print number of lines and characters in the specified buffer." (interactive "_b") (save-excursion (let ((buf (or b (current-buffer))) @@ -3060,7 +3060,7 @@ (defvar log-message-filter-function 'log-message-filter "Value must be a function of two arguments: a symbol (label) and -a string (messsage). It should return non-nil to indicate a message +a string (message). It should return non-nil to indicate a message should be logged. Possible values include 'log-message-filter and 'log-message-filter-errors-only.")
--- a/lisp/prim/specifier.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/specifier.el Mon Aug 13 09:18:39 2007 +0200 @@ -119,7 +119,7 @@ Canonicalizing means converting to the full form for an inst-list, i.e. `((TAG-SET . INSTANTIATOR) ...)'. This function accepts a single -inst-pair or any abbrevation thereof or a list of (possibly +inst-pair or any abbreviation thereof or a list of (possibly abbreviated) inst-pairs. (See `canonicalize-inst-pair'.) If NOERROR is non-nil, signal an error if the inst-list is invalid; @@ -127,7 +127,7 @@ ;; OK, the possibilities are: ;; - ;; a) an inst-pair or various abbrevations thereof + ;; a) an inst-pair or various abbreviations thereof ;; b) a list of (a) (let ((result (canonicalize-inst-pair inst-list specifier-type t))) (if (not (eq result t)) @@ -176,7 +176,7 @@ otherwise return t." ;; OK, the possibilities are: ;; - ;; a) an inst-list or some abbrevation thereof + ;; a) an inst-list or some abbreviation thereof ;; b) a cons of a locale and an inst-list (let ((result (canonicalize-inst-list spec specifier-type t))) (if (not (eq result t))
--- a/lisp/prim/startup.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/startup.el Mon Aug 13 09:18:39 2007 +0200 @@ -760,9 +760,27 @@ ;; 'startup-presentation-hack-help)) ) +(defun splash-hack-version-string () + (save-excursion + (save-restriction + (goto-char (point-min)) + (re-search-forward "^XEmacs" nil t) + (narrow-to-region (point-at-bol) (point-at-eol)) + (goto-char (point-min)) + (when (re-search-forward " \\[Lucid\\]" nil t) + (delete-region (match-beginning 0) (match-end 0))) + (when (re-search-forward "[^(].*-.*-" nil t) + (delete-region (1+ (match-beginning 0)) (match-end 0)) + (insert "(")) + (goto-char (point-max)) + (search-backward " " nil t) + (when (search-forward "." nil t) + (delete-region (1- (point)) (point-max)))))) + (defun splash-frame-present (l) (cond ((stringp l) - (insert l)) + (insert l) + (splash-hack-version-string)) ((eq (car-safe l) 'face) ;; (face name string) (let ((p (point))) @@ -820,10 +838,15 @@ (defun startup-splash-frame-body () `("\n" ,(emacs-version) "\n" + ,@(if (string-match "beta" emacs-version) + `( (face (bold blue) ( "This is an Experimental version of XEmacs. " + " Type " (key describe-beta) + " to see what this means.\n"))) + `( "\n")) (face bold-italic "\ -Copyright (C) 1985-1996 Free Software Foundation, Inc. +Copyright (C) 1985-1997 Free Software Foundation, Inc. Copyright (C) 1990-1994 Lucid, Inc. -Copyright (C) 1993-1996 Sun Microsystems, Inc. All Rights Reserved. +Copyright (C) 1993-1997 Sun Microsystems, Inc. All Rights Reserved. Copyright (C) 1994-1996 Board of Trustees, University of Illinois Copyright (C) 1995-1996 Ben Wing\n\n")
--- a/lisp/prim/subr.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/prim/subr.el Mon Aug 13 09:18:39 2007 +0200 @@ -470,7 +470,7 @@ (defmacro check-argument-type (predicate argument) "Check that ARGUMENT satisfies PREDICATE. If not, signal a continuable `wrong-type-argument' error until the -returned value satifies PREDICATE, and assign the returned value +returned value satisfies PREDICATE, and assign the returned value to ARGUMENT." `(if (not (,(eval predicate) ,argument)) (setq ,argument @@ -564,7 +564,7 @@ ;; to this, so I'm leaving this undefined for now. --ben ;;; The objection is this: there is more than one way to load the same file. -;;; "foo", "foo.elc", "foo.el", and "/some/path/foo.elc" are all differrent +;;; "foo", "foo.elc", "foo.el", and "/some/path/foo.elc" are all different ;;; ways to load the exact same code. `eval-after-load' is too stupid to ;;; deal with this sort of thing. If this sort of feature is desired, then ;;; it should work off of a hook on `provide'. Features are unique and
--- a/lisp/psgml/psgml-edit.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/psgml/psgml-edit.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,6 +1,6 @@ ;;; psgml-edit.el --- Editing commands for SGML-mode with parsing support ;;-*-byte-compile-warnings:(free-vars unused-vars unresolved callargs redefine)-*- -;; $Id: psgml-edit.el,v 1.1.1.1 1996/12/18 22:43:36 steve Exp $ +;; $Id: psgml-edit.el,v 1.2 1997/03/08 23:26:53 steve Exp $ ;; Copyright (C) 1994, 1995, 1996 Lennart Staflin @@ -1083,7 +1083,7 @@ ((sgml-element-mixed c)) (t ;; Put region before element on agenda. Can't fill it now - ;; that would mangel the parse tree that is beeing traversed. + ;; that would mangel the parse tree that is being traversed. (push (cons last-pos (sgml-element-start c)) agenda) (goto-char (sgml-element-start c))
--- a/lisp/psgml/psgml-other.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/psgml/psgml-other.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,5 +1,5 @@ ;;;; psgml-other.el --- Part of SGML-editing mode with parsing support -;; $Id: psgml-other.el,v 1.2 1997/01/03 03:10:27 steve Exp $ +;; $Id: psgml-other.el,v 1.3 1997/03/08 23:26:53 steve Exp $ ;; Copyright (C) 1994 Lennart Staflin @@ -146,7 +146,7 @@ (defun sgml-set-face-after-change (start end &optional pre-len) ;; If inserting in front of an markup overlay, move that overlay. - ;; this avoids the overlay beeing deleted and recreated by + ;; this avoids the overlay being deleted and recreated by ;; sgml-set-face-for. (when (and sgml-set-face (not sgml-use-text-properties)) (loop for o in (overlays-at start)
--- a/lisp/psgml/psgml-parse.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/psgml/psgml-parse.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,5 +1,5 @@ ;;;; psgml-parse.el --- Parser for SGML-editing mode with parsing support -;; $Id: psgml-parse.el,v 1.3 1997/01/11 20:14:09 steve Exp $ +;; $Id: psgml-parse.el,v 1.4 1997/03/08 23:26:54 steve Exp $ ;; Copyright (C) 1994, 1995 Lennart Staflin @@ -229,7 +229,7 @@ Only valid after `sgml-parse-to'.") (defvar sgml-markup-start nil - "Start point of markup beeing parsed.") + "Start point of markup being parsed.") (defvar sgml-conref-flag nil "This variable is set by `sgml-parse-attribute-specification-list'
--- a/lisp/psgml/psgml.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/psgml/psgml.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,5 +1,5 @@ ;;; psgml.el --- SGML-editing mode with parsing support -;; $Id: psgml.el,v 1.5 1997/01/30 02:22:44 steve Exp $ +;; $Id: psgml.el,v 1.6 1997/03/08 23:26:54 steve Exp $ ;; Copyright (C) 1993, 1994, 1995, 1996 Lennart Staflin ;; Copyright (C) 1992 Free Software Foundation, Inc. @@ -410,7 +410,7 @@ (defvar sgml-custom-dtd nil "Menu entries to be added to the DTD menu. -The value should be a list of entrys to be added to the DTD menu. +The value should be a list of entries to be added to the DTD menu. Every entry should be a list. The first element of the entry is a string used as the menu entry. The second element is a string containing a doctype declaration (this can be nil if no doctype). The rest of the @@ -991,7 +991,7 @@ Structure editing: \\[sgml-backward-element] Moves backwards over the previous element. -\\[sgml-forward-element] Moves forward over the nex element. +\\[sgml-forward-element] Moves forward over the next element. \\[sgml-down-element] Move forward and down one level in the element structure. \\[sgml-backward-up-element] Move backward out of this element level. \\[sgml-beginning-of-element] Move to after the start tag of the current element. @@ -1035,7 +1035,7 @@ sgml-indent-data If non-nil, indent in data/mixed context also. sgml-set-face If non-nil, psgml will set the face of parsed markup. sgml-markup-faces The faces used when the above variable is non-nil. -sgml-system-path List of directorys used to look for system identifiers. +sgml-system-path List of directories used to look for system identifiers. sgml-public-map Mapping from public identifiers to file names. sgml-offer-save If non-nil, ask about saving modified buffers before \\[sgml-validate] is run.
--- a/lisp/rmail/rmail.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/rmail/rmail.el Mon Aug 13 09:18:39 2007 +0200 @@ -993,7 +993,7 @@ ;; (defun rmail-decode-coding-system (from to) ;; (let (coding-system) ;; ;; At first, detect the coding-system of the region and set it to -;; ;; `coding-sytem'. +;; ;; `coding-system'. ;; (let ((detected-coding-system (code-detect-region from to)) ;; (coding (get-code mail-coding-system))) ;; (if (listp detected-coding-system)
--- a/lisp/tl/emu-xemacs.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/tl/emu-xemacs.el Mon Aug 13 09:18:39 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Version: -;; $Id: emu-xemacs.el,v 1.1.1.2 1996/12/21 20:50:48 steve Exp $ +;; $Id: emu-xemacs.el,v 1.2 1997/03/08 23:26:56 steve Exp $ ;; Keywords: emulation, compatibility, XEmacs ;; This file is part of emu. @@ -54,10 +54,10 @@ ))) ) -(defun tl:add-text-properties (start end properties) +(defun tl:add-text-properties (start end properties &optional object) (add-text-properties start end (append properties (list 'highlight t)) - ) + object) ) (defalias 'tl:make-overlay 'make-extent)
--- a/lisp/tl/file-detect.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/tl/file-detect.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Version: -;; $Id: file-detect.el,v 1.3 1997/01/30 02:22:46 steve Exp $ +;; $Id: file-detect.el,v 1.4 1997/03/08 23:26:56 steve Exp $ ;; Keywords: install, module ;; This file is part of tl (Tiny Library). @@ -20,8 +20,8 @@ ;; General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with This program; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; 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: @@ -102,7 +102,7 @@ )))) (defun file-installed-p (file &optional paths) - "Return t if FILE exists in PATHS. + "Return absolute-path of FILE if FILE exists in PATHS. If PATHS is omitted, `load-path' is used. [file-detect.el]" (if (null paths) (setq paths load-path)
--- a/lisp/tm/gnus-mime.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/tm/gnus-mime.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1996/8/6 -;; Version: $Revision: 1.4 $ +;; Version: $Revision: 1.5 $ ;; Keywords: news, MIME, multimedia, multilingual, encoded-word ;; This file is not part of GNU Emacs yet. @@ -33,7 +33,7 @@ ;;; (defconst gnus-mime-RCS-ID - "$Id: gnus-mime.el,v 1.4 1997/03/04 08:01:31 steve Exp $") + "$Id: gnus-mime.el,v 1.5 1997/03/08 23:26:57 steve Exp $") (defconst gnus-mime-version (get-version-string gnus-mime-RCS-ID)) @@ -65,7 +65,8 @@ (require 'gnus) (require 'gnus-charset) -(require 'gnus-sum) +(eval-when-compile + (require 'gnus-sum)) ;;; @ for tm-partial ;;;
--- a/lisp/tm/tm-play.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/tm/tm-play.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1995/9/26 (separated from tm-view.el) -;; Version: $Id: tm-play.el,v 1.2 1997/02/15 22:21:29 steve Exp $ +;; Version: $Id: tm-play.el,v 1.3 1997/03/08 23:26:57 steve Exp $ ;; Keywords: mail, news, MIME, multimedia ;; This file is part of tm (Tools for MIME). @@ -424,7 +424,9 @@ ;;; @ rot13-47 ;;; -(require 'view) +(condition-case nil + (require 'view-less) + (error (require 'view))) (defconst mime-view-text/plain-mode-map (copy-keymap view-mode-map)) (define-key mime-view-text/plain-mode-map
--- a/lisp/tm/tm-view.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/tm/tm-view.el Mon Aug 13 09:18:39 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp> ;; Created: 1994/7/13 (1994/8/31 obsolete tm-body.el) -;; Version: $Revision: 1.2 $ +;; Version: $Revision: 1.3 $ ;; Keywords: mail, news, MIME, multimedia ;; This file is part of tm (Tools for MIME). @@ -42,7 +42,7 @@ ;;; (defconst mime-viewer/RCS-ID - "$Id: tm-view.el,v 1.2 1997/02/15 22:21:30 steve Exp $") + "$Id: tm-view.el,v 1.3 1997/03/08 23:26:58 steve Exp $") (defconst mime-viewer/version (get-version-string mime-viewer/RCS-ID)) (defconst mime/viewer-version mime-viewer/version) @@ -732,8 +732,10 @@ (defun mime-viewer/define-keymap (&optional mother) (let ((mime/viewer-mode-map (if mother (copy-keymap mother) - (make-keymap)))) - (suppress-keymap mime/viewer-mode-map) + (make-keymap) + ))) + (or mother + (suppress-keymap mime/viewer-mode-map)) (define-key mime/viewer-mode-map "u" (function mime-viewer/up-content)) (define-key mime/viewer-mode-map
--- a/lisp/tooltalk/tooltalk-util.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/tooltalk/tooltalk-util.el Mon Aug 13 09:18:39 2007 +0200 @@ -75,7 +75,7 @@ "Initialize the tooltalk message attributes. The value of attributes must be a property list in the same form as for make-tooltalk-message. This function can be used to reset -an existing message or to initailize a new one. See +an existing message or to initialize a new one. See initialize-tooltalk-message-args for a description of how arguments are initialized." (let ((args attributes) @@ -121,7 +121,7 @@ The no-callback arg is a hack to prevent the registration of the C-level callback. This hack is needed by the current SPARCworks -tool startup mechanism. Yuchho." +tool startup mechanism. Yucko." (let ((msg (create-tooltalk-message no-callback))) (initialize-tooltalk-message-attributes msg attributes) msg)) @@ -199,7 +199,7 @@ a corresponding attribute that matches any member of the list. This function can be used to add attribute values to an existing -pattern or to initiallize a new one. See +pattern or to initialize a new one. See `initialize-tooltalk-message/pattern-args' for a description of how arguments are initialized." (let ((args attributes)
--- a/lisp/utils/mail-extr.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/utils/mail-extr.el Mon Aug 13 09:18:39 2007 +0200 @@ -1709,7 +1709,7 @@ ;; If the last thing in the name is 2 or more periods, or one or more ;; other sentence terminators (but not a single period) then keep them - ;; and the preceeding word. This is for the benefit of whole sentences + ;; and the preceding word. This is for the benefit of whole sentences ;; in the name field: it's better behavior than dropping the last word ;; of the sentence... (if (and (not suffix-flag)
--- a/lisp/utils/passwd.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/utils/passwd.el Mon Aug 13 09:18:39 2007 +0200 @@ -102,7 +102,7 @@ the default choice (it is not, of course, displayed.) If running under X, the keyboard will be grabbed (with XGrabKeyboard()) -to reduce the possibility that evesdropping is occuring. +to reduce the possibility that eavesdropping is occuring. When reading a password, all keys self-insert, except for: \\<read-passwd-map>
--- a/lisp/utils/pretty-print.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/utils/pretty-print.el Mon Aug 13 09:18:39 2007 +0200 @@ -114,8 +114,8 @@ ; Change History ; ; $Log: pretty-print.el,v $ -; Revision 1.2 1997/01/03 03:10:34 steve -; Main beta 34 patches +; Revision 1.3 1997/03/08 23:27:00 steve +; Patches to Beta6 ; ; Revision 1.4 1993/03/25 14:09:52 bosch ; Commands `prettyexpand-sexp' and `prettyexpand-all-sexp' and @@ -157,7 +157,7 @@ ;; User level functions ;;;###autoload (defun pp-function (symbol) - "Pretty print the function definition of SYMBOL in a seperate buffer" + "Pretty print the function definition of SYMBOL in a separate buffer" (interactive (list (pp-read-symbol 'fboundp "Pretty print function definition of: "))) (if (compiled-function-p (symbol-function symbol)) @@ -169,14 +169,14 @@ ;;;###autoload (defun pp-variable (symbol) - "Pretty print the variable value of SYMBOL in a seperate buffer" + "Pretty print the variable value of SYMBOL in a separate buffer" (interactive (list (pp-read-symbol 'boundp "Pretty print variable value of: "))) (pp-symbol-cell symbol 'symbol-value)) ;;;###autoload (defun pp-plist (symbol) - "Pretty print the property list of SYMBOL in a seperate buffer" + "Pretty print the property list of SYMBOL in a separate buffer" (interactive (list (pp-read-symbol 'symbol-plist "Pretty print property list of: "))) (pp-symbol-cell symbol 'symbol-plist))
--- a/lisp/utils/tree-menu.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/utils/tree-menu.el Mon Aug 13 09:18:39 2007 +0200 @@ -35,7 +35,7 @@ ;;; Note: This function is very time consuming ! Therefore you should ;;; call `tree-make-file-list' once and make several menus ;;; from the same list. And you should only rebuild the menu if -;;; it is neccessary, if you've a big directory tree. +;;; it is necessary, if you've a big directory tree. ;;; ;;; Installation: ;;;
--- a/lisp/utils/uniquify.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/utils/uniquify.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,10 +1,11 @@ ;;; uniquify.el --- unique buffer names dependent on file name -;; Copyright (c) 1989, 1995 Free Software Foundation, Inc. +;; Copyright (c) 1989, 1995, 1996, 1997 Free Software Foundation, Inc. ;; Author: Dick King <king@reasoning.com> ;; Maintainer: Michael Ernst <mernst@theory.lcs.mit.edu> ;; Created: 15 May 86 +;; Time-stamp: <97/03/03 17:16:23 mernst> ;; This file is part of GNU Emacs. @@ -19,9 +20,8 @@ ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: @@ -34,12 +34,17 @@ ;; Makefile|zaphod, respectively (instead of Makefile and Makefile<2>). ;; Other buffer name styles are also available. -;; To use this file, just load it. +;; To use this file, just load it; or add (require 'uniquify) to your .emacs. ;; To disable it after loading, set variable uniquify-buffer-name-style to nil. ;; For other options, see "User-visible variables", below. -;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs, -;; and InfoDock is available from the maintainer. +;; uniquify.el works under Emacs 18, Emacs 19, XEmacs, and InfoDock. + +;; Doesn't correctly handle buffer names created by M-x write-file in Emacs 18. +;; Doesn't work under NT when backslash is used as a path separator (forward +;; slash path separator works fine). To fix, check system-type against +;; 'windows-nt, write a routine that breaks paths down into components. +;; (Surprisingly, there isn't one built in.) ;;; Change Log: @@ -59,13 +64,17 @@ ;; uniquify-buffer-name-style; add 'forward and 'post-forward-angle-brackets ;; styles; remove uniquify-reverse-dir-content-p; add ;; uniquify-trailing-separator-p. mernst 4 Aug 95 +;; Don't call expand-file-name on nil. mernst 7 Jan 96 +;; Check whether list-buffers-directory is bound. mernst 11 Oct 96 +;; Ignore non-file non-dired buffers. Colin Rafferty <craffert@ml.com> 3 Mar 97 ;; Valuable feedback was provided by ;; Paul Smith <psmith@baynetworks.com>, ;; Alastair Burt <burt@dfki.uni-kl.de>, ;; Bob Weiner <weiner@footloose.sps.mot.com>, ;; Albert L. Ting <alt@vlibs.com>, -;; gyro@reasoning.com. +;; gyro@reasoning.com, +;; Bryan O'Sullivan <bos@eng.sun.com>. ;;; Code: @@ -148,8 +157,8 @@ (while buffers (let* ((buffer (car buffers)) (bfn (if (eq buffer newbuf) - (and newbuffile - (expand-file-name newbuffile)) + (and newbuffile + (expand-file-name newbuffile)) (uniquify-buffer-file-name buffer))) (rawname (and bfn (file-name-nondirectory bfn))) (deserving (and rawname @@ -172,11 +181,23 @@ ;; uniquify's version of buffer-file-name (defun uniquify-buffer-file-name (buffer) "Return name of file BUFFER is visiting, or nil if none. -Works on dired buffers as well as ordinary file-visiting buffers." +Works on dired buffers as well as ordinary file-visiting buffers, +but no others." (or (buffer-file-name buffer) - (save-excursion - (set-buffer buffer) - list-buffers-directory))) + (and (featurep 'dired) + (save-excursion + (set-buffer buffer) + (and + (eq major-mode 'dired-mode) ; do nothing if not a dired buffer + (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this + list-buffers-directory + ;; don't use default-directory if dired-directory is nil + (and dired-directory + (expand-file-name + (directory-file-name + (if (consp dired-directory) + (car dired-directory) + dired-directory)))))))))) (defun uniquify-fix-list-filename-lessp (fixlist1 fixlist2) (uniquify-filename-lessp @@ -316,69 +337,149 @@ ;;; Hooks from the rest of Emacs -;; Emacs 19 (Emacs or XEmacs) +(cond + ((string-match "^19" emacs-version) + ;; Emacs 19 (Emacs or XEmacs) + + ;; The logical place to put all this code is in generate-new-buffer-name. + ;; It's written in C, so we would add a generate-new-buffer-name-function + ;; which, if non-nil, would be called instead of the C. One problem with + ;; that is that generate-new-buffer-name takes a potential buffer name as + ;; its argument -- not other information, such as what file the buffer will + ;; visit. -;; The logical place to put all this code is in generate-new-buffer-name. -;; It's written in C, so we would add a generate-new-buffer-name-function -;; which, if non-nil, would be called instead of the C. One problem with -;; that is that generate-new-buffer-name takes a potential buffer name as -;; its argument -- not other information, such as what file the buffer will -;; visit. + ;; The below solution works because generate-new-buffer-name is called + ;; only by rename-buffer (which, as of 19.29, is never called from C) and + ;; generate-new-buffer, which is called only by Lisp functions + ;; create-file-buffer and rename-uniquely. Rename-uniquely generally + ;; isn't used for buffers visiting files, so it's sufficient to hook + ;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't + ;; sufficient.) + + (defadvice rename-buffer (after rename-buffer-uniquify activate) + "Uniquify buffer names with parts of directory name." + (if (and uniquify-buffer-name-style + ;; UNIQUE argument + (ad-get-arg 1)) + (progn + (if uniquify-after-kill-buffer-p + ;; call with no argument; rationalize vs. old name as well as new + (uniquify-rationalize-file-buffer-names) + ;; call with argument: rationalize vs. new name only + (uniquify-rationalize-file-buffer-names + (uniquify-buffer-file-name (current-buffer)) (current-buffer))) + (setq ad-return-value (buffer-name (current-buffer)))))) -;; The below solution works because generate-new-buffer-name is called -;; only by rename-buffer (which, as of 19.29, is never called from C) and -;; generate-new-buffer, which is called only by Lisp functions -;; create-file-buffer and rename-uniquely. Rename-uniquely generally -;; isn't used for buffers visiting files, so it's sufficient to hook -;; rename-buffer and create-file-buffer. (Setting find-file-hooks isn't -;; sufficient.) + (defadvice create-file-buffer (after create-file-buffer-uniquify activate) + "Uniquify buffer names with parts of directory name." + (if uniquify-buffer-name-style + (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) + + ;; Buffer deletion + ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. + ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. + ;; That means that the kill-buffer-hook function cannot just delete the + ;; buffer -- it has to set something to do the rationalization *later*. + ;; It actually puts another function on `post-command-hook'. This other + ;; function runs the rationalization and then removes itself from the hook. + ;; Is there a better way to accomplish this? + ;; (This ought to set some global variables so the work is done only for + ;; buffers with names similar to the deleted buffer. -MDE) -(defadvice rename-buffer (after rename-buffer-uniquify activate) - "Uniquify buffer names with parts of directory name." - (if (and uniquify-buffer-name-style - ;; UNIQUE argument - (ad-get-arg 1)) - (progn - (if uniquify-after-kill-buffer-p - ;; call with no argument; rationalize vs. old name as well as new - (uniquify-rationalize-file-buffer-names) - ;; call with argument: rationalize vs. new name only - (uniquify-rationalize-file-buffer-names - (uniquify-buffer-file-name (current-buffer)) (current-buffer))) - (setq ad-return-value (buffer-name (current-buffer)))))) + (cond + ((or (not (string-lessp emacs-version "19.28")) + (and (string-match "XEmacs" emacs-version) + (not (string-lessp emacs-version "19.12")))) + ;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?) + (defun delay-uniquify-rationalize-file-buffer-names () + "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. +For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." + (if (and uniquify-buffer-name-style + uniquify-after-kill-buffer-p) + (add-hook 'post-command-hook + 'delayed-uniquify-rationalize-file-buffer-names))) + (defun delayed-uniquify-rationalize-file-buffer-names () + "Rerationalize buffer names and remove self from `post-command-hook'. +See also `delay-rationalize-file-buffer-names' for hook setter." + (uniquify-rationalize-file-buffer-names) + (remove-hook 'post-command-hook + 'delayed-uniquify-rationalize-file-buffer-names)) -(defadvice create-file-buffer (after create-file-buffer-uniquify activate) - "Uniquify buffer names with parts of directory name." - (if uniquify-buffer-name-style - (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value))) + (add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)) + (t + ;; GNU Emacs 19.01 through 19.27 + ;; Before version 19.28, {pre,post}-command-hook was unable to set itself. + + (defvar uniquify-post-command-p nil + "Set to trigger re-rationalization of buffer names by function on +`post-command-hook'. Used by kill-buffer-rationalization mechanism.") + + (defun uniquify-post-command-rerationalization () + "Set variable so buffer names may be rationalized by `post-command-hook'. -;; Buffer deletion -;; Rerationalize after a buffer is killed, to reduce coinciding buffer names. -;; This mechanism uses `kill-buffer-hook', which runs *before* deletion. -;; That means that the kill-buffer-hook function cannot just delete the -;; buffer -- it has to set something to do the rationalization *later*. -;; It actually puts another function on `post-command-hook'. This other -;; function runs the rationalization and then removes itself from the hook. -;; Is there a better way to accomplish this? -;; (This ought to set some global variables so the work is done only for -;; buffers with names similar to the deleted buffer. -MDE) +See variables `uniquify-post-command-p', `uniquify-buffer-name-style', and +`uniquify-after-kill-buffer-p'." + (if (and uniquify-buffer-name-style + uniquify-after-kill-buffer-p) + (setq uniquify-post-command-p + ;; Set the buffer name, so, once the delimiter character + ;; is parameterized, we could selectively rationalize just + ;; related buffer names. + (cons (buffer-name) uniquify-post-command-p)))) + (defun uniquify-rationalize-after-buffer-kill () + "Via `post-command-hook', rerationalize buffer names after kill-buffer. + +Checks `uniquify-post-command-p', which should be set by +`uniquify-post-command-rerationalization' function on `kill-buffer-hook'." + (if uniquify-post-command-p + (progn (if (and uniquify-buffer-name-style + uniquify-after-kill-buffer-p) + (uniquify-rationalize-file-buffer-names)) + (setq uniquify-post-command-p nil)))) + + (add-hook 'kill-buffer-hook 'uniquify-post-command-rerationalization) + (add-hook 'post-command-hook 'uniquify-rationalize-after-buffer-kill)) + )) + (t + ;; Emacs 18: redefine create-file-buffer and dired-find-buffer. -(defun delay-uniquify-rationalize-file-buffer-names () - "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'. -For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion." - (if (and uniquify-buffer-name-style - uniquify-after-kill-buffer-p) - (add-hook 'post-command-hook - 'delayed-uniquify-rationalize-file-buffer-names))) + ;; Since advice.el can run in Emacs 18 as well as Emacs 19, we could use + ;; advice here, too, if it is available; but it's not worth it, since + ;; Emacs 18 is obsolescent anyway. -(defun delayed-uniquify-rationalize-file-buffer-names () - "Rerationalize buffer names and remove self from `post-command-hook'. -See also `delay-rationalize-file-buffer-names' for hook setter." - (uniquify-rationalize-file-buffer-names) - (remove-hook 'post-command-hook - 'delayed-uniquify-rationalize-file-buffer-names)) + (defun create-file-buffer (filename) ;from files.el + "Create a suitably named buffer for visiting FILENAME, and return it." + (let ((base (file-name-nondirectory filename))) + (if (string= base "") + (setq base filename)) + (if (and (get-buffer base) + uniquify-ask-about-buffer-names-p) + (get-buffer-create + (let ((tem (read-string (format + "Buffer name \"%s\" is in use; type a new name, or Return to clobber: " + base)))) + (if (equal tem "") base tem))) + (let ((buf (generate-new-buffer base))) + (if uniquify-buffer-name-style + (uniquify-rationalize-file-buffer-names filename buf)) + buf)))) -(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names) + (defun dired-find-buffer (dirname) ;from dired.el + (let ((blist (buffer-list)) + found) + (while blist + (save-excursion + (set-buffer (car blist)) + (if (and (eq major-mode 'dired-mode) + (equal dired-directory dirname)) + (setq found (car blist) + blist nil) + (setq blist (cdr blist))))) + (or found + (progn (if (string-match "/$" dirname) + (setq dirname (substring dirname 0 -1))) + (create-file-buffer (if uniquify-buffer-name-style + dirname + (file-name-nondirectory dirname))))))))) ;;; uniquify.el ends here -
--- a/lisp/version.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/version.el Mon Aug 13 09:18:39 2007 +0200 @@ -25,7 +25,7 @@ (defconst emacs-version "20.1" "Version numbers of this version of Emacs.") -(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta5)"))) +(setq emacs-version (purecopy (concat emacs-version " XEmacs Lucid (beta6)"))) (defconst emacs-major-version (progn (or (string-match "^[0-9]+" emacs-version)
--- a/lisp/vm/Makefile Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/Makefile Mon Aug 13 09:18:39 2007 +0200 @@ -58,8 +58,8 @@ vm-motion.elc vm-page.elc vm-pop.elc vm-reply.elc \ vm-save.elc \ vm-search.elc vm-sort.elc vm-summary.elc vm-startup.elc vm-thread.elc \ - vm-toolbar.elc \ - vm-undo.elc vm-vars.elc vm-version.elc vm-virtual.elc vm-window.elc + vm-toolbar.elc vm-undo.elc \ + vm-user.elc vm-vars.elc vm-version.elc vm-virtual.elc vm-window.elc SOURCES = \ vm-delete.el vm-digest.el vm-easymenu.el vm-edit.el vm-folder.el \ @@ -67,8 +67,8 @@ vm-mime.el vm-minibuf.el vm-misc.el vm-mouse.el \ vm-motion.el vm-page.el vm-pop.el vm-reply.el vm-save.el \ vm-search.el vm-sort.el vm-startup.el vm-summary.el vm-thread.el \ - vm-toolbar.el \ - vm-undo.el vm-vars.el vm-version.el vm-virtual.el vm-window.el + vm-toolbar.el vm-undo.el \ + vm-user.el vm-vars.el vm-version.el vm-virtual.el vm-window.el vm: vm.elc @@ -213,6 +213,10 @@ @echo compiling vm-undo.el... @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-undo.el +vm-user.elc: vm-user.el $(CORE) + @echo compiling vm-user.el... + @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-user.el + vm-vars.elc: vm-vars.el $(CORE) @echo compiling vm-vars.el... @$(EMACS) $(BATCHFLAGS) $(PRELOADS) -f batch-byte-compile vm-vars.el
--- a/lisp/vm/vm-digest.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-digest.el Mon Aug 13 09:18:39 2007 +0200 @@ -161,10 +161,11 @@ (setq part-list (vm-mm-layout-parts layout)) (while part-list ;; Maybe we should verify that each part is - ;; of type message/rfc822 in here. But it - ;; seems more useful to just copy whatever - ;; the contents are and let teh user see the - ;; goop, whatever type it really is. + ;; of type message/rfc822 or message/news in + ;; here. But it seems more useful to just + ;; copy whatever the contents are and let the + ;; user see the goop, whatever type it really + ;; is. (insert (vm-leading-message-separator folder-type)) (and ident-header (insert ident-header)) (setq start (point)) @@ -173,7 +174,7 @@ (insert (vm-trailing-message-separator folder-type)) (setq part-list (cdr part-list)))) (t (error - "MIME type is not multipart/digest or message/rfc822"))) + "MIME type is not multipart/digest or message/rfc822 or message/news"))) ;; do header conversions. (let ((vm-folder-type folder-type)) (goto-char (point-min)) @@ -379,8 +380,8 @@ (if rfc1153 (setq prologue-separator-regexp "^----------------------------------------------------------------------\n" separator-regexp "^------------------------------\n") - (setq prologue-separator-regexp "^-[^ ].*\n" - separator-regexp "^-[^ ].*\n")) + (setq prologue-separator-regexp "\\(^-[^ ].*\n+\\)+" + separator-regexp "\\(^-[^ ].*\n+\\)+")) (vm-save-restriction (save-excursion (widen) @@ -425,10 +426,10 @@ (save-excursion (save-match-data (skip-chars-forward "\n") - (and (vm-match-header) - (or (vm-digest-get-header-contents "From") - (not (re-search-forward separator-regexp - nil t))))))) + (or (and (vm-match-header) + (vm-digest-get-header-contents "From")) + (not (re-search-forward separator-regexp + nil t)))))) (setq prev-sep (point) after-prev-sep (point)) ;; insert a trailing message separator @@ -601,6 +602,8 @@ (or (vm-mime-types-match "multipart/digest" (car (vm-mm-layout-type layout))) (vm-mime-types-match "message/rfc822" + (car (vm-mm-layout-type layout))) + (vm-mime-types-match "message/news" (car (vm-mm-layout-type layout))))) (throw 'return-value "mime")))) (save-excursion
--- a/lisp/vm/vm-folder.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-folder.el Mon Aug 13 09:18:39 2007 +0200 @@ -508,7 +508,7 @@ (set-buffer temp-buffer) (if (file-readable-p file) (condition-case nil - (let ((overriding-file-coding-system 'binary)) + (let ((coding-system-for-read 'binary)) (insert-file-contents file nil 0 4096)) (wrong-number-of-arguments (call-process "sed" file temp-buffer nil @@ -1035,8 +1035,16 @@ (vm-text-of message)) (goto-char (point-min)))) (setq old-header-start (point)) - (while (and (not (= (following-char) ?\n)) - (vm-match-header)) + ;; as we loop through the headers, skip >From + ;; lines. these can occur anywhere in the + ;; header section if the message has been + ;; manhandled by some dumb delivery agents + ;; (SCO and Solaris are the usual suspects.) + ;; it's a tough ol' world. + (while (progn (while (looking-at ">From ") + (forward-line)) + (and (not (= (following-char) ?\n)) + (vm-match-header))) (setq end-of-header (vm-matched-header-end) list (vm-match-ordered-header header-alist)) ;; don't display/keep this header if @@ -2196,7 +2204,7 @@ (if timer (timer-set-time timer (current-time) vm-mail-check-interval) (set-itimer-restart current-itimer vm-mail-check-interval)) - ;; user has changed the variable value to a something that + ;; user has changed the variable value to something that ;; isn't a number, make the timer go away. (if timer (cancel-timer timer) @@ -2209,7 +2217,15 @@ (set-buffer (car b-list)) (if (and (eq major-mode 'vm-mode) (setq found-one t) - (not vm-block-new-mail)) + ;; to avoid reentrance into the pop code + (not vm-block-new-mail) + ;; Don't bother checking if we already know from + ;; a previous check that there's mail waiting + ;; and the user hasn't retrieved it yet. Not + ;; completely accurate, but saves network + ;; connection build and tear down which is slow + ;; for some users. + (not vm-spooled-mail-waiting)) (progn (setq oldval vm-spooled-mail-waiting) (vm-check-for-spooled-mail nil) @@ -2235,7 +2251,7 @@ (if timer (timer-set-time timer (current-time) vm-auto-get-new-mail) (set-itimer-restart current-itimer vm-auto-get-new-mail)) - ;; user has changed the variable value to a something that + ;; user has changed the variable value to something that ;; isn't a number, make the timer go away. (if timer (cancel-timer timer) @@ -2538,7 +2554,7 @@ ;; enable-local-variables == nil disables them for newer Emacses (let ((inhibit-local-variables t) (enable-local-variables nil) - (overriding-file-coding-system 'no-conversion)) + (coding-system-for-read 'no-conversion)) (find-file-noselect crash-box))) (save-excursion (set-buffer crash-buf) @@ -2598,12 +2614,21 @@ (kill-buffer crash-buf) (if (not (stringp vm-keep-crash-boxes)) (vm-error-free-call 'delete-file crash-box) - (let (name) - (setq name (expand-file-name (format "Z%d" (vm-abs (random))) - vm-keep-crash-boxes)) + (let ((time (decode-time (current-time))) + name) + (setq name + (expand-file-name (format "Z-%02d-%02d-%05d" + (nth 4 time) + (nth 3 time) + (% (vm-abs (random)) 100000)) + vm-keep-crash-boxes)) (while (file-exists-p name) - (setq name (expand-file-name (format "Z%d" (vm-abs (random))) - vm-keep-crash-boxes))) + (setq name + (expand-file-name (format "Z-%02d-%02d-%05d" + (nth 4 time) + (nth 3 time) + (% (vm-abs (random)) 100000)) + vm-keep-crash-boxes))) (rename-file crash-box name)))) got-mail )))) @@ -2758,6 +2783,16 @@ ;; put into the crash box or ;; not, so return t just to be ;; safe. + t ) + (quit (message "quitting from %s..." + (if popdrop + 'vm-pop-move-mail + 'vm-spool-move-mail)) + (sleep-for 1) + ;; we don't know if mail was + ;; put into the crash box or + ;; not, so return t just to be + ;; safe. t )) (funcall retrieval-function maildrop crash)) (if (vm-gobble-crash-box crash) @@ -2839,7 +2874,7 @@ (vm-save-restriction (widen) (goto-char (point-max)) - (let ((overriding-file-coding-system 'binary)) + (let ((coding-system-for-read 'binary)) (insert-file-contents folder)))) (setq mcount (length vm-message-list)) (if (vm-assimilate-new-messages)
--- a/lisp/vm/vm-menu.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-menu.el Mon Aug 13 09:18:39 2007 +0200 @@ -193,6 +193,8 @@ ["Unmark" vm-unmark-message vm-message-list] ["Mark All" vm-mark-all-messages vm-message-list] ["Clear All Marks" vm-clear-all-marks vm-message-list] + ["Mark Region in Summary" vm-mark-summary-region vm-message-list] + ["Unmark Region in Summary" vm-unmark-summary-region vm-message-list] "----" ["Mark Same Subject" vm-mark-messages-same-subject vm-message-list] ["Unmark Same Subject" vm-unmark-messages-same-subject vm-message-list] @@ -376,21 +378,30 @@ (defconst vm-menu-mime-dispose-menu (let ((title (if (vm-menu-fsfemacs-menus-p) - (list "Send MIME body to ..." - "Send MIME body to ..." + (list "Take Action on MIME body ..." + "Take Action on MIME body ..." "---" "---") - (list "Send MIME body to ...")))) + (list "Take Action on MIME body ...")))) (append title - (list ["File" (vm-mime-run-display-function-at-point - 'vm-mime-send-body-to-file) t] - ["Shell Pipeline (display output)" + (list ["Display as US-ASCII Text" + (vm-mime-run-display-function-at-point + 'vm-mime-display-body-as-text) t] + ["Display using External Viewer" (vm-mime-run-display-function-at-point - 'vm-mime-pipe-body-to-command) t] - ["Shell Pipeline (discard output)" + 'vm-mime-display-body-using-external-viewer) t] + "---" + ["Save to File" (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-file) t] + ["Send to Printer" (vm-mime-run-display-function-at-point + 'vm-mime-send-body-to-printer) t] + ["Feed to Shell Pipeline (display output)" (vm-mime-run-display-function-at-point - 'vm-mime-pipe-body-to-command-discard-output) t])))) + 'vm-mime-pipe-body-to-queried-command) t] + ["Feed to Shell Pipeline (discard output)" + (vm-mime-run-display-function-at-point + 'vm-mime-pipe-body-to-queried-command-discard-output) t])))) (defconst vm-menu-url-browser-menu (let ((title (if (vm-menu-fsfemacs-menus-p) @@ -461,6 +472,33 @@ vm-message-list] )))) +(defconst vm-menu-content-disposition-menu + (let ((title (if (vm-menu-fsfemacs-menus-p) + (list "Set Content Disposition" + "Set Content Disposition" + "---" + "---") + (list "Set Content Disposition")))) + (append + title + (list ["Unspecified" + (vm-mime-set-attachment-disposition-at-point 'unspecified) + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-disposition-at-point) + 'unspecified)] + ["Inline" + (vm-mime-set-attachment-disposition-at-point 'inline) + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-disposition-at-point) 'inline)] + ["Attachment" + (vm-mime-set-attachment-disposition-at-point 'attachment) + :active vm-send-using-mime + :style radio + :selected (eq (vm-mime-attachment-disposition-at-point) + 'attachment)])))) + (defvar vm-menu-vm-menubar nil) (defconst vm-menu-vm-menu @@ -631,6 +669,10 @@ (vm-easy-menu-define vm-menu-fsfemacs-mime-dispose-menu (list dummy) nil vm-menu-mime-dispose-menu) + ;; content disposition menu + (vm-easy-menu-define vm-menu-fsfemacs-content-disposition-menu + (list dummy) nil + vm-menu-content-disposition-menu) ;; block the global menubar entries in the map so that VM ;; can take over the menubar if necessary. (define-key map [rootmenu] (make-sparse-keymap)) @@ -727,6 +769,7 @@ (goto-char (posn-point (event-start event))) (vm-menu-popup-fsfemacs-menu event)))) +(defvar vm-menu-fsfemacs-content-disposition-menu) (defun vm-menu-popup-context-menu (event) (interactive "e") ;; We should not need to do anything here for XEmacs. The @@ -739,57 +782,67 @@ (cond ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) (set-buffer (window-buffer (posn-window (event-start event)))) (goto-char (posn-point (event-start event))) - (let (o-list o menu (found nil)) - (setq o-list (overlays-at (point))) - (while (and o-list (not found)) - (cond ((overlay-get (car o-list) 'vm-url) - (setq found t) - (vm-menu-popup-url-browser-menu event)) - ((setq menu (overlay-get (car o-list) 'vm-header)) - (setq found t) - (vm-menu-popup-fsfemacs-menu event menu)) - ((overlay-get (car o-list) 'vm-mime-layout) - (setq found t) - (vm-menu-popup-mime-dispose-menu event))) - (setq o-list (cdr o-list))) - (and (not found) (vm-menu-popup-fsfemacs-menu event)))))) + (if (get-text-property (point) 'vm-mime-object) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-content-disposition-menu) + (let (o-list o menu (found nil)) + (setq o-list (overlays-at (point))) + (while (and o-list (not found)) + (cond ((overlay-get (car o-list) 'vm-url) + (setq found t) + (vm-menu-popup-url-browser-menu event)) + ((setq menu (overlay-get (car o-list) 'vm-header)) + (setq found t) + (vm-menu-popup-fsfemacs-menu event menu)) + ((overlay-get (car o-list) 'vm-mime-layout) + (setq found t) + (vm-menu-popup-mime-dispose-menu event))) + (setq o-list (cdr o-list))) + (and (not found) (vm-menu-popup-fsfemacs-menu event))))))) ;; to quiet the byte-compiler (defvar vm-menu-fsfemacs-url-browser-menu) (defvar vm-menu-fsfemacs-mime-dispose-menu) -(defun vm-menu-popup-url-browser-menu (event) - (interactive "e") - (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) +(defun vm-menu-goto-event (event) + (cond ((vm-menu-xemacs-menus-p) ;; Must select window instead of just set-buffer because ;; popup-menu returns before the user has made a ;; selection. This will cause the command loop to ;; resume which might undo what set-buffer does. (select-window (event-window event)) - (and (event-point event) (goto-char (event-point event))) + (and (event-point event) (goto-char (event-point event)))) + ((vm-menu-fsfemacs-menus-p) + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event)))))) + +(defun vm-menu-popup-url-browser-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) (popup-menu vm-menu-url-browser-menu)) ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) - (set-buffer (window-buffer (posn-window (event-start event)))) - (goto-char (posn-point (event-start event))) (vm-menu-popup-fsfemacs-menu event vm-menu-fsfemacs-url-browser-menu)))) (defun vm-menu-popup-mime-dispose-menu (event) (interactive "e") + (vm-menu-goto-event event) (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) - ;; Must select window instead of just set-buffer because - ;; popup-menu returns before the user has made a - ;; selection. This will cause the command loop to - ;; resume which might undo what set-buffer does. - (select-window (event-window event)) - (and (event-point event) (goto-char (event-point event))) (popup-menu vm-menu-mime-dispose-menu)) ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) - (set-buffer (window-buffer (posn-window (event-start event)))) - (goto-char (posn-point (event-start event))) (vm-menu-popup-fsfemacs-menu event vm-menu-fsfemacs-mime-dispose-menu)))) +(defun vm-menu-popup-content-disposition-menu (event) + (interactive "e") + (vm-menu-goto-event event) + (cond ((and (vm-menu-xemacs-menus-p) vm-use-menus) + (popup-menu vm-menu-content-disposition-menu)) + ((and (vm-menu-fsfemacs-menus-p) vm-use-menus) + (vm-menu-popup-fsfemacs-menu + event vm-menu-fsfemacs-content-disposition-menu)))) + ;; to quiet the byte-compiler (defvar vm-menu-fsfemacs-mail-menu) (defvar vm-menu-fsfemacs-dispose-popup-menu) @@ -816,7 +869,8 @@ (if (vm-menu-xemacs-menus-p) (cond ((eq major-mode 'mail-mode) vm-menu-mail-menu) - ((memq major-mode '(vm-mode vm-summary-mode vm-virtual-mode)) + ((memq major-mode '(vm-mode vm-presentation-mode + vm-summary-mode vm-virtual-mode)) vm-menu-dispose-menu) (t vm-menu-vm-menu)) (cond ((eq major-mode 'mail-mode) @@ -923,7 +977,7 @@ (cons "Mail" vm-menu-fsfemacs-mail-menu)) (if vm-popup-menu-on-mouse-3 (define-key vm-mail-mode-map [down-mouse-3] - 'vm-menu-popup-mode-menu))))) + 'vm-menu-popup-context-menu))))) (defun vm-menu-install-menus () (cond ((consp vm-use-menus)
--- a/lisp/vm/vm-mime.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-mime.el Mon Aug 13 09:18:39 2007 +0200 @@ -39,6 +39,7 @@ (defun vm-mm-layout-parts (e) (aref e 10)) (defun vm-mm-layout-cache (e) (aref e 11)) +(defun vm-set-mm-layout-type (e type) (aset e 0 type)) (defun vm-set-mm-layout-cache (e c) (aset e 11 c)) (defun vm-mm-layout (m) @@ -362,7 +363,7 @@ (and (> (- end start) 200) (message "Decoding quoted-printable... done"))) -(defun vm-mime-qp-encode-region (start end &optional Q-encoding) +(defun vm-mime-qp-encode-region (start end &optional Q-encoding quote-from) (and (> (- end start) 200) (message "Encoding quoted-printable...")) (let ((work-buffer nil) @@ -386,7 +387,9 @@ ((and (= char 32) (not (= ?\n (char-after (1+ inputpos))))) (vm-insert-char char 1 nil work-buffer) (vm-increment cols)) - ((or (< char 33) (> char 126) (= char 61)) + ((or (< char 33) (> char 126) (= char 61) + (and quote-from (= cols 0) (let ((case-fold-search nil)) + (looking-at "From ")))) (vm-insert-char ?= 1 nil work-buffer) (vm-insert-char (car (rassq (lsh char -4) hex-digit-alist)) 1 nil work-buffer) @@ -415,29 +418,45 @@ (defun vm-decode-mime-message-headers (m) (let ((case-fold-search t) (buffer-read-only nil) + (did-decode nil) charset encoding match-start match-end start end) (save-excursion (goto-char (vm-headers-of m)) (while (re-search-forward vm-mime-encoded-word-regexp (vm-text-of m) t) (setq match-start (match-beginning 0) match-end (match-end 0) - charset (match-string 1) - encoding (match-string 2) + charset (buffer-substring (match-beginning 1) (match-end 1)) + encoding (buffer-substring (match-beginning 2) (match-end 2)) start (match-beginning 3) end (vm-marker (match-end 3))) ;; don't change anything if we can't display the ;; character set properly. (if (not (vm-mime-charset-internally-displayable-p charset)) nil + (setq did-decode t) (delete-region end match-end) - (cond ((string-match "B" encoding) - (vm-mime-B-decode-region start end)) - ((string-match "Q" encoding) - (vm-mime-Q-decode-region start end)) - (t (vm-mime-error "unknown encoded word encoding, %s" - encoding))) + (condition-case data + (cond ((string-match "B" encoding) + (vm-mime-B-decode-region start end)) + ((string-match "Q" encoding) + (vm-mime-Q-decode-region start end)) + (t (vm-mime-error "unknown encoded word encoding, %s" + encoding))) + (vm-mime-error (apply 'message (cdr data)) + (goto-char start) + (insert "**invalid encoded word**") + (delete-region (point) end))) (vm-mime-charset-decode-region charset start end) - (delete-region match-start start)))))) + (delete-region match-start start))) + ;; if we did some decoding, re-electrify the headers since + ;; some of the extents might have been wiped by the + ;; decoding process. + (if did-decode + (save-restriction + (narrow-to-region (vm-headers-of m) (vm-text-of m)) + (vm-energize-urls) + (vm-highlight-headers-maybe) + (vm-energize-headers-and-xfaces)))))) (defun vm-decode-mime-encoded-words () (let ((case-fold-search t) @@ -448,8 +467,8 @@ (while (re-search-forward vm-mime-encoded-word-regexp nil t) (setq match-start (match-beginning 0) match-end (match-end 0) - charset (match-string 1) - encoding (match-string 2) + charset (buffer-substring (match-beginning 1) (match-end 1)) + encoding (buffer-substring (match-beginning 2) (match-end 2)) start (match-beginning 3) end (vm-marker (match-end 3))) ;; don't change anything if we can't display the @@ -457,12 +476,17 @@ (if (not (vm-mime-charset-internally-displayable-p charset)) nil (delete-region end match-end) - (cond ((string-match "B" encoding) - (vm-mime-B-decode-region start end)) - ((string-match "Q" encoding) - (vm-mime-Q-decode-region start end)) - (t (vm-mime-error "unknown encoded word encoding, %s" - encoding))) + (condition-case data + (cond ((string-match "B" encoding) + (vm-mime-B-decode-region start end)) + ((string-match "Q" encoding) + (vm-mime-Q-decode-region start end)) + (t (vm-mime-error "unknown encoded word encoding, %s" + encoding))) + (vm-mime-error (apply 'message (cdr data)) + (goto-char start) + (insert "**invalid encoded word**") + (delete-region (point) end))) (vm-mime-charset-decode-region charset start end) (delete-region match-start start)))))) @@ -715,7 +739,7 @@ ((string-match "^multipart/" (car type)) (setq c-t '("text/plain" "charset=us-ascii") c-t-e "7bit")) ; below - ((string-match "^message/rfc822" (car type)) + ((string-match "^message/\\(rfc822\\|news\\)" (car type)) (setq c-t '("text/plain" "charset=us-ascii") c-t-e "7bit") (goto-char (point-min)) @@ -885,6 +909,10 @@ ;; Tell XEmacs/MULE not to mess with the text on writes. buffer-read-only t mode-line-format vm-mode-line-format) + ;; scroll in place messes with scroll-up and this loses + (defvar scroll-in-place) + (make-local-variable 'scroll-in-place) + (setq scroll-in-place nil) (and (vm-xemacs-mule-p) (set-file-coding-system 'binary t)) (cond ((vm-fsfemacs-19-p) @@ -896,7 +924,7 @@ (copy-sequence standard-display-table))) (standard-display-european t) (setq buffer-display-table standard-display-table)))) - (if vm-frame-per-folder + (if (and vm-frame-per-folder (vm-multiple-frames-possible-p)) (vm-set-hooks-for-frame-deletion)) (use-local-map vm-mode-map) (and (vm-toolbar-support-possible-p) vm-use-toolbar @@ -969,7 +997,7 @@ "iso-2022-jp")) (t (or (car (cdr - (vm-string-assoc + (assoc (car charsets) vm-mime-mule-charset-to-charset-alist))) "unknown")))) @@ -1309,7 +1337,9 @@ ;; display unmatched message and text types as ;; text/plain. (vm-mime-display-internal-text/plain layout))) - (t (vm-mime-display-internal-application/octet-stream + (t (and extent (vm-mime-rewrite-failed-button + extent (vm-mm-layout-cache layout))) + (vm-mime-display-internal-application/octet-stream (or extent layout)))) (and extent (vm-mime-delete-button-maybe extent))) (set-buffer-modified-p modified))) @@ -1348,7 +1378,10 @@ (buffer-read-only nil) (charset (or (vm-mime-get-parameter layout "charset") "us-ascii"))) (if (not (vm-mime-charset-internally-displayable-p charset)) - nil + (progn + (vm-set-mm-layout-cache + layout (concat "Undisplayable charset: " charset)) + nil) (vm-mime-insert-mime-body layout) (setq end (point-marker)) (vm-mime-transfer-decode-region layout start end) @@ -1389,7 +1422,7 @@ (start (point)) end) (if (and (processp process) (eq (process-status process) 'run)) - nil + t (cond ((or (null tempfile) (null (file-exists-p tempfile))) (vm-mime-insert-mime-body layout) (setq end (point-marker)) @@ -1412,9 +1445,7 @@ (setq vm-folder-garbage-alist (cons (cons tempfile 'delete-file) vm-folder-garbage-alist))))) - (message "Launching %s..." (mapconcat 'identity - program-list - " ")) + (message "Launching %s..." (mapconcat 'identity program-list " ")) (setq process (apply 'start-process (format "view %25s" (vm-mime-layout-description layout)) @@ -1601,6 +1632,8 @@ t ) (fset 'vm-mime-display-button-message/rfc822 'vm-mime-display-internal-message/rfc822) +(fset 'vm-mime-display-internal-message/news + 'vm-mime-display-internal-message/rfc822) (defun vm-mime-display-internal-message/partial (layout) (if (vectorp layout) @@ -1829,7 +1862,7 @@ layout disposable) t )) -(defun vm-mime-run-display-function-at-point (&optional function) +(defun vm-mime-run-display-function-at-point (&optional function dispose) (interactive) ;; save excursion to keep point from moving. its motion would ;; drag window point along, to a place arbitrarily far from @@ -1896,7 +1929,8 @@ (keymap (make-sparse-keymap)) (buffer-read-only nil)) (if (fboundp 'set-keymap-parents) - (set-keymap-parents keymap (list (current-local-map))) + (if (current-local-map) + (set-keymap-parents keymap (list (current-local-map)))) (setq keymap (nconc keymap (current-local-map)))) (define-key keymap "\r" 'vm-mime-run-display-function-at-point) (if (and (vm-mouse-xemacs-mouse-p) vm-popup-menu-on-mouse-3) @@ -1927,6 +1961,14 @@ (vm-set-extent-property e 'vm-mime-layout layout) (vm-set-extent-property e 'vm-mime-function action))) +(defun vm-mime-rewrite-failed-button (button error-string) + (let* ((buffer-read-only nil) + (start (point))) + (goto-char (vm-extent-start-position button)) + (insert (format "DISPLAY FAILED -- %s" error-string)) + (vm-set-extent-endpoints button start (vm-extent-end-position button)) + (delete-region (point) (vm-extent-end-position button)))) + (defun vm-mime-send-body-to-file (layout &optional default-filename) (if (not (vectorp layout)) (setq layout (vm-extent-property layout 'vm-mime-layout))) @@ -1982,11 +2024,10 @@ (write-region (point-min) (point-max) file nil nil)) (and work-buffer (kill-buffer work-buffer)))))) -(defun vm-mime-pipe-body-to-command (layout &optional discard-output) +(defun vm-mime-pipe-body-to-command (command layout &optional discard-output) (if (not (vectorp layout)) (setq layout (vm-extent-property layout 'vm-mime-layout))) - (let ((command-line (read-string "Pipe to command: ")) - (output-buffer (if discard-output + (let ((output-buffer (if discard-output 0 (get-buffer-create "*Shell Command Output*"))) (work-buffer nil)) @@ -2009,7 +2050,7 @@ (call-process-region (point-min) (point-max) (or shell-file-name "sh") nil output-buffer nil - shell-command-switch command-line))) + shell-command-switch command))) (and work-buffer (kill-buffer work-buffer))) (if (bufferp output-buffer) (progn @@ -2021,8 +2062,37 @@ '(vm-pipe-message-to-command))))))) t ) -(defun vm-mime-pipe-body-to-command-discard-output (layout) - (vm-mime-pipe-body-to-command layout t)) +(defun vm-mime-pipe-body-to-queried-command (layout &optional discard-output) + (let ((command (read-string "Pipe to command: "))) + (vm-mime-pipe-body-to-command command layout discard-output))) + +(defun vm-mime-pipe-body-to-queried-command-discard-output (layout) + (vm-mime-pipe-body-to-queried-command layout t)) + +(defun vm-mime-send-body-to-printer (layout) + (vm-mime-pipe-body-to-command (mapconcat (function identity) + (nconc (list vm-print-command) + vm-print-command-switches) + " ") + layout)) + +(defun vm-mime-display-body-as-text (button) + (let ((vm-auto-displayed-mime-content-types '("text/plain")) + (layout (copy-sequence (vm-extent-property button 'vm-mime-layout)))) + (vm-set-extent-property button 'vm-mime-disposable t) + (vm-set-extent-property button 'vm-mime-layout layout) + ;; not universally correct, but close enough. + (vm-set-mm-layout-type layout '("text/plain" "charset=us-ascii")) + (goto-char (vm-extent-start-position button)) + (vm-decode-mime-layout button t))) + +(defun vm-mime-display-body-using-external-viewer (button) + (let ((layout (vm-extent-property button 'vm-mime-layout))) + (goto-char (vm-extent-start-position button)) + (if (not (vm-mime-find-external-viewer (car (vm-mm-layout-type layout)))) + (error "No viewer defined for type %s" + (car (vm-mm-layout-type layout))) + (vm-mime-display-external-generic layout)))) (defun vm-mime-scrub-description (string) (let ((work-buffer nil)) @@ -2260,10 +2330,6 @@ (or type "MIME file"))) (insert tag-string "\n") (setq end (1- (point))) - ;; attach default filename for recipient if currently - ;; non-MIME. if already MIME'd don't do this because it - ;; would override any content-disposition header already in - ;; the attachment. (if (and (stringp object) (not mimed)) (progn (if (or (vm-mime-types-match "application" type) @@ -2274,11 +2340,15 @@ (list (concat "filename=\"" (file-name-nondirectory object) - "\"")))))) + "\""))))) + (setq disposition (list "unspecified"))) (cond ((vm-fsfemacs-19-p) (put-text-property start end 'front-sticky nil) (put-text-property start end 'rear-nonsticky t) - (put-text-property start end 'intangible object) +;; can't be intangible because menu clicking at a position needs +;; to set point inside the tag so that a command can access the +;; text properties there. +;; (put-text-property start end 'intangible object) (put-text-property start end 'face vm-mime-button-face) (put-text-property start end 'vm-mime-type type) (put-text-property start end 'vm-mime-object object) @@ -2292,6 +2362,12 @@ (set-extent-property e 'start-open t) (set-extent-property e 'face vm-mime-button-face) (vm-set-extent-property e 'duplicable t) + (let ((keymap (make-sparse-keymap))) + (if vm-popup-menu-on-mouse-3 + (define-key keymap 'button3 + 'vm-menu-popup-content-disposition-menu)) + (vm-set-extent-property e 'keymap keymap) + (set-extent-property e 'balloon-help 'vm-mouse-3-help)) (vm-set-extent-property e 'vm-mime-type type) (vm-set-extent-property e 'vm-mime-object object) (vm-set-extent-property e 'vm-mime-parameters params) @@ -2299,6 +2375,24 @@ (vm-set-extent-property e 'vm-mime-disposition disposition) (vm-set-extent-property e 'vm-mime-encoded mimed))))) +(defun vm-mime-attachment-disposition-at-point () + (cond ((vm-fsfemacs-19-p) + (let ((disp (get-text-property (point) 'vm-mime-disposition))) + (intern (car disp)))) + ((vm-xemacs-p) + (let* ((e (extent-at (point) nil 'vm-mime-disposition)) + (disp (extent-property e 'vm-mime-disposition))) + (intern (car disp)))))) + +(defun vm-mime-set-attachment-disposition-at-point (sym) + (cond ((vm-fsfemacs-19-p) + (let ((disp (get-text-property (point) 'vm-mime-disposition))) + (setcar disp (symbol-name sym)))) + ((vm-xemacs-p) + (let* ((e (extent-at (point) nil 'vm-mime-disposition)) + (disp (extent-property e 'vm-mime-disposition))) + (setcar disp (symbol-name sym)))))) + (defun vm-disallow-overlay-endpoint-insertion (overlay after start end &optional old-size) (cond ((null after) nil) @@ -2360,21 +2454,26 @@ (replace-match mail-header-separator t t)))) (defun vm-mime-transfer-encode-region (encoding beg end crlf) - (let ((case-fold-search t)) + (let ((case-fold-search t) + (armor-from (and vm-mime-composition-armor-from-lines + (let ((case-fold-search nil)) + (save-excursion + (goto-char beg) + (re-search-forward "^From " nil t)))))) (cond ((string-match "^binary$" encoding) (vm-mime-base64-encode-region beg end crlf) (setq encoding "base64")) - ((string-match "^7bit$" encoding) t) + ((and (not armor-from) (string-match "^7bit$" encoding)) t) ((string-match "^base64$" encoding) t) ((string-match "^quoted-printable$" encoding) t) - ;; must be 8bit ((eq vm-mime-8bit-text-transfer-encoding 'quoted-printable) - (vm-mime-qp-encode-region beg end) + (vm-mime-qp-encode-region beg end nil armor-from) (setq encoding "quoted-printable")) ((eq vm-mime-8bit-text-transfer-encoding 'base64) (vm-mime-base64-encode-region beg end crlf) (setq encoding "base64")) - ((eq vm-mime-8bit-text-transfer-encoding 'send) t)) + (armor-from (vm-mime-qp-encode-region beg end nil armor-from)) + ((eq vm-mime-8bit-text-transfer-encoding '8bit) t)) encoding )) (defun vm-mime-transfer-encode-layout (layout) @@ -2475,7 +2574,19 @@ (setq object (vm-extent-property e 'vm-mime-object)) ;; insert the object (cond ((bufferp object) - (insert-buffer-substring object)) + (if (vm-xemacs-p) + (insert-buffer-substring object) + ;; as of FSF Emacs 19.34, even with the hooks + ;; we've attached to the attachment overlays, + ;; text STILL can be inserted into them when + ;; font-lock is enabled. Explaining why is + ;; beyond the scope of this comment and I + ;; don't know the answer anyway. This works + ;; to prevent it. + (insert-before-markers " ") + (forward-char -1) + (insert-buffer-substring object) + (delete-char 1))) ((stringp object) (let ((overridding-file-coding-system 'no-conversion)) (insert-file-contents-literally object)))) @@ -2489,12 +2600,22 @@ params (or (vm-extent-property e 'vm-mime-parameters) (cdr (vm-mm-layout-qtype layout))) description (vm-extent-property e 'vm-mime-description) - disposition (or (vm-extent-property e 'vm-mime-disposition) - (vm-mm-layout-qdisposition layout))) + disposition + (if (not + (equal + (car (vm-extent-property e 'vm-mime-disposition)) + "unspecified")) + (vm-extent-property e 'vm-mime-disposition) + (vm-mm-layout-qdisposition layout))) (setq type (vm-extent-property e 'vm-mime-type) params (vm-extent-property e 'vm-mime-parameters) description (vm-extent-property e 'vm-mime-description) - disposition (vm-extent-property e 'vm-mime-disposition))) + disposition + (if (not (equal + (car (vm-extent-property e 'vm-mime-disposition)) + "unspecified")) + (vm-extent-property e 'vm-mime-disposition) + nil))) (cond ((vm-mime-types-match "text" type) (setq encoding (vm-determine-proper-content-transfer-encoding @@ -2511,6 +2632,7 @@ t)) (setq 8bit (or 8bit (equal encoding "8bit")))) ((or (vm-mime-types-match "message/rfc822" type) + (vm-mime-types-match "message/news" type) (vm-mime-types-match "multipart" type)) (setq opoint-min (point-min)) (if (not already-mimed) @@ -2591,6 +2713,9 @@ (insert "Content-Transfer-Encoding: " encoding "\n\n")) (goto-char (point-max)) (widen) + (save-excursion + (goto-char (vm-extent-start-position e)) + (vm-assert (looking-at "\\[ATTACHMENT"))) (delete-region (vm-extent-start-position e) (vm-extent-end-position e)) (vm-detach-extent e)
--- a/lisp/vm/vm-misc.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-misc.el Mon Aug 13 09:18:39 2007 +0200 @@ -218,10 +218,10 @@ (make-list (- length vlength) fill))) vector ))) -(defun vm-obarray-to-string-list (obarray) +(defun vm-obarray-to-string-list (blobarray) (let ((list nil)) (mapatoms (function (lambda (s) (setq list (cons (symbol-name s) list)))) - obarray) + blobarray) list )) (defun vm-mapcar (function &rest lists) @@ -542,6 +542,10 @@ (fset 'vm-set-extent-property 'overlay-put) (fset 'vm-set-extent-property 'set-extent-property)) +(if (fboundp 'move-overlay) + (fset 'vm-set-extent-endpoints 'move-overlay) + (fset 'vm-set-extent-endpoints 'set-extent-endpoints)) + (if (fboundp 'make-overlay) (fset 'vm-make-extent 'make-overlay) (fset 'vm-make-extent 'make-extent)) @@ -674,3 +678,10 @@ (setq found t) (setq list (cdr list)))) list)) + +(defmacro vm-assert (expression) + (list 'or expression + (list 'progn + (list 'setq 'debug-on-error t) + (list 'error "assertion failed: %S" + (list 'quote expression)))))
--- a/lisp/vm/vm-mouse.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-mouse.el Mon Aug 13 09:18:39 2007 +0200 @@ -75,7 +75,7 @@ ((eq major-mode 'vm-virtual-mode) (vm-menu-popup-context-menu event)) ((eq major-mode 'mail-mode) - (vm-menu-popup-mode-menu event)))))) + (vm-menu-popup-context-menu event)))))) (defun vm-mouse-3-help (object) nil @@ -268,9 +268,9 @@ nil arg-list)) (cond ((equal status 0) t) ;; even if exit status non-zero, if there was no - ;; diagnostic output the command probablyt - ;; succeeded. I have tried just use exit status - ;; as the failure criteria and users complained. + ;; diagnostic output the command probably + ;; succeeded. I have tried to just use exit status + ;; as the failure criterion and users complained. ((equal (nth 7 (file-attributes tempfile)) 0) (message "%s exited non-zero (code %s)" command status) t)
--- a/lisp/vm/vm-page.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-page.el Mon Aug 13 09:18:39 2007 +0200 @@ -412,7 +412,7 @@ (progn (goto-char (match-beginning 0)) (vm-match-header) - (setq h (vm-matched-header)) + (setq h (concat "X-Face: " (vm-matched-header-contents))) (setq g (intern h vm-xface-cache)) (if (boundp g) (setq g (symbol-value g)) @@ -535,6 +535,7 @@ ;; at this point the current buffer is the presentation buffer ;; if we're using one for this message. + (vm-unbury-buffer (current-buffer)) (vm-energize-urls-in-message-region) (vm-highlight-headers-maybe) (vm-energize-headers-and-xfaces)
--- a/lisp/vm/vm-pop.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-pop.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,5 +1,5 @@ -;;; Simple POP (RFC 1460) client for VM -;;; Copyright (C) 1993, 1994 Kyle E. Jones +;;; Simple POP (RFC 1939) client for VM +;;; Copyright (C) 1993, 1994, 1997 Kyle E. Jones ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by @@ -32,6 +32,7 @@ (wrong-number-of-arguments (find-file-name-handler source))))) (popdrop (vm-safe-popdrop-string source)) + (statblob nil) mailbox-count mailbox-size message-size response n retrieved retrieved-bytes process-buffer) (unwind-protect @@ -58,17 +59,18 @@ ;; loop through the maildrop retrieving and deleting ;; messages as we go. (setq n 1 retrieved 0 retrieved-bytes 0) + (setq statblob (vm-pop-start-status-timer)) + (vm-set-pop-stat-x-box statblob popdrop) + (vm-set-pop-stat-x-maxmsg statblob mailbox-count) (while (and (<= n mailbox-count) (or (not (natnump m-per-session)) (< retrieved m-per-session)) (or (not (natnump b-per-session)) (< retrieved-bytes b-per-session))) - (if (or vm-pop-max-message-size - b-per-session) - (progn - (vm-pop-send-command process (format "LIST %d" n)) - (setq message-size - (vm-pop-read-list-response process)))) + (vm-set-pop-stat-x-currmsg statblob n) + (vm-pop-send-command process (format "LIST %d" n)) + (setq message-size (vm-pop-read-list-response process)) + (vm-set-pop-stat-x-need statblob message-size) (if (and (integerp vm-pop-max-message-size) (> message-size vm-pop-max-message-size) (progn @@ -94,7 +96,8 @@ (vm-pop-send-command process (format "RETR %d" n)) (and (null (vm-pop-read-response process)) (throw 'done (not (equal retrieved 0)))) - (and (null (vm-pop-retrieve-to-crashbox process destination)) + (and (null (vm-pop-retrieve-to-crashbox process destination + statblob)) (throw 'done (not (equal retrieved 0)))) (vm-increment retrieved) (and b-per-session @@ -107,6 +110,7 @@ (throw 'done (not (equal retrieved 0))))) (vm-increment n)) (not (equal retrieved 0)) )) + (and statblob (vm-pop-stop-status-timer statblob)) (if process (vm-pop-end-session process))))) @@ -240,7 +244,7 @@ (vm-pop-md5 (concat timestamp pass)))) (and (null (vm-pop-read-response process)) (throw 'done nil))) - (t (error "Don't know how to authenticate with %s" auth))) + (t (error "Don't know how to authenticate using %s" auth))) (setq process-to-shutdown nil) process )) (if process-to-shutdown @@ -255,6 +259,68 @@ (add-async-timeout 2 'delete-process process) (run-at-time 2 nil 'delete-process process)))) +(defun vm-pop-stat-timer (o) (aref o 0)) +(defun vm-pop-stat-x-box (o) (aref o 1)) +(defun vm-pop-stat-x-currmsg (o) (aref o 2)) +(defun vm-pop-stat-x-maxmsg (o) (aref o 3)) +(defun vm-pop-stat-x-got (o) (aref o 4)) +(defun vm-pop-stat-x-need (o) (aref o 5)) +(defun vm-pop-stat-y-box (o) (aref o 6)) +(defun vm-pop-stat-y-currmsg (o) (aref o 7)) +(defun vm-pop-stat-y-maxmsg (o) (aref o 8)) +(defun vm-pop-stat-y-got (o) (aref o 9)) +(defun vm-pop-stat-y-need (o) (aref o 10)) + +(defun vm-set-pop-stat-timer (o val) (aset o 0 val)) +(defun vm-set-pop-stat-x-box (o val) (aset o 1 val)) +(defun vm-set-pop-stat-x-currmsg (o val) (aset o 2 val)) +(defun vm-set-pop-stat-x-maxmsg (o val) (aset o 3 val)) +(defun vm-set-pop-stat-x-got (o val) (aset o 4 val)) +(defun vm-set-pop-stat-x-need (o val) (aset o 5 val)) +(defun vm-set-pop-stat-y-box (o val) (aset o 6 val)) +(defun vm-set-pop-stat-y-currmsg (o val) (aset o 7 val)) +(defun vm-set-pop-stat-y-maxmsg (o val) (aset o 8 val)) +(defun vm-set-pop-stat-y-got (o val) (aset o 9 val)) +(defun vm-set-pop-stat-y-need (o val) (aset o 10 val)) + +(defun vm-pop-start-status-timer () + (let ((blob (make-vector 11 nil)) + timer) + (setq timer (add-timeout 5 'vm-pop-report-retrieval-status blob 5)) + (vm-set-pop-stat-timer blob timer) + blob )) + +(defun vm-pop-stop-status-timer (status-blob) + (if (fboundp 'disable-timeout) + (disable-timeout (vm-pop-stat-timer status-blob)) + (cancel-timer (vm-pop-stat-timer status-blob)))) + +(defun vm-pop-report-retrieval-status (o) + (cond ((null (vm-pop-stat-x-got o)) t) + ;; should not be possible, but better safe... + ((not (eq (vm-pop-stat-x-box o) (vm-pop-stat-y-box o))) t) + ((not (eq (vm-pop-stat-x-currmsg o) (vm-pop-stat-y-currmsg o))) t) + (t (message "Retrieving message %d (of %d) from %s, %s..." + (vm-pop-stat-x-currmsg o) + (vm-pop-stat-x-maxmsg o) + (vm-pop-stat-x-box o) + (format "%d%s of %d%s" + (vm-pop-stat-x-got o) + (if (> (vm-pop-stat-x-got o) + (vm-pop-stat-x-need o)) + "!" + "") + (vm-pop-stat-x-need o) + (if (eq (vm-pop-stat-x-got o) + (vm-pop-stat-y-got o)) + " (stalled)" + ""))))) + (vm-set-pop-stat-y-box o (vm-pop-stat-x-box o)) + (vm-set-pop-stat-y-currmsg o (vm-pop-stat-x-currmsg o)) + (vm-set-pop-stat-y-maxmsg o (vm-pop-stat-x-maxmsg o)) + (vm-set-pop-stat-y-got o (vm-pop-stat-x-got o)) + (vm-set-pop-stat-y-need o (vm-pop-stat-x-need o))) + (defun vm-pop-send-command (process command) (goto-char (point-max)) (if (= (aref command 0) ?P) @@ -283,7 +349,7 @@ (defun vm-pop-read-past-dot-sentinel-line (process) (let ((case-fold-search nil)) (goto-char vm-pop-read-point) - (while (not (search-forward "^.\r\n" nil 0)) + (while (not (re-search-forward "^\\.\r\n" nil 0)) (beginning-of-line) ;; save-excursion doesn't work right (let ((opoint (point))) @@ -337,15 +403,26 @@ 'skip)))) (and work-buffer (kill-buffer work-buffer))))) -(defun vm-pop-retrieve-to-crashbox (process crash) +(defun vm-pop-retrieve-to-crashbox (process crash statblob) (let ((start vm-pop-read-point) end) (goto-char start) + (vm-set-pop-stat-x-got statblob 0) (while (not (re-search-forward "^\\.\r\n" nil 0)) (beginning-of-line) ;; save-excursion doesn't work right - (let ((opoint (point))) + (let* ((opoint (point)) + (func + (function + (lambda (beg end len) + (if vm-pop-read-point + (progn + (vm-set-pop-stat-x-got statblob (- end start)) + (if (zerop (% (random) 10)) + (vm-pop-report-retrieval-status statblob))))))) + (after-change-functions (cons func after-change-functions))) (accept-process-output process) (goto-char opoint))) + (vm-set-pop-stat-x-got statblob nil) (setq vm-pop-read-point (point-marker)) (goto-char (match-beginning 0)) (setq end (point-marker)) @@ -389,6 +466,8 @@ t )) (defun vm-pop-cleanup-region (start end) + (if (> (- end start) 30000) + (message "CRLF conversion and char unstuffing...")) (setq end (vm-marker end)) (save-excursion (goto-char start) @@ -400,6 +479,8 @@ (while (and (< (point) end) (re-search-forward "^\\." end t)) (replace-match "" t t) (forward-char))) + (if (> (- end start) 30000) + (message "CRLF conversion and dot unstuffing... done")) (set-marker end nil)) (defun vm-pop-md5 (string)
--- a/lisp/vm/vm-save.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-save.el Mon Aug 13 09:18:39 2007 +0200 @@ -496,12 +496,73 @@ (vm-display nil nil '(vm-pipe-message-to-command) '(vm-pipe-message-to-command))))) -(defun vm-print-message () - "Print the current message." - (interactive) - (vm-pipe-message-to-command - (mapconcat (function identity) - (nconc (list vm-print-command) vm-print-command-switches) - " ") - '(64))) +(defun vm-print-message (count) + "Print the current message +Prefix arg N means print the current message and the next N - 1 messages. +Prefix arg -N means print the current message and the previous N - 1 messages. + +The variables `vm-print-command' controls what command is run to +print the message, and `vm-print-command-switches' is a list of switches +to pass to the command. + +When invoked on marked messages (via vm-next-command-uses-marks), +each marked message is printed, one message per vm-print-command invocation. +Output, if any, is displayed. The message is not altered." + (interactive "p") + (vm-follow-summary-cursor) + (vm-select-folder-buffer) + (vm-check-for-killed-summary) + (vm-error-if-folder-empty) + (let ((buffer (get-buffer-create "*Shell Command Output*")) + (command (mapconcat (function identity) + (nconc (list vm-print-command) + vm-print-command-switches) + " ")) + (m nil) + (pop-up-windows (and pop-up-windows (eq vm-mutable-windows t))) + (mlist (vm-select-marked-or-prefixed-messages count))) + (set-buffer buffer) + (erase-buffer) + (while mlist + (setq m (vm-real-message-of (car mlist))) + (set-buffer (vm-buffer-of m)) + (if (and vm-display-using-mime (vectorp (vm-mm-layout m))) + (let ((work-buffer nil)) + (unwind-protect + (progn + (setq work-buffer (generate-new-buffer "*vm-work*")) + (set-buffer work-buffer) + (vm-insert-region-from-buffer + (vm-buffer-of m) (vm-vheaders-of m) (vm-text-of m)) + (vm-decode-mime-encoded-words) + (goto-char (point-max)) + (let ((vm-auto-displayed-mime-content-types + '("text" "multipart")) + (vm-mime-internal-content-types + '("text" "multipart")) + (vm-mime-external-content-types-alist nil)) + (vm-decode-mime-layout (vm-mm-layout m))) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-windows t)))) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil buffer nil + shell-command-switch command))) + (and work-buffer (kill-buffer work-buffer)))) + (save-restriction + (widen) + (narrow-to-region (vm-vheaders-of m) (vm-text-end-of m)) + (let ((pop-up-windows (and pop-up-windows + (eq vm-mutable-windows t)))) + (call-process-region (point-min) (point-max) + (or shell-file-name "sh") + nil buffer nil + shell-command-switch command)))) + (setq mlist (cdr mlist))) + (set-buffer buffer) + (if (not (zerop (buffer-size))) + (vm-display buffer t '(vm-pipe-message-to-command) + '(vm-pipe-message-to-command)) + (vm-display nil nil '(vm-pipe-message-to-command) + '(vm-pipe-message-to-command)))))
--- a/lisp/vm/vm-startup.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-startup.el Mon Aug 13 09:18:39 2007 +0200 @@ -63,7 +63,7 @@ (inhibit-local-variables t) (enable-local-variables nil) ;; for XEmacs/Mule - (overriding-file-coding-system 'no-conversion)) + (coding-system-for-read 'no-conversion)) (message "Reading %s..." file) (prog1 (find-file-noselect file) ;; update folder history @@ -275,7 +275,7 @@ (defun vm-mode (&optional read-only) "Major mode for reading mail. -This is VM 6.16. +This is VM 6.19. Commands: h - summarize folder contents @@ -338,7 +338,8 @@ x - exit VM with no change to the folder M N - use marks; the next vm command will affect only marked messages - if it makes sense for the command to do so + if it makes sense for the command to do so. These commands + apply and remove marks to messages. M M - mark the current message M U - unmark the current message @@ -373,7 +374,7 @@ V ? - help for virtual folder commands C-_ - undo, special undo that retracts the most recent - changes in message attributes and labels. Expunges + changes in message attributes and labels. Expunges, message edits, and saves cannot be undone. C-x u is also bound to this command.
--- a/lisp/vm/vm-summary.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-summary.el Mon Aug 13 09:18:39 2007 +0200 @@ -201,10 +201,10 @@ ;; what we want. ;; ;; 1. We need to avoid having the su-start-of - ;; and su-end-of market clumping together at + ;; and su-end-of markers clumping together at ;; the start position. ;; - ;; 2. We want the window point market (w->pointm + ;; 2. We want the window point marker (w->pointm ;; in the Emacs display code) to move to the ;; start of the summary entry if it is ;; anywhere within the su-start-of to @@ -735,7 +735,8 @@ (vm-set-year-of m (substring date (match-beginning 5) (match-end 5))) (if (match-beginning 6) (vm-set-zone-of m (substring date (match-beginning 6) - (match-end 6))))) + (match-end 6))) + (vm-set-zone-of m ""))) (t (setq vector (vm-parse-date date)) (vm-set-weekday-of m (elt vector 0))
--- a/lisp/vm/vm-undo.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-undo.el Mon Aug 13 09:18:39 2007 +0200 @@ -360,13 +360,8 @@ (vm-buffer-of (vm-real-message-of m))) vm-folder-read-only)))) - (aset (vm-attributes-of m) attr-index flag) - (vm-mark-for-summary-update m) (cond ((not norecord) - (if (eq vm-flush-interval t) - (vm-stuff-virtual-attributes m) - (vm-set-modflag-of m t)) (setq vmp (cons (vm-real-message-of m) (vm-virtual-messages-of m))) (while vmp (if (eq (vm-attributes-of m) (vm-attributes-of (car vmp))) @@ -383,7 +378,14 @@ (vm-undo-record (list function (car m-list) (not flag))) (vm-undo-boundary) (vm-increment vm-modification-counter)) - (setq m-list (cdr m-list))))))))) + (setq m-list (cdr m-list))))) + (aset (vm-attributes-of m) attr-index flag) + (vm-mark-for-summary-update m) + (if (not norecord) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-attributes m) + (vm-set-modflag-of m t))))))) + (defun vm-set-labels (m labels) (let ((m-list nil) @@ -397,12 +399,6 @@ (vm-buffer-of (vm-real-message-of m))) vm-folder-read-only)))) - (vm-set-labels-of m labels) - (vm-set-label-string-of m nil) - (vm-mark-for-summary-update m) - (if (eq vm-flush-interval t) - (vm-stuff-virtual-attributes m) - (vm-set-modflag-of m t)) (setq vmp (cons (vm-real-message-of m) (vm-virtual-messages-of m))) (while vmp (if (eq (vm-attributes-of m) (vm-attributes-of (car vmp))) @@ -419,7 +415,14 @@ (vm-undo-record (list 'vm-set-labels m old-labels)) (vm-undo-boundary) (vm-increment vm-modification-counter)) - (setq m-list (cdr m-list))))))) + (setq m-list (cdr m-list))) + (vm-set-labels-of m labels) + (vm-set-label-string-of m nil) + (vm-mark-for-summary-update m) + (if (eq vm-flush-interval t) + (vm-stuff-virtual-attributes m) + (vm-set-modflag-of m t)))))) + (defun vm-set-new-flag (m flag &optional norecord) (vm-set-xxxx-flag m flag norecord 'vm-set-new-flag 0))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/vm/vm-user.el Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,54 @@ +;;; Interface functions to VM internal data +;;; Copyright (C) 1997 Kyle E. Jones +;;; +;;; This program 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. +;;; +;;; This program 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 this program; if not, write to the Free Software +;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + +(provide 'vm-user) + +(defun vm-user-composition-folder-buffer () + "Returns the folder buffer associated with the current buffer. +The current buffer must be a composition buffer created by VM for +a reply, resend or forward. + +Nil is returned if the current buffer is not assocaited with any +VM folder. + +Note that the buffer returned might be a virtual folder buffer, +which might have several underlying real folders associated with +it. To get the list of real folder buffers associated with a +composition buffer, use vm-user-composition-real-folder-buffers +instead." + (if (eq major-mode 'mail-mode) + vm-mail-buffer + nil )) + +(defun vm-user-composition-real-folder-buffers () + "Returns a list of the real folder buffers associated with the current +buffer. The current buffer must be a composition buffer created +by VM for a reply, resend or forward." + (if (eq major-mode 'mail-mode) + (let ((list nil) (newlist nil)) + (cond ((eq vm-system-state 'replying) + (setq list vm-reply-list)) + ((eq vm-system-state 'forwarding) + (setq list vm-forward-list)) + ((eq vm-system-state 'redistributing) + (setq list vm-redistribute-list))) + (while list + (setq newlist (cons (vm-buffer-of (vm-real-message-of (car list))) + newlist) + list (cdr list))) + newlist ) + nil ))
--- a/lisp/vm/vm-vars.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-vars.el Mon Aug 13 09:18:39 2007 +0200 @@ -615,7 +615,7 @@ "*Symbol specifying what kind of transfer encoding to use on 8bit text. Characters with the high bit set cannot safely pass through all mail gateways and mail transport software. MIME has -two transfer encodings that convert 8-bit data to 7-bit for same +two transfer encodings that convert 8-bit data to 7-bit for safe transport. Quoted-printable leaves the text mostly readable even if the recipient does not have a MIME-capable mail reader. BASE64 is unreadable without a MIME-capable mail reader, unless your name @@ -625,12 +625,27 @@ A value of 'base64 means to use BASE64 encoding. A value of '8bit means to send the message as is. -Note that this only applies to textual MIME content types. Images, audio, -video, etc. will always use BASE64 encoding. - -Note that lines of 1000 characters or longer will automatically -trigger BASE64 encoding. Carriage returns (ascii code 13) in the -text will also trigger BASE64 encoding.") +Note that this variable usually only applies to textual MIME +content types. Images, audio, video, etc. typically will have +some attribute that makes VM consider them to be \"binary\", +which moves them outside the scope of this variable. For +example, messages with line lengths of 1000 characters or more +are considered binary, as are messages that contain carriage +returns (ascii code 13) or NULs (ascii code 0).") + +(defvar vm-mime-composition-armor-from-lines nil + "*Non-nil value means \"From \" lines should be armored before sending. +A line beginning with \"From \" is considered a message separator +by many mail delivery agents. These agents will often insert a > +before the word \"From\" to prevent mail readers from being +confused. This is proper behavior, but it breaks digitally signed +messages, which require bit-perfect transport in order for the +message contents to be considered genuine. + +If vm-mime-composition-armor-from-lines is non-nil, a line +beginning with \"From \" will cause VM to encode the message +using either quoted-printable or BASE64 encoding so that the From +line can be protected.") (defvar vm-mime-attachment-auto-type-alist '( @@ -3009,6 +3024,7 @@ ("application/postscript") ("application/octet-stream") ("message/rfc822") + ("message/news") )) (defconst vm-mime-encoded-word-regexp "=\\?\\([^?]+\\)\\?\\([BQ]\\)\\?\\([^?]+\\)\\?=")
--- a/lisp/vm/vm-version.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-version.el Mon Aug 13 09:18:39 2007 +0200 @@ -2,7 +2,7 @@ (provide 'vm-version) -(defconst vm-version "6.16" +(defconst vm-version "6.19" "Version number of VM.") (defun vm-version ()
--- a/lisp/vm/vm-window.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/vm/vm-window.el Mon Aug 13 09:18:39 2007 +0200 @@ -83,7 +83,8 @@ ((and buffer (not display)) (if (and vm-undisplay-buffer-hook (vm-get-visible-buffer-window buffer)) - (progn (run-hooks 'vm-undisplay-buffer-hook) + (progn (set-buffer buffer) + (run-hooks 'vm-undisplay-buffer-hook) (vm-record-current-window-configuration nil)) (if (not (and (memq this-command commands) (apply 'vm-set-window-configuration configs)))
--- a/lisp/vm/vm.el Mon Aug 13 09:17:27 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,4 +0,0 @@ -(require 'vm-startup) -(require 'vm-vars) -(require 'vm-version) -(require 'vm-autoload)
--- a/lisp/w3/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,160 @@ +Fri Mar 7 06:13:20 1997 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-document-information): Better handling of last-modified + findings. + +* w3-forms.el (w3-form-create-image): Try to use the value of an + image-input area as the label for the widget we create. + +* w3-elisp.el (w3-elisp-safe-eval): Throw a condition-case() around the + eval to catch bad forms, etc. + +* w3-script.el (w3-script-evaluate-form): Don't signal an error on unknown + scripting languages, just show a warning. + +Thu Mar 6 08:24:49 1997 William M. Perry <wmperry@aventail.com> + +* w3.el (w3-complete-link): Protect against malformed widgets (null :from + or :to). Is this from delayed image widgets? + +* w3-vars.el (w3-mode-map): Changed binding of M-s to w3-save-as instead + of w3-search - does anybody use that instead of the forms interface? + +* w3.el (w3-document-information): Show document size + +* css.el (css-parse): Removed warning about old-style stuff for + device-dependent styles - was too annoying. Need to just remove this + support totally for the 3.0 release. + +* w3.el (w3-internal-handle-preview): When previewing a buffer, remove all + text properties from the document source before doing anything. + (w3-mail-current-document): Bind case-fold-search when looking for where + to insert the <base> tag. + (w3-loaded-stylesheets): New variable to keep track of what stylesheets + were loaded at startup. + +* url-cache.el (url-cache-create-filename-human-readable): New function to + create cached filenames using the old method, that was slightly more + human readable. + +Wed Mar 5 15:38:00 1997 William M. Perry <wmperry@aventail.com> + +* Emacs-W3 3.0.64 released + +* w3-parse.el: OH god, finally got raw text inside a <tr> to push a <td> + onto the parse tree. got raw text inside a <table> to push a <tr> + onto the parse tee. + +* w3-widget.el: Support 'target' in img widgets + +Tue Mar 4 07:55:56 1997 William M. Perry <wmperry@aventail.com> + +* w3-display.el (w3-display-node): Support 'seqnum' attribute + +* w3.el (w3-mail-document-author): Fixed for new 'link' representation + (w3-document-information): If a document has a 'Last modified: blah' line, + use it as the last modified information as a last resort. + +* Synch'ed up with widget 1.50 + +* w3-forms.el: Try to play nice with old and new versions of + widget-edit/wid-edit.el + +Tue Mar 4 06:23:41 1997 Michael Ernst <mernst@cs.washington.edu> + +* url.el (url-get-url-at-point): If a possible URL starts with www., slap + on 'http://', as someone probably just forgot it. + +Tue Mar 4 06:23:41 1997 William M. Perry <wmperry@aventail.com> + +* w3-prefs.el (w3-preferences-hooks-variables): Removed some old variables. + (w3-preferences-edit): The preferences panel actually works again. No + longer tries to use an imagemap - a dropdown is good enough dammit. + +* w3-vars.el: Removed some old variables + +* w3-display.el (w3-display-node): For <a> tags, do not embed a widget in + the buffer unless it actually has an 'href' attribute. This helps a + _lot_ with <a name="blah">...</a> constructs. + +Tue Mar 4 06:18:06 1997 Toby Speight <tms@ansa.co.uk> + +* w3.el (w3-mail-current-document): Allow TM (if it's in use) to choose + the appropriate Transfer-Encoding of a mailed document. + (w3-mail-current-document): Try real hard to put <base> where it belongs + (in the <head>, if that is not found, then just after <html>, otherwise + just at the beginning of the document) + +Mon Mar 3 07:10:11 1997 William M. Perry <wmperry@aventail.com> + +* Emacs-W3 3.0.63 released + +* w3-forms.el (w3-form-field-label): Labels are now reimplemented for form + fields + +* w3-display.el (w3-parse-link): Now honors the old variable + w3-honor-stylesheets, which hadn't made it back onto the reimplemented + features list yet. + +* font.el: Added quite a few autoloads. Package no longer overwrites the + set-face-* functions, as this was deemed evil in the extreme. + +* w3-display.el (w3-face-for-element): Use the font-set-face-* functions + instead of the raw set-face-* functions. + +* w3-widget.el (widget-image-inaudible-p): New variable that controls + whether image widgets are rendered inaudible by emacspeak or not. + (widget-image-value-set): Use it. + +* url-cache.el (url-cache-directory): New variable that controls where you + cache files will be stored. Defaults to "~/.w3/cache" + (url-cache-creation-function): New variable that controls what function + will be used to create cached filenames. + (url-cache-create-filename-using-md5): This is now the default (and + only) cache-file-creation function. Suitably fast under Emacs 19 (lisp + implementation), _very_ fast under XEmacs, where it is written in C. + +Thu Feb 27 07:27:43 1997 William M. Perry <wmperry@aventail.com> + +* w3-sysdp.el: Added alias of make-symbolic-link to copy-file for NTEmacs + +* w3-elisp.el: Removed face functions from the safe list. + +Wed Feb 26 16:08:08 1997 Per Abrahamsen <abraham@dina.kvl.dk> + +* font.el (font-create-object): Added autoload. + +Wed Feb 26 08:17:37 1997 William M. Perry <wmperry@aventail.com> + +* w3-display.el (w3-region): Fixed typo when binding + w3-display-same-buffer - no wonder it wasn't working right. + +* images.el (image-normalize): Bind file-coding-system to the appropriate + no-conversion so that running subprocesses doesn't munge the data when + running under MULE. + (image-normalize): Now uses call-process-region instead of + shell-command-on-region, and removed the explicit mention of '/bin/sh' + and friends. Uses the ability of call-process-region to specify a + separate file to use for stderr - yipeee. + +* url.el (url-setup-privacy-info): Slight change as to how url-system-type + and url-os-type are set up. No longer uses nested parens, as this seems + to confuse some sites that try to use the User-Agent header as a + state-tracker. + +Mon Feb 24 10:15:45 1997 William M. Perry <wmperry@aventail.com> + +* w3-display.el (w3-widget-echo): Make sure that nothing that will be + echoed is the empty string. + +Sun Feb 23 08:34:18 1997 William M. Perry <wmperry@aventail.com> + +* url-cache.el (url-store-in-cache): fixed stupid bug in caching logic + +Sat Feb 22 07:21:29 1997 William M. Perry <wmperry@aventail.com> + +* Emacs-W3 3.0.62 released + Thu Feb 20 13:40:22 1997 William M. Perry <wmperry@aventail.com> * w3-forms.el (w3-form-summarize-password): By default, don't summarize
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/w3/FAQ Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,13 @@ +Q: Options menu is ugly under Emacs 19 +A: Wait for 19.35 - this is because of a 'feature lack' in easymenu.el + +Q: I get an error when starting up: + Symbol's value as variable is void: widget-mouse-face +A: This usually means you compiled W3 in an emacs that could not find + the 'custom' package (or found an old version), but are running W3 + in an emacs that find the new one. This is usually the case if you + have a recent version of GNUS installed in a non-standard place. + + Make sure that you can load the custom library when compiling + emacs. Set the environment variable WIDGETDIR to where your custom + library lives (ie: ~/lisp/gnus/lisp)
--- a/lisp/w3/css.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/css.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; css.el -- Cascading Style Sheet parser ;; Author: wmperry -;; Created: 1997/02/20 00:47:21 -;; Version: 1.28 +;; Created: 1997/03/07 01:12:31 +;; Version: 1.29 ;; Keywords: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -862,10 +862,8 @@ (import (css-handle-import data)) (media (css-handle-media-directive data active-device-types)) (t (message "Unknown directive in stylesheet: @%s" directive))))) - ;; Giving us some output device information + ;; Giving us some output device information, old way ((looking-at "[ \t\r]*:\\([^: \n]+\\):") - (message "You are using the old way of specifying device-dependent stylesheets! Please upgrade!") - (sleep-for 2) (downcase-region (match-beginning 1) (match-end 1)) (setq device-type (intern (buffer-substring (match-beginning 1) (match-end 1))))
--- a/lisp/w3/docomp.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/docomp.el Mon Aug 13 09:18:39 2007 +0200 @@ -7,41 +7,6 @@ (setq max-specpdl-size (* 10 max-specpdl-size) max-lisp-eval-depth (* 10 max-lisp-eval-depth)) -(defun hack-dot-emacs () - (interactive) - (let* ((args command-line-args-left) - (fname (expand-file-name (nth 0 args))) - (lispdir (nth 1 args))) - (setq command-line-args-left (cdr (cdr (cdr command-line-args-left)))) - (set-buffer (get-buffer-create " *x*")) - (erase-buffer) - (if (file-exists-p fname) - (insert-file-contents fname)) - (goto-char (point-min)) - (if (search-forward ";;; Emacs-w3 configuration options" nil t) - (message "No changes made.") - (goto-char (point-max)) - (insert "\n;;; Emacs-w3 configuration options\n") - (insert "(setq load-path (cons (expand-file-name \"" - lispdir "\") load-path))\n") - (insert "(autoload 'w3-preview-this-buffer \"w3\" \"WWW Previewer\" t)\n") - (insert "(autoload 'w3-follow-url-at-point \"w3\" \"Find document at pt\" t)\n") - (insert "(autoload 'w3 \"w3\" \"WWW Browser\" t)\n") - (insert "(autoload 'w3-open-local \"w3\" \"Open local file for WWW browsing\" t)\n") - (insert "(autoload 'w3-fetch \"w3\" \"Open remote file for WWW browsing\" t)\n") - (insert "(autoload 'w3-use-hotlist \"w3\" \"Use shortcuts to view WWW docs\" t)\n") - (insert "(autoload 'w3-show-hotlist \"w3\" \"Use shortcuts to view WWW docs\" t)\n") - (insert "(autoload 'w3-follow-link \"w3\" \"Follow a hypertext link.\" t)\n") - (insert "(autoload 'w3-batch-fetch \"w3\" \"Batch retrieval of URLs\" t)\n") - (insert "(autoload 'url-get-url-at-point \"url\" \"Find the url under the cursor\" nil)\n") - (insert "(autoload 'url-file-attributes \"url\" \"File attributes of a URL\" nil)\n") - (insert "(autoload 'url-popup-info \"url\" \"Get info on a URL\" t)\n") - (insert "(autoload 'url-retrieve \"url\" \"Retrieve a URL\" nil)\n") - (insert "(autoload 'url-buffer-visiting \"url\" \"Find buffer visiting a URL.\" nil)\n") - (insert "(autoload 'gopher-dispatch-object \"gopher\" \"Fetch gopher dir\" t)\n") - (insert ";;; End of Emacs-w3 configuration options\n") - (write-file fname)))) - (defun w3-declare-variables (&rest args) (while args (eval (list 'defvar (car args) nil "")) @@ -69,6 +34,9 @@ 'charset-latin-iso8859-1 'file-coding-system-for-read 'file-coding-system) +;; For TM +(w3-declare-variables 'mime/editor-mode-flag 'mime-tag-format) + ;; For NNTP (w3-declare-variables 'nntp-server-buffer 'nntp-server-process 'nntp/connection 'gnus-nntp-server 'nntp-server-name 'nntp-version
--- a/lisp/w3/font.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/font.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; font.el --- New font model ;; Author: wmperry -;; Created: 1997/02/08 00:56:14 -;; Version: 1.33 +;; Created: 1997/03/03 15:15:42 +;; Version: 1.34 ;; Keywords: faces ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -376,6 +376,7 @@ (func (car (cdr-safe (assq type font-window-system-mappings))))) (and func (fboundp func) (funcall func fontobj device)))) +;;;###autoload (defun font-create-object (fontname &optional device) (let* ((type (device-type device)) (func (car (cdr (cdr-safe (assq type font-window-system-mappings)))))) @@ -536,6 +537,7 @@ (defvar font-default-cache nil) +;;;###autoload (defun font-default-font-for-device (&optional device) (or device (setq device (selected-device))) (if font-running-xemacs @@ -547,6 +549,7 @@ (aref (get-font-info (aref (cdr (get-fontset-info font)) 0)) 2) font)))) +;;;###autoload (defun font-default-object-for-device (&optional device) (let ((font (font-default-font-for-device device))) (or (cdr-safe @@ -557,10 +560,12 @@ font-default-cache)) (cdr-safe (assoc font font-default-cache)))))) +;;;###autoload (defun font-default-family-for-device (&optional device) (or device (setq device (selected-device))) (font-family (font-default-object-for-device device))) +;;;###autoload (defun font-default-size-for-device (&optional device) (or device (setq device (selected-device))) ;; face-height isn't the right thing (always 1 pixel too high?) @@ -696,6 +701,7 @@ ;;; Cache building code +;;;###autoload (defun x-font-build-cache (&optional device) (let ((hashtable (make-hash-table :test 'equal :size 15)) (fonts (mapcar 'x-font-create-object @@ -726,47 +732,46 @@ ;;; Now overwrite the original copy of set-face-font with our own copy that ;;; can deal with either syntax. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ###autoload (defun font-set-face-font (&optional face font &rest args) - (if (interactive-p) - (call-interactively 'font-original-set-face-font) - (cond - ((and (vectorp font) (= (length font) 12)) - (let ((font-name (font-create-name font))) - (set-face-property face 'font-specification font) - (cond - ((null font-name) ; No matching font! - nil) - ((listp font-name) ; For TTYs - (let (cur) - (while font-name - (setq cur (car font-name) - font-name (cdr font-name)) - (apply 'set-face-property face (car cur) (cdr cur) args)))) - (font-running-xemacs - (apply 'font-original-set-face-font face font-name args) - (apply 'set-face-underline-p face (font-underline-p font) args) - (if (and (or (font-smallcaps-p font) (font-bigcaps-p font)) - (fboundp 'set-face-display-table)) - (apply 'set-face-display-table - face font-caps-display-table args)) - (apply 'set-face-property face 'strikethru (or - (font-linethrough-p font) - (font-strikethru-p font)) - args)) - (t - (condition-case nil - (apply 'font-original-set-face-font face font-name args) - (error - (let ((args (car-safe args))) - (and (or (font-bold-p font) - (memq (font-weight font) '(:bold :demi-bold))) - (make-face-bold face args t)) - (and (font-italic-p font) (make-face-italic face args t))))) - (apply 'set-face-underline-p face (font-underline-p font) args))))) - (t - ;; Let the original set-face-font signal any errors - (set-face-property face 'font-specification nil) - (apply 'font-original-set-face-font face font args))))) + (cond + ((and (vectorp font) (= (length font) 12)) + (let ((font-name (font-create-name font))) + (set-face-property face 'font-specification font) + (cond + ((null font-name) ; No matching font! + nil) + ((listp font-name) ; For TTYs + (let (cur) + (while font-name + (setq cur (car font-name) + font-name (cdr font-name)) + (apply 'set-face-property face (car cur) (cdr cur) args)))) + (font-running-xemacs + (apply 'set-face-font face font-name args) + (apply 'set-face-underline-p face (font-underline-p font) args) + (if (and (or (font-smallcaps-p font) (font-bigcaps-p font)) + (fboundp 'set-face-display-table)) + (apply 'set-face-display-table + face font-caps-display-table args)) + (apply 'set-face-property face 'strikethru (or + (font-linethrough-p font) + (font-strikethru-p font)) + args)) + (t + (condition-case nil + (apply 'set-face-font face font-name args) + (error + (let ((args (car-safe args))) + (and (or (font-bold-p font) + (memq (font-weight font) '(:bold :demi-bold))) + (make-face-bold face args t)) + (and (font-italic-p font) (make-face-italic face args t))))) + (apply 'set-face-underline-p face (font-underline-p font) args))))) + (t + ;; Let the original set-face-font signal any errors + (set-face-property face 'font-specification nil) + (apply 'set-face-font face font args)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1079,42 +1084,23 @@ (defun font-set-face-background (&optional face color &rest args) (interactive) - (if (interactive-p) - (call-interactively 'font-original-set-face-background) - (cond - ((font-rgb-color-p color) - (apply 'font-original-set-face-background face - (font-normalize-color color) args)) - (t - (apply 'font-original-set-face-background face color args))))) + (condition-case nil + (cond + ((font-rgb-color-p color) + (apply 'set-face-background face + (font-normalize-color color) args)) + (t + (apply 'set-face-background face color args))) + (error nil))) (defun font-set-face-foreground (&optional face color &rest args) (interactive) - (if (interactive-p) - (call-interactively 'font-original-set-face-foreground) - (cond - ((font-rgb-color-p color) - (apply 'font-original-set-face-foreground face - (font-normalize-color color) args)) - (t - (apply 'font-original-set-face-foreground face color args))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Do the actual overwriting of some functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defmacro font-overwrite-fn (func) - (` (let ((our-func (intern (format "font-%s" (, func)))) - (new-func (intern (format "font-original-%s" (, func)))) - (old-func (and (fboundp (, func)) (symbol-function (, func))))) - (if (not (fboundp new-func)) - (progn - (if old-func - (fset new-func old-func) - (fset new-func 'ignore)) - (fset (, func) our-func)))))) - -(font-overwrite-fn 'set-face-foreground) -(font-overwrite-fn 'set-face-background) -(font-overwrite-fn 'set-face-font) + (condition-case nil + (cond + ((font-rgb-color-p color) + (apply 'set-face-foreground face (font-normalize-color color) args)) + (t + (apply 'set-face-foreground face color args))) + (error nil))) (provide 'font)
--- a/lisp/w3/images.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/images.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; images.el --- Automatic image converters ;; Author: wmperry -;; Created: 1997/02/13 15:01:57 -;; Version: 1.8 +;; Created: 1997/02/26 16:21:01 +;; Version: 1.9 ;; Keywords: images ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -149,12 +149,13 @@ (while chain (cond ((stringp (car chain)) - (shell-command-on-region (point-min) (point-max) - (concat - "/bin/sh -c '" - (car chain) - " 2> /dev/null" - "'") t)) + (let ((file-coding-system mule-no-coding-system)) + (call-process-region + (point-min) (point-max) + shell-file-name t + (list (current-buffer) nil) + shell-command-switch + (car chain)))) ((and (symbolp (car chain)) (fboundp (car chain))) (funcall (car chain) (point-min) (point-max)))) (setq chain (cdr chain)))
--- a/lisp/w3/url-cache.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/url-cache.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/02/20 15:33:47 -;; Version: 1.3 +;; Created: 1997/03/06 16:25:51 +;; Version: 1.7 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -27,6 +27,9 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (require 'md5) +(defvar url-cache-directory "~/.w3/cache/" + "*The directory where cache files should be stored.") + ;; Cache manager (defun url-cache-file-writable-p (file) "Follows the documentation of file-writable-p, unlike file-writable-p." @@ -35,7 +38,7 @@ (not (file-directory-p file)) (file-directory-p (file-name-directory file))))) -(defun url-prepare-cache-for-file (file) +(defun url-cache-prepare (file) "Makes it possible to cache data in FILE. Creates any necessary parent directories, deleting any non-directory files that would stop this. Returns nil if parent directories can not be @@ -44,74 +47,13 @@ version of FILE. Returns nil if this can not be done. Returns nil if FILE already exists as a directory. Otherwise, returns t, indicating that FILE can be created or overwritten." - - ;; COMMENT: We don't delete directories because that requires - ;; recursively deleting the directories's contents, which might - ;; eliminate a substantial portion of the cache. - (cond ((url-cache-file-writable-p file) t) ((file-directory-p file) nil) (t - (catch 'upcff-tag - (let ((dir (file-name-directory file)) - dir-parent dir-last-component) - (if (string-equal dir file) - ;; *** Should I have a warning here? - ;; FILE must match a pattern like /foo/bar/, indicating it is a - ;; name only suitable for a directory. So presume we won't be - ;; able to overwrite FILE and return nil. - (throw 'upcff-tag nil)) - - ;; Make sure the containing directory exists, or throw a failure - ;; if we can't create it. - (if (file-directory-p dir) - nil - (or (fboundp 'make-directory) - (throw 'upcff-tag nil)) - (make-directory dir t) - ;; make-directory silently fails if there is an obstacle, so - ;; we must verify its results. - (if (file-directory-p dir) - nil - ;; Look at prefixes of the path to find the obstacle that is - ;; stopping us from making the directory. Unfortunately, there - ;; is no portable function in Emacs to find the parent directory - ;; of a *directory*. So this code may not work on VMS. - (while (progn - (if (eq ?/ (aref dir (1- (length dir)))) - (setq dir (substring dir 0 -1)) - ;; Maybe we're on VMS where the syntax is different. - (throw 'upcff-tag nil)) - (setq dir-parent (file-name-directory dir)) - (not (file-directory-p dir-parent))) - (setq dir dir-parent)) - ;; We have found the longest path prefix that exists as a - ;; directory. Deal with any obstacles in this directory. - (if (file-exists-p dir) - (condition-case nil - (delete-file dir) - (error (throw 'upcff-tag nil)))) - (if (file-exists-p dir) - (throw 'upcff-tag nil)) - ;; Try making the directory again. - (setq dir (file-name-directory file)) - (make-directory dir t) - (or (file-directory-p dir) - (throw 'upcff-tag nil)))) - - ;; The containing directory exists. Let's see if there is - ;; something in the way in this directory. - (if (url-cache-file-writable-p file) - (throw 'upcff-tag t) - (condition-case nil - (delete-file file) - (error (throw 'upcff-tag nil)))) - - ;; The return value, if we get this far. - (url-cache-file-writable-p file)))))) + (make-directory (file-name-directory file) t)))) (defvar url-cache-ignored-protocols '("www" "about" "https" "mailto") @@ -131,23 +73,26 @@ ((member (url-type obj) '("http" "https")) (let* ((status (cdr-safe (assoc "status" url-current-mime-headers))) (class (if status (/ status 100) 0))) - (case class - (2 ; Various 'OK' statuses - (memq status '(200))) - (otherwise nil)))) + (cond + ((string-match (eval-when-compile (regexp-quote "?")) + (url-filename obj)) + nil) + ((= class 2) + (memq status '(200))) + (t nil)))) (t nil))) ;;;###autoload (defun url-store-in-cache (&optional buff) "Store buffer BUFF in the cache" - (if (and buff (get-buffer buff)) + (if (not (and buff (get-buffer buff))) nil (save-excursion (and buff (set-buffer buff)) (if (not (url-cache-cachable-p url-current-object)) nil - (let* ((fname (url-create-cached-filename (url-view-url t))) + (let* ((fname (url-cache-create-filename (url-view-url t))) (fname-hdr (concat fname ".hdr")) (info (mapcar (function (lambda (var) (cons (symbol-name var) @@ -159,8 +104,8 @@ url-current-mime-headers url-current-mime-type )))) - (cond ((and (url-prepare-cache-for-file fname) - (url-prepare-cache-for-file fname-hdr)) + (cond ((and (url-cache-prepare fname) + (url-cache-prepare fname-hdr)) (write-region (point-min) (point-max) fname nil 5) (set-buffer (get-buffer-create " *cache-tmp*")) (erase-buffer) @@ -183,37 +128,27 @@ ;;;###autoload (defun url-is-cached (url) "Return non-nil if the URL is cached." - (let* ((fname (url-create-cached-filename url)) + (let* ((fname (url-cache-create-filename url)) (attribs (file-attributes fname))) (and fname ; got a filename (file-exists-p fname) ; file exists (not (eq (nth 0 attribs) t)) ; Its not a directory (nth 5 attribs)))) ; Can get last mod-time - -(defun url-create-cached-filename-using-md5 (url) - (if url - (expand-file-name (md5 url) - (concat url-temporary-directory "/" - (user-real-login-name))))) -;;;###autoload -(defun url-create-cached-filename (url) +(defun url-cache-create-filename-human-readable (url) "Return a filename in the local cache for URL" (if url (let* ((url url) - (urlobj (if (vectorp url) - url - (url-generic-parse-url url))) + (urlobj (url-generic-parse-url url)) (protocol (url-type urlobj)) (hostname (url-host urlobj)) (host-components (cons (user-real-login-name) (cons (or protocol "file") - (nreverse - (delq nil - (mm-string-to-tokens - (or hostname "localhost") ?.)))))) + (split-string (or hostname "localhost") + (eval-when-compile + (regexp-quote ".")))))) (fname (url-filename urlobj))) (if (and fname (/= (length fname) 0) (= (aref fname 0) ?/)) (setq fname (substring fname 1 nil))) @@ -234,11 +169,6 @@ (setq slash nil) (char-to-string x))))) fname "")))) - (if (and fname (memq system-type '(ms-windows ms-dos windows-nt)) - (string-match "\\([A-Za-z]\\):[/\\]" fname)) - (setq fname (concat (url-match fname 1) "/" - (substring fname (match-end 0))))) - (setq fname (and fname (mapconcat (function (lambda (x) @@ -256,33 +186,44 @@ (if (string= (substring fname -1 nil) "/") (concat fname url-directory-index-file) fname)))) - - ;; Honor hideous 8.3 filename limitations on dos and windows - ;; we don't have to worry about this in Windows NT/95 (or OS/2?) - (if (and fname (memq system-type '(ms-windows ms-dos))) - (let ((base (url-file-extension fname t)) - (ext (url-file-extension fname nil))) - (setq fname (concat (substring base 0 (min 8 (length base))) - (substring ext 0 (min 4 (length ext))))) - (setq host-components - (mapcar - (function - (lambda (x) - (if (> (length x) 8) - (concat - (substring x 0 8) "." - (substring x 8 (min (length x) 11))) - x))) - host-components)))) - (and fname (expand-file-name fname (expand-file-name (mapconcat 'identity host-components "/") - url-temporary-directory)))))) + url-cache-directory)))))) + +(defun url-cache-create-filename-using-md5 (url) + "Create a cached filename using MD5. + Very fast if you are in XEmacs, suitably fast otherwise." + (if url + (let* ((checksum (md5 url)) + (urlobj (url-generic-parse-url url)) + (protocol (url-type urlobj)) + (hostname (url-host urlobj)) + (host-components + (cons + (user-real-login-name) + (cons (or protocol "file") + (nreverse + (delq nil + (split-string (or hostname "localhost") + (eval-when-compile + (regexp-quote ".")))))))) + (fname (url-filename urlobj))) + (and fname + (expand-file-name checksum + (expand-file-name + (mapconcat 'identity host-components "/") + url-cache-directory)))))) + +(defvar url-cache-creation-function 'url-cache-create-filename-using-md5 + "*What function to use to create a cached filename.") + +(defun url-cache-create-filename (url) + (funcall url-cache-creation-function url)) ;;;###autoload -(defun url-extract-from-cache (fnam) +(defun url-cache-extract (fnam) "Extract FNAM from the local disk cache" (set-buffer (get-buffer-create url-working-buffer)) (erase-buffer) @@ -301,10 +242,10 @@ (type (url-type urlobj))) (cond (url-standalone-mode - (not (file-exists-p (url-create-cached-filename urlobj)))) + (not (file-exists-p (url-cache-create-filename urlobj)))) ((string= type "http") (if (not url-standalone-mode) t - (not (file-exists-p (url-create-cached-filename urlobj))))) + (not (file-exists-p (url-cache-create-filename urlobj))))) ((not (fboundp 'current-time)) t) ((member type '("file" "ftp"))
--- a/lisp/w3/url-http.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/url-http.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-http.el --- HTTP Uniform Resource Locator retrieval code ;; Author: wmperry -;; Created: 1997/02/19 00:50:08 -;; Version: 1.15 +;; Created: 1997/03/03 15:13:11 +;; Version: 1.16 ;; Keywords: comm, data, processes ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -399,7 +399,7 @@ "Please notify the server maintainer."))))) ((= status 304) ; Cached document is newer (message "Extracting from cache...") - (url-extract-from-cache (url-create-cached-filename (url-view-url t)))) + (url-cache-extract (url-cache-create-filename (url-view-url t)))) ((= status 305) ; Use proxy in Location: header nil))) ((= class 4) ; Client error
--- a/lisp/w3/url-vars.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/url-vars.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool ;; Author: wmperry -;; Created: 1997/02/18 23:35:21 -;; Version: 1.28 +;; Created: 1997/03/07 16:46:48 +;; Version: 1.31 ;; Keywords: comm, data, processes, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -26,7 +26,7 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst url-version (let ((x "Exp")) +(defconst url-version (let ((x "p3.0.65")) (if (string-match "State: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x))
--- a/lisp/w3/url.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/url.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,13 +1,13 @@ ;;; url.el --- Uniform Resource Locator retrieval tool ;; Author: wmperry -;; Created: 1997/02/20 15:34:07 -;; Version: 1.57 +;; Created: 1997/03/05 23:37:22 +;; Version: 1.61 ;; Keywords: comm, data, processes, hypermedia ;;; LCD Archive Entry: ;;; url|William M. Perry|wmperry@cs.indiana.edu| ;;; Functions for retrieving/manipulating URLs| -;;; 1997/02/20 15:34:07|1.57|Location Undetermined +;;; 1997/03/05 23:37:22|1.61|Location Undetermined ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -119,8 +119,8 @@ (autoload 'url-is-cached "url-cache") (autoload 'url-store-in-cache "url-cache") (autoload 'url-is-cached "url-cache") -(autoload 'url-create-cached-filename "url-cache") -(autoload 'url-extract-from-cache "url-cache") +(autoload 'url-cache-create-filename "url-cache") +(autoload 'url-cache-extract "url-cache") (autoload 'url-cache-expired "url-cache") (require 'md5) @@ -796,20 +796,21 @@ (and (listp url-privacy-level) (memq 'os url-privacy-level))) nil) + ;; First, we handle the inseparable OS/Windowing system + ;; combinations ((eq system-type 'Apple-Macintosh) "Macintosh") ((eq system-type 'next-mach) "NeXT") ((eq system-type 'windows-nt) "Windows-NT; 32bit") ((eq system-type 'ms-windows) "Windows; 16bit") ((eq system-type 'ms-dos) "MS-DOS; 32bit") - ((and (eq system-type 'vax-vms) (device-type)) - "VMS; X11") - ((eq system-type 'vax-vms) "VMS; TTY") - ((eq (device-type) 'x) "X11") - ((eq (device-type) 'ns) "NeXTStep") - ((eq (device-type) 'pm) "OS/2") ((eq (device-type) 'win32) "Windows; 32bit") - ((eq (device-type) 'tty) "(Unix?); TTY") - (t "UnkownPlatform"))) + ((eq (device-type) 'pm) "OS/2; 32bit") + (t + (case (device-type) + (x "X11") + (ns "OpenStep") + (tty "TTY") + (otherwise nil))))) (setq url-personal-mail-address (or url-personal-mail-address user-mail-address @@ -821,14 +822,17 @@ (memq 'email url-privacy-level))) (setq url-personal-mail-address nil)) - (if (or (eq url-privacy-level 'paranoid) - (and (listp url-privacy-level) - (memq 'os url-privacy-level))) - (setq url-os-type nil) - (let ((vers (emacs-version))) - (if (string-match "(\\([^, )]+\\))$" vers) - (setq url-os-type (url-match vers 1)) - (setq url-os-type (symbol-name system-type)))))) + (setq url-os-type + (cond + ((or (eq url-privacy-level 'paranoid) + (and (listp url-privacy-level) + (memq 'os url-privacy-level))) + nil) + ((boundp 'system-configuration) + system-configuration) + ((boundp 'system-type) + (symbol-name system-type)) + (t nil)))) (defun url-handle-no-scheme (url) (let ((temp url-registered-protocols) @@ -1047,6 +1051,8 @@ (setq url (substring url 4 nil))) (if (string-match "\\.$" url) (setq url (substring url 0 -1))) + (if (string-match "^www\\." url) + (setq url (concat "http://" url))) (if (not (string-match url-nonrelative-link url)) (setq url nil)) url))) @@ -1345,8 +1351,7 @@ url-current-callback-data)) (t (funcall url-current-callback-func)))))) - ((fboundp 'w3-sentinel) - (set-variable 'w3-working-buffer buf) + ((and (fboundp 'w3-sentinel) (get-buffer buf)) (w3-sentinel)) (t (message "Retrieval for %s complete." buf)))) @@ -1372,10 +1377,10 @@ (setq url-current-mime-type (mm-extension-to-mime (url-file-extension (url-filename - url-current-object))))) - (if (member status '(401 301 302 303 204)) - nil - (funcall url-default-retrieval-proc (buffer-name url-working-buffer))))))))) + url-current-object)))))))) + (if (member status '(401 301 302 303 204)) + nil + (funcall url-default-retrieval-proc (buffer-name url-working-buffer)))))) (defun url-remove-relative-links (name) ;; Strip . and .. from pathnames @@ -1921,11 +1926,11 @@ (setq cached (url-is-cached url) cached (and cached (not (url-cache-expired url cached))) handler (if cached - 'url-extract-from-cache + 'url-cache-extract (car-safe (cdr-safe (assoc (or type "auto") url-registered-protocols)))) - url (if cached (url-create-cached-filename url) url)) + url (if cached (url-cache-create-filename url) url)) (save-excursion (set-buffer (get-buffer-create url-working-buffer)) (setq url-current-can-be-cached (not no-cache) @@ -1946,7 +1951,7 @@ (cond ((and url-be-asynchronous (not cached) (member type '("http" "proxy"))) nil) - (url-be-asynchronous + ((and url-be-asynchronous (get-buffer url-working-buffer)) (funcall url-default-retrieval-proc (buffer-name))) ((not (get-buffer url-working-buffer)) nil) ((and (not url-inhibit-mime-parsing)
--- a/lisp/w3/w3-auto.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-auto.el Mon Aug 13 09:18:39 2007 +0200 @@ -37,13 +37,13 @@ (autoload 'w3-next-widget "w3-forms") ;; Widget stuff -(autoload 'widget-setup "widget-edit") -(autoload 'widget-create "widget-edit") -(autoload 'widget-get "widget-edit") -(autoload 'widget-put "widget-edit") -(autoload 'widget-forward "widget-edit") -(autoload 'widget-backward "widget-edit") -(autoload 'widget-at "widget-edit") +(autoload 'widget-setup "wid-edit") +(autoload 'widget-create "wid-edit") +(autoload 'widget-get "wid-edit") +(autoload 'widget-put "wid-edit") +(autoload 'widget-forward "wid-edit") +(autoload 'widget-backward "wid-edit") +(autoload 'widget-at "wid-edit") ;; Preferences (autoload 'w3-preferences-edit "w3-prefs")
--- a/lisp/w3/w3-display.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-display.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-display.el --- display engine v99999 ;; Author: wmperry -;; Created: 1997/02/20 21:48:44 -;; Version: 1.135 +;; Created: 1997/03/06 04:12:42 +;; Version: 1.144 ;; Keywords: faces, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -42,6 +42,7 @@ (defmacro w3-d-s-var-def (var) (` (make-variable-buffer-local (defvar (, var) nil)))) +(w3-d-s-var-def w3-display-label-marker) (w3-d-s-var-def w3-display-open-element-stack) (w3-d-s-var-def w3-display-alignment-stack) (w3-d-s-var-def w3-display-list-stack) @@ -258,11 +259,11 @@ "An Emacs-W3 face... don't edit by hand." t) w3-face-index (1+ w3-face-index)) (if w3-face-font-spec - (set-face-font w3-face-face w3-face-font-spec)) + (font-set-face-font w3-face-face w3-face-font-spec)) (if (car w3-face-color) - (set-face-foreground w3-face-face (car w3-face-color))) + (font-set-face-foreground w3-face-face (car w3-face-color))) (if (car w3-face-background-color) - (set-face-background w3-face-face (car w3-face-background-color))) + (font-set-face-background w3-face-face (car w3-face-background-color))) ;;(set-face-background-pixmap w3-face-face w3-face-pixmap) (setq w3-face-cache (cons (cons w3-face-descr w3-face-face) @@ -411,6 +412,7 @@ (while check (and (boundp (car check)) (stringp (symbol-value (car check))) + (> (length (symbol-value (car check))) 0) (throw 'exit (symbol-value (car check)))) (pop check))))) @@ -426,12 +428,7 @@ (delete-other-windows) (w3-fetch href)) (otherwise - (and target - (let ((window-distance (cdr-safe (assq target w3-target-window-distances)))) - (if (numberp window-distance) - (other-window window-distance) - (error "target %S not found." target)))) - (w3-fetch href))))) + (w3-fetch href target))))) (defun w3-balloon-help-callback (object &optional event) (let* ((widget (widget-at (extent-start-position object))) @@ -622,7 +619,8 @@ (setq desc (and desc (intern dc-desc))) (case desc ((style stylesheet) - (w3-handle-style plist)) + (if w3-honor-stylesheets + (w3-handle-style plist))) (otherwise ) ) @@ -742,6 +740,7 @@ (usemap (w3-get-attribute 'usemap)) (base (w3-get-attribute 'base)) (href (and hyperlink-info (widget-get (cadr hyperlink-info) 'href))) + (target (and hyperlink-info (widget-get (cadr hyperlink-info) 'target))) (widget nil) (align (or (w3-get-attribute 'align) (w3-get-style-info 'vertical-align node)))) @@ -754,9 +753,14 @@ 'ismap ismap ; Is it a server-side map? 'usemap usemap ; Is it a client-side map? 'href href ; Hyperlink destination + 'target target )) (widget-put widget 'buffer (current-buffer)) (w3-maybe-start-image-download widget) + (if (widget-get widget :from) + (add-text-properties (widget-get widget :from) + (widget-get widget :to) + (list 'html-stack w3-display-open-element-stack))) (goto-char (point-max)))))) ;; The table handling @@ -1078,8 +1082,8 @@ (face-id 'w3-table-hack-x-face)) (progn (make-face 'w3-table-hack-x-face) - (set-face-font 'w3-table-hack-x-face - (make-font :family "terminal")) + (font-set-face-font 'w3-table-hack-x-face + (make-font :family "terminal")) (face-id 'w3-table-hack-x-face))))) (if (not (face-differs-from-default-p 'w3-table-hack-x-face)) nil @@ -1516,13 +1520,15 @@ cur id class + last-element ) (while content-stack (setq content (pop content-stack)) (pop w3-active-faces) (pop w3-active-voices) (w3-display-progress-meter) - (case (car (pop w3-display-open-element-stack)) + (setq last-element (pop w3-display-open-element-stack)) + (case (car last-element) ;; Any weird, post-display-of-content stuff for specific tags ;; goes here. Couldn't think of any better way to do this when we ;; are iterative. *sigh* @@ -1545,6 +1551,15 @@ (setq hyperlink-info nil)) ((ol ul dl dir menu) (pop w3-display-list-stack)) + (label + (if (and (markerp w3-display-label-marker) + (marker-position w3-display-label-marker) + (marker-buffer w3-display-label-marker)) + (push (cons (or (cdr-safe (assq 'for (cdr last-element))) + (cdr-safe (assq 'id (cdr last-element))) + "unknown") + (buffer-substring w3-display-label-marker (point))) + w3-form-labels))) (otherwise nil)) (if (car insert-after) @@ -1619,23 +1634,27 @@ (face nil) (voice nil) (st nil)) - (setq st (point) - hyperlink-info (list - st - (append - (list 'link :args nil - :value "" :tag "" - :action 'w3-follow-hyperlink - :from (set-marker (make-marker) st) - :help-echo 'w3-widget-echo - :emacspeak-help 'w3-widget-echo - ) - (alist-to-plist args)))) + (if (w3-get-attribute 'href) + (setq st (point) + hyperlink-info (list + st + (append + (list 'link :args nil + :value "" :tag "" + :action 'w3-follow-hyperlink + :from (set-marker + (make-marker) st) + :help-echo 'w3-widget-echo + :emacspeak-help 'w3-widget-echo + ) + (alist-to-plist args))))) (w3-handle-content node) ) ) ((ol ul dl menu) - (push 0 w3-display-list-stack) + (push (if (w3-get-attribute 'seqnum) + (1- (string-to-int (w3-get-attribute 'seqnum))) + 0) w3-display-list-stack) (w3-handle-content node)) (dir (push 0 w3-display-list-stack) @@ -1691,6 +1710,9 @@ (if w3-display-frames (w3-handle-empty-tag) (w3-handle-content node))) + (applet ; Wow, Java + (w3-handle-content node) + ) (script ; Scripts (w3-handle-empty-tag)) ((embed object) ; Embedded images/content @@ -1953,6 +1975,11 @@ (cons (cons 'data (apply 'concat (nth 2 node))) (nth 1 node)))) (w3-handle-empty-tag)) + (label + (if (not (markerp w3-display-label-marker)) + (setq w3-display-label-marker (make-marker))) + (set-marker w3-display-label-marker (point)) + (w3-handle-content node)) ;; Emacs-W3 stuff that cannot be expressed in a stylesheet (pinhead ;; This check is so that we don't screw up table auto-layout @@ -2050,7 +2077,7 @@ (defun w3-region (st nd) (if (not w3-setup-done) (w3-do-setup)) (let* ((source (buffer-substring st nd)) - (w3-dislplay-same-buffer t) + (w3-display-same-buffer t) (parse nil)) (save-window-excursion (save-excursion @@ -2217,16 +2244,16 @@ (reverse dimensions) ;; substitute numbers for * (let ((star-replacement (/ remaining-available-dimension nb-stars)) - (star-dimensions dimensions)) - (setq dimensions nil) - (while star-dimensions - (push (if (eq '* (car star-dimensions)) - star-replacement - (car star-dimensions)) - dimensions) - (pop star-dimensions)) - ;; push + push => in order - dimensions)))))) + (star-dimensions dimensions)) + (setq dimensions nil) + (while star-dimensions + (push (if (eq '* (car star-dimensions)) + star-replacement + (car star-dimensions)) + dimensions) + (pop star-dimensions)) + ;; push + push => in order + dimensions)))))) (provide 'w3-display)
--- a/lisp/w3/w3-elisp.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-elisp.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-elisp.el --- Scripting support for emacs-lisp ;; Author: wmperry -;; Created: 1997/02/19 23:44:26 -;; Version: 1.5 +;; Created: 1997/03/07 14:14:02 +;; Version: 1.7 ;; Keywords: hypermedia, scripting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -68,14 +68,6 @@ ;; Interfacing to W3 w3-fetch w3-refresh-buffer w3-view-this-url - ;; Face stuff - is this really safe? - make-face set-face-foreground set-face-underline-p - set-face-doc-string set-face-parent set-face-dim-p set-face-background - set-face-background-pixmap set-face-property set-face-blinking-p - set-face-font-family set-face-reverse-p set-face-strikethru-p - set-face-font-size set-face-font set-face-display-table - set-face-highlight-p - ;; All the XEmacs event manipulation functions event-live-p event-glyph-extent event-glyph-y-pixel event-x-pixel event-type event-glyph event-button event-over-text-area-p @@ -127,6 +119,9 @@ (t nil))) (defun w3-elisp-safe-eval (form) - (and (w3-elisp-safe-expression form) (eval form))) + (if (w3-elisp-safe-expression form) + (condition-case () + (eval form) + (error nil)))) (provide 'w3-elisp)
--- a/lisp/w3/w3-forms.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-forms.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-forms.el --- Emacs-w3 forms parsing code for new display engine ;; Author: wmperry -;; Created: 1997/02/20 21:40:42 -;; Version: 1.73 +;; Created: 1997/03/07 14:26:02 +;; Version: 1.77 ;; Keywords: faces, help, comm, data, languages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -35,7 +35,9 @@ (eval-and-compile (require 'w3-display) (require 'widget) - (require 'widget-edit)) + (condition-case nil + (require 'wid-edit) + (error (require 'widget-edit)))) (require 'w3-vars) (require 'mule-sysdp) @@ -323,6 +325,7 @@ :notify 'w3-form-submit/reset-callback :value (or (plist-get (w3-form-element-plist el) 'alt) + (w3-form-element-value el) "Form-Image"))) (defun w3-form-create-submit-button (el face) @@ -531,7 +534,10 @@ (defsubst w3-form-field-label (data) ;;; FIXXX!!! Need to reimplement using the new forms implementation! (declare (special w3-form-labels)) - nil) + (cdr-safe + (assoc (or (plist-get (w3-form-element-plist data) 'id) + (plist-get (w3-form-element-plist data) 'label)) + w3-form-labels))) (defun w3-form-summarize-default (data widget) (let ((label (w3-form-field-label data))
--- a/lisp/w3/w3-menu.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-menu.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-menu.el --- Menu functions for emacs-w3 ;; Author: wmperry -;; Created: 1997/02/13 23:04:55 -;; Version: 1.29 +;; Created: 1997/03/04 14:32:11 +;; Version: 1.30 ;; Keywords: menu, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -642,8 +642,6 @@ w3-delay-image-loads w3-do-incremental-display w3-dump-to-disk - w3-file-done-hook - w3-file-prepare-hook w3-honor-stylesheets w3-image-mappings w3-load-hook
--- a/lisp/w3/w3-parse.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-parse.el Mon Aug 13 09:18:39 2007 +0200 @@ -1486,6 +1486,7 @@ (content-model . [(nil nil (((caption) *include *next) + ((%text) tr *same error) ((col colgroup thead tfoot tbody tr) *retry *next)) (*retry *next)) ;error handling ((col colgroup) @@ -1537,7 +1538,7 @@ nil (((tr tfoot tbody) *close) ;; error handling - ((%body.content) td *same error)) + ((%body.content %text) td *same error)) nil)]) (end-tag-omissible . t)) ((td th)
--- a/lisp/w3/w3-prefs.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-prefs.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-prefs.el --- Preferences panels for Emacs-W3 ;; Author: wmperry -;; Created: 1997/01/17 04:34:13 -;; Version: 1.15 +;; Created: 1997/03/04 14:33:41 +;; Version: 1.16 ;; Keywords: hypermedia, preferences ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -35,8 +35,6 @@ (eval-and-compile (require 'w3-widget)) -(defvar w3-preferences-glyph nil) -(defvar w3-preferences-map nil) (defvar w3-preferences-panel-begin-marker nil) (defvar w3-preferences-panel-end-marker nil) (defvar w3-preferences-panels '( @@ -47,21 +45,6 @@ (compatibility . "Compatibility") (proxy . "Proxy"))) -(defun w3-preferences-setup-glyph-map () - (let* ((x 0) - (height (and w3-preferences-glyph - (glyph-height w3-preferences-glyph))) - (width (and height (/ (glyph-width w3-preferences-glyph) - (length w3-preferences-panels))))) - (mapcar - (function - (lambda (region) - (vector "rect" (list (vector (if width (* x width) 0) 0) - (vector (if width (* (setq x (1+ x)) width) 0) - (or height 0))) - (car region) (cdr region)))) - w3-preferences-panels))) - (defun w3-preferences-generic-variable-callback (widget &rest ignore) (condition-case () (set (widget-get widget 'variable) (widget-value widget)) @@ -188,19 +171,6 @@ :value (symbol-value 'w3-preferences-temp-w3-delay-image-loads)) 'variable 'w3-preferences-temp-w3-delay-image-loads) (widget-insert " Delay Image Loads\n" -;;; "\nAllowed Image Types\n" -;;; "-------------------\n") -;;; (set -;;; (make-local-variable 'w3-preferences-image-type-widget) -;;; (widget-create -;;; 'repeat -;;; :entry-format "%i %d %v" -;;; :value (mapcar -;;; (function -;;; (lambda (x) -;;; (list 'item :format "%t" :tag (car x) :value (cdr x)))) -;;; w3-image-mappings) -;;; '(item :tag "*/*" :value 'unknown))) )) (defun w3-preferences-save-images-panel () @@ -228,9 +198,7 @@ ;;; The hooks panel ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar w3-preferences-hooks-variables - '(w3-file-done-hook - w3-file-prepare-hook - w3-load-hook + '(w3-load-hook w3-mode-hook w3-preferences-cancel-hook w3-preferences-default-hook @@ -484,8 +452,6 @@ ;;###autoload (defun w3-preferences-edit () (interactive) - (if (not w3-preferences-map) - (setq w3-preferences-map (w3-preferences-setup-glyph-map))) (let* ((prefs-buffer (get-buffer-create "W3 Preferences")) (widget nil) (inhibit-read-only t) @@ -502,11 +468,18 @@ (use-local-map widget-keymap) (erase-buffer) (run-hooks 'w3-preferences-setup-hook) - (setq widget (widget-create 'image - :notify 'w3-preferences-notify - :value 'appearance - :tag "Panel" - 'usemap w3-preferences-map)) + (setq widget (apply 'widget-create 'menu-choice + :tag "Panel" + :notify 'w3-preferences-notify + :value 'appearance + (mapcar + (function + (lambda (x) + (list 'choice-item + :format "%[%t%]" + :tag (cdr x) + :value (car x)))) + w3-preferences-panels))) (goto-char (point-max)) (insert "\n\n") (set-marker w3-preferences-panel-begin-marker (point))
--- a/lisp/w3/w3-script.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-script.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-script.el --- Scripting support ;; Author: wmperry -;; Created: 1997/02/18 23:32:46 -;; Version: 1.4 +;; Created: 1997/03/07 14:13:39 +;; Version: 1.5 ;; Keywords: hypermedia, scripting ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -86,7 +86,7 @@ form (car form)) (w3-elisp-safe-eval form)))) (otherwise - (error "Unimplemented scripting language: %S" - w3-current-scripting-language))))) + (message "Unimplemented scripting language: %S" + w3-current-scripting-language))))) (provide 'w3-script)
--- a/lisp/w3/w3-sysdp.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-sysdp.el Mon Aug 13 09:18:39 2007 +0200 @@ -984,6 +984,9 @@ (t 'identity))) ; All others ;; Misc. +;; NT doesn't have make-symbolic-link +(sysdep-defalias 'make-symbolic-link 'copy-file) + (sysdep-defun split-string (string pattern) "Return a list of substrings of STRING which are separated by PATTERN." (let (parts (start 0))
--- a/lisp/w3/w3-vars.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-vars.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-vars.el,v --- All variable definitions for emacs-w3 ;; Author: wmperry -;; Created: 1997/02/22 15:18:42 -;; Version: 1.97 +;; Created: 1997/03/07 16:46:48 +;; Version: 1.102 ;; Keywords: comm, help, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -30,7 +30,7 @@ ;;; Variable definitions for w3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst w3-version-number - (let ((x "p3.0.62")) + (let ((x "p3.0.65")) (if (string-match "State:[ \t\n]+.\\([^ \t\n]+\\)" x) (setq x (substring x (match-beginning 1) (match-end 1))) (setq x (substring x 1))) @@ -38,7 +38,7 @@ (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x "")) "Version # of w3-mode.") -(defconst w3-version-date (let ((x "1997/02/22 15:18:42")) +(defconst w3-version-date (let ((x "1997/03/07 16:46:48")) (if (string-match "Date: \\([^ \t\n]+\\)" x) (substring x (match-beginning 1) (match-end 1)) x)) @@ -274,9 +274,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar w3-load-hook nil "*Hooks to be run after loading w3.") (defvar w3-mode-hook nil "*Hooks to be run after entering w3-mode.") -(defvar w3-file-prepare-hook nil - "*Hooks to be run before preparing a buffer.") -(defvar w3-file-done-hook nil "*Hooks to be run after preparing a buffer.") (defvar w3-source-file-hook nil "*Hooks to be run after getting document source.") @@ -808,7 +805,7 @@ (define-key w3-mode-map "\C-o" 'w3-fetch) (define-key w3-mode-map "\M-M" 'w3-mail-document-under-point) (define-key w3-mode-map "\M-m" 'w3-mail-current-document) -(define-key w3-mode-map "\M-s" 'w3-search) +(define-key w3-mode-map "\M-s" 'w3-save-as) (define-key w3-mode-map "\M-\r" 'w3-follow-inlined-image) (define-key w3-mode-map "\r" 'w3-widget-button-press) (define-key w3-mode-map "\n" 'w3-widget-button-press)
--- a/lisp/w3/w3-widget.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3-widget.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3-widget.el --- An image widget ;; Author: wmperry -;; Created: 1997/02/09 06:37:14 -;; Version: 1.18 +;; Created: 1997/03/05 23:37:58 +;; Version: 1.20 ;; Keywords: faces, images ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -72,6 +72,9 @@ widget-mouse-button2 'mouse-2 widget-mouse-button3 'mouse-3)) +(defvar widget-image-inaudible-p nil + "*Whether to make images inaudible or not.") + (define-key widget-image-keymap (vector widget-mouse-button1) 'widget-image-button-press) (define-key widget-image-keymap (vector widget-mouse-button2) @@ -126,7 +129,12 @@ (if (widget-glyphp value) (widget-put widget 'glyph value) (widget-put widget :value value)) - (widget-apply widget :create))) + (put-text-property (point) + (progn + (widget-apply widget :create) + (point)) + 'inaudible + widget-image-inaudible-p))) (defsubst widget-image-usemap (widget) (let ((usemap (widget-get widget 'usemap))) @@ -137,7 +145,7 @@ (cdr-safe (assoc usemap w3-imagemaps))))) (defun widget-image-callback (widget widget-ignore &optional event) - (and (widget-get widget 'href) (w3-fetch (widget-get widget 'href)))) + (and (widget-get widget 'href) (w3-fetch (widget-get widget 'href) (widget-get widget 'target)))) (defmacro widget-image-create-subwidget (&rest args) (` (widget-create (,@ args) @@ -355,15 +363,16 @@ (img-src (or (widget-get widget 'src) (and widget-changed (widget-get widget-changed 'src)))) (value (widget-value widget)) + (target (widget-get widget 'target)) ) (cond ((and glyph usemap) ; Do the client-side imagemap stuff (setq href (w3-point-in-map (vector x y) usemap nil)) (if (stringp href) - (w3-fetch href) + (w3-fetch href target) (message "No destination found for %d,%d" x y))) ((and glyph x y ismap) ; Do the server-side imagemap stuff - (w3-fetch (format "%s?%d,%d" href x y))) + (w3-fetch (format "%s?%d,%d" href x y) target)) (usemap ; Dummed-down tty client side imap (let ((choices (mapcar (function (lambda (entry) @@ -373,11 +382,11 @@ (choice nil)) (setq choice (completing-read "Imagemap: " choices nil t) choice (cdr-safe (assoc choice choices))) - (and (stringp choice) (w3-fetch choice)))) + (and (stringp choice) (w3-fetch choice target)))) (ismap ; Do server-side dummy imagemap for tty - (w3-fetch (concat href "?0,0"))) + (w3-fetch (concat href "?0,0") target)) ((stringp href) ; Normal hyperlink - (w3-fetch href)) + (w3-fetch href target)) ((stringp img-src) (cond ((null widget-image-auto-retrieve) nil)
--- a/lisp/w3/w3.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/w3/w3.el Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ ;;; w3.el --- Main functions for emacs-w3 on all platforms/versions ;; Author: wmperry -;; Created: 1997/02/20 21:50:57 -;; Version: 1.82 +;; Created: 1997/03/07 16:44:12 +;; Version: 1.93 ;; Keywords: faces, help, comm, news, mail, processes, mouse, hypermedia ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -445,7 +445,7 @@ url)) ;;;###autoload -(defun w3-fetch (&optional url) +(defun w3-fetch (&optional url target) "Retrieve a document over the World Wide Web. Defaults to URL of the current document, if any. With prefix argument, use the URL of the hyperlink under point instead." @@ -467,6 +467,14 @@ ;; In the common case, this is probably cheaper than searching. (while (= (string-to-char url) ? ) (setq url (substring url 1))) + (or target (setq target w3-base-target)) + (if (stringp target) + (setq target (intern (downcase target)))) + (and target + (let ((window-distance (cdr-safe (assq target w3-target-window-distances)))) + (if (numberp window-distance) + (other-window window-distance) + (error "target %S not found." target)))) (cond ((= (string-to-char url) ?#) (w3-relative-link url)) @@ -633,18 +641,28 @@ (let* ((url (url-view-url t)) (cur-links w3-current-links) (title (buffer-name)) + (case-fold-search t) + (possible-lastmod (save-excursion + (goto-char (point-min)) + (if (re-search-forward "^Last modified:\\(.*\\)" nil t) + (buffer-substring (match-beginning 1) + (match-end 1))))) + (attributes (url-file-attributes url)) (lastmod (or (cdr-safe (assoc "last-modified" - url-current-mime-headers)))) + url-current-mime-headers)) + (nth 5 attributes))) (hdrs url-current-mime-headers) + (size (or (cdr (assoc "content-length" url-current-mime-headers)) + (point-max))) (info w3-current-metainfo)) (set-buffer (get-buffer-create url-working-buffer)) (setq url-current-can-be-cached nil) (erase-buffer) (cond ((stringp lastmod) nil) - ((equal '(0 . 0) lastmod) (setq lastmod nil)) + ((equal '(0 . 0) lastmod) (setq lastmod possible-lastmod)) ((consp lastmod) (setq lastmod (current-time-string lastmod))) - (t (setq lastmod nil))) + (t (setq lastmod possible-lastmod))) (insert "<html>\n" " <head>\n" " <title>Document Information</title>\n" @@ -654,6 +672,10 @@ " <tr><th colspan=2>Document Information</th></tr>\n" " <tr><td>Title:</td><td>" title "</td></tr>\n" " <tr><td>Location:</td><td>" url "</td></tr>\n" + " <tr><td>Size:</td><td>" (url-pretty-length + (if (stringp size) + (string-to-int size) + size)) "</td></tr>\n" " <tr><td>Last Modified:</td><td>" (or lastmod "None Given") "</td></tr>\n") (if hdrs @@ -828,24 +850,6 @@ (interactive) (w3-source-document t)) -(defun w3-my-safe-copy-face (old new locale) - (let ((fore (face-foreground old)) - (back (face-background old)) - (bpxm (face-background-pixmap old)) - (font (face-font old)) - (font-spec (get old 'font-specification))) - (if (color-specifier-p fore) - (setq fore (color-name fore))) - (if (color-specifier-p back) - (setq back (color-name back))) - (if (font-specifier-p font) - (setq font (font-name font))) - (and fore (set-face-foreground new fore locale)) - (and back (set-face-background new back locale)) - (and bpxm (set-face-background-pixmap new bpxm locale)) - (and (or font-spec font) (set-face-font new (or font-spec font) locale)) - new)) - (defun w3-source-document (under) "View this document's source" (interactive "P") @@ -910,6 +914,7 @@ ("LaTeX Source") ) nil t))) + (case-fold-search t) (url (cond ((stringp under) under) (under (w3-view-this-url t)) @@ -964,15 +969,23 @@ (buffer-string)))) (funcall w3-mail-command) (mail-subject) - (insert format " from URL " url "\n" - "Mime-Version: 1.0\n" - "Content-transfer-encoding: 8bit\n" - "Content-type: " content-type) + (if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag) + (insert format " from <URL: " url ">") + (insert format " from <URL: " url ">\n" + "Mime-Version: 1.0\n" + "Content-transfer-encoding: 8bit\n" + "Content-type: " content-type)) (re-search-forward mail-header-separator nil) (forward-char 1) - (insert (if (equal "HTML Source" format) - (format "<BASE HREF=\"%s\">" url) "") - str) + (if (and (boundp 'mime/editor-mode-flag) mime/editor-mode-flag) + (insert (format mime-tag-format content-type) "\n")) + (save-excursion + (insert str)) + (cond ((equal "HTML Source" format) + (if (or (search-forward "<head>" nil t) + (search-forward "<html>" nil t)) + (insert "\n")) + (insert (format "<base href=\"%s\">" url)))) (mail-to))) (defun w3-internal-use-history (hist-item) @@ -1585,6 +1598,8 @@ (if base (setq base (url-generic-parse-url base))) (insert-buffer buffer) + (let ((inhibit-read-only t)) + (set-text-properties (point-min) (point-max) nil)) (if (not base) (setq url-current-object (url-generic-parse-url (concat "file:" @@ -1794,12 +1809,13 @@ x (cdr x) found (cdr-safe (assoc "made" y)))) (if found - (let ((possible nil)) + (let ((possible nil) + (href nil)) (setq x (car found)) ; Fallback if no mail(to|server) found (while found - (if (string-match "^mail[^:]+:" (car found)) - (setq possible (cons (car found) possible))) - (setq found (cdr found))) + (setq href (plist-get (pop found) 'href)) + (if (and href (string-match "^mail[^:]+:" href)) + (setq possible (cons href possible)))) (case (length possible) (0 ; No mailto links found (w3-fetch x)) ; fall back onto first 'made' link @@ -1920,7 +1936,11 @@ (w3-find-default-stylesheets) ) +(defvar w3-loaded-stylesheets nil + "A list of all the stylesheets Emacs-W3 loaded at startup.") + (defun w3-find-default-stylesheets () + (setq w3-loaded-stylesheets nil) (let* ((lightp (w3-color-light-p 'default)) (longname (if lightp "stylesheet-light" "stylesheet-dark")) (shortname (if lightp "light.css" "dark.css")) @@ -1957,6 +1977,7 @@ (not (file-directory-p cur)) cur)) (if found (setq total-found (1+ total-found) + w3-loaded-stylesheets (cons cur w3-loaded-stylesheets) w3-user-stylesheet (css-parse (concat "file:" cur) nil w3-user-stylesheet)))) (setq-default url-be-asynchronous old-asynch) @@ -2188,20 +2209,24 @@ link-at-point (and link-at-point (widget-get link-at-point 'href) + (widget-get link-at-point :from) + (widget-get link-at-point :to) (w3-fix-spaces (buffer-substring (widget-get link-at-point :from) (widget-get link-at-point :to))))) (w3-map-links (function (lambda (widget arg) - (setq links-alist (cons - (cons - (w3-fix-spaces - (buffer-substring-no-properties - (widget-get widget :from) - (widget-get widget :to))) - (widget-get widget 'href)) - links-alist))))) + (if (and (widget-get widget :from) + (widget-get widget :to)) + (setq links-alist (cons + (cons + (w3-fix-spaces + (buffer-substring-no-properties + (widget-get widget :from) + (widget-get widget :to))) + (widget-get widget 'href)) + links-alist)))))) (if (not links-alist) (error "No links in current document.")) (setq links-alist (sort links-alist (function (lambda (x y)
--- a/lisp/x11/x-faces.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/x11/x-faces.el Mon Aug 13 09:18:39 2007 +0200 @@ -168,11 +168,19 @@ If it fails, it returns nil." (try-font-name (x-frob-font-weight font "medium") device)) +(defvar *try-oblique-before-italic-fonts* nil + "*If NIL, italic fonts are searched before oblique fonts. If +non-NIL, oblique fonts are tried before italic fonts. This is mostly +applicable to adobe-courier fonts") + (defun x-make-font-italic (font &optional device) "Given an X font specification, this attempts to make an `italic' font. If it fails, it returns nil." - (or (try-font-name (x-frob-font-slant font "i") device) - (try-font-name (x-frob-font-slant font "o") device))) + (if *try-oblique-before-italic-fonts* + (or (try-font-name (x-frob-font-slant font "o") device) + (try-font-name (x-frob-font-slant font "i") device)) + (or (try-font-name (x-frob-font-slant font "i") device) + (try-font-name (x-frob-font-slant font "o") device)))) (defun x-make-font-unitalic (font &optional device) "Given an X font specification, this attempts to make a non-italic font.
--- a/lisp/x11/x-menubar.el Mon Aug 13 09:17:27 2007 +0200 +++ b/lisp/x11/x-menubar.el Mon Aug 13 09:18:39 2007 +0200 @@ -137,6 +137,7 @@ ) ("Options" + ,custom-help-menu ["Read Only" (toggle-read-only) :style toggle :selected buffer-read-only] ("Editing Options" @@ -556,7 +557,7 @@ :selected (eq browse-url-browser-function 'browse-url-grail)] ) "-----" - ["Edit Faces..." cu-edit-faces t] + ["Browse Faces..." edit-faces t] ("Font" :filter font-menu-family-constructor) ("Size" :filter font-menu-size-constructor) ("Weight" :filter font-menu-weight-constructor) @@ -656,7 +657,6 @@ ["No Warranty" describe-no-warranty t] ["XEmacs License" describe-copying t] ["The Latest Version" describe-distribution t]) - ,custom-help-menu ) ))) @@ -1175,7 +1175,7 @@ (cons 'progn (mapcar #'(lambda (face) `(make-face ',face)) - (face-list)))) + (save-options-non-customized-face-list)))) (if options-save-faces (cons 'progn @@ -1194,7 +1194,7 @@ (delq 'display-table (copy-sequence built-in-face-specifiers))))) - (face-list))))) + (save-options-non-customized-face-list))))) ;; Mule-specific: (if (featurep 'mule) @@ -1205,6 +1205,15 @@ This is used by `save-options-menu-settings' and should mirror the options listed in the Options menu.") +(defun save-options-non-customized-face-list () + "This function will return a list of all faces that have not been +'customized'." + (delq nil (mapcar '(lambda (face) + (if (not (or (get face 'saved-face) + (get face 'factory-face))) + face)) + (face-list)))) + (defun save-options-specifier-spec-list (face property) (if (not (or (eq property 'font) (eq property 'color))) (specifier-spec-list (face-property face property) 'global)
--- a/man/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,15 @@ +Thu Mar 6 13:33:54 1997 Steven L Baur <steve@altair.xemacs.org> + + * Makefile: Update for new texinfo manual. + +Tue Mar 4 11:37:42 1997 Steven L Baur <steve@altair.xemacs.org> + + * Makefile (../info/w3.info): Use special version of makeinfo + since this manual is not backwards compatible. + Clean up error handling so we only have to type make once to + rebuild the info tree. + (../info/vm.info): Make sure to continue in the event of error. + Tue Feb 25 20:17:53 1997 Steven L Baur <steve@altair.xemacs.org> * auctex/Makefile: Added `mostlyclean' and `distclean' target.
--- a/man/Makefile Mon Aug 13 09:17:27 2007 +0200 +++ b/man/Makefile Mon Aug 13 09:18:39 2007 +0200 @@ -23,15 +23,22 @@ # inherited from the environment. SHELL = /bin/sh +EMACS = xemacs +EMACSFLAGS = -batch -q -no-site-file + +# Implies makeinfo-1.64 +MAKEINFO = makeinfo +# Implies makeinfo-1.67 +NEWMAKEINFO = makeinfo-1.67 + .SUFFIXES: .info .texi .dvi # Subdirectories to make recursively. SUBDIR = xemacs lispref new-users-guide internals tm auctex ../info/%.info : %.texi - makeinfo -o $@ $< + -$(MAKEINFO) -o $@ $< -# hyperbole and oo-browser manuals broken - do not TeX properly srcs = cc-mode cl custom ediff external-widget forms gnus \ hyperbole ilisp info ispell mailcrypt message mh-e oo-browser \ pcl-cvs psgml psgml-api rmail standards supercite term \ @@ -40,24 +47,38 @@ info = $(srcs:%=../info/%.info) dvi = $(srcs:%=%.dvi) +special = # ../info/w3.info ../info/vm.info ../info/texinfo.info + all : info -info : $(info) - for d in $(SUBDIR) ; do (cd $${d} && $(MAKE) $(MFLAGS) $@) ; done +info : $(info) $(special) + -for d in $(SUBDIR) ; do (cd $${d} && $(MAKE) $(MFLAGS) $@) ; done xemacs: FORCE - cd $@ && $(MAKE) $(MFLAGS) + -cd $@ && $(MAKE) $(MFLAGS) lispref: FORCE - cd $@ && $(MAKE) $(MFLAGS) + -cd $@ && $(MAKE) $(MFLAGS) new-users-guide: FORCE - cd $@ && $(MAKE) $(MFLAGS) + -cd $@ && $(MAKE) $(MFLAGS) internals: FORCE - cd $@ && $(MAKE) $(MFLAGS) + -cd $@ && $(MAKE) $(MFLAGS) tm: FORCE - cd $@ && $(MAKE) $(MFLAGS) + -cd $@ && $(MAKE) $(MFLAGS) auctex: FORCE - cd $@ && $(MAKE) $(MFLAGS) + -cd $@ && $(MAKE) $(MFLAGS) FORCE : +../info/w3.info : w3.texi + -$(NEWMAKEINFO) w3.texi -o ../info/w3.info + +../info/texinfo.info : texinfo.texi + -$(NEWMAKEINFO) texinfo.texi -o ../info/texinfo.info + + +../info/vm.info : vm.texi + -$(EMACS) $(EMACSFLAGS) -insert vm.texi -l texinfmt \ + -f texinfo-format-buffer -f save-buffer + -mv vm.info* ../info + PERL = perl TEXI2DVI = texi2dvi
--- a/man/custom.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/custom.texi Mon Aug 13 09:18:39 2007 +0200 @@ -13,7 +13,7 @@ @comment node-name, next, previous, up @top The Customization Library -Version: 1.50 +Version: 1.59 @menu * Introduction:: @@ -395,12 +395,12 @@ The last part of the customization buffer looks like this: @example -[Set] [Save] [Reset] +[Set] [Save] [Reset] [Done] @end example Activating the @samp{[Set]}, @samp{[Save]}, or @samp{[Reset]} button will affect all modified customization items that are visible in -the buffer. +the buffer. @samp{[Done]} will bury the buffer. @node Declarations, Utilities, The Customization Buffer, Top @comment node-name, next, previous, up @@ -546,21 +546,21 @@ @table @code @item type -(the value of (window-system))@br +(the value of (window-system))@* Should be one of @code{x} or @code{tty}. @item class -(the frame's color support)@br +(the frame's color support)@* Should be one of @code{color}, @code{grayscale}, or @code{mono}. @item background -(what color is used for the background text)@br +(what color is used for the background text)@* Should be one of @code{light} or @code{dark}. @end table Internally, custom uses the symbol property @code{factory-face} for the program specified default face properties, @code{saved-face} for -properties saved by the user, and @code{face-documentation} for the +properties saved by the user, and @code{face-doc-string} for the documentation string.@refill @end defun @@ -640,7 +640,8 @@ @item Integrate with @file{w3} so you can customization buffers with much better formatting. I'm thinking about adding a <custom>name</custom> -tag. +tag. The latest w3 have some support for this, so come up with a +convincing example. @item Add an `examples' section, with explained examples of custom type
--- a/man/gnus.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/gnus.texi Mon Aug 13 09:18:39 2007 +0200 @@ -2005,6 +2005,13 @@ Also @pxref{Topic Parameters}. +Here's an example group parameter list: + +@example +((to-address . "ding@@ifi.uio.no") + (auto-expiry . t)) +@end example + @node Listing Groups @section Listing Groups @@ -9002,8 +9009,8 @@ If you use @code{procmail} to split things directory into an @code{nnmh} directory (which you shouldn't do), you should set @code{nnmail-keep-last-article} to non-@code{nil} to prevent Gnus from -ever expiring the final article in a mail newsgroup. This is quite, -quite important. +ever expiring the final article (i. e., the article with the highest +article number) in a mail newsgroup. This is quite, quite important. Here's an example setup: The incoming spools are located in @file{~/incoming/} and have @samp{""} as suffixes (i. e., the incoming @@ -9282,9 +9289,8 @@ stored.) If all this sounds scary to you, you can set @code{nnmail-treat-duplicates} to @code{warn} (which is what it is by default), and @code{nnmail} won't delete duplicate mails. Instead it -will generate a brand new @code{Message-ID} for the mail and insert a -warning into the head of the mail saying that it thinks that this is a -duplicate of a different message. +will insert a warning into the head of the mail saying that it thinks +that this is a duplicate of a different message. This variable can also be a function. If that's the case, the function will be called from a buffer narrowed to the message in question with @@ -13831,6 +13837,7 @@ Also thanks to the following for patches and stuff: +Adrian Aichner, Peter Arius, Marc Auslander, Chris Bone, @@ -13841,6 +13848,7 @@ Kevin Buhr, Alastair Burt, Joao Cachopo, +Zlatko Calusic, Massimo Campostrini, Michael R. Cook, Glenn Coombs, @@ -13868,17 +13876,20 @@ Randell Jesup, Fred Johansen, Greg Klanderman, +Karl Kleinpaste, Peter Skov Knudsen, Shuhei Kobayashi, @c Kobayashi Thor Kristoffersen, Jens Lautenbacher, Carsten Leonhardt, +James LewisMoss, Christian Limpach, Markus Linnala, Dave Love, Tonny Madsen, Shlomo Mahlab, Nat Makarevitch, +David Martin, Timo Metzemakers, Richard Mlynarik, Lantz Moore,
--- a/man/lispref/positions.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/lispref/positions.texi Mon Aug 13 09:18:39 2007 +0200 @@ -687,7 +687,7 @@ @samp{[@dots{}]} in a regular expression except that @samp{]} is never special and @samp{\} quotes @samp{^}, @samp{-} or @samp{\}. Thus, @code{"a-zA-Z"} skips over all letters, stopping before the first -nonletter, and @code{"^a-zA-Z}" skips nonletters stopping before the +non-letter, and @code{"^a-zA-Z}" skips non-letters stopping before the first letter. @xref{Regular Expressions}. If @var{limit} is supplied (it must be a number or a marker), it
--- a/man/lispref/specifiers.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/lispref/specifiers.texi Mon Aug 13 09:18:39 2007 +0200 @@ -530,7 +530,7 @@ Canonicalizing means converting to the full form for an inst-list, i.e. @code{((@var{tag-set} . @var{instantiator}) ...)}. This function -accepts a single inst-pair or any abbrevation thereof or a list of +accepts a single inst-pair or any abbreviation thereof or a list of (possibly abbreviated) inst-pairs. (See @code{canonicalize-inst-pair}.) If @var{noerror} is non-@code{nil}, signal an error if the inst-list is
--- a/man/lispref/streams.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/lispref/streams.texi Mon Aug 13 09:18:39 2007 +0200 @@ -752,7 +752,7 @@ that is, those which were made with @code{make-symbol} or by calling @code{intern} with a second argument. -When @code{print-gensym} is true, such symbols will be preceeded by +When @code{print-gensym} is true, such symbols will be preceded by @samp{#:}, which causes the reader to create a new symbol instead of interning and returning an existing one. Beware: The @samp{#:} syntax creates a new symbol each time it is seen, so if you print an object
--- a/man/lispref/tooltalk.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/lispref/tooltalk.texi Mon Aug 13 09:18:39 2007 +0200 @@ -217,7 +217,7 @@ protocol you're using need to agree what types mean (if anything). Conventionally @code{string} is used for strings and @code{int} for 32 bit integers. Arguments can initialized by providing a value or with -@code{set-tooltalk-message-attribute}; the latter is neccessary if you +@code{set-tooltalk-message-attribute}; the latter is necessary if you want to initialize the argument with a string that can contain embedded nulls (use @code{arg_bval}). @refill
--- a/man/mule/languages.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/mule/languages.texi Mon Aug 13 09:18:39 2007 +0200 @@ -2487,7 +2487,7 @@ replaces the spaces between two Ethiopic characters in the specified region. You will be asked the new space character. Answer by typing 1, 2 or 3. 1 means the single width ASCII space. 2 means the double width -Ethiopic blank. 3 means the traditional Ethiopic word separater. This +Ethiopic blank. 3 means the traditional Ethiopic word separator. This command is independent from the space selection for keyboard input. @item @key{[F8]} or @kbd{M-x ethio-input-special-character}
--- a/man/mule/mule.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/mule/mule.texi Mon Aug 13 09:18:39 2007 +0200 @@ -112,7 +112,7 @@ (LF), 2 (CRLF), and 3 (CR). The names of generated coding-systems are NAMEunix, NAMEdos, and NAMEmac respectively. -Just to make an alias of some coding-system, call a fucntion +Just to make an alias of some coding-system, call a function `copy-coding-system'. FUNCTION copy-coding-system: ORIGINAL ALIAS
--- a/man/texinfo.tex Mon Aug 13 09:17:27 2007 +0200 +++ b/man/texinfo.tex Mon Aug 13 09:18:39 2007 +0200 @@ -1,6 +1,7 @@ %% TeX macros to handle texinfo files -% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, 1994 Free Software Foundation, Inc. +% Copyright (C) 1985, 86, 88, 90, 91, 92, 93, +% 94, 95, 1996 Free Software Foundation, Inc. %This texinfo.tex file is free software; you can redistribute it and/or %modify it under the terms of the GNU General Public License as @@ -14,8 +15,8 @@ %You should have received a copy of the GNU General Public License %along with this texinfo.tex file; see the file COPYING. If not, write -%to the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, -%USA. +%to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +%Boston, MA 02111-1307, USA. %In other words, you are welcome to use, share and improve this program. @@ -34,7 +35,7 @@ % This automatically updates the version number based on RCS. \def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}} -\deftexinfoversion$Revision: 1.1.1.1 $ +\deftexinfoversion$Revision: 1.2 $ \message{Loading texinfo package [Version \texinfoversion]:} % If in a .fmt file, print the version number @@ -45,20 +46,20 @@ % Save some parts of plain tex whose names we will redefine. -\let\ptextilde=\~ +\let\ptexb=\b +\let\ptexbullet=\bullet +\let\ptexc=\c +\let\ptexcomma=\, +\let\ptexdot=\. +\let\ptexdots=\dots +\let\ptexend=\end +\let\ptexequiv = \equiv +\let\ptexi=\i \let\ptexlbrace=\{ \let\ptexrbrace=\} -\let\ptexdots=\dots -\let\ptexdot=\. \let\ptexstar=\* -\let\ptexend=\end -\let\ptexbullet=\bullet -\let\ptexb=\b -\let\ptexc=\c -\let\ptexi=\i \let\ptext=\t -\let\ptexl=\l -\let\ptexL=\L +\let\ptextilde=\~ % Be sure we're in horizontal mode when doing a tie, since we make space % equivalent to this in @example-like environments. Otherwise, a space @@ -66,10 +67,14 @@ % since \penalty is valid in vertical mode, we'd end up putting the % penalty on the vertical list instead of in the new paragraph. {\catcode`@ = 11 - \gdef\tie{\leavevmode\penalty\@M\ } + % Avoid using \@M directly, because that causes trouble + % if the definition is written into an index file. + \global\let\tiepenalty = \@M + \gdef\tie{\leavevmode\penalty\tiepenalty\ } } \let\~ = \tie % And make it available as @~. + \message{Basics,} \chardef\other=12 @@ -99,10 +104,9 @@ \hyphenation{eshell} % Margin to add to right of even pages, to left of odd pages. -\newdimen \bindingoffset \bindingoffset=0pt -\newdimen \normaloffset \normaloffset=\hoffset +\newdimen \bindingoffset +\newdimen \normaloffset \newdimen\pagewidth \newdimen\pageheight -\pagewidth=\hsize \pageheight=\vsize % Sometimes it is convenient to have everything in the transcript file % and nothing on the terminal. We don't just call \tracingall here, @@ -123,7 +127,7 @@ \newdimen\cornerlong \newdimen\cornerthick \newdimen \topandbottommargin \newdimen \outerhsize \newdimen \outervsize -\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks +\cornerlong=1pc\cornerthick=.3pt % These set size of cropmarks \outerhsize=7in %\outervsize=9.5in % Alternative @smallbook page size is 9.25in @@ -133,15 +137,24 @@ %---------------------End change----------------------- % \onepageout takes a vbox as an argument. Note that \pagecontents -% does insertions itself, but you have to call it yourself. +% does insertions, but you have to call it yourself. \chardef\PAGE=255 \output={\onepageout{\pagecontents\PAGE}} -\def\onepageout#1{\hoffset=\normaloffset -\ifodd\pageno \advance\hoffset by \bindingoffset -\else \advance\hoffset by -\bindingoffset\fi -{\escapechar=`\\\relax % makes sure backslash is used in output files. -\shipout\vbox{{\let\hsize=\pagewidth \makeheadline} \pagebody{#1}% -{\let\hsize=\pagewidth \makefootline}}}% -\advancepageno \ifnum\outputpenalty>-20000 \else\dosupereject\fi} +\def\onepageout#1{% + \hoffset=\normaloffset + \ifodd\pageno \advance\hoffset by \bindingoffset + \else \advance\hoffset by -\bindingoffset\fi + {% + \escapechar = `\\ % use backslash in output files. + \indexdummies + \shipout\vbox{% + {\let\hsize=\pagewidth \makeheadline}% + \pagebody{#1}% + {\let\hsize=\pagewidth \makefootline}% + }% + }% + \advancepageno + \ifnum\outputpenalty>-20000 \else\dosupereject\fi +} %%%% For @cropmarks command %%%% @@ -153,8 +166,8 @@ % \def\croppageout#1{\hoffset=0pt % make sure this doesn't mess things up {\escapechar=`\\\relax % makes sure backslash is used in output files. - \shipout - \vbox to \outervsize{\hsize=\outerhsize + \shipout + \vbox to \outervsize{\hsize=\outerhsize \vbox{\line{\ewtop\hfill\ewtop}} \nointerlineskip \line{\vbox{\moveleft\cornerthick\nstop} @@ -162,19 +175,19 @@ \vbox{\moveright\cornerthick\nstop}} \vskip \topandbottommargin \centerline{\ifodd\pageno\hskip\bindingoffset\fi - \vbox{ - {\let\hsize=\pagewidth \makeheadline} - \pagebody{#1} - {\let\hsize=\pagewidth \makefootline}} - \ifodd\pageno\else\hskip\bindingoffset\fi} - \vskip \topandbottommargin plus1fill minus1fill + \vbox{ + {\let\hsize=\pagewidth \makeheadline} + \pagebody{#1} + {\let\hsize=\pagewidth \makefootline}} + \ifodd\pageno\else\hskip\bindingoffset\fi} + \vskip \topandbottommargin plus1fill minus1fill \boxmaxdepth\cornerthick \line{\vbox{\moveleft\cornerthick\nsbot} \hfill \vbox{\moveright\cornerthick\nsbot}} \nointerlineskip \vbox{\line{\ewbot\hfill\ewbot}} - }} + }} \advancepageno \ifnum\outputpenalty>-20000 \else\dosupereject\fi} % @@ -362,11 +375,43 @@ %\def\'{{'}} % Used to generate quoted braces. - \def\mylbrace {{\tt \char '173}} \def\myrbrace {{\tt \char '175}} \let\{=\mylbrace \let\}=\myrbrace +\begingroup + % Definitions to produce actual \{ & \} command in an index. + \catcode`\{ = 12 \catcode`\} = 12 + \catcode`\[ = 1 \catcode`\] = 2 + \catcode`\@ = 0 \catcode`\\ = 12 + @gdef@lbracecmd[\{]% + @gdef@rbracecmd[\}]% +@endgroup + +% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent +% Others are defined by plain TeX: @` @' @" @^ @~ @= @v @H. +\let\, = \c +\let\dotaccent = \. +\def\ringaccent#1{{\accent23 #1}} +\let\tieaccent = \t +\let\ubaraccent = \b +\let\udotaccent = \d + +% Other special characters: @questiondown @exclamdown +% Plain TeX defines: @AA @AE @O @OE @L (and lowercase versions) @ss. +\def\questiondown{?`} +\def\exclamdown{!`} + +% Dotless i and dotless j, used for accents. +\def\imacro{i} +\def\jmacro{j} +\def\dotless#1{% + \def\temp{#1}% + \ifx\temp\imacro \ptexi + \else\ifx\temp\jmacro \j + \else \errmessage{@dotless can be used only with i or j}% + \fi\fi +} % @: forces normal size whitespace following. \def\:{\spacefactor=1000 } @@ -533,17 +578,34 @@ \def\nofillexdentyyy #1{{\advance \leftskip by -\exdentamount \leftline{\hskip\leftskip{\rm#1}}}} +% @inmargin{TEXT} puts TEXT in the margin next to the current paragraph. + +\def\inmargin#1{% +\strut\vadjust{\nobreak\kern-\strutdepth + \vtop to \strutdepth{\baselineskip\strutdepth\vss + \llap{\rightskip=\inmarginspacing \vbox{\noindent #1}}\null}}} +\newskip\inmarginspacing \inmarginspacing=1cm +\def\strutdepth{\dp\strutbox} + %\hbox{{\rm#1}}\hfil\break}} % @include file insert text of that file as input. - -\def\include{\parsearg\includezzz} -%Use \input\thisfile to avoid blank after \input, which may be an active -%char (in which case the blank would become the \input argument). -%The grouping keeps the value of \thisfile correct even when @include -%is nested. -\def\includezzz #1{\begingroup -\def\thisfile{#1}\input\thisfile +% Allow normal characters that we make active in the argument (a file name). +\def\include{\begingroup + \catcode`\\=12 + \catcode`~=12 + \catcode`^=12 + \catcode`_=12 + \catcode`|=12 + \catcode`<=12 + \catcode`>=12 + \catcode`+=12 + \parsearg\includezzz} +% Restore active chars for included file. +\def\includezzz#1{\endgroup\begingroup + % Read the included file in a group so nested @include's work. + \def\thisfile{#1}% + \input\thisfile \endgroup} \def\thisfile{} @@ -558,7 +620,7 @@ % @sp n outputs n lines of vertical space \def\sp{\parsearg\spxxx} -\def\spxxx #1{\par \vskip #1\baselineskip} +\def\spxxx #1{\vskip #1\baselineskip} % @comment ...line which is ignored... % @c is the same as @comment @@ -571,6 +633,9 @@ \let\c=\comment +% @paragraphindent is defined for the Info formatting commands only. +\let\paragraphindent=\comment + % Prevent errors for section commands. % Used in @ignore and in failing conditionals. \def\ignoresections{% @@ -605,6 +670,7 @@ % incorrectly. % \def\ignoremorecommands{% + \let\defcodeindex = \relax \let\defcv = \relax \let\deffn = \relax \let\deffnx = \relax @@ -628,6 +694,15 @@ \let\printindex = \relax \let\pxref = \relax \let\settitle = \relax + \let\setchapternewpage = \relax + \let\setchapterstyle = \relax + \let\everyheading = \relax + \let\evenheading = \relax + \let\oddheading = \relax + \let\everyfooting = \relax + \let\evenfooting = \relax + \let\oddfooting = \relax + \let\headings = \relax \let\include = \relax \let\lowersections = \relax \let\down = \relax @@ -636,7 +711,6 @@ \let\set = \relax \let\clear = \relax \let\item = \relax - \let\message = \relax } % Ignore @ignore ... @end ignore. @@ -651,6 +725,16 @@ \def\menu{\doignore{menu}} \def\direntry{\doignore{direntry}} +% Also ignore @macro ... @end macro. The user must run texi2dvi, +% which runs makeinfo to do macro expansion. Ignore @unmacro, too. +\def\macro{\doignore{macro}} +\let\unmacro = \comment + + +% @dircategory CATEGORY -- specify a category of the dir file +% which this file should belong to. Ignore this in TeX. +\let\dircategory = \comment + % Ignore text until a line `@end #1'. % \def\doignore#1{\begingroup @@ -682,11 +766,12 @@ \immediate\write16{If you are running another version of TeX, relax.} \immediate\write16{If you are running Unix TeX 3.0, kill this TeX process.} \immediate\write16{ Then upgrade your TeX installation if you can.} + \immediate\write16{ (See ftp://ftp.gnu.ai.mit.edu/pub/gnu/TeX.README.)} \immediate\write16{If you are stuck with version 3.0, run the} \immediate\write16{ script ``tex3patch'' from the Texinfo distribution} \immediate\write16{ to use a workaround.} \immediate\write16{} - \warnedobstrue + \global\warnedobstrue \fi } @@ -762,15 +847,17 @@ % Since we want to separate VAR from REST-OF-LINE (which might be % empty), we can't just use \parsearg; we have to insert a space of our % own to delimit the rest of the line, and then take it out again if we -% didn't need it. +% didn't need it. Make sure the catcode of space is correct to avoid +% losing inside @example, for instance. % -\def\set{\parsearg\setxxx} +\def\set{\begingroup\catcode` =10 \parsearg\setxxx} \def\setxxx#1{\setyyy#1 \endsetyyy} \def\setyyy#1 #2\endsetyyy{% \def\temp{#2}% \ifx\temp\empty \global\expandafter\let\csname SET#1\endcsname = \empty \else \setzzz{#1}#2\endsetzzz % Remove the trailing space \setxxx inserted. \fi + \endgroup } % Can't use \xdef to pre-expand #2 and save some time, since \temp or % \next or other control sequences that we've defined might get us into @@ -785,9 +872,9 @@ % @value{foo} gets the text saved in variable foo. % \def\value#1{\expandafter - \ifx\csname SET#1\endcsname\relax - {\{No value for ``#1''\}} - \else \csname SET#1\endcsname \fi} + \ifx\csname SET#1\endcsname\relax + {\{No value for ``#1''\}} + \else \csname SET#1\endcsname \fi} % @ifset VAR ... @end ifset reads the `...' iff VAR has been defined % with @set. @@ -887,6 +974,7 @@ \expandafter\expandafter\expandafter\appendixsetref{\lastnode}\fi \global\let\lastnode=\relax} +% @refill is a no-op. \let\refill=\relax % @setfilename is done at the beginning of every texinfo file. @@ -901,11 +989,24 @@ \comment % Ignore the actual filename. } +% @bye. \outer\def\bye{\pagealignmacro\tracingstats=1\ptexend} -\def\inforef #1{\inforefzzz #1,,,,**} -\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, - node \samp{\ignorespaces#1{}}} +% \def\macro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\macroxxx} +% \def\macroxxx#1#2 \end macro{% +% \expandafter\gdef\macrotemp#1{#2}% +% \endgroup} + +%\def\linemacro#1{\begingroup\ignoresections\catcode`\#=6\def\macrotemp{#1}\parsearg\linemacroxxx} +%\def\linemacroxxx#1#2 \end linemacro{% +%\let\parsearg=\relax +%\edef\macrotempx{\csname M\butfirst\expandafter\string\macrotemp\endcsname}% +%\expandafter\xdef\macrotemp{\parsearg\macrotempx}% +%\expandafter\gdef\macrotempx#1{#2}% +%\endgroup} + +%\def\butfirst#1{} + \message{fonts,} @@ -917,12 +1018,16 @@ \def\sf{\fam=\sffam \tensf} \let\li = \sf % Sometimes we call it \li, not \sf. +% We don't need math for this one. +\def\ttsl{\tenttsl} + %% Try out Computer Modern fonts at \magstephalf \let\mainmagstep=\magstephalf % Set the font macro #1 to the font named #2, adding on the % specified font prefix (normally `cm'). -\def\setfont#1#2{\font#1=\fontprefix#2} +% #3 is the font's design size, #4 is a scale factor +\def\setfont#1#2#3#4{\font#1=\fontprefix#2#3 scaled #4} % Use cm as the default font prefix. % To specify the font prefix, you must define \fontprefix @@ -930,96 +1035,119 @@ \ifx\fontprefix\undefined \def\fontprefix{cm} \fi +% Support font families that don't use the same naming scheme as CM. +\def\rmshape{r} +\def\rmbshape{bx} %where the normal face is bold +\def\bfshape{b} +\def\bxshape{bx} +\def\ttshape{tt} +\def\ttbshape{tt} +\def\ttslshape{sltt} +\def\itshape{ti} +\def\itbshape{bxti} +\def\slshape{sl} +\def\slbshape{bxsl} +\def\sfshape{ss} +\def\sfbshape{ss} +\def\scshape{csc} +\def\scbshape{csc} \ifx\bigger\relax \let\mainmagstep=\magstep1 -\setfont\textrm{r12} -\setfont\texttt{tt12} +\setfont\textrm\rmshape{12}{1000} +\setfont\texttt\ttshape{12}{1000} \else -\setfont\textrm{r10 scaled \mainmagstep} -\setfont\texttt{tt10 scaled \mainmagstep} +\setfont\textrm\rmshape{10}{\mainmagstep} +\setfont\texttt\ttshape{10}{\mainmagstep} \fi % Instead of cmb10, you many want to use cmbx10. % cmbx10 is a prettier font on its own, but cmb10 % looks better when embedded in a line with cmr10. -\setfont\textbf{b10 scaled \mainmagstep} -\setfont\textit{ti10 scaled \mainmagstep} -\setfont\textsl{sl10 scaled \mainmagstep} -\setfont\textsf{ss10 scaled \mainmagstep} -\setfont\textsc{csc10 scaled \mainmagstep} +\setfont\textbf\bfshape{10}{\mainmagstep} +\setfont\textit\itshape{10}{\mainmagstep} +\setfont\textsl\slshape{10}{\mainmagstep} +\setfont\textsf\sfshape{10}{\mainmagstep} +\setfont\textsc\scshape{10}{\mainmagstep} +\setfont\textttsl\ttslshape{10}{\mainmagstep} \font\texti=cmmi10 scaled \mainmagstep \font\textsy=cmsy10 scaled \mainmagstep % A few fonts for @defun, etc. -\setfont\defbf{bx10 scaled \magstep1} %was 1314 -\setfont\deftt{tt10 scaled \magstep1} +\setfont\defbf\bxshape{10}{\magstep1} %was 1314 +\setfont\deftt\ttshape{10}{\magstep1} \def\df{\let\tentt=\deftt \let\tenbf = \defbf \bf} -% Fonts for indices and small examples. +% Fonts for indices and small examples (9pt). % We actually use the slanted font rather than the italic, % because texinfo normally uses the slanted fonts for that. % Do not make many font distinctions in general in the index, since they % aren't very useful. -\setfont\ninett{tt9} -\setfont\indrm{r9} -\setfont\indit{sl9} +\setfont\ninett\ttshape{9}{1000} +\setfont\indrm\rmshape{9}{1000} +\setfont\indit\slshape{9}{1000} \let\indsl=\indit \let\indtt=\ninett +\let\indttsl=\ninett \let\indsf=\indrm \let\indbf=\indrm -\setfont\indsc{csc10 at 9pt} +\setfont\indsc\scshape{10}{900} \font\indi=cmmi9 \font\indsy=cmsy9 -% Fonts for headings -\setfont\chaprm{bx12 scaled \magstep2} -\setfont\chapit{ti12 scaled \magstep2} -\setfont\chapsl{sl12 scaled \magstep2} -\setfont\chaptt{tt12 scaled \magstep2} -\setfont\chapsf{ss12 scaled \magstep2} +% Chapter (and unnumbered) fonts (17.28pt). +\setfont\chaprm\rmbshape{12}{\magstep2} +\setfont\chapit\itbshape{10}{\magstep3} +\setfont\chapsl\slbshape{10}{\magstep3} +\setfont\chaptt\ttbshape{12}{\magstep2} +\setfont\chapttsl\ttslshape{10}{\magstep3} +\setfont\chapsf\sfbshape{12}{\magstep2} \let\chapbf=\chaprm -\setfont\chapsc{csc10 scaled\magstep3} +\setfont\chapsc\scbshape{10}{\magstep3} \font\chapi=cmmi12 scaled \magstep2 \font\chapsy=cmsy10 scaled \magstep3 -\setfont\secrm{bx12 scaled \magstep1} -\setfont\secit{ti12 scaled \magstep1} -\setfont\secsl{sl12 scaled \magstep1} -\setfont\sectt{tt12 scaled \magstep1} -\setfont\secsf{ss12 scaled \magstep1} -\setfont\secbf{bx12 scaled \magstep1} -\setfont\secsc{csc10 scaled\magstep2} +% Section fonts (14.4pt). +\setfont\secrm\rmbshape{12}{\magstep1} +\setfont\secit\itbshape{10}{\magstep2} +\setfont\secsl\slbshape{10}{\magstep2} +\setfont\sectt\ttbshape{12}{\magstep1} +\setfont\secttsl\ttslshape{10}{\magstep2} +\setfont\secsf\sfbshape{12}{\magstep1} +\let\secbf\secrm +\setfont\secsc\scbshape{10}{\magstep2} \font\seci=cmmi12 scaled \magstep1 \font\secsy=cmsy10 scaled \magstep2 -% \setfont\ssecrm{bx10 scaled \magstep1} % This size an font looked bad. -% \setfont\ssecit{cmti10 scaled \magstep1} % The letters were too crowded. -% \setfont\ssecsl{sl10 scaled \magstep1} -% \setfont\ssectt{tt10 scaled \magstep1} -% \setfont\ssecsf{ss10 scaled \magstep1} - -%\setfont\ssecrm{b10 scaled 1315} % Note the use of cmb rather than cmbx. -%\setfont\ssecit{ti10 scaled 1315} % Also, the size is a little larger than -%\setfont\ssecsl{sl10 scaled 1315} % being scaled magstep1. -%\setfont\ssectt{tt10 scaled 1315} -%\setfont\ssecsf{ss10 scaled 1315} +% \setfont\ssecrm\bxshape{10}{\magstep1} % This size an font looked bad. +% \setfont\ssecit\itshape{10}{\magstep1} % The letters were too crowded. +% \setfont\ssecsl\slshape{10}{\magstep1} +% \setfont\ssectt\ttshape{10}{\magstep1} +% \setfont\ssecsf\sfshape{10}{\magstep1} + +%\setfont\ssecrm\bfshape{10}{1315} % Note the use of cmb rather than cmbx. +%\setfont\ssecit\itshape{10}{1315} % Also, the size is a little larger than +%\setfont\ssecsl\slshape{10}{1315} % being scaled magstep1. +%\setfont\ssectt\ttshape{10}{1315} +%\setfont\ssecsf\sfshape{10}{1315} %\let\ssecbf=\ssecrm -\setfont\ssecrm{bx12 scaled \magstephalf} -\setfont\ssecit{ti12 scaled \magstephalf} -\setfont\ssecsl{sl12 scaled \magstephalf} -\setfont\ssectt{tt12 scaled \magstephalf} -\setfont\ssecsf{ss12 scaled \magstephalf} -\setfont\ssecbf{bx12 scaled \magstephalf} -\setfont\ssecsc{csc10 scaled \magstep1} +% Subsection fonts (13.15pt). +\setfont\ssecrm\rmbshape{12}{\magstephalf} +\setfont\ssecit\itbshape{10}{1315} +\setfont\ssecsl\slbshape{10}{1315} +\setfont\ssectt\ttbshape{12}{\magstephalf} +\setfont\ssecttsl\ttslshape{10}{\magstep1} +\setfont\ssecsf\sfbshape{12}{\magstephalf} +\let\ssecbf\ssecrm +\setfont\ssecsc\scbshape{10}{\magstep1} \font\sseci=cmmi12 scaled \magstephalf \font\ssecsy=cmsy10 scaled \magstep1 % The smallcaps and symbol fonts should actually be scaled \magstep1.5, % but that is not a standard magnification. % Fonts for title page: -\setfont\titlerm{bx12 scaled \magstep3} +\setfont\titlerm\rmbshape{12}{\magstep3} \let\authorrm = \secrm % In order for the font changes to affect most math symbols and letters, @@ -1038,34 +1166,35 @@ % The font-changing commands redefine the meanings of \tenSTYLE, instead % of just \STYLE. We do this so that font changes will continue to work % in math mode, where it is the current \fam that is relevant in most -% cases, not the current. Plain TeX does, for example, -% \def\bf{\fam=\bffam \tenbf} By redefining \tenbf, we obviate the need -% to redefine \bf itself. +% cases, not the current font. Plain TeX does \def\bf{\fam=\bffam +% \tenbf}, for example. By redefining \tenbf, we obviate the need to +% redefine \bf itself. \def\textfonts{% \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc - \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy + \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy \let\tenttsl=\textttsl \resetmathfonts} \def\chapfonts{% \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc - \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy - \resetmathfonts} + \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy \let\tenttsl=\chapttsl + \resetmathfonts \setleading{19pt}} \def\secfonts{% \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc - \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy - \resetmathfonts} + \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy \let\tenttsl=\secttsl + \resetmathfonts \setleading{16pt}} \def\subsecfonts{% \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc - \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy - \resetmathfonts} + \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy \let\tenttsl=\ssecttsl + \resetmathfonts \setleading{15pt}} +\let\subsubsecfonts = \subsecfonts % Maybe make sssec fonts scaled magstephalf? \def\indexfonts{% \let\tenrm=\indrm \let\tenit=\indit \let\tensl=\indsl \let\tenbf=\indbf \let\tentt=\indtt \let\smallcaps=\indsc - \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy - \resetmathfonts} + \let\tensf=\indsf \let\teni=\indi \let\tensy=\indsy \let\tenttsl=\indttsl + \resetmathfonts \setleading{12pt}} % Set up the default fonts, so we can use them for creating boxes. % @@ -1075,9 +1204,9 @@ \newcount\fontdepth \fontdepth=0 % Fonts for short table of contents. -\setfont\shortcontrm{r12} -\setfont\shortcontbf{bx12} -\setfont\shortcontsl{sl12} +\setfont\shortcontrm\rmshape{12}{1000} +\setfont\shortcontbf\bxshape{12}{1000} +\setfont\shortcontsl\slshape{12}{1000} %% Add scribe-like font environments, plus @l for inline lisp (usually sans %% serif) and @ii for TeX italic @@ -1104,16 +1233,26 @@ \def\restorehyphenation{\hyphenchar\font = `- } \def\t#1{% - {\tt \nohyphenation \rawbackslash \frenchspacing #1}% + {\tt \rawbackslash \frenchspacing #1}% \null } -\let\ttfont = \t -%\def\samp #1{`{\tt \rawbackslash \frenchspacing #1}'\null} +\let\ttfont=\t \def\samp #1{`\tclose{#1}'\null} -\def\key #1{{\tt \nohyphenation \uppercase{#1}}\null} +\setfont\smallrm\rmshape{8}{1000} +\font\smallsy=cmsy9 +\def\key#1{{\smallrm\textfont2=\smallsy \leavevmode\hbox{% + \raise0.4pt\hbox{$\langle$}\kern-.08em\vtop{% + \vbox{\hrule\kern-0.4pt + \hbox{\raise0.4pt\hbox{\vphantom{$\langle$}}#1}}% + \kern-0.4pt\hrule}% + \kern-.06em\raise0.4pt\hbox{$\rangle$}}}} +% The old definition, with no lozenge: +%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null} \def\ctrl #1{{\tt \rawbackslash \hat}#1} \let\file=\samp +\let\url=\samp % perhaps include a hypertex \special eventually +\def\email#1{$\langle${\tt #1}$\rangle$} % @code is a modification of @t, % which makes spaces the same size as normal in the surrounding text. @@ -1139,13 +1278,13 @@ } % We *must* turn on hyphenation at `-' and `_' in \code. -% Otherwise, it is too hard to avoid overful hboxes +% Otherwise, it is too hard to avoid overfull hboxes % in the Emacs manual, the Library manual, etc. % Unfortunately, TeX uses one parameter (\hyphenchar) to control % both hyphenation at - and hyphenation within words. % We must therefore turn them both off (\tclose does that) -% and arrange explicitly to hyphenate an a dash. +% and arrange explicitly to hyphenate at a dash. % -- rms. { \catcode`\-=\active @@ -1157,6 +1296,7 @@ % ever called. -- mycroft \global\def\indexbreaks{\catcode`\-=\active \let-\realdash \catcode`\_=\active \let_\realunder} } + \def\realdash{-} \def\realunder{_} \def\codedash{-\discretionary{}{}{}} @@ -1167,12 +1307,19 @@ % @kbd is like @code, except that if the argument is just one @key command, % then @kbd has no effect. - +% \def\xkey{\key} \def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% \ifx\one\xkey\ifx\threex\three \key{#2}% -\else\tclose{\look}\fi -\else\tclose{\look}\fi} +\else{\tclose{\ttsl\look}}\fi +\else{\tclose{\ttsl\look}}\fi} + +% Check if we are currently using a typewriter font. Since all the +% Computer Modern typewriter fonts have zero interword stretch (and +% shrink), and it is reasonable to expect all typewriter fonts to have +% this property, we can check that font parameter. +% +\def\ifmonospace{\ifdim\fontdimen3\font=0pt } % Typeset a dimension, e.g., `in' or `pt'. The only reason for the % argument is to make the input look right: @dmn{pt} instead of @@ -1182,12 +1329,19 @@ \def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par} -\def\l#1{{\li #1}\null} % - -\def\r#1{{\rm #1}} % roman font +% @l was never documented to mean ``switch to the Lisp font'', +% and it is not used as such in any manual I can find. We need it for +% Polish suppressed-l. --karl, 22sep96. +%\def\l#1{{\li #1}\null} + +\def\r#1{{\rm #1}} % roman font % Use of \lowercase was suggested. -\def\sc#1{{\smallcaps#1}} % smallcaps font -\def\ii#1{{\it #1}} % italic font +\def\sc#1{{\smallcaps#1}} % smallcaps font +\def\ii#1{{\it #1}} % italic font + +% @pounds{} is a sterling sign. +\def\pounds{{\it\$}} + \message{page headings,} @@ -1202,7 +1356,7 @@ \def\shorttitlepage{\parsearg\shorttitlepagezzz} \def\shorttitlepagezzz #1{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}% - \endgroup\page\hbox{}\page} + \endgroup\page\hbox{}\page} \def\titlepage{\begingroup \parindent=0pt \textfonts \let\subtitlerm=\tenrm @@ -1219,9 +1373,9 @@ % Now you can print the title using @title. \def\title{\parsearg\titlezzz}% \def\titlezzz##1{\leftline{\titlefont{##1}} - % print a rule at the page bottom also. - \finishedtitlepagefalse - \vskip4pt \hrule height 4pt width \hsize \vskip4pt}% + % print a rule at the page bottom also. + \finishedtitlepagefalse + \vskip4pt \hrule height 4pt width \hsize \vskip4pt}% % No rule at page bottom unless we print one at the top with @title. \finishedtitlepagetrue % @@ -1239,7 +1393,7 @@ \let\oldpage = \page \def\page{% \iffinishedtitlepage\else - \finishtitlepage + \finishtitlepage \fi \oldpage \let\page = \oldpage @@ -1327,14 +1481,15 @@ % }% unbind the catcode of @. -% @headings double turns headings on for double-sided printing. -% @headings single turns headings on for single-sided printing. -% @headings off turns them off. -% @headings on same as @headings double, retained for compatibility. -% @headings after turns on double-sided headings after this page. -% @headings doubleafter turns on double-sided headings after this page. +% @headings double turns headings on for double-sided printing. +% @headings single turns headings on for single-sided printing. +% @headings off turns them off. +% @headings on same as @headings double, retained for compatibility. +% @headings after turns on double-sided headings after this page. +% @headings doubleafter turns on double-sided headings after this page. % @headings singleafter turns on single-sided headings after this page. -% By default, they are off. +% By default, they are off at the start of a document, +% and turned `on' after @end titlepage. \def\headings #1 {\csname HEADINGS#1\endcsname} @@ -1348,22 +1503,24 @@ % title on inside top of left hand pages, and page numbers on outside top % edge of all pages. \def\HEADINGSdouble{ -%\pagealignmacro \global\pageno=1 \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} +\global\let\contentsalignmacro = \chapoddpage } +\let\contentsalignmacro = \chappager + % For single-sided printing, chapter title goes across top left of page, % page number on top right. \def\HEADINGSsingle{ -%\pagealignmacro \global\pageno=1 \global\evenfootline={\hfil} \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} \global\oddheadline={\line{\thischapter\hfil\folio}} +\global\let\contentsalignmacro = \chappager } \def\HEADINGSon{\HEADINGSdouble} @@ -1374,6 +1531,7 @@ \global\oddfootline={\hfil} \global\evenheadline={\line{\folio\hfil\thistitle}} \global\oddheadline={\line{\thischapter\hfil\folio}} +\global\let\contentsalignmacro = \chapoddpage } \def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex} @@ -1382,6 +1540,7 @@ \global\oddfootline={\hfil} \global\evenheadline={\line{\thischapter\hfil\folio}} \global\oddheadline={\line{\thischapter\hfil\folio}} +\global\let\contentsalignmacro = \chappager } % Subroutines used in generating headings @@ -1405,6 +1564,7 @@ \def\settitle{\parsearg\settitlezzz} \def\settitlezzz #1{\gdef\thistitle{#1}} + \message{tables,} % @tabs -- simple alignment @@ -1437,7 +1597,7 @@ \newif\ifitemxneedsnegativevskip -\def\itemxpar{\par\ifitemxneedsnegativevskip\vskip-\parskip\nobreak\fi} +\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi} \def\internalBitem{\smallbreak \parsearg\itemzzz} \def\internalBitemx{\itemxpar \parsearg\itemzzz} @@ -1544,7 +1704,7 @@ \def\tablez #1#2#3#4#5#6{% \aboveenvbreak % \begingroup % -\def\Edescription{\Etable}% Neccessary kludge. +\def\Edescription{\Etable}% Necessary kludge. \let\itemindex=#1% \ifnum 0#3>0 \advance \leftskip by #3\mil \fi % \ifnum 0#4>0 \tableindent=#4\mil \fi % @@ -1708,10 +1868,10 @@ \flushcr} % @multitable macros -% Amy Hendrickson, 8/18/94 +% Amy Hendrickson, 8/18/94, 3/6/96 % -% @multitable ... @endmultitable will make as many columns as desired. -% Contents of each column will wrap at width given in preamble. Width +% @multitable ... @end multitable will make as many columns as desired. +% Contents of each column will wrap at width given in preamble. Width % can be specified either with sample text given in a template line, % or in percent of \hsize, the current width of text on page. @@ -1720,25 +1880,35 @@ % To make preamble: % % Either define widths of columns in terms of percent of \hsize: -% @multitable @percentofhsize .2 .3 .5 +% @multitable @columnfractions .25 .3 .45 % @item ... % -% Numbers following @percentofhsize are the percent of the total +% Numbers following @columnfractions are the percent of the total % current hsize to be used for each column. You may use as many % columns as desired. + % Or use a template: % @multitable {Column 1 template} {Column 2 template} {Column 3 template} % @item ... % using the widest term desired in each column. - +% +% For those who want to use more than one line's worth of words in +% the preamble, break the line within one argument and it +% will parse correctly, i.e., +% +% @multitable {Column 1 template} {Column 2 template} {Column 3 +% template} +% Not: +% @multitable {Column 1 template} {Column 2 template} +% {Column 3 template} % Each new table line starts with @item, each subsequent new column % starts with @tab. Empty columns may be produced by supplying @tab's % with nothing between them for as many times as empty columns are needed, % ie, @tab@tab@tab will produce two empty columns. -% @item, @tab, @multicolumn or @endmulticolumn do not need to be on their +% @item, @tab, @multitable or @end multitable do not need to be on their % own lines, but it will not hurt if they are. % Sample multitable: @@ -1756,71 +1926,86 @@ % % They will wrap at the width determined by the template. % @item@tab@tab This will be in third column. -% @endmultitable +% @end multitable % Default dimensions may be reset by user. -% @intableparskip will set vertical space between paragraphs in table. -% @intableparindent will set paragraph indent in table. -% @spacebetweencols will set horizontal space to be left between columns. -% @spacebetweenlines will set vertical space to be left between lines. +% @multitableparskip is vertical space between paragraphs in table. +% @multitableparindent is paragraph indent in table. +% @multitablecolmargin is horizontal space to be left between columns. +% @multitablelinespace is space to leave between table items, baseline +% to baseline. +% 0pt means it depends on current normal line spacing. %%%% % Dimensions -\newdimen\intableparskip -\newdimen\intableparindent -\newdimen\spacebetweencols -\newdimen\spacebetweenlines -\intableparskip=0pt -\intableparindent=6pt -\spacebetweencols=12pt -\spacebetweenlines=12pt +\newskip\multitableparskip +\newskip\multitableparindent +\newdimen\multitablecolspace +\newskip\multitablelinespace +\multitableparskip=0pt +\multitableparindent=6pt +\multitablecolspace=12pt +\multitablelinespace=0pt %%%% % Macros used to set up halign preamble: \let\endsetuptable\relax \def\xendsetuptable{\endsetuptable} -\let\percentofhsize\relax -\def\xpercentofhsize{\percentofhsize} +\let\columnfractions\relax +\def\xcolumnfractions{\columnfractions} \newif\ifsetpercent +%% 2/1/96, to allow fractions to be given with more than one digit. +\def\pickupwholefraction#1 {\global\advance\colcount by1 % +\expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}% +\setuptable} + \newcount\colcount \def\setuptable#1{\def\firstarg{#1}% \ifx\firstarg\xendsetuptable\let\go\relax% \else - \ifx\firstarg\xpercentofhsize\global\setpercenttrue% + \ifx\firstarg\xcolumnfractions\global\setpercenttrue% \else \ifsetpercent - \if#1.\else% - \global\advance\colcount by1 % - \expandafter\xdef\csname col\the\colcount\endcsname{.#1\hsize}% - \fi + \let\go\pickupwholefraction % In this case arg of setuptable + % is the decimal point before the + % number given in percent of hsize. + % We don't need this so we don't use it. \else \global\advance\colcount by1 - \setbox0=\hbox{#1}% + \setbox0=\hbox{#1 }% Add a normal word space as a separator; + % typically that is always in the input, anyway. \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}% \fi% \fi% - \let\go\setuptable% +\ifx\go\pickupwholefraction\else\let\go\setuptable\fi% \fi\go} + %%%% % multitable syntax -\def\tab{&} +\def\tab{&\hskip1sp\relax} % 2/2/96 + % tiny skip here makes sure this column space is + % maintained, even if it is never used. + %%%% -% @multitable ... @endmultitable definitions: - -\def\multitable#1\item{\bgroup +% @multitable ... @end multitable definitions: + +\def\multitable{\parsearg\dotable} + +\def\dotable#1{\bgroup \let\item\cr \tolerance=9500 \hbadness=9500 -\parskip=\intableparskip -\parindent=\intableparindent +\setmultitablespacing +\parskip=\multitableparskip +\parindent=\multitableparindent \overfullrule=0pt \global\colcount=0\relax% \def\Emultitable{\global\setpercentfalse\global\everycr{}\cr\egroup\egroup}% % To parse everything between @multitable and @item : -\def\one{#1}\expandafter\setuptable\one\endsetuptable +\setuptable#1 \endsetuptable % Need to reset this to 0 after \setuptable. \global\colcount=0\relax% % @@ -1829,11 +2014,11 @@ % \vtop will set a single line and will also let text wrap and % continue for many paragraphs if desired. \halign\bgroup&\global\advance\colcount by 1\relax% -\vtop{\hsize=\expandafter\csname col\the\colcount\endcsname +\multistrut\vtop{\hsize=\expandafter\csname col\the\colcount\endcsname % In order to keep entries from bumping into each other - % we will add a \leftskip of \spacebetweencols to all columns after + % we will add a \leftskip of \multitablecolspace to all columns after % the first one. - % If a template has been used, we will add \spacebetweencols + % If a template has been used, we will add \multitablecolspace % to the width of each template entry. % If user has set preamble in terms of percent of \hsize % we will use that dimension as the width of the column, and @@ -1845,20 +2030,46 @@ \ifsetpercent \else % If user has <not> set preamble in terms of percent of \hsize - % we will advance \hsize by \spacebetweencols - \advance\hsize by \spacebetweencols + % we will advance \hsize by \multitablecolspace + \advance\hsize by \multitablecolspace \fi - % In either case we will make \leftskip=\spacebetweencols: -\leftskip=\spacebetweencols + % In either case we will make \leftskip=\multitablecolspace: +\leftskip=\multitablecolspace \fi -\noindent##}\cr% +\noindent##\multistrut}\cr% % \everycr will reset column counter, \colcount, at the end of % each line. Every column entry will cause \colcount to advance by one. % The table preamble % looks at the current \colcount to find the correct column width. -\global\everycr{\noalign{\nointerlineskip\vskip\spacebetweenlines +\global\everycr{\noalign{% \filbreak%% keeps underfull box messages off when table breaks over pages. -\global\colcount=0\relax}}} +\global\colcount=0\relax}} +} + +\def\setmultitablespacing{% test to see if user has set \multitablelinespace. +% If so, do nothing. If not, give it an appropriate dimension based on +% current baselineskip. +\ifdim\multitablelinespace=0pt +%% strut to put in table in case some entry doesn't have descenders, +%% to keep lines equally spaced +\let\multistrut = \strut +%% Test to see if parskip is larger than space between lines of +%% table. If not, do nothing. +%% If so, set to same dimension as multitablelinespace. +\else +\gdef\multistrut{\vrule height\multitablelinespace depth\dp0 +width0pt\relax} \fi +\ifdim\multitableparskip>\multitablelinespace +\global\multitableparskip=\multitablelinespace +\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller + %% than skip between lines in the table. +\fi% +\ifdim\multitableparskip=0pt +\global\multitableparskip=\multitablelinespace +\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller + %% than skip between lines in the table. +\fi} + \message{indexing,} % Index generation facilities @@ -1872,14 +2083,14 @@ % It automatically defines \fooindex such that % \fooindex ...rest of line... puts an entry in the index foo. % It also defines \fooindfile to be the number of the output channel for -% the file that accumulates this index. The file's extension is foo. +% the file that accumulates this index. The file's extension is foo. % The name of an index should be no more than 2 characters long % for the sake of vms. \def\newindex #1{ \expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex +\openout \csname#1indfile\endcsname \jobname.#1 % Open the file +\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex \noexpand\doindex {#1}} } @@ -1891,8 +2102,8 @@ \def\newcodeindex #1{ \expandafter\newwrite \csname#1indfile\endcsname% Define number for output file -\openout \csname#1indfile\endcsname \jobname.#1 % Open the file -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex +\openout \csname#1indfile\endcsname \jobname.#1 % Open the file +\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex \noexpand\docodeindex {#1}} } @@ -1903,7 +2114,7 @@ \def\synindex #1 #2 {% \expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname \expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex +\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex \noexpand\doindex {#2}}% } @@ -1912,7 +2123,7 @@ \def\syncodeindex #1 #2 {% \expandafter\let\expandafter\synindexfoo\expandafter=\csname#2indfile\endcsname \expandafter\let\csname#1indfile\endcsname=\synindexfoo -\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex +\expandafter\xdef\csname#1index\endcsname{% % Define \xxxindex \noexpand\docodeindex {#2}}% } @@ -1960,24 +2171,31 @@ \def\L{\realbackslash L}% \def\ss{\realbackslash ss}% % Take care of texinfo commands likely to appear in an index entry. +% (Must be a way to avoid doing expansion at all, and thus not have to +% laboriously list every single command here.) +\def\@{@}% will be @@ when we switch to @ as escape char. +%\let\{ = \lbracecmd +%\let\} = \rbracecmd \def\_{{\realbackslash _}}% \def\w{\realbackslash w }% \def\bf{\realbackslash bf }% -\def\rm{\realbackslash rm }% +%\def\rm{\realbackslash rm }% \def\sl{\realbackslash sl }% \def\sf{\realbackslash sf}% \def\tt{\realbackslash tt}% \def\gtr{\realbackslash gtr}% \def\less{\realbackslash less}% \def\hat{\realbackslash hat}% -\def\char{\realbackslash char}% +%\def\char{\realbackslash char}% \def\TeX{\realbackslash TeX}% \def\dots{\realbackslash dots }% \def\copyright{\realbackslash copyright }% \def\tclose##1{\realbackslash tclose {##1}}% \def\code##1{\realbackslash code {##1}}% +\def\dotless##1{\realbackslash dotless {##1}}% \def\samp##1{\realbackslash samp {##1}}% -\def\t##1{\realbackslash r {##1}}% +\def\,##1{\realbackslash ,{##1}}% +\def\t##1{\realbackslash t {##1}}% \def\r##1{\realbackslash r {##1}}% \def\i##1{\realbackslash i {##1}}% \def\b##1{\realbackslash b {##1}}% @@ -1988,8 +2206,15 @@ \def\kbd##1{\realbackslash kbd {##1}}% \def\dfn##1{\realbackslash dfn {##1}}% \def\emph##1{\realbackslash emph {##1}}% +\unsepspaces } +% If an index command is used in an @example environment, any spaces +% therein should become regular spaces in the raw index file, not the +% expansion of \tie (\\leavevmode \penalty \@M \ ). +{\obeyspaces + \gdef\unsepspaces{\obeyspaces\let =\space}} + % \indexnofonts no-ops all font-change commands. % This is used when outputting the strings to sort the index by. \def\indexdummyfont#1{#1} @@ -1998,6 +2223,7 @@ \def\indexnofonts{% % Just ignore accents. +\let\,=\indexdummyfont \let\"=\indexdummyfont \let\`=\indexdummyfont \let\'=\indexdummyfont @@ -2010,6 +2236,7 @@ \let\u=\indexdummyfont \let\v=\indexdummyfont \let\H=\indexdummyfont +\let\dotless=\indexdummyfont % Take care of the plain tex special European modified letters. \def\oe{oe}% \def\ae{ae}% @@ -2043,6 +2270,7 @@ \let\var=\indexdummyfont \let\TeX=\indexdummytex \let\dots=\indexdummydots +\def\@{@}% } % To define \realbackslash, we must make \ not be an escape. @@ -2058,29 +2286,37 @@ % workhorse for all \fooindexes % #1 is name of index, #2 is stuff to put there \def\doind #1#2{% -% Put the index entry in the margin if desired. -\ifx\SETmarginindex\relax\else% -\insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}% -\fi% -{\count10=\lastpenalty % -{\indexdummies % Must do this here, since \bf, etc expand at this stage -\escapechar=`\\% -{\let\folio=0% Expand all macros now EXCEPT \folio -\def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now -% so it will be output as is; and it will print as backslash in the indx. -% -% Now process the index-string once, with all font commands turned off, -% to get the string to sort the index by. -{\indexnofonts -\xdef\temp1{#2}% -}% -% Now produce the complete index entry. We process the index-string again, -% this time with font commands expanded, to get what to print in the index. -\edef\temp{% -\write \csname#1indfile\endcsname{% -\realbackslash entry {\temp1}{\folio}{#2}}}% -\temp }% -}\penalty\count10}} + % Put the index entry in the margin if desired. + \ifx\SETmarginindex\relax\else + \insert\margin{\hbox{\vrule height8pt depth3pt width0pt #2}}% + \fi + {% + \count255=\lastpenalty + {% + \indexdummies % Must do this here, since \bf, etc expand at this stage + \escapechar=`\\ + {% + \let\folio=0 % We will expand all macros now EXCEPT \folio. + \def\rawbackslashxx{\indexbackslash}% \indexbackslash isn't defined now + % so it will be output as is; and it will print as backslash. + % + % First process the index-string with all font commands turned off + % to get the string to sort by. + {\indexnofonts \xdef\indexsorttmp{#2}}% + % + % Now produce the complete index entry, with both the sort key and the + % original text, including any font commands. + \toks0 = {#2}% + \edef\temp{% + \write\csname#1indfile\endcsname{% + \realbackslash entry{\indexsorttmp}{\folio}{\the\toks0}}% + }% + \temp + }% + }% + \penalty\count255 + }% +} \def\dosubind #1#2#3{% {\count10=\lastpenalty % @@ -2141,26 +2377,19 @@ \def\printindex{\parsearg\doprintindex} -\def\doprintindex#1{% - \tex - \dobreak \chapheadingskip {10000} - \catcode`\%=\other\catcode`\&=\other\catcode`\#=\other - \catcode`\$=\other - \catcode`\~=\other - \indexbreaks +\def\doprintindex#1{\begingroup + \dobreak \chapheadingskip{10000}% % - % The following don't help, since the chars were translated - % when the raw index was written, and their fonts were discarded - % due to \indexnofonts. - %\catcode`\"=\active - %\catcode`\^=\active - %\catcode`\_=\active - %\catcode`\|=\active - %\catcode`\<=\active - %\catcode`\>=\active - % % - \def\indexbackslash{\rawbackslashxx} - \indexfonts\rm \tolerance=9500 \advance\baselineskip -1pt + \indexfonts \rm + \tolerance = 9500 + \indexbreaks + \def\indexbackslash{\rawbackslashxx}% + % Index files are almost Texinfo source, but we use \ as the escape + % character. It would be better to use @, but that's too big a change + % to make right now. + \catcode`\\ = 0 + \catcode`\@ = 11 + \escapechar = `\\ \begindoublecolumns % % See if the index file exists and is nonempty. @@ -2171,7 +2400,7 @@ % index. The easiest way to prevent this problem is to make sure % there is some text. (Index is nonexistent) - \else + \else % % If the index file exists but is empty, then \openin leaves \ifeof % false. We have to make TeX try to read something from the file, so @@ -2185,8 +2414,7 @@ \fi \closein 1 \enddoublecolumns - \Etex -} +\endgroup} % These macros are used by the sorted index file itself. % Change them to control the appearance of the index. @@ -2240,7 +2468,7 @@ % % Insert the text of the index entry. TeX will do line-breaking on it. #1% - % The following is kluged to not output a line of dots in the index if + % The following is kludged to not output a line of dots in the index if % there are no page numbers. The next person who breaks this will be % cursed by a Unix daemon. \def\tempa{{\rm }}% @@ -2277,15 +2505,15 @@ \noindent\hskip\secondaryindent\hbox{#1}\indexdotfill #2\par }} -%% Define two-column mode, which is used in indexes. -%% Adapted from the TeXbook, page 416. -\catcode `\@=11 +% Define two-column mode, which we use to typeset indexes. +% Adapted from the TeXbook, page 416, which is to say, +% the manmac.tex format used to print the TeXbook itself. +\catcode`\@=11 \newbox\partialpage - \newdimen\doublecolumnhsize -\def\begindoublecolumns{\begingroup +\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns % Grab any single-column material above us. \output = {\global\setbox\partialpage =\vbox{\unvbox255\kern -\topskip \kern \baselineskip}}% @@ -2318,51 +2546,51 @@ % Double the \vsize as well. (We don't need a separate register here, % since nobody clobbers \vsize.) \vsize = 2\vsize - \doublecolumnpagegoal } - -\def\enddoublecolumns{\eject \endgroup \pagegoal=\vsize \unvbox\partialpage} - -\def\doublecolumnsplit{\splittopskip=\topskip \splitmaxdepth=\maxdepth - \global\dimen@=\pageheight \global\advance\dimen@ by-\ht\partialpage - \global\setbox1=\vsplit255 to\dimen@ \global\setbox0=\vbox{\unvbox1} - \global\setbox3=\vsplit255 to\dimen@ \global\setbox2=\vbox{\unvbox3} - \ifdim\ht0>\dimen@ \setbox255=\vbox{\unvbox0\unvbox2} \global\setbox255=\copy5 \fi - \ifdim\ht2>\dimen@ \setbox255=\vbox{\unvbox0\unvbox2} \global\setbox255=\copy5 \fi -} -\def\doublecolumnpagegoal{% - \dimen@=\vsize \advance\dimen@ by-2\ht\partialpage \global\pagegoal=\dimen@ -} -\def\pagesofar{\unvbox\partialpage % - \hsize=\doublecolumnhsize % have to restore this since output routine - \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}} \def\doublecolumnout{% - \setbox5=\copy255 - {\vbadness=10000 \doublecolumnsplit} - \ifvbox255 - \setbox0=\vtop to\dimen@{\unvbox0} - \setbox2=\vtop to\dimen@{\unvbox2} - \onepageout\pagesofar \unvbox255 \penalty\outputpenalty - \else - \setbox0=\vbox{\unvbox5} - \ifvbox0 - \dimen@=\ht0 \advance\dimen@ by\topskip \advance\dimen@ by-\baselineskip - \divide\dimen@ by2 \splittopskip=\topskip \splitmaxdepth=\maxdepth - {\vbadness=10000 - \loop \global\setbox5=\copy0 - \setbox1=\vsplit5 to\dimen@ - \setbox3=\vsplit5 to\dimen@ - \ifvbox5 \global\advance\dimen@ by1pt \repeat - \setbox0=\vbox to\dimen@{\unvbox1} - \setbox2=\vbox to\dimen@{\unvbox3} - \global\setbox\partialpage=\vbox{\pagesofar} - \doublecolumnpagegoal - } - \fi - \fi + \splittopskip=\topskip \splitmaxdepth=\maxdepth + % Get the available space for the double columns -- the normal + % (undoubled) page height minus any material left over from the + % previous page. + \dimen@=\pageheight \advance\dimen@ by-\ht\partialpage + % box0 will be the left-hand column, box1 the right. + \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@ + \onepageout\pagesofar + \unvbox255 \penalty\outputpenalty +} +\def\pagesofar{% + % The contents of the output page -- any previous material, + % followed by the two boxes we just split. + \unvbox\partialpage + \hsize = \doublecolumnhsize + \wd0=\hsize \wd2=\hsize \hbox to\pagewidth{\box0\hfil\box2}% } - +\def\enddoublecolumns{% + \output={\balancecolumns}\eject % split what we have + \endgroup + % Back to normal single-column typesetting, but take account of the + % fact that we just accumulated some stuff on the output page. + \pagegoal=\vsize +} +\def\balancecolumns{% + % Called on the last page of the double column material. + \setbox0=\vbox{\unvbox255}% + \dimen@ = \ht0 + \advance\dimen@ by \topskip + \advance\dimen@ by-\baselineskip + \divide\dimen@ by 2 + \splittopskip = \topskip + % Loop until we get a decent breakpoint. + {\vbadness=10000 \loop \global\setbox3=\copy0 + \global\setbox1=\vsplit3 to\dimen@ + \ifdim\ht3>\dimen@ \global\advance\dimen@ by1pt \repeat}% + \setbox0=\vbox to\dimen@{\unvbox1}% + \setbox2=\vbox to\dimen@{\unvbox3}% + \pagesofar +} \catcode `\@=\other + + \message{sectioning,} % Define chapters, sections, etc. @@ -2534,6 +2762,10 @@ \global\let\subsubsection = \appendixsubsubsec }} +% @centerchap is like @unnumbered, but the heading is centered. +\outer\def\centerchap{\parsearg\centerchapyyy} +\def\centerchapyyy #1{{\let\unnumbchapmacro=\centerchapmacro \unnumberedyyy{#1}}} + \outer\def\top{\parsearg\unnumberedyyy} \outer\def\unnumbered{\parsearg\unnumberedyyy} \def\unnumberedyyy #1{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz @@ -2578,7 +2810,7 @@ \penalty 10000 % }} -\outer\def\appenixsection{\parsearg\appendixsecyyy} +\outer\def\appendixsection{\parsearg\appendixsecyyy} \outer\def\appendixsec{\parsearg\appendixsecyyy} \def\appendixsecyyy #1{\apphead1{#1}} % normally calls appendixsectionzzz \def\appendixsectionzzz #1{\seccheck{appendixsection}% @@ -2636,7 +2868,7 @@ \outer\def\unnumberedsubsec{\parsearg\unnumberedsubsecyyy} \def\unnumberedsubsecyyy #1{\unnmhead2{#1}} %normally calls unnumberedsubseczzz \def\unnumberedsubseczzz #1{\seccheck{unnumberedsubsec}% -\plainsecheading {#1}\gdef\thissection{#1}% +\plainsubsecheading {#1}\gdef\thissection{#1}% {\chapternofonts% \edef\temp{{\realbackslash unnumbsubsecentry{#1}{\noexpand\folio}}}% \escapechar=`\\% @@ -2681,7 +2913,7 @@ \outer\def\unnumberedsubsubsec{\parsearg\unnumberedsubsubsecyyy} \def\unnumberedsubsubsecyyy #1{\unnmhead3{#1}} %normally unnumberedsubsubseczzz \def\unnumberedsubsubseczzz #1{\seccheck{unnumberedsubsubsec}% -\plainsecheading {#1}\gdef\thissection{#1}% +\plainsubsubsecheading {#1}\gdef\thissection{#1}% {\chapternofonts% \edef\temp{{\realbackslash unnumbsubsubsecentry{#1}{\noexpand\folio}}}% \escapechar=`\\% @@ -2719,10 +2951,10 @@ % NOTE on use of \vbox for chapter headings, section headings, and % such: -% 1) We use \vbox rather than the earlier \line to permit -% overlong headings to fold. -% 2) \hyphenpenalty is set to 10000 because hyphenation in a -% heading is obnoxious; this forbids it. +% 1) We use \vbox rather than the earlier \line to permit +% overlong headings to fold. +% 2) \hyphenpenalty is set to 10000 because hyphenation in a +% heading is obnoxious; this forbids it. % 3) Likewise, headings look best if no \parindent is used, and % if justification is not attempted. Hence \raggedright. @@ -2740,11 +2972,10 @@ \parindent=0pt\raggedright \rm #1\hfill}}\bigskip \par\penalty 200} -\def\heading{\parsearg\secheadingi} - -\def\subheading{\parsearg\subsecheadingi} - -\def\subsubheading{\parsearg\subsubsecheadingi} +% @heading, @subheading, @subsubheading. +\def\heading{\parsearg\plainsecheading} +\def\subheading{\parsearg\plainsubsecheading} +\def\subsubheading{\parsearg\plainsubsubsecheading} % These macros generate a chapter, section, etc. heading only % (including whitespace, linebreaking, etc. around it), @@ -2758,7 +2989,7 @@ %%% Define plain chapter starts, and page on/off switching for it % Parameter controlling skip before chapter headings (if needed) -\newskip \chapheadingskip \chapheadingskip = 30pt plus 8pt minus 4pt +\newskip\chapheadingskip \def\chapbreak{\dobreak \chapheadingskip {-4000}} \def\chappager{\par\vfill\supereject} @@ -2767,15 +2998,18 @@ \def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname} \def\CHAPPAGoff{ +\global\let\contentsalignmacro = \chappager \global\let\pchapsepmacro=\chapbreak \global\let\pagealignmacro=\chappager} \def\CHAPPAGon{ +\global\let\contentsalignmacro = \chappager \global\let\pchapsepmacro=\chappager \global\let\pagealignmacro=\chappager \global\def\HEADINGSon{\HEADINGSsingle}} \def\CHAPPAGodd{ +\global\let\contentsalignmacro = \chapoddpage \global\let\pchapsepmacro=\chapoddpage \global\let\pagealignmacro=\chapoddpage \global\def\HEADINGSon{\HEADINGSdouble}} @@ -2784,25 +3018,39 @@ \def\CHAPFplain{ \global\let\chapmacro=\chfplain -\global\let\unnumbchapmacro=\unnchfplain} - -\def\chfplain #1#2{% +\global\let\unnumbchapmacro=\unnchfplain +\global\let\centerchapmacro=\centerchfplain} + +% Plain chapter opening. +% #1 is the text, #2 the chapter number or empty if unnumbered. +\def\chfplain#1#2{% \pchapsepmacro {% - \chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #2\enspace #1}% + \chapfonts \rm + \def\chapnum{#2}% + \setbox0 = \hbox{#2\ifx\chapnum\empty\else\enspace\fi}% + \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright + \hangindent = \wd0 \centerparametersmaybe + \unhbox0 #1\par}% }% - \bigskip - \penalty5000 + \nobreak\bigskip % no page break after a chapter title + \nobreak } -\def\unnchfplain #1{% -\pchapsepmacro % -{\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}\bigskip \par\penalty 10000 % -} +% Plain opening for unnumbered. +\def\unnchfplain#1{\chfplain{#1}{}} + +% @centerchap -- centered and unnumbered. +\let\centerparametersmaybe = \relax +\def\centerchfplain#1{{% + \def\centerparametersmaybe{% + \advance\rightskip by 3\rightskip + \leftskip = \rightskip + \parfillskip = 0pt + }% + \chfplain{#1}{}% +}} + \CHAPFplain % The default \def\unnchfopen #1{% @@ -2816,73 +3064,81 @@ \par\penalty 5000 % } +\def\centerchfopen #1{% +\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000 + \parindent=0pt + \hfill {\rm #1}\hfill}}\bigskip \par\penalty 10000 % +} + \def\CHAPFopen{ \global\let\chapmacro=\chfopen -\global\let\unnumbchapmacro=\unnchfopen} - -% Parameter controlling skip before section headings. - -\newskip \subsecheadingskip \subsecheadingskip = 17pt plus 8pt minus 4pt -\def\subsecheadingbreak{\dobreak \subsecheadingskip {-500}} - -\newskip \secheadingskip \secheadingskip = 21pt plus 8pt minus 4pt +\global\let\unnumbchapmacro=\unnchfopen +\global\let\centerchapmacro=\centerchfopen} + + +% Section titles. +\newskip\secheadingskip \def\secheadingbreak{\dobreak \secheadingskip {-1000}} - -% @paragraphindent is defined for the Info formatting commands only. -\let\paragraphindent=\comment - -% Section fonts are the base font at magstep2, which produces -% a size a bit more than 14 points in the default situation. - -\def\secheading #1#2#3{\secheadingi {#2.#3\enspace #1}} -\def\plainsecheading #1{\secheadingi {#1}} -\def\secheadingi #1{{\advance \secheadingskip by \parskip % -\secheadingbreak}% -{\secfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}% -\ifdim \parskip<10pt \kern 10pt\kern -\parskip\fi \penalty 10000 } - - -% Subsection fonts are the base font at magstep1, -% which produces a size of 12 points. - -\def\subsecheading #1#2#3#4{\subsecheadingi {#2.#3.#4\enspace #1}} -\def\subsecheadingi #1{{\advance \subsecheadingskip by \parskip % -\subsecheadingbreak}% -{\subsecfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}% -\ifdim \parskip<10pt \kern 10pt\kern -\parskip\fi \penalty 10000 } - -\def\subsubsecfonts{\subsecfonts} % Maybe this should change: - % Perhaps make sssec fonts scaled - % magstep half -\def\subsubsecheading #1#2#3#4#5{\subsubsecheadingi {#2.#3.#4.#5\enspace #1}} -\def\subsubsecheadingi #1{{\advance \subsecheadingskip by \parskip % -\subsecheadingbreak}% -{\subsubsecfonts \vbox{\hyphenpenalty=10000\tolerance=5000 - \parindent=0pt\raggedright - \rm #1\hfill}}% -\ifdim \parskip<10pt \kern 10pt\kern -\parskip\fi \penalty 10000} +\def\secheading#1#2#3{\sectionheading{sec}{#2.#3}{#1}} +\def\plainsecheading#1{\sectionheading{sec}{}{#1}} + +% Subsection titles. +\newskip \subsecheadingskip +\def\subsecheadingbreak{\dobreak \subsecheadingskip {-500}} +\def\subsecheading#1#2#3#4{\sectionheading{subsec}{#2.#3.#4}{#1}} +\def\plainsubsecheading#1{\sectionheading{subsec}{}{#1}} + +% Subsubsection titles. +\let\subsubsecheadingskip = \subsecheadingskip +\let\subsubsecheadingbreak = \subsecheadingbreak +\def\subsubsecheading#1#2#3#4#5{\sectionheading{subsubsec}{#2.#3.#4.#5}{#1}} +\def\plainsubsubsecheading#1{\sectionheading{subsubsec}{}{#1}} + + +% Print any size section title. +% +% #1 is the section type (sec/subsec/subsubsec), #2 is the section +% number (maybe empty), #3 the text. +\def\sectionheading#1#2#3{% + {% + \expandafter\advance\csname #1headingskip\endcsname by \parskip + \csname #1headingbreak\endcsname + }% + {% + % Switch to the right set of fonts. + \csname #1fonts\endcsname \rm + % + % Only insert the separating space if we have a section number. + \def\secnum{#2}% + \setbox0 = \hbox{#2\ifx\secnum\empty\else\enspace\fi}% + % + \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright + \hangindent = \wd0 % zero if no section number + \unhbox0 #3}% + }% + \ifdim\parskip<10pt \nobreak\kern10pt\nobreak\kern-\parskip\fi \nobreak +} \message{toc printing,} - % Finish up the main text and prepare to read what we've written % to \contentsfile. \newskip\contentsrightmargin \contentsrightmargin=1in \def\startcontents#1{% - \pagealignmacro + % If @setchapternewpage on, and @headings double, the contents should + % start on an odd page, unlike chapters. Thus, we maintain + % \contentsalignmacro in parallel with \pagealignmacro. + % From: Torbjorn Granlund <tege@matematik.su.se> + \contentsalignmacro \immediate\closeout \contentsfile \ifnum \pageno>0 - \pageno = -1 % Request roman numbered pages. + \pageno = -1 % Request roman numbered pages. \fi % Don't need to put `Contents' or `Short Contents' in the headline. % It is abundantly clear what they are. \unnumbchapmacro{#1}\def\thischapter{}% - \begingroup % Set up to handle contents files properly. + \begingroup % Set up to handle contents files properly. \catcode`\\=0 \catcode`\{=1 \catcode`\}=2 \catcode`\@=11 \catcode`\^=7 % to see ^^e4 as \"a etc. juha@piuha.ydi.vtt.fi \raggedbottom % Worry more about breakpoints than the bottom. @@ -2908,6 +3164,7 @@ \secfonts \let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl \rm + \hyphenpenalty = 10000 \advance\baselineskip by 1pt % Open it up a little. \def\secentry ##1##2##3##4{} \def\unnumbsecentry ##1##2{} @@ -2951,7 +3208,7 @@ % This space should be plenty, since a single number is .5em, and the % widest letter (M) is 1em, at least in the Computer Modern fonts. % (This space doesn't include the extra space that gets added after - % the label; that gets put in in \shortchapentry above.) + % the label; that gets put in by \shortchapentry above.) \advance\dimen0 by 1.1em \hbox to \dimen0{#1\hfil}% } @@ -2972,22 +3229,21 @@ \dosubsubsecentry{#2.#3.#4.#5\labelspace#1}{#6}} \def\unnumbsubsubsecentry#1#2{\dosubsubsecentry{#1}{#2}} - % This parameter controls the indentation of the various levels. \newdimen\tocindent \tocindent = 3pc % Now for the actual typesetting. In all these, #1 is the text and #2 is the % page number. % -% If the toc has to be broken over pages, we would want to be at chapters +% If the toc has to be broken over pages, we want it to be at chapters % if at all possible; hence the \penalty. \def\dochapentry#1#2{% - \penalty-300 \vskip\baselineskip + \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip \begingroup \chapentryfonts \tocentry{#1}{\dopageno{#2}}% \endgroup - \nobreak\vskip .25\baselineskip + \nobreak\vskip .25\baselineskip plus.1\baselineskip } \def\dosecentry#1#2{\begingroup @@ -3010,9 +3266,10 @@ % can't do that in the \entry macro, since index entries might consist % of hyphenated-identifiers-that-do-not-fit-on-a-line-and-nothing-else.) % +% \turnoffactive is for the sake of @" used for umlauts. \def\tocentry#1#2{\begingroup - \hyphenpenalty = 10000 - \entry{#1}{#2}% + \vskip 0pt plus1pt % allow a little stretch for the sake of nice page breaks + \entry{\turnoffactive #1}{\turnoffactive #2}% \endgroup} % Space between chapter (or whatever) number and the title. @@ -3036,8 +3293,6 @@ \newbox\pushcharbox \newbox\bullbox \newbox\equivbox \newbox\errorbox -\let\ptexequiv = \equiv - %{\tentt %\global\setbox\dblarrowbox = \hbox to 1em{\hfil$\Rightarrow$\hfil} %\global\setbox\longdblarrowbox = \hbox to 1em{\hfil$\mapsto$\hfil} @@ -3048,12 +3303,11 @@ % depth .1ex\hfil} %} +% @point{}, @result{}, @expansion{}, @print{}, @equiv{}. \def\point{$\star$} - \def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}} \def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}} \def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}} - \def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}} % Adapted from the TeXbook's \boxit. @@ -3085,7 +3339,7 @@ \catcode `\$=3 \catcode `\&=4 \catcode `\#=6 \catcode `\^=7 \catcode `\_=8 \catcode `\~=13 \let~=\tie \catcode `\%=14 -\catcode 43=12 +\catcode 43=12 % plus \catcode`\"=12 \catcode`\==12 \catcode`\|=12 @@ -3093,16 +3347,18 @@ \catcode`\>=12 \escapechar=`\\ % +\let\,=\ptexcomma \let\~=\ptextilde \let\{=\ptexlbrace \let\}=\ptexrbrace \let\.=\ptexdot \let\*=\ptexstar \let\dots=\ptexdots +\def\endldots{\mathinner{\ldots\ldots\ldots\ldots}} +\def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi} \def\@{@}% \let\bullet=\ptexbullet -\let\b=\ptexb \let\c=\ptexc \let\i=\ptexi \let\t=\ptext \let\l=\ptexl -\let\L=\ptexL +\let\b=\ptexb \let\c=\ptexc \let\i=\ptexi \let\t=\ptext % \let\Etex=\endgroup} @@ -3161,50 +3417,50 @@ \def\cbl{{\circle\char'012\hskip -6pt}} \def\cbr{{\hskip 6pt\circle\char'011}} \def\carttop{\hbox to \cartouter{\hskip\lskip - \ctl\leaders\hrule height\circthick\hfil\ctr - \hskip\rskip}} + \ctl\leaders\hrule height\circthick\hfil\ctr + \hskip\rskip}} \def\cartbot{\hbox to \cartouter{\hskip\lskip - \cbl\leaders\hrule height\circthick\hfil\cbr - \hskip\rskip}} + \cbl\leaders\hrule height\circthick\hfil\cbr + \hskip\rskip}} % \newskip\lskip\newskip\rskip \long\def\cartouche{% \begingroup - \lskip=\leftskip \rskip=\rightskip - \leftskip=0pt\rightskip=0pt %we want these *outside*. - \cartinner=\hsize \advance\cartinner by-\lskip - \advance\cartinner by-\rskip - \cartouter=\hsize - \advance\cartouter by 18pt % allow for 3pt kerns on either -% side, and for 6pt waste from -% each corner char - \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip - % Flag to tell @lisp, etc., not to narrow margin. - \let\nonarrowing=\comment - \vbox\bgroup - \baselineskip=0pt\parskip=0pt\lineskip=0pt - \carttop - \hbox\bgroup - \hskip\lskip - \vrule\kern3pt - \vbox\bgroup - \hsize=\cartinner - \kern3pt - \begingroup - \baselineskip=\normbskip - \lineskip=\normlskip - \parskip=\normpskip - \vskip -\parskip + \lskip=\leftskip \rskip=\rightskip + \leftskip=0pt\rightskip=0pt %we want these *outside*. + \cartinner=\hsize \advance\cartinner by-\lskip + \advance\cartinner by-\rskip + \cartouter=\hsize + \advance\cartouter by 18pt % allow for 3pt kerns on either +% side, and for 6pt waste from +% each corner char + \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip + % Flag to tell @lisp, etc., not to narrow margin. + \let\nonarrowing=\comment + \vbox\bgroup + \baselineskip=0pt\parskip=0pt\lineskip=0pt + \carttop + \hbox\bgroup + \hskip\lskip + \vrule\kern3pt + \vbox\bgroup + \hsize=\cartinner + \kern3pt + \begingroup + \baselineskip=\normbskip + \lineskip=\normlskip + \parskip=\normpskip + \vskip -\parskip \def\Ecartouche{% - \endgroup - \kern3pt - \egroup - \kern3pt\vrule - \hskip\rskip - \egroup - \cartbot - \egroup + \endgroup + \kern3pt + \egroup + \kern3pt\vrule + \hskip\rskip + \egroup + \cartbot + \egroup \endgroup }} @@ -3267,8 +3523,7 @@ \let\Esmalllisp = \nonfillfinish \let\Esmallexample = \nonfillfinish % - % Smaller interline space and fonts for small examples. - \setleading{10pt}% + % Smaller fonts for small examples. \indexfonts \tt \rawbackslash % make \ output the \ character from the current font (tt) \gobble @@ -3796,6 +4051,7 @@ \def\deftpx #1 {\errmessage{@deftpx in invalid context}} + \message{cross reference,} % Define cross-reference macros \newwrite \auxfile @@ -3803,6 +4059,11 @@ \newif\ifhavexrefs % True if xref values are known. \newif\ifwarnedxrefs % True if we warned once that they aren't known. +% @inforef is simple. +\def\inforef #1{\inforefzzz #1,,,,**} +\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}}, + node \samp{\ignorespaces#1{}}} + % \setref{foo} defines a cross-reference point named foo. \def\setref#1{% @@ -3836,7 +4097,10 @@ \setbox0=\hbox{\printednodename}% \ifdim \wd0 = 0pt % No printed node name was explicitly given. - \ifx\SETxref-automatic-section-title\relax % + \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax + % Use the node name inside the square brackets. + \def\printednodename{\ignorespaces #1}% + \else % Use the actual chapter/section title appear inside % the square brackets. Use the real section title if we have it. \ifdim \wd1>0pt% @@ -3845,16 +4109,12 @@ \else \ifhavexrefs % We know the real title if we have the xref values. - \def\printednodename{\refx{#1-title}}% + \def\printednodename{\refx{#1-title}{}}% \else % Otherwise just copy the Info node name. \def\printednodename{\ignorespaces #1}% \fi% \fi - \def\printednodename{#1-title}% - \else - % Use the node name inside the square brackets. - \def\printednodename{\ignorespaces #1}% \fi \fi % @@ -4039,7 +4299,8 @@ % The trailing space in the following definition for supereject is % vital for proper filling; pages come out unaligned when you do a % pagealignmacro call if that space before the closing brace is -% removed. +% removed. (Generally, numeric constants should always be followed by a +% space to prevent strange expansion errors.) \def\supereject{\par\penalty -20000\footnoteno =0 } % @footnotestyle is meaningful for info output only.. @@ -4164,13 +4425,18 @@ % Set some numeric style parameters, for 8.5 x 11 format. -%\hsize = 6.5in +\hsize = 6in +\hoffset = .25in \newdimen\defaultparindent \defaultparindent = 15pt \parindent = \defaultparindent -\parskip 18pt plus 1pt -\setleading{15pt} +\parskip 3pt plus 2pt minus 1pt +\setleading{13.2pt} \advance\topskip by 1.2cm +\chapheadingskip = 15pt plus 4pt minus 2pt +\secheadingskip = 12pt plus 3pt minus 2pt +\subsecheadingskip = 9pt plus 2pt minus 2pt + % Prevent underfull vbox error messages. \vbadness=10000 @@ -4193,30 +4459,28 @@ % Use @smallbook to reset parameters for 7x9.5 format (or else 7x9.25) \def\smallbook{ - -% These values for secheadingskip and subsecheadingskip are -% experiments. RJC 7 Aug 1992 -\global\secheadingskip = 17pt plus 6pt minus 3pt -\global\subsecheadingskip = 14pt plus 6pt minus 3pt - -\global\lispnarrowing = 0.3in -\setleading{12pt} -\advance\topskip by -1cm -\global\parskip 3pt plus 1pt -\global\hsize = 5in -\global\vsize=7.5in -\global\tolerance=700 -\global\hfuzz=1pt -\global\contentsrightmargin=0pt -\global\deftypemargin=0pt -\global\defbodyindent=.5cm - -\global\pagewidth=\hsize -\global\pageheight=\vsize - -\global\let\smalllisp=\smalllispx -\global\let\smallexample=\smalllispx -\global\def\Esmallexample{\Esmalllisp} + \global\chapheadingskip = 15pt plus 4pt minus 2pt + \global\secheadingskip = 12pt plus 3pt minus 2pt + \global\subsecheadingskip = 9pt plus 2pt minus 2pt + % + \global\lispnarrowing = 0.3in + \setleading{12pt} + \advance\topskip by -1cm + \global\parskip 2pt plus 1pt + \global\hsize = 5in + \global\vsize=7.5in + \global\tolerance=700 + \global\hfuzz=1pt + \global\contentsrightmargin=0pt + \global\deftypemargin=0pt + \global\defbodyindent=.5cm + % + \global\pagewidth=\hsize + \global\pageheight=\vsize + % + \global\let\smalllisp=\smalllispx + \global\let\smallexample=\smalllispx + \global\def\Esmallexample{\Esmalllisp} } % Use @afourpaper to print on European A4 paper. @@ -4239,12 +4503,19 @@ \global\pageheight=\vsize } +\bindingoffset=0pt +\normaloffset=\hoffset +\pagewidth=\hsize +\pageheight=\vsize + % Allow control of the text dimensions. Parameters in order: textheight; -% textwidth; \voffset; \hoffset (!); binding offset. All require a dimension; +% textwidth; voffset; hoffset; binding offset; topskip. +% All require a dimension; % header is additional; added length extends the bottom of the page. -\def\changepagesizes#1#2#3#4#5{ +\def\changepagesizes#1#2#3#4#5#6{ \global\vsize= #1 + \global\topskip= #6 \advance\vsize by \topskip \global\voffset= #3 \global\hsize= #2 @@ -4257,13 +4528,20 @@ \global\normaloffset= #4 \global\bindingoffset= #5} -% This layout is compatible with Latex on A4 paper. - -\def\afourlatex{\changepagesizes{22cm}{15cm}{7mm}{4.6mm}{5mm}} +% A specific text layout, 24x15cm overall, intended for A4 paper. Top margin +% 29mm, hence bottom margin 28mm, nominal side margin 3cm. +\def\afourlatex + {\global\tolerance=700 + \global\hfuzz=1pt + \setleading{12pt} + \global\parskip 15pt plus 1pt + \advance\baselineskip by 1.6pt + \changepagesizes{237mm}{150mm}{3.6mm}{3.6mm}{3mm}{7mm} + } % Use @afourwide to print on European A4 paper in wide format. \def\afourwide{\afourpaper -\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}} +\changepagesizes{9.5in}{6.5in}{\hoffset}{\normaloffset}{\bindingoffset}{7mm}} % Define macros to output various characters with catcode for normal text. \catcode`\"=\other @@ -4312,14 +4590,7 @@ \catcode`\_=\active \def_{\ifusingtt\normalunderscore\_} % Subroutine for the previous macro. -\def\_{\lvvmode \kern.06em \vbox{\hrule width.3em height.1ex}} - -% \lvvmode is equivalent in function to \leavevmode. -% Using \leavevmode runs into trouble when written out to -% an index file due to the expansion of \leavevmode into ``\unhbox -% \voidb@x'' ---which looks to TeX like ``\unhbox \voidb\x'' due to our -% magic tricks with @. -\def\lvvmode{\vbox to 0pt{}} +\def\_{\leavevmode \kern.06em \vbox{\hrule width.3em height.1ex}} \catcode`\|=\active \def|{{\tt \char '174}}
--- a/man/texinfo.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/texinfo.texi Mon Aug 13 09:18:39 2007 +0200 @@ -1,60 +1,51 @@ \input texinfo.tex @c -*-texinfo-*- @comment %**start of header -@setfilename ../info/texinfo.info +@setfilename texinfo @settitle Texinfo @value{edition} -@syncodeindex vr fn +@c Define a new index for options. +@defcodeindex op +@c Put everything except function (command, in this case) names in one +index (arbitrarily chosen to be the concept index). +@syncodeindex op cp +@syncodeindex vr cp +@syncodeindex pg cp @footnotestyle separate @paragraphindent 2 -@smallbook +@finalout @comment %**end of header +@comment $Id: texinfo.texi,v 1.2 1997/03/08 23:27:25 steve Exp $ + +@c Before release, run C-u C-c C-u C-a (texinfo-all-menus-update with a +@c prefix arg). This updates the node pointers, which texinfmt.el needs. + +@dircategory Texinfo documentation system +@direntry +* Texinfo: (texinfo). The GNU documentation format. +* install-info: (texinfo)Invoking install-info. Updating info/dir entries. +* texi2dvi: (texinfo)Format with texi2dvi. Printing Texinfo documentation. +* texindex: (texinfo)Format with tex/texindex. Sorting Texinfo index files. +@end direntry @c Set smallbook if printing in smallbook format so the example of the @c smallbook font is actually written using smallbook; in bigbook, a kludge @c is used for TeX output. +@smallbook @set smallbook @c @@clear smallbook -@ignore -@ifinfo -@format -START-INFO-DIR-ENTRY -* Texinfo: (texinfo). The documentation format for the GNU Project. -END-INFO-DIR-ENTRY -@end format -@end ifinfo -@end ignore - -@set edition 2.21 -@set update-date 7 June 1995 -@set update-month June 1995 - -@c Experiment with smaller amounts of whitespace between chapters -@c and sections. -@tex -\global\chapheadingskip = 15pt plus 4pt minus 2pt -\global\secheadingskip = 12pt plus 3pt minus 2pt -\global\subsecheadingskip = 9pt plus 2pt minus 2pt -@end tex - -@c Experiment with smaller amounts of whitespace between paragraphs in -@c the 8.5 by 11 inch format. -@ifclear smallbook -@tex -\global\parskip 6pt plus 1pt -@end tex -@end ifclear - -@finalout +@set edition 2.23 +@set update-month October 1996 +@set update-date 1 @value{update-month} @c Currently undocumented command, 5 December 1993: @c @c nwnode (Same as node, but no warnings; for `makeinfo'.) @ifinfo -This file documents Texinfo, a documentation system that uses a single -source file to produce both on-line information and a printed manual. - -Copyright (C) 1988, 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. +This file documents Texinfo, a documentation system that can produce +both on-line information and a printed manual from a single source file. + +Copyright (C) 1988, 90, 91, 92, 93, 95, 1996 Free Software Foundation, Inc. This is the second edition of the Texinfo documentation,@* and is consistent with version 2 of @file{texinfo.tex}. @@ -92,14 +83,15 @@ @subtitle Edition @value{edition}, for Texinfo Version Three @subtitle @value{update-month} -@author by Robert J. Chassell and Richard M. Stallman - -@comment Include the Distribution inside the titlepage so -@c that headings are turned off. +@author Robert J.@: Chassell +@author Richard M.@: Stallman + +@c Include the Distribution inside the titlepage so +@c that headings are turned off. @page @vskip 0pt plus 1filll -Copyright @copyright{} 1988, 1990, 1991, 1992, 1993, 1995 Free Software Foundation, Inc. +Copyright @copyright{} 1988, 1990, 1991, 1992, 1993, 1995, 1996 Free Software Foundation, Inc. @sp 2 This is the second edition of the Texinfo documentation,@* @@ -110,8 +102,9 @@ 59 Temple Place Suite 330, @* Boston, MA 02111-1307 USA @* Printed copies are available for $15 each.@* -ISBN 1-882114-63-9 -@c ISBN number 1-882114-63-9 is for edition 2.20 of 28 February 1995 +ISBN 1-882114-64-7 +@c ISBN 1-882114-63-9 is for edition 2.20 of 28 February 1995 +@c ISBN 1-882114-64-7 is for edition 2.23 of 1 October 1996. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice @@ -141,12 +134,12 @@ document, including the @@-command and concept indices. The rest of the menu lists all the lower level nodes in the document.@refill -This is Edition @value{edition} of the Texinfo documentation, +This is Edition @value{edition} of the Texinfo documentation, @w{@value{update-date},} for Texinfo Version Three. @end ifinfo @c Here is a spare copy of the chapter menu entry descriptions, -@c in case they are accidently deleted +@c in case they are accidently deleted @ignore Your rights. Texinfo in brief. @@ -191,7 +184,7 @@ @end ignore @menu -* Copying:: Your rights. +* Copying:: Your rights. * Overview:: Texinfo in brief. * Texinfo Mode:: How to use Texinfo mode. * Beginning a File:: What is at the beginning of a Texinfo file? @@ -211,10 +204,11 @@ * Glyphs:: How to indicate results of evaluation, expansion of macros, errors, etc. * Breaks:: How to force and prevent line and page breaks. -* Definition Commands:: How to describe functions and the like +* Definition Commands:: How to describe functions and the like in a uniform manner. * Footnotes:: How to write footnotes. * Conditionals:: How to specify text for either @TeX{} or Info. +* Macros:: Defining new Texinfo commands. * Format/Print Hardcopy:: How to convert a Texinfo file to a file for printing and how to print that file. * Create an Info File:: Convert a Texinfo file into an Info file. @@ -234,11 +228,13 @@ * Command and Variable Index:: A menu containing commands and variables. * Concept Index:: A menu covering many topics. +@detailmenu + --- The Detailed Node Listing --- Overview of Texinfo -* Using Texinfo:: Create a conventional printed book +* Using Texinfo:: Create a conventional printed book or an Info file. * Info Files:: What is an Info file? * Printed Books:: Characteristics of a printed book or manual. @@ -256,7 +252,7 @@ * Texinfo Mode Overview:: How Texinfo mode can help you. * Emacs Editing:: Texinfo mode adds to GNU Emacs' general purpose editing features. -* Inserting:: How to insert frequently used @@-commands. +* Inserting:: How to insert frequently used @@-commands. * Showing the Structure:: How to show the structure of a file. * Updating Nodes and Menus:: How to update or create new nodes and menus. * Info Formatting:: How to format for Info. @@ -285,7 +281,7 @@ The Texinfo File Header -* First Line:: The first line of a Texinfo file. +* First Line:: The first line of a Texinfo file. * Start of Header:: Formatting a region requires this. * setfilename:: Tell Info the name of the Info file. * settitle:: Create a title for the printed work. @@ -314,7 +310,7 @@ Ending a Texinfo File -* Printing Indices & Menus:: How to print an index in hardcopy and +* Printing Indices & Menus:: How to print an index in hardcopy and generate index menus in Info. * Contents:: How to create a table of contents. * File End:: How to mark the end of a file. @@ -336,7 +332,7 @@ Nodes -* Two Paths:: Different commands to structure +* Two Paths:: Different commands to structure Info output and printed output. * Node Menu Illustration:: A diagram, and sample nodes and menus. * node:: How to write a node, in detail. @@ -349,7 +345,7 @@ * Node Line Tips:: Keep names short. * Node Line Requirements:: Keep names unique, without @@-commands. * First Node:: How to write a `Top' node. -* makeinfo top command:: How to use the @code{@@top} command. +* makeinfo top command:: How to use the @code{@@top} command. * Top Node Summary:: Write a brief description for readers. Menus @@ -396,6 +392,8 @@ * file:: How to indicate the name of a file. * dfn:: How to specify a definition. * cite:: How to refer to a book that is not in Info. +* url:: How to indicate a world wide web reference. +* email:: How to indicate an electronic mail address. Emphasizing Text @@ -406,7 +404,7 @@ Quotations and Examples -* Block Enclosing Commands:: Use different constructs for +* Block Enclosing Commands:: Use different constructs for different purposes. * quotation:: How to write a quotation. * example:: How to write an example in a fixed-width font. @@ -426,6 +424,7 @@ * itemize:: How to construct a simple list. * enumerate:: How to construct a numbered list. * Two-column Tables:: How to construct a two-column table. +* Multi-column Tables:: How to construct generalized tables. Making a Two-column Table @@ -434,6 +433,11 @@ with automatic indexing. * itemx:: How to put more entries in the first column. +Multi-column Tables + +* Multitable Column Widths:: Defining multitable column widths. +* Multitable Rows:: Defining multitable rows, with examples. + Creating Indices * Index Entries:: Choose different words for index entries. @@ -452,20 +456,28 @@ Special Insertions -* Braces Atsigns Periods:: How to insert braces, @samp{@@} and periods. -* dmn:: How to format a dimension. +* Braces Atsigns:: How to insert braces, @samp{@@}. +* Inserting Space:: How to insert the right amount of space + within a sentence. +* Inserting Accents:: How to insert accents and special characters. * Dots Bullets:: How to insert dots and bullets. -* TeX and copyright:: How to insert the @TeX{} logo +* TeX and copyright:: How to insert the @TeX{} logo and the copyright symbol. +* pounds:: How to insert the pounds currency symbol. * minus:: How to insert a minus sign. * math:: How to format a mathematical expression. -Inserting @samp{@@}, Braces, and Periods - -* Inserting An Atsign:: -* Inserting Braces:: How to insert @samp{@{} and @samp{@}} -* Controlling Spacing:: How to insert the right amount of space - after punctuation within a sentence. +Inserting @@ and Braces + +* Inserting An Atsign:: How to insert @samp{@@}. +* Inserting Braces:: How to insert @samp{@{} and @samp{@}}. + +Inserting Space + +* Not Ending a Sentence:: Sometimes a . doesn't end a sentence. +* Ending a Sentence:: Sometimes it does. +* Multiple Spaces:: Inserting multiple spaces. +* dmn:: How to format a dimension. Inserting Ellipsis, Dots, and Bullets @@ -477,7 +489,7 @@ * tex:: How to insert the @TeX{} logo. * copyright symbol:: How to use @code{@@copyright}@{@}. -Glyphs for Examples +Glyphs for Examples * Glyphs Summary:: * result:: How to show the result of expression. @@ -491,7 +503,8 @@ * Break Commands:: Cause and prevent splits. * Line Breaks:: How to force a single line to use two lines. -* w:: How to prevent unwanted line breaks. +* - and hyphenation:: How to tell TeX about hyphenation points. +* w:: How to prevent unwanted line breaks. * sp:: How to insert blank lines. * page:: How to force the start of a new page. * group:: How to prevent unwanted page breaks. @@ -516,9 +529,14 @@ * Abstract Objects:: Commands for object-oriented programming. * Data Types:: The definition command for data types. +Footnotes + +* Footnote Commands:: How to write a footnote in Texinfo. +* Footnote Styles:: Controlling how footnotes appear in Info. + Conditionally Visible Text -* Conditional Commands:: How to specify text for Info or @TeX{}. +* Conditional Commands:: How to specify text for HTML, Info, or @TeX{}. * Using Ordinary TeX Commands:: You can use any and all @TeX{} commands. * set clear value:: How to designate which text to format (for both Info and @TeX{}); and how to set a @@ -527,9 +545,14 @@ @code{@@set}, @code{@@clear}, and @code{@@value} * ifset ifclear:: Format a region if a flag is set. -* value:: Replace a flag with a string. +* value:: Replace a flag with a string. * value Example:: An easy way to update edition information. +Macros: Defining New Texinfo Commands + +* Defining Macros:: Both defining and undefining new commands. +* Invoking Macros:: Using a macro, once you've defined it. + Format and Print Hardcopy * Use TeX:: Use @TeX{} to format for hardcopy. @@ -555,18 +578,21 @@ * Pointer Validation:: How to check that pointers point somewhere. * makeinfo in Emacs:: How to run @code{makeinfo} from Emacs. * texinfo-format commands:: Two Info formatting commands written - in Emacs Lisp are an alternative + in Emacs Lisp are an alternative to @code{makeinfo}. * Batch Formatting:: How to format for Info in Emacs Batch mode. -* Tag and Split Files:: How tagged and split files help Info +* Tag and Split Files:: How tagged and split files help Info to run better. Installing an Info File * Directory file:: The top level menu for all Info files. * New Info File:: Listing a new info file. -* Other Info Directories:: How to specify Info files that are +* Other Info Directories:: How to specify Info files that are located in other directories. +* Installing Dir Entries:: How to specify what menu entry to add + to the Info directory. +* Invoking install-info:: @code{install-info} options. Sample Permissions @@ -612,6 +638,7 @@ * New Texinfo Mode Commands:: The updating commands are especially useful. * New Commands:: Many newly described @@-commands. +@end detailmenu @end menu @node Copying, Overview, Top, Top @@ -668,7 +695,7 @@ rather than the English letter ``ex''. Pronounce @TeX{} as if the @samp{X} were the last sound in the name `Bach'; but pronounce Texinfo as if the @samp{x} were a `k'. Spell ``Texinfo'' with a capital ``T'' -and write the other letters in lower case.} +and write the other letters in lower case.} is a documentation system that uses a single source file to produce both on-line information and printed output. This means that instead of writing two different documents, one for the on-line help or other on-line @@ -678,7 +705,7 @@ @dfn{Info file}, with an Info documentation-reading program.)@refill @menu -* Using Texinfo:: Create a conventional printed book +* Using Texinfo:: Create a conventional printed book or an Info file. * Info Files:: What is an Info file? * Printed Books:: Characteristics of a printed book or manual. @@ -709,11 +736,10 @@ To make a printed document, you process a Texinfo source file with the @TeX{} typesetting program. This creates a @sc{dvi} file that you can -typeset and print as a book or report. (Note that the Texinfo language is -completely different from @TeX{}'s usual language, Plain@TeX{}, which -Texinfo replaces.) If you do not have @TeX{}, but do have -@code{troff} or @code{nroff}, you can use the @code{texi2roff} program -instead.@refill +typeset and print as a book or report. (Note that the Texinfo language +is completely different from @TeX{}'s usual language, plain @TeX{}.) If +you do not have @TeX{}, but do have @code{troff} or @code{nroff}, you +can use the @code{texi2roff} program instead.@refill To make an Info file, you process a Texinfo source file with the @code{makeinfo} utility or Emacs's @code{texinfo-format-buffer} command; @@ -773,7 +799,7 @@ is at the logical level of a chapter, its child nodes are at the level of sections; likewise, the child nodes of sections are at the level of subsections.@refill - + All the children of any one parent are linked together in a bidirectional chain of `Next' and `Previous' pointers. The `Next' pointer provides a link to the next section, and the `Previous' pointer @@ -815,7 +841,7 @@ node listed in the main menu, or you can search the index menus and then go directly to the node that has the information you want.@refill @c !!! With the standalone Info system you may go to specific nodes -@c directly.. +@c directly.. If you want to read through an Info file in sequence, as if it were a printed manual, you can get the whole file with the advanced Info @@ -827,7 +853,7 @@ @c /usr/local/lib/emacs/info mentioned in info.c DEFAULT_INFOPATH @c /usr/gnu/info mentioned in info.c DEFAULT_INFOPATH @c /usr/local/info -@c /usr/local/lib/info +@c /usr/local/lib/info The @file{dir} file in the @file{info} directory serves as the departure point for the whole Info system. From it, you can reach the `Top' nodes of each of the documents in a complete Info system.@refill @@ -841,6 +867,7 @@ @cindex Texinfo printed book characteristics @cindex Characteristics, printed books or manuals +@cindex Knuth, Donald A Texinfo file can be formatted and typeset as a printed book or manual. To do this, you need @TeX{}, a powerful, sophisticated typesetting program written by Donald Knuth.@footnote{You can also use the @@ -865,7 +892,7 @@ (@file{texinfo.tex} tells @TeX{} how to convert the Texinfo @@-commands to @TeX{} commands, which @TeX{} can then process to create the typeset document.) @file{texinfo.tex} contains the specifications for printing -a document.@refill +a document.@refill Most often, documents are printed on 8.5 inch by 11 inch pages (216@dmn{mm} by 280@dmn{mm}; this is the default size), but you @@ -987,7 +1014,7 @@ @cindex Syntactic conventions @cindex Conventions, syntactic -All @sc{ascii} printing characters except @samp{@@}, @samp{@{} and +All printable @sc{ascii} characters except @samp{@@}, @samp{@{} and @samp{@}} can appear in a Texinfo file and stand for themselves. @samp{@@} is the escape character which introduces commands. @samp{@{} and @samp{@}} should be used only to surround arguments to @@ -1009,7 +1036,7 @@ convention should be followed in Texinfo files. @TeX{} converts doubled single-quote characters to left- and right-hand doubled quotation marks, ``like this'', and Info converts doubled single-quote -characters to @sc{ascii} double-quotes: @w{@tt{ `` }} and +characters to @sc{ascii} double-quotes: @w{@tt{ `` }} and @w{@tt{ '' }} to @w{@tt{ " }}.@refill @end iftex @@ -1025,11 +1052,12 @@ If you mark off a region of the Texinfo file with the @code{@@iftex} and @w{@code{@@end iftex}} commands, that region will appear only in the printed copy; in that region, you can use certain commands -borrowed from Plain@TeX{} that you cannot use in Info. Likewise, if +borrowed from plain @TeX{} that you cannot use in Info. Likewise, if you mark off a region with the @code{@@ifinfo} and @code{@@end ifinfo} commands, that region will appear only in the Info file; in that region, you can use Info commands that you cannot use in @TeX{}. -(@xref{Conditionals}.) +Similarly for @code{@@ifhtml} and @code{@@end ifhtml}. +@xref{Conditionals}. @cindex Tabs; don't use! @quotation @@ -1057,7 +1085,7 @@ Such comments are for the person who reads the Texinfo file. All the text on a line that follows either @code{@@comment} or @code{@@c} is a comment; the rest of the line does not appear in either the Info file -or the printed manual. (Often, you can write the @code{@@comment} or +or the printed manual. (Often, you can write the @code{@@comment} or @code{@@c} in the middle of a line, and only the text that follows after the @code{@@comment} or @code{@@c} command does not appear; but some commands, such as @code{@@settitle} and @code{@@setfilename}, work on a @@ -1105,8 +1133,8 @@ reader the nature of the file. The shorter extensions are for operating systems that cannot handle long file names.@refill -In order to be made into a printed manual and an Info file, a -Texinfo file @strong{must} begin with lines like this:@refill +In order to be made into a printed manual and an Info file, a Texinfo +file @strong{must} begin with lines like this:@refill @example @group @@ -1130,9 +1158,9 @@ @file{texinfo.tex} file, which tells @TeX{} how to translate the Texinfo @@-commands into @TeX{} typesetting commands. (Note the use of the backslash, @samp{\}; this is correct for @TeX{}.) The -@samp{@@setfilename} line provides a name for the Info file and the -@samp{@@settitle} line specifies a title for the page headers (or -footers) of the printed manual.@refill +@samp{@@setfilename} line provides a name for the Info file and tells +@TeX{} to open auxiliary files. The @samp{@@settitle} line specifies a +title for the page headers (or footers) of the printed manual.@refill The @code{@@bye} line at the end of the file on a line of its own tells the formatters that the file is ended and to stop formatting.@refill @@ -1153,7 +1181,7 @@ @noindent In the first line, @samp{-*-texinfo-*-} causes Emacs to switch into -Texinfo mode when you edit the file. +Texinfo mode when you edit the file. The @code{@@c} lines which surround the @samp{@@setfilename} and @samp{@@settitle} lines are optional, but you need them in order to @@ -1184,7 +1212,7 @@ @code{@@end ifinfo} commands so that the formatters place it only in the Info file.@refill -@item 3. Title and Copyright +@item 3. Title and Copyright The @dfn{Title and Copyright} segment contains the title and copyright pages and copying permissions for the printed manual. The segment must be enclosed between @code{@@titlepage} and @code{@@end titlepage} commands. @@ -1218,8 +1246,8 @@ @noindent In the following, the sample text is @emph{indented}; comments on it are -not. The complete file, without any comments, is shown in -@ref{Sample Texinfo File}. +not. The complete file, without any comments, is shown in +@ref{Sample Texinfo File}. @subheading Part 1: Header @@ -1230,7 +1258,7 @@ @example @group -\input texinfo @@c -*-texinfo-*- +\input texinfo @@c -*-texinfo-*- @@c %**start of header @@setfilename sample.info @@settitle Sample Document @@ -1295,7 +1323,7 @@ @example @group @@menu -* First Chapter:: The first chapter is the +* First Chapter:: The first chapter is the only chapter in this sample. * Concept Index:: This index has two entries. @@end menu @@ -1318,7 +1346,7 @@ @end group @group -This is the contents of the first chapter. +This is the contents of the first chapter. @@cindex Another sample index entry @end group @@ -1336,8 +1364,8 @@ @group The @@code@{makeinfo@} and @@code@{texinfo-format-buffer@} -commands transform a Texinfo file such as this into -an Info file; and @@TeX@{@} typesets it for a printed +commands transform a Texinfo file such as this into +an Info file; and @@TeX@{@} typesets it for a printed manual. @end group @end example @@ -1372,7 +1400,7 @@ @sp 1 @need 700 @quotation -This is the contents of the first chapter. +This is the contents of the first chapter. Here is a numbered list. @@ -1384,43 +1412,44 @@ This is the second item. @end enumerate -The @code{makeinfo} and @code{texinfo-format-buffer} -commands transform a Texinfo file such as this into -an Info file; and @TeX{} typesets it for a printed +The @code{makeinfo} and @code{texinfo-format-buffer} +commands transform a Texinfo file such as this into +an Info file; and @TeX{} typesets it for a printed manual. @end quotation -@node Acknowledgements, , Short Sample, Overview +@node Acknowledgements, , Short Sample, Overview @comment node-name, next, previous, up @section Acknowledgements -Richard M.@: Stallman wrote Edition 1.0 of this manual. -@w{Robert J.@: Chassell} revised and extended it, -starting with Edition 1.1. - +@cindex Stallman, Richard M. +@cindex Chassell, Robert J. +@cindex Berry, Karl +Richard M.@: Stallman wrote Edition 1.0 of this manual. @w{Robert J.@: +Chassell} revised and extended it, starting with Edition 1.1. Karl +Berry made updates for the Texinfo 3.8 and subsequent releases, starting +with Edition 2.22. + +@cindex Pinard, Fran@,{c}ois +@cindex Zuhn, David D. +@cindex Weisshaus, Melissa Our thanks go out to all who helped improve this work, particularly to -@w{Francois Pinard} and @w{David D.@: Zuhn}, who tirelessly recorded -and reported mistakes and obscurities; our special thanks go to -@w{Melissa Weisshaus} for her frequent and often tedious reviews of -nearly similar editions. Our mistakes are our own. - -@c ignore until mailing lists set up -@ignore +Fran@,{c}ois Pinard and @w{David D.@: Zuhn}, who tirelessly recorded and +reported mistakes and obscurities; our special thanks go to Melissa +Weisshaus for her frequent and often tedious reviews of nearly similar +editions. Our mistakes are our own. + Please send suggestions and corrections to: @example @group @r{Internet address:} bug-texinfo@@prep.ai.mit.edu - -@r{UUCP path:} - mit-eddie!prep.ai.mit.edu!bug-texinfo -@end group -@end example - -@noindent -Please include the manual's edition number in your messages. -@end ignore +@end group +@end example + +@noindent +Please include the manual's edition number and update date in your messages. @node Texinfo Mode, Beginning a File, Overview, Top @comment node-name, next, previous, up @@ -1446,7 +1475,7 @@ * Texinfo Mode Overview:: How Texinfo mode can help you. * Emacs Editing:: Texinfo mode adds to GNU Emacs' general purpose editing features. -* Inserting:: How to insert frequently used @@-commands. +* Inserting:: How to insert frequently used @@-commands. * Showing the Structure:: How to show the structure of a file. * Updating Nodes and Menus:: How to update or create new nodes and menus. * Info Formatting:: How to format for Info. @@ -1455,7 +1484,7 @@ @end menu @node Texinfo Mode Overview, Emacs Editing, Texinfo Mode, Texinfo Mode -@ifinfo +@ifinfo @heading Texinfo Mode Overview @end ifinfo @@ -1463,7 +1492,7 @@ files:@refill @itemize @bullet -@item +@item Insert frequently used @@-commands. @refill @item @@ -1482,7 +1511,7 @@ @item Automatically create a master menu.@refill -@item +@item Format a part or all of a file for Info.@refill @item @@ -1493,7 +1522,7 @@ used @@-commands and for creating node pointers and menus.@refill @node Emacs Editing, Inserting, Texinfo Mode Overview, Texinfo Mode -@section The Usual GNU Emacs Editing Commands +@section The Usual GNU Emacs Editing Commands In most cases, the usual Text mode commands work the same in Texinfo mode as they do in Text mode. Texinfo mode adds new editing commands @@ -1521,9 +1550,9 @@ preferred, since it is explicit, but a shorter extension may be necessary for operating systems that limit the length of file names. GNU Emacs automatically enters Texinfo mode when you visit a file with -a @file{.texinfo} or @file{.texi} -extension. Also, Emacs switches to Texinfo mode -when you visit a +a @file{.texinfo} or @file{.texi} +extension. Also, Emacs switches to Texinfo mode +when you visit a file that has @samp{-*-texinfo-*-} in its first line. If ever you are in another mode and wish to switch to Texinfo mode, type @code{M-x texinfo-mode}.@refill @@ -1554,13 +1583,13 @@ Insert @code{@@code@{@}} and put the cursor between the braces.@refill -@item C-c C-c d +@item C-c C-c d @itemx M-x texinfo-insert-@@dfn @findex texinfo-insert-@@dfn Insert @code{@@dfn@{@}} and put the cursor between the braces.@refill -@item C-c C-c e +@item C-c C-c e @itemx M-x texinfo-insert-@@end @findex texinfo-insert-@@end Insert @code{@@end} and attempt to insert the correct following word, @@ -1568,7 +1597,7 @@ nested lists correctly, but inserts the word appropriate to the immediately preceding list.)@refill -@item C-c C-c i +@item C-c C-c i @itemx M-x texinfo-insert-@@item @findex texinfo-insert-@@item Insert @code{@@item} and put the @@ -1580,11 +1609,11 @@ Insert @code{@@kbd@{@}} and put the cursor between the braces.@refill -@item C-c C-c n +@item C-c C-c n @itemx M-x texinfo-insert-@@node @findex texinfo-insert-@@node Insert @code{@@node} and a comment line -listing the sequence for the `Next', +listing the sequence for the `Next', `Previous', and `Up' nodes. Leave point after the @code{@@node}.@refill @@ -1603,7 +1632,7 @@ @item C-c C-c t @itemx M-x texinfo-insert-@@table @findex texinfo-insert-@@table -Insert @code{@@table} followed by a @key{SPC} +Insert @code{@@table} followed by a @key{SPC} and leave the cursor after the @key{SPC}.@refill @item C-c C-c v @@ -1618,7 +1647,7 @@ Insert @code{@@example} and put the cursor at the beginning of the next line.@refill -@c M-@{ was the binding for texinfo-insert-braces; +@c M-@{ was the binding for texinfo-insert-braces; @c in Emacs 19, backward-paragraph will take this binding. @item C-c C-c @{ @itemx M-x texinfo-insert-braces @@ -1698,7 +1727,7 @@ in the Texinfo file.@refill @table @kbd -@item C-c C-s +@item C-c C-s @itemx M-x texinfo-show-structure @findex texinfo-show-structure Show the @code{@@chapter}, @code{@@section}, and such lines of a @@ -1731,7 +1760,7 @@ (@xref{Narrowing, , , emacs, The GNU Emacs Manual}, for more information about the narrowing commands.)@refill -@vindex page-delimiter +@vindex page-delimiter @cindex Page delimiter in Texinfo mode In addition to providing the @code{texinfo-show-structure} command, Texinfo mode sets the value of the page delimiter variable to match @@ -1748,7 +1777,7 @@ @cindex Updating nodes and menus @cindex Create nodes, menus automatically @cindex Insert nodes, menus automatically -@cindex Automatically insert nodes, menus +@cindex Automatically insert nodes, menus Texinfo mode provides commands for automatically creating or updating menus and node pointers. The commands are called ``update'' commands @@ -1900,7 +1929,7 @@ @itemx M-x texinfo-all-menus-update @findex texinfo-all-menus-update Create or update all the menus in the buffer. With an argument -(@kbd{C-u} as prefix argument, if interactive), first insert +(@kbd{C-u} as prefix argument, if interactive), first insert or update all the node pointers before working on the menus.@refill @@ -1914,7 +1943,7 @@ @example C-u C-c C-u C-a -@exdent or +@exdent or C-u M-x texinfo-all-menus-update @end example @@ -1944,7 +1973,7 @@ @cindex Requirements for updating commands To use the updating commands, you must organize the Texinfo file -hierarchically with chapters, sections, subsections, and the like. +hierarchically with chapters, sections, subsections, and the like. When you construct the hierarchy of the manual, do not `jump down' more than one level at a time: you can follow the `Top' node with a chapter, but not with a section; you can follow a chapter with a @@ -2000,7 +2029,7 @@ both @code{makeinfo} and the @code{texinfo-format-@dots{}} commands require that you insert menus in the file.@refill -@node Other Updating Commands, , Updating Requirements, Updating Nodes and Menus +@node Other Updating Commands, , Updating Requirements, Updating Nodes and Menus @comment node-name, next, previous, up @subsection Other Updating Commands @@ -2130,10 +2159,8 @@ M-x makeinfo-buffer @end example -For the Info formatting commands to work, the file @emph{must} include -a line that has @code{@@setfilename} in its header.@refill - -Not all systems support the @code{makeinfo}-based formatting commands.@refill +For @TeX{} or the Info formatting commands to work, the file @emph{must} +include a line that has @code{@@setfilename} in its header.@refill @xref{Create an Info File}, for details about Info formatting.@refill @@ -2201,13 +2228,13 @@ @xref{Format/Print Hardcopy}, for a description of the other @TeX{} related commands, such as @code{tex-show-print-queue}.@refill -@node Texinfo Mode Summary, , Printing, Texinfo Mode +@node Texinfo Mode Summary, , Printing, Texinfo Mode @comment node-name, next, previous, up @section Texinfo Mode Summary In Texinfo mode, each set of commands has default keybindings that begin with the same keys. All the commands that are custom-created -for Texinfo mode begin with @kbd{C-c}. The keys are somewhat +for Texinfo mode begin with @kbd{C-c}. The keys are somewhat mnemonic.@refill @subheading Insert Commands @@ -2288,7 +2315,7 @@ @group C-c C-u C-a @r{Make or update all} - @r{menus in a buffer.} + @r{menus in a buffer.} @end group @group @@ -2411,18 +2438,18 @@ Generally, the beginning of a Texinfo file has four parts:@refill @enumerate -@item +@item The header, delimited by special comment lines, that includes the commands for naming the Texinfo file and telling @TeX{} what definitions' file to use when processing the Texinfo file.@refill -@item +@item A short statement of what the file is about, with a copyright notice and copying permissions. This is enclosed in @code{@@ifinfo} and @code{@@end ifinfo} commands so that the formatters place it only in the Info file.@refill -@item +@item A title page and copyright page, with a copyright notice and copying permissions. This is enclosed between @code{@@titlepage} and @code{@@end titlepage} commands. The title and copyright page appear @@ -2480,7 +2507,7 @@ @end group @group -@@c The following two commands +@@c The following two commands @@c start the copyright page. @@page @@vskip 0pt plus 1filll @@ -2495,9 +2522,9 @@ @@node Top, Overview, (dir), (dir) @@ifinfo -This document describes @dots{} - -This document applies to version @dots{} +This document describes @dots{} + +This document applies to version @dots{} of the program named @dots{} @@end ifinfo @@ -2537,7 +2564,7 @@ @example @group -\input texinfo @@c -*-texinfo-*- +\input texinfo @@c -*-texinfo-*- @@setfilename sample.info @@settitle Sample Document @end group @@ -2548,7 +2575,7 @@ @example @group -\input texinfo @@c -*-texinfo-*- +\input texinfo @@c -*-texinfo-*- @@c %**start of header @@setfilename sample.info @@settitle Sample Document @@ -2557,7 +2584,7 @@ @end example @menu -* First Line:: The first line of a Texinfo file. +* First Line:: The first line of a Texinfo file. * Start of Header:: Formatting a region requires this. * setfilename:: Tell Info the name of the Info file. * settitle:: Create a title for the printed work. @@ -2584,7 +2611,7 @@ This line serves two functions: @enumerate -@item +@item When the file is processed by @TeX{}, the @code{\input texinfo} command tells @TeX{} to load the macros needed for processing a Texinfo file. These are in a file called @file{texinfo.tex}, which is usually located @@ -2594,7 +2621,7 @@ to @samp{@@}; before the switch occurs, @TeX{} requires @samp{\}, which is why it appears at the beginning of the file.@refill -@item +@item When the file is edited in GNU Emacs, the @samp{-*-texinfo-*-} mode specification tells Emacs to use Texinfo mode.@refill @end enumerate @@ -2628,8 +2655,8 @@ @cindex Info file requires @code{@@setfilename} @findex setfilename -In order to be made into an Info file, a Texinfo file must contain a line -that looks like this:@refill +In order to serve as the primary input file for either @code{makeinfo} +or @TeX{}, a Texinfo file must contain a line that looks like this: @example @@setfilename @var{info-file-name} @@ -2642,8 +2669,9 @@ The @code{@@setfilename} line specifies the name of the Info file to be generated. This name should be different from the name of the Texinfo -file. The convention is to write a name with a @samp{.info} extension, -to produce an Info file name such as @file{texinfo.info}.@refill +file. There are two conventions for choosing the name: you can either +remove the @samp{.tex} extension from the input file name, or replace it +with the @samp{.info} extension. Some operating systems cannot handle long file names. You can run into a problem even when the file name you specify is itself short enough. @@ -2652,14 +2680,16 @@ `-10', `-11', and so on, to the original file name. (@xref{Tag and Split Files, , Tag Files and Split Files}.) The subfile name @file{texinfo.info-10}, for example, is too long for some systems; so -the Info file name for this document is actually @file{texinfo} rather than +the Info file name for this document is @file{texinfo} rather than @file{texinfo.info}.@refill The Info formatting commands ignore everything written before the -@code{@@setfilename} line, which is why the very first line of +@code{@@setfilename} line, which is why the very first line of the file (the @code{\input} line) does not need to be commented out. -The @code{@@setfilename} line is ignored when you typeset a printed -manual.@refill + +The @code{@@setfilename} line produces no output when you typeset a +printed manual, but is does an essential job: it opens the index, +cross-reference, and other auxiliary files used by Texinfo. @node settitle, setchapternewpage, setfilename, Header @comment node-name, next, previous, up @@ -2844,9 +2874,9 @@ @xref{Refilling Paragraphs}, for a detailed description of what goes on.@refill -@node End of Header, , paragraphindent, Header -@comment node-name, next, previous, up -@subsection End of Header +@node End of Header, , paragraphindent, Header +@comment node-name, next, previous, up +@subsection End of Header @cindex End of header line Follow the header lines with an @w{end-of-header} line. @@ -2946,8 +2976,8 @@ @code{@@end titlepage} on a line by itself.@refill The @code{@@end titlepage} command starts a new page and turns on page -numbering. (@xref{Headings, , Page Headings}, for details about how to -generate of page headings.) All the material that you want to +numbering. (@xref{Headings, , Page Headings}, for details about how to +generate page headings.) All the material that you want to appear on unnumbered pages should be put between the @code{@@titlepage} and @code{@@end titlepage} commands. By using the @code{@@page} command you can force a page break within the region @@ -2972,7 +3002,7 @@ should also contain this information; see @ref{makeinfo top, , @code{@@top}}.)@refill -Texinfo provides two methods for creating a title page. One method +Texinfo provides two main methods for creating a title page. One method uses the @code{@@titlefont}, @code{@@sp}, and @code{@@center} commands to generate a title page in which the words on the page are centered.@refill @@ -2985,6 +3015,13 @@ you want, and Texinfo does the formatting. You may use either method.@refill +@findex shorttitlepage +For extremely simple applications, Texinfo also provides a command +@code{@@shorttitlepage} which takes a single argument as the title. +The argument is typeset on a page by itself and followed by a blank +page. + + @node titlefont center sp, title subtitle author, titlepage, Titlepage & Copyright Page @comment node-name, next, previous, up @subsection @code{@@titlefont}, @code{@@center}, and @code{@@sp} @@ -3055,7 +3092,7 @@ You can use the @code{@@title}, @code{@@subtitle}, and @code{@@author} commands to create a title page in which the vertical and horizontal -spacing is done for you automatically. This contrasts with the method +spacing is done for you automatically. This contrasts with the method described in the previous section, in which the @code{@@sp} command is needed to adjust vertical spacing.@refill @@ -3201,7 +3238,7 @@ @subsection Heading Generation @findex end titlepage @cindex Headings, page, begin to appear -@cindex Titlepage end starts headings +@cindex Titlepage end starts headings @cindex End titlepage starts headings An @code{@@end titlepage} command on a line by itself not only marks @@ -3211,7 +3248,7 @@ To repeat what is said elsewhere, Texinfo has two standard page heading formats, one for documents which are printed on one side of each sheet of paper (single-sided printing), and the other for documents which are printed on both -sides of each sheet (double-sided printing). +sides of each sheet (double-sided printing). (@xref{setchapternewpage, ,@code{@@setchapternewpage}}.) You can specify these formats in different ways:@refill @@ -3240,7 +3277,7 @@ double-sided printing and no @code{@@setchapternewpage} command for single-sided printing.@refill -@node headings on off, , end titlepage, Titlepage & Copyright Page +@node headings on off, , end titlepage, Titlepage & Copyright Page @comment node-name, next, previous, up @subsection The @code{@@headings} Command @findex headings @@ -3253,7 +3290,7 @@ headings prior to defining your own. Write an @code{@@headings} command immediately after the @code{@@end titlepage} command.@refill -There are four ways to use the @code{@@headings} command:@refill +You can use @code{@@headings} as follows:@refill @table @code @item @@headings off @@ -3264,10 +3301,18 @@ @refill @item @@headings double -@itemx @@headings on Turn on page headings appropriate for double-sided printing. The two commands, @code{@@headings on} and @code{@@headings double}, are synonymous.@refill + +@item @@headings singleafter +@itemx @@headings doubleafter +Turn on @code{single} or @code{double} headings, respectively, after the +current page is output. + +@item @@headings on +Turn on page headings: @code{single} if @samp{@@setchapternewpage +on}, @code{double} otherwise. @end table For example, suppose you write @code{@@setchapternewpage off} before the @@ -3304,7 +3349,7 @@ The `Top' node is the node from which you enter an Info file.@refill A `Top' node should contain a brief description of the Info file and an -extensive, master menu for the whole Info file. +extensive, master menu for the whole Info file. This helps the reader understand what the Info file is about. Also, you should write the version number of the program to which the Info file applies; or, at least, the edition number.@refill @@ -3356,7 +3401,7 @@ @group @@menu -* Copying:: Texinfo is freely +* Copying:: Texinfo is freely redistributable. * Overview:: What is Texinfo? @dots{} @@ -3370,7 +3415,7 @@ menu, which is usually the copying permissions, introduction, or first chapter.@refill -@node Master Menu Parts, , Title of Top Node, The Top Node +@node Master Menu Parts, , Title of Top Node, The Top Node @subsection Parts of a Master Menu @cindex Master menu parts @cindex Parts of a master menu @@ -3397,7 +3442,9 @@ through an intermediary menu, an inquirer can go directly to a particular node when searching for specific information. These menu items are not required; add them if you think they are a -convenience.@refill +convenience. If you do use them, put @code{@@detailmenu} before the +first one, and @code{@@end detailmenu} after the last; otherwise, +@code{makeinfo} will get confused. @end itemize Each section in the menu can be introduced by a descriptive line. So @@ -3411,7 +3458,7 @@ @example @group @@menu -* Copying:: Texinfo is freely +* Copying:: Texinfo is freely redistributable. * Overview:: What is Texinfo? * Texinfo Mode:: Special features in GNU Emacs. @@ -3419,18 +3466,19 @@ @dots{} @end group @group -* Command and Variable Index:: +* Command and Variable Index:: An entry for each @@-command. * Concept Index:: An entry for each concept. @end group @group +@@detailmenu --- The Detailed Node Listing --- Overview of Texinfo * Info Files:: What is an Info file? -* Printed Manuals:: Characteristics of +* Printed Manuals:: Characteristics of a printed manual. @dots{} @dots{} @@ -3439,15 +3487,16 @@ @group Using Texinfo Mode -* Info on a Region:: Formatting part of a file +* Info on a Region:: Formatting part of a file for Info. @dots{} @dots{} +@@end detailmenu @@end menu @end group @end example -@node Software Copying Permissions, , The Top Node, Beginning a File +@node Software Copying Permissions, , The Top Node, Beginning a File @comment node-name, next, previous, up @section Software Copying Permissions @cindex Software copying permissions @@ -3504,7 +3553,7 @@ @end example @menu -* Printing Indices & Menus:: How to print an index in hardcopy and +* Printing Indices & Menus:: How to print an index in hardcopy and generate index menus in Info. * Contents:: How to create a table of contents. * File End:: How to mark the end of a file. @@ -3606,11 +3655,11 @@ @code{texindex} program to convert these files to sorted index files. (@xref{Format/Print Hardcopy}, for more information.)@refill @end ignore -@node Contents, File End, Printing Indices & Menus, Ending a File +@node Contents, File End, Printing Indices & Menus, Ending a File @comment node-name, next, previous, up @section Generating a Table of Contents @cindex Table of contents -@cindex Contents, Table of +@cindex Contents, Table of @findex contents @findex summarycontents @findex shortcontents @@ -3674,7 +3723,7 @@ formatting commands ignore the @code{@@contents} and @code{@@shortcontents} commands.@refill -@node File End, , Contents, Ending a File +@node File End, , Contents, Ending a File @comment node-name, next, previous, up @section @code{@@bye} File Ending @findex bye @@ -3753,7 +3802,7 @@ Chapter 1 Chapter 2 Chapter 3 | | | -------- -------- -------- - | | | | | | + | | | | | | Section Section Section Section Section Section 1.1 1.2 2.1 2.2 3.1 3.2 @@ -3874,7 +3923,7 @@ @r{No new pages} @r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered} @r{In contents} @r{In contents} @r{In contents} @r{Not in contents} - + @@top @@majorheading @@chapter @@unnumbered @@appendix @@chapheading @@section @@unnumberedsec @@appendixsec @@heading @@ -3894,7 +3943,7 @@ @r{No new pages} @r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered} @r{In contents} @r{In contents} @r{In contents} @r{Not in contents} - + @@top @@majorheading @@chapter @@unnumbered @@appendix @@chapheading @@section @@unnumberedsec @@appendixsec @@heading @@ -3911,7 +3960,7 @@ @r{No new pages} @r{Numbered} @r{Unnumbered} @r{Lettered and numbered} @r{Unnumbered} @r{In contents} @r{In contents} @r{In contents} @r{Not in contents} - + @@top @@majorheading @@chapter @@unnumbered @@appendix @@chapheading @@section @@unnumberedsec @@appendixsec @@heading @@ -3924,11 +3973,11 @@ @node makeinfo top, chapter, Structuring Command Types, Structuring @comment node-name, next, previous, up -@section @code{@@top} +@section @code{@@top} The @code{@@top} command is a special sectioning command that you use only after an @code{@@node Top} line at the beginning of a Texinfo file. -The @code{@@top} command tells the @code{makeinfo} formatter +The @code{@@top} command tells the @code{makeinfo} formatter which node is the `Top' node. It has the same typesetting effect as @code{@@unnumbered} (@pxref{unnumbered & appendix, , @code{@@unnumbered}, @code{@@appendix}}). @@ -3964,6 +4013,13 @@ ******************* @end example +@findex centerchap +Texinfo also provides a command @code{@@centerchap}, which is analogous +to @code{@@unnumbered}, but centers its argument in the printed output. +This kind of stylistic choice is not usually offered by Texinfo. +@c but the Hacker's Dictionary wanted it ... + + @node unnumbered & appendix, majorheading & chapheading, chapter, Structuring @comment node-name, next, previous, up @section @code{@@unnumbered}, @code{@@appendix} @@ -3985,6 +4041,7 @@ line and follow it on the same line by the title, as you would if you were creating a chapter.@refill + @node majorheading & chapheading, section, unnumbered & appendix, Structuring @section @code{@@majorheading}, @code{@@chapheading} @findex majorheading @@ -4107,8 +4164,8 @@ @node unnumberedsubsec appendixsubsec subheading, subsubsection, subsection, Structuring @comment node-name, next, previous, up -@section The @code{@@subsection}-like Commands -@cindex Subsection-like commands +@section The @code{@@subsection}-like Commands +@cindex Subsection-like commands @findex unnumberedsubsec @findex appendixsubsec @findex subheading @@ -4131,7 +4188,7 @@ @node subsubsection, Raise/lower sections, unnumberedsubsec appendixsubsec subheading, Structuring @comment node-name, next, previous, up @section The `subsub' Commands -@cindex Subsub commands +@cindex Subsub commands @findex subsubsection @findex unnumberedsubsubsec @findex appendixsubsubsec @@ -4166,7 +4223,7 @@ headings.@refill @end table -In Info, `subsub' titles are underlined with periods. +In Info, `subsub' titles are underlined with periods. For example,@refill @example @@ -4183,13 +4240,13 @@ @end group @end example -@node Raise/lower sections, , subsubsection, Structuring +@node Raise/lower sections, , subsubsection, Structuring @comment node-name, next, previous, up @section @code{@@raisesections} and @code{@@lowersections} -@findex @@raisesections -@findex @@lowersections +@findex raisesections +@findex lowersections @cindex Raising and lowering sections -@cindex Sections, raising and lowering +@cindex Sections, raising and lowering The @code{@@raisesections} and @code{@@lowersections} commands raise and lower the hierarchical level of chapters, sections, subsections and the @@ -4264,7 +4321,7 @@ books.@refill @menu -* Two Paths:: Different commands to structure +* Two Paths:: Different commands to structure Info output and printed output. * Node Menu Illustration:: A diagram, and sample nodes and menus. * node:: How to write a node, in detail. @@ -4326,7 +4383,7 @@ Chapter 1 Chapter 2 Chapter 3 | | | -------- -------- -------- - | | | | | | + | | | | | | Section Section Section Section Section Section 1.1 1.2 2.1 2.2 3.1 3.2 @@ -4368,7 +4425,7 @@ @group @@menu * Sect. 2.1:: Description of this section. - * Sect. 2.2:: + * Sect. 2.2:: @@end menu @end group @end example @@ -4462,7 +4519,7 @@ * Node Line Tips:: Keep names short. * Node Line Requirements:: Keep names unique, without @@-commands. * First Node:: How to write a `Top' node. -* makeinfo top command:: How to use the @code{@@top} command. +* makeinfo top command:: How to use the @code{@@top} command. * Top Node Summary:: Write a brief description for readers. @end menu @@ -4528,8 +4585,8 @@ If you wish, you can ignore @code{@@node} lines altogether in your first draft and then use the @code{texinfo-insert-node-lines} command to -create @code{@@node} lines for you. However, we do not -recommend this practice. It is better to name the node itself +create @code{@@node} lines for you. However, we do not +recommend this practice. It is better to name the node itself at the same time that you write a segment so you can easily make cross references. A large number of cross references are an especially important feature of a good Info @@ -4624,7 +4681,7 @@ For example, the following is a section title: @smallexample -@@code@{@@@@unnumberedsec@}, @@code@{@@@@appendixsec@}, @@code@{@@@@heading@} +@@code@{@@@@unnumberedsec@}, @@code@{@@@@appendixsec@}, @@code@{@@@@heading@} @end smallexample @noindent @@ -4641,7 +4698,7 @@ @node First Node, makeinfo top command, Node Line Requirements, node @comment node-name, next, previous, up -@subsection The First Node +@subsection The First Node @cindex @samp{@r{Top}} node is first @cindex First node @@ -4697,7 +4754,7 @@ @code{@@unnumbered} when you use the Texinfo updating commands to create or update pointers and menus.@refill -@node Top Node Summary, , makeinfo top command, node +@node Top Node Summary, , makeinfo top command, node @subsection The `Top' Node Summary @cindex @samp{@r{Top}} node summary @@ -4726,7 +4783,7 @@ contain this information: see @ref{titlepage, , @code{@@titlepage}}.)@refill -@node makeinfo Pointer Creation, , node, Nodes +@node makeinfo Pointer Creation, , node, Nodes @section Creating Pointers with @code{makeinfo} @cindex Creating pointers with @code{makeinfo} @cindex Pointer creation with @code{makeinfo} @@ -4834,11 +4891,11 @@ * Menu Parts:: A menu entry has three parts. * Less Cluttered Menu Entry:: Two part menu entry. * Menu Example:: Two and three part entries. -* Other Info Files:: How to refer to a different +* Other Info Files:: How to refer to a different Info file. @@end menu -@@node Menu Location, Writing a Menu, , Menus +@@node Menu Location, Writing a Menu, , Menus @@ifinfo @@heading Menus Need Short Nodes @@end ifinfo @@ -4867,7 +4924,7 @@ Larger Units of Text * Files:: All about handling files. -* Multiples: Buffers. Multiple buffers; editing +* Multiples: Buffers. Multiple buffers; editing several files at once. @@end menu @end group @@ -4992,7 +5049,7 @@ Larger Units of Text * Files:: All about handling files. -* Multiples: Buffers. Multiple buffers; editing +* Multiples: Buffers. Multiple buffers; editing several files at once. @@end menu @end group @@ -5008,7 +5065,7 @@ Larger Units of Text * Files:: All about handling files. -* Multiples: Buffers. Multiple buffers; editing +* Multiples: Buffers. Multiple buffers; editing several files at once. @end group @end example @@ -5023,7 +5080,7 @@ @samp{Buffers}, they must be the names of nodes in the same Info file (@pxref{Other Info Files, , Referring to Other Info Files}).@refill -@node Other Info Files, , Menu Example, Menus +@node Other Info Files, , Menu Example, Menus @comment node-name, next, previous, up @section Referring to Other Info Files @cindex Referring to other Info files @@ -5057,9 +5114,9 @@ @example @group @@menu -* Outlining: (emacs)Outline Mode. The major mode for +* Outlining: (emacs)Outline Mode. The major mode for editing outlines. -* Rebinding: (emacs)Rebinding. How to redefine the +* Rebinding: (emacs)Rebinding. How to redefine the meaning of a key. @@end menu @end group @@ -5078,7 +5135,7 @@ @example @group * Info: (info). Documentation browsing system. -* Emacs: (emacs). The extensible, self-documenting +* Emacs: (emacs). The extensible, self-documenting text editor. @end group @end example @@ -5223,7 +5280,7 @@ @example @group -@@xref@{Node name, Cross Reference Name, Particular Topic, +@@xref@{Node name, Cross Reference Name, Particular Topic, info-file-name, A Printed Manual@}, for details. @end group @end example @@ -5464,7 +5521,7 @@ @end example @noindent -and +and @quotation See Section 5.2 [Electrical Effects], page 57. @@ -5487,7 +5544,7 @@ @end example @noindent -and +and @quotation See Section 5.2 [Electrical Effects], page 57, for more info. @@ -5590,12 +5647,12 @@ @@xref@{Sample Program@}. @@xref@{Glossary@}. @@xref@{Case-sensitivity, ,Case-sensitivity in Matching@}. -@@xref@{Close Output, , Closing Output Files and Pipes@}, +@@xref@{Close Output, , Closing Output Files and Pipes@}, for more information. @@xref@{Regexp, , Regular Expressions as Patterns@}. @end smallexample -@node Four and Five Arguments, , Three Arguments, xref +@node Four and Five Arguments, , Three Arguments, xref @subsection @code{@@xref} with Four and Five Arguments In a cross reference, a fourth argument specifies the name of another @@ -5622,7 +5679,7 @@ For example, @example -@@xref@{Electrical Effects, Lightning, Thunder and Lightning, +@@xref@{Electrical Effects, Lightning, Thunder and Lightning, weather, An Introduction to Meteorology@}, for details. @end example @@ -5681,7 +5738,7 @@ For example, @example -@@xref@{Electrical Effects, , Thunder and Lightning, +@@xref@{Electrical Effects, , Thunder and Lightning, weather, An Introduction to Meteorology@}, for details. @end example @@ -5921,7 +5978,7 @@ breaks up the flow of text.@refill @end quotation -@node inforef, , pxref, Cross References +@node inforef, , pxref, Cross References @comment node-name, next, previous, up @section @code{@@inforef} @cindex Cross references using @code{@@inforef} @@ -6053,7 +6110,7 @@ an @emph{intentional} formatting language rather than a @emph{typesetting} formatting language.)@refill -For example, in a printed manual, +For example, in a printed manual, code is usually illustrated in a typewriter font; @code{@@code} tells @TeX{} to typeset this text in this font. But it would be easy to change the way @TeX{} highlights code to use another @@ -6073,6 +6130,8 @@ * file:: How to indicate the name of a file. * dfn:: How to specify a definition. * cite:: How to refer to a book that is not in Info. +* url:: How to indicate a world wide web reference. +* email:: How to indicate an electronic mail address. @end menu @node Useful Highlighting, code, Indicating, Indicating @@ -6106,9 +6165,15 @@ @item @@var@{@var{metasyntactic-variable}@} Indicate a metasyntactic variable.@refill +@item @@url@{@var{uniform-resource-locator}@} +Indicate a uniform resource locator for the World Wide Web. + @item @@file@{@var{file-name}@} Indicate the name of a file.@refill +@item @@email@{@var{email-address}@} +Indicate an electronic mail address. + @item @@dfn@{@var{term}@} Indicate the introductory or defining use of a term.@refill @@ -6141,7 +6206,7 @@ and other variables.@refill Use @code{@@code} for command names in command languages that -resemble programming languages, such as Texinfo or the shell. +resemble programming languages, such as Texinfo or the shell. For example, @code{@@code} and @code{@@samp} are produced by writing @samp{@@code@{@@@@code@}} and @samp{@@code@{@@@@samp@}} in the Texinfo source, respectively.@refill @@ -6234,7 +6299,7 @@ press the @key{RET} key'':@refill @example -@@kbd@{r @@key@{RET@}@} +@@kbd@{r @@key@{RET@}@} @end example @noindent @@ -6244,7 +6309,7 @@ you type; for example:@refill @example -To give the @@code@{logout@} command, +To give the @@code@{logout@} command, type the characters @@kbd@{l o g o u t @@key@{RET@}@}. @end example @@ -6252,7 +6317,7 @@ This produces: @quotation -To give the @code{logout} command, +To give the @code{logout} command, type the characters @kbd{l o g o u t @key{RET}}. @end quotation @@ -6283,10 +6348,7 @@ @@kbd@{C-x @@key@{ESC@}@} @end example -@c bob: this next sentence looks weird, having a semi-colon followed by -@c a colon that ends the "sentence".. --mew -Here is a list of the recommended names for keys; they are all in -upper case:@refill +Here is a list of the recommended names for keys: @cindex Recommended names for keys @cindex Keys, recommended names @cindex Names recommended for keys @@ -6299,7 +6361,8 @@ @item RET Return @item LFD -Linefeed +Linefeed (however, since most keyboards nowadays do not have a Linefeed key, +it might be better to call this character @kbd{C-j}. @item TAB Tab @item BS @@ -6308,29 +6371,30 @@ Escape @item DEL Delete -@item SFT +@item SHIFT Shift -@item CTL +@item CTRL Control @item META Meta @end table @end quotation -There are subtleties to handling words like `meta' or `ctl' that are -names of shift keys. When mentioning a character in which the shift -key is used, such as @kbd{Meta-a}, use the @code{@@kbd} command alone; -do not use the @code{@@key} command; but when you are referring to the +@cindex META key +There are subtleties to handling words like `meta' or `ctrl' that are +names of shift keys. When mentioning a character in which the shift key +is used, such as @kbd{Meta-a}, use the @code{@@kbd} command alone; do +not use the @code{@@key} command; but when you are referring to the shift key in isolation, use the @code{@@key} command. For example, write @samp{@@kbd@{Meta-a@}} to produce @kbd{Meta-a} and -@samp{@@key@{META@}} to produce @key{META}. This is because -@kbd{Meta-a} refers to keys that you press on a keyboard, but -@key{META} refers to a key without implying that you press it. In -short, use @code{@@kbd} for what you do, and use @code{@@key} for what -you talk about: ``Press @code{@@kbd@{M-a@}} to move point to the -beginning of the sentence. The @code{@@key@{META@}} key is often in the -lower left of the keyboard.''@refill -@cindex META key +@samp{@@key@{META@}} to produce @key{META}. + +@c I don't think this is a good explanation. +@c I think it will puzzle readers more than it clarifies matters. -- rms. +@c In other words, use @code{@@kbd} for what you do, and use @code{@@key} +@c for what you talk about: ``Press @code{@@kbd@{M-a@}} to move point to +@c the beginning of the sentence. The @code{@@key@{META@}} key is often in +@c the lower left of the keyboard.''@refill @node samp, var, key, Indicating @comment node-name, next, previous, up @@ -6344,7 +6408,7 @@ addition, it is printed in a fixed-width font.@refill @example -To match @@samp@{foo@} at the end of the line, +To match @@samp@{foo@} at the end of the line, use the regexp @@samp@{foo$@}. @end example @@ -6372,8 +6436,8 @@ @example @group -In English, the vowels are @@samp@{a@}, @@samp@{e@}, -@@samp@{i@}, @@samp@{o@}, @@samp@{u@}, and sometimes +In English, the vowels are @@samp@{a@}, @@samp@{e@}, +@@samp@{i@}, @@samp@{o@}, @@samp@{u@}, and sometimes @@samp@{y@}. @end group @end example @@ -6383,7 +6447,7 @@ @quotation In English, the vowels are @samp{a}, @samp{e}, -@samp{i}, @samp{o}, @samp{u}, and sometimes +@samp{i}, @samp{o}, @samp{u}, and sometimes @samp{y}. @end quotation @@ -6405,13 +6469,13 @@ properly formatted using @code{@@code}.@refill The effect of @code{@@var} in the Info file is to change the case of -the argument to all upper case; in the printed manual, to italicize it. +the argument to all upper case; in the printed manual, to italicize it. @need 700 For example, @example -To delete file @@var@{filename@}, +To delete file @@var@{filename@}, type @@code@{rm @@var@{filename@}@}. @end example @@ -6476,7 +6540,7 @@ For example,@refill @example -The @@file@{.el@} files are in +The @@file@{.el@} files are in the @@file@{/usr/local/emacs/lisp@} directory. @end example @@ -6484,7 +6548,7 @@ produces @quotation -The @file{.el} files are in +The @file{.el} files are in the @file{/usr/local/emacs/lisp} directory. @end quotation @@ -6517,7 +6581,7 @@ to say explicitly that it is a definition, but it should contain the information of a definition---it should make the meaning clear. -@node cite, , dfn, Indicating +@node cite, url, dfn, Indicating @comment node-name, next, previous, up @subsection @code{@@cite}@{@var{reference}@} @findex cite @@ -6529,16 +6593,16 @@ (If a book is written in Texinfo, it is better to use a cross reference command since a reader can easily follow such a reference in Info. @xref{xref, , @code{@@xref}}.)@refill + @ignore - -@c node ctrl, , cite, Indicating +@c node ctrl, , cite, Indicating @comment node-name, next, previous, up @c subsection @code{@@ctrl}@{@var{ctrl-char}@} @findex ctrl The @code{@@ctrl} command is seldom used. It describes an @sc{ascii} control character by inserting the actual character into the Info -file. +file. Usually, in Texinfo, you talk what you type as keyboard entry by describing it with @code{@@kbd}: thus, @samp{@@kbd@{C-a@}} for @@ -6579,7 +6643,39 @@ @var{ch}.@refill @end ignore -@node Emphasis, , Indicating, Marking Text +@node url, email, cite, Indicating +@subsection @code{@@url}@{@var{uniform-resource-locator}@} +@findex url + +Use the @code{@@url} command to indicate a uniform resource locator on +the World Wide Web. For example: + +@c Two lines because one is too long for smallbook format. +@example +The official GNU ftp site is +@@url@{ftp://ftp.gnu.ai.mit.edu/pub/gnu@}. +@end example + +In Info and @TeX{}, this acts like @code{@@samp}. When +Texinfo is converted to HTML, this produces a link you can follow. + +@node email, , url, Indicating +@subsection @code{@@email}@{@var{email-address}@} +@findex email + +Use the @code{@@email} command to indicate an electronic mail address. +For example: + +@example +Send bug reports to @email{bug-texinfo@@prep.ai.mit.edu}. +@end example + +In Info and @TeX{}, this acts like @code{@@samp}. When we have support +for conversion of Texinfo to HTML, this will produce a link you can +follow to bring up a mail composition window initialized with +@var{email-address}. + +@node Emphasis, , Indicating, Marking Text @comment node-name, next, previous, up @section Emphasizing Text @cindex Emphasizing text @@ -6629,7 +6725,7 @@ produces the following in printed output: @quotation -@strong{Caution}: @code{rm * .[^.]*} removes @emph{all} +@strong{Caution}: @code{rm * .[^.]*} removes @emph{all} files in the directory. @end quotation @@ -6642,7 +6738,7 @@ @end ifinfo @example - *Caution*: `rm * .[^.]*' removes *all* + *Caution*: `rm * .[^.]*' removes *all* files in the directory. @end example @@ -6758,20 +6854,22 @@ you need to use one, it probably indicates a gap in the Texinfo language.@refill -@node Customized Highlighting, , Fonts, Emphasis +@node Customized Highlighting, , Fonts, Emphasis @comment node-name, next, previous, up @subsection Customized Highlighting -@findex @@definfoenclose -@cindex `Enclosure' command for Info @cindex Highlighting, customized @cindex Customized highlighting +@c I think this whole section is obsolete with the advent of macros +@c --karl, 15sep96. You can use regular @TeX{} commands inside of @code{@@iftex} @dots{} @code{@@end iftex} to create your own customized highlighting commands for Texinfo. The easiest way to do this is to equate your customized commands with pre-existing commands, such as those for italics. Such new commands work only with @TeX{}.@refill +@findex definfoenclose +@cindex Enclosure command for Info You can use the @code{@@definfoenclose} command inside of @code{@@ifinfo} @dots{} @code{@@end ifinfo} to define commands for Info with the same names as new commands for @TeX{}. @@ -6801,7 +6899,7 @@ This defines @code{@@phoo} as a command that causes @TeX{} to typeset the argument to @code{@@phoo} in italics. @code{@@global@@let} tells @TeX{} to equate the next argument with the argument that follows the -equals sign. +equals sign. @need 1300 For Info, write the following to tell the Info formatters to enclose the @@ -6818,7 +6916,7 @@ @noindent Write the @code{@@definfoenclose} command on a line and follow it with three arguments separated by commas (commas are used as separators in an -@code{@@node} line in the same way).@refill +@code{@@node} line in the same way).@refill @itemize @bullet @item @@ -6829,7 +6927,7 @@ the second argument is the Info start delimiter string; and, @item -the third argument is the Info end delimiter string. +the third argument is the Info end delimiter string. @end itemize @noindent @@ -6854,7 +6952,7 @@ the other for Info. @need 1200 -Here is another example: +Here is another example: @example @group @@ -6890,7 +6988,7 @@ @findex end @menu -* Block Enclosing Commands:: Use different constructs for +* Block Enclosing Commands:: Use different constructs for different purposes. * quotation:: How to write a quotation. * example:: How to write an example in a fixed-width font. @@ -6920,7 +7018,7 @@ in a fixed-width font, and indented but not filled.@refill @item @@lisp -Illustrate Lisp code. The text is printed in a fixed-width font, +Illustrate Lisp code. The text is printed in a fixed-width font, and indented but not filled.@refill @item @@smallexample @@ -6944,7 +7042,7 @@ @end table The @code{@@exdent} command is used within the above constructs to -undo the indentation of a line. +undo the indentation of a line. The @code{@@flushleft} and @code{@@flushright} commands are used to line up the left or right margins of unfilled text.@refill @@ -7021,7 +7119,7 @@ @example @group This is an example of text written between an -@code{@@example} command +@code{@@example} command and an @code{@@end example} command. The text is indented but not filled. @end group @@ -7103,7 +7201,7 @@ This is an example @@end example -@@noindent +@@noindent This line is not indented. As you can see, the beginning of the line is fully flush left with the line that follows after it. (This whole example is between @@ -7168,7 +7266,7 @@ @node smallexample & smalllisp, display, Lisp Example, Quotations and Examples @comment node-name, next, previous, up @section @code{@@smallexample} and @code{@@smalllisp} -@cindex Small book example +@cindex Small book example @cindex Example for a small book @cindex Lisp example for a small book @findex smallexample @@ -7208,12 +7306,12 @@ @tex % Remove extra vskip; this is a kludge to counter the effect of display \vskip-3\baselineskip -{\ninett +{\ninett \dots{} to make sure that you have the freedom to -distribute copies of free software (and charge for -this service if you wish), that you receive source -code or can get it if you want it, that you can -change the software or use pieces of it in new free +distribute copies of free software (and charge for +this service if you wish), that you receive source +code or can get it if you want it, that you can +change the software or use pieces of it in new free programs; and that you know you can do these things.} @end tex @end display @@ -7282,7 +7380,7 @@ @format This is an example of text written between an @code{@@format} command and an @code{@@end format} command. As you can see -from this example, +from this example, the @code{@@format} command does not fill the text. @end format @@ -7344,7 +7442,7 @@ @example @group @@flushleft -This text is +This text is written flushleft. @@end flushleft @end group @@ -7355,7 +7453,7 @@ @quotation @flushleft -This text is +This text is written flushleft. @end flushleft @end quotation @@ -7372,7 +7470,7 @@ @group @@flushright Here is an example of text written -flushright. The @@code@{@@flushright@} command +flushright. The @@code@{@@flushright@} command right justifies every line but leaves the left end ragged. @@end flushright @@ -7389,7 +7487,7 @@ left end ragged. @end flushright -@node cartouche, , flushleft & flushright, Quotations and Examples +@node cartouche, , flushleft & flushright, Quotations and Examples @section Drawing Cartouches Around Examples @findex cartouche @cindex Box with rounded corners @@ -7404,7 +7502,7 @@ no effect in the Info file.@refill @need 1500 -For example, +For example, @example @group @@ -7450,6 +7548,7 @@ * itemize:: How to construct a simple list. * enumerate:: How to construct a numbered list. * Two-column Tables:: How to construct a two-column table. +* Multi-column Tables:: How to construct generalized tables. @end menu @ifinfo @@ -7482,13 +7581,13 @@ Here is an itemized list of the different kinds of table and lists:@refill @itemize @bullet -@item +@item Itemized lists with and without bullets. -@item +@item Enumerated lists, using numbers or letters. -@item +@item Two-column tables with highlighting. @end itemize @@ -7497,13 +7596,13 @@ Here is an enumerated list with the same items:@refill @enumerate -@item +@item Itemized lists with and without bullets. -@item +@item Enumerated lists, using numbers or letters. -@item +@item Two-column tables with highlighting. @end enumerate @@ -7522,7 +7621,7 @@ @item @@table @itemx @@ftable @itemx @@vtable -Two-column tables with highlighting. +Two-column tables with indexing. @end table @node itemize, enumerate, Introducing Lists, Lists and Tables @@ -7532,7 +7631,7 @@ @findex itemize The @code{@@itemize} command produces sequences of indented -paragraphs, with a bullet or other mark inside the left margin +paragraphs, with a bullet or other mark inside the left margin at the beginning of each paragraph for which such a mark is desired.@refill Begin an itemized list by writing @code{@@itemize} at the beginning of @@ -7643,13 +7742,13 @@ the left margin contain successive integers or letters. (@xref{itemize, , @code{@@itemize}}.)@refill -Write the @code{@@enumerate} command at the beginning of a line. +Write the @code{@@enumerate} command at the beginning of a line. The command does not require an argument, but accepts either a number or a letter as an option. -Without an argument, @code{@@enumerate} starts the list +Without an argument, @code{@@enumerate} starts the list with the number 1. With a numeric argument, such as 3, the command starts the list with that number. -With an upper or lower case letter, such as @kbd{a} or @kbd{A}, +With an upper or lower case letter, such as @kbd{a} or @kbd{A}, the command starts the list with that letter.@refill Write the text of the enumerated list in the same way you write an @@ -7721,38 +7820,37 @@ using @code{@@enumerate} with an argument of @kbd{a}.@refill @sp 1 @enumerate a -@item +@item @code{@@enumerate} Without an argument, produce a numbered list, starting with the number 1.@refill -@item +@item @code{@@enumerate @var{positive-integer}} With a (positive) numeric argument, start a numbered list with that number. You can use this to continue a list that you interrupted with other text.@refill -@item +@item @code{@@enumerate @var{upper-case-letter}} -With an upper case letter as argument, start a list +With an upper case letter as argument, start a list in which each item is marked by a letter, beginning with that upper case letter.@refill -@item +@item @code{@@enumerate @var{lower-case-letter}} -With a lower case letter as argument, start a list +With a lower case letter as argument, start a list in which each item is marked by a letter, beginning with that lower case letter.@refill @end enumerate You can also nest enumerated lists, as in an outline.@refill -@node Two-column Tables, , enumerate, Lists and Tables -@comment node-name, next, previous, up +@node Two-column Tables, Multi-column Tables, enumerate, Lists and Tables @section Making a Two-column Table @cindex Tables, making two-column @findex table @@ -7779,7 +7877,7 @@ Write the @code{@@table} command at the beginning of a line and follow it on the same line with an argument that is a Texinfo command such as -@code{@@code}, @code{@@samp}, @code{@@var}, or @code{@@kbd}. +@code{@@code}, @code{@@samp}, @code{@@var}, or @code{@@kbd}. Although these commands are usually followed by arguments in braces, in this case you use the command name without an argument because @code{@@item} will supply the argument. This command will be applied @@ -7846,7 +7944,7 @@ @node ftable vtable, itemx, table, Two-column Tables @comment node-name, next, previous, up -@subsection @code{@@ftable} and @code{@@vtable} +@subsection @code{@@ftable} and @code{@@vtable} @cindex Tables with indexes @cindex Indexing table entries automatically @findex ftable @@ -7869,7 +7967,9 @@ with an @code{@@end ftable} or @code{@@end vtable} command on a line by itself. -@node itemx, , ftable vtable, Two-column Tables +See the example for @code{@@table} in the previous section. + +@node itemx, , ftable vtable, Two-column Tables @comment node-name, next, previous, up @subsection @code{@@itemx} @cindex Two named items for @code{@@table} @@ -7912,6 +8012,127 @@ (Note also that this example illustrates multi-line supporting text in a two-column table.)@refill + +@node Multi-column Tables, , Two-column Tables, Lists and Tables +@section Multi-column Tables +@cindex Tables, making multi-column +@findex multitable + +@code{@@multitable} allows you to construct tables with any number of +columns, with each column having any width you like. + +You define the column widths on the @code{@@multitable} line itself, and +write each row of the actual table following an @code{@@item} command, +with columns separated by an @code{@@tab} command. Finally, @code{@@end +multitable} completes the table. Details in the sections below. + +@menu +* Multitable Column Widths:: Defining multitable column widths. +* Multitable Rows:: Defining multitable rows, with examples. +@end menu + +@node Multitable Column Widths, Multitable Rows, Multi-column Tables, Multi-column Tables +@subsection Multitable Column Widths +@cindex Multitable column widths +@cindex Column widths, defining for multitables +@cindex Widths, defining multitable column + +You can define the column widths for a multitable in two ways: as +fractions of the line length; or with a prototype row. Mixing the two +methods is not supported. In either case, the widths are defined +entirely on the same line as the @code{@@multitable} command. + +@enumerate +@item +@findex columnfractions +@cindex Line length, column widths as fraction of +To specify column widths as fractions of the line length, write +@code{@@columnfractions} and the decimal numbers (presumably less than +1) after the @code{@@multitable} command, as in: + +@example +@@multitable @@columnfractions .33 .33 .33 +@end example + +@noindent The fractions need not add up exactly to 1.0, as these do +not. This allows you to produce tables that do not need the full line +length. + +@item +@cindex Prototype row, column widths defined by +To specify a prototype row, write the longest entry for each column +enclosed in braces after the @code{@@multitable} command. For example: + +@example +@@multitable @{some text for column one@} @{for column two@} +@end example + +@noindent +The first column will then have the width of the typeset `some text for +column one', and the second column the width of `for column two'. + +The prototype entries need not appear in the table itself. + +Although we used simple text in this example, the prototype entries can +contain Texinfo commands; markup commands such as @code{@@code} are +particularly likely to be useful. + +@end enumerate + + +@node Multitable Rows, , Multitable Column Widths, Multi-column Tables +@subsection Multitable Rows +@cindex Multitable rows +@cindex Rows, of a multitable + +@findex item +@cindex tab +After the @code{@@multitable} command defining the column widths (see +the previous section), you begin each row in the body of a multitable +with @code{@@item}, and separate the column entries with @code{@@tab}. +Line breaks are not special within the table body, and you may break +input lines in your source file as necessary. + +Here is a complete example of a multi-column table (the text is from +the GNU Emacs manual): + +@example +@@multitable @@columnfractions .15 .45 .4 +@@item Key @@tab Command @@tab Description +@@item C-x 2 +@@tab @@code@{split-window-vertically@} +@@tab Split the selected window into two windows, +with one above the other. +@@item C-x 3 +@@tab @@code@{split-window-horizontally@} +@@tab Split the selected window into two windows +positioned side by side. +@@item C-Mouse-2 +@@tab +@@tab In the mode line or scroll bar of a window, +split that window. +@@end multitable +@end example + +@noindent produces: + +@multitable @columnfractions .15 .45 .4 +@item Key @tab Command @tab Description +@item C-x 2 +@tab @code{split-window-vertically} +@tab Split the selected window into two windows, +with one above the other. +@item C-x 3 +@tab @code{split-window-horizontally} +@tab Split the selected window into two windows +positioned side by side. +@item C-Mouse-2 +@tab +@tab In the mode line or scroll bar of a window, +split that window. +@end multitable + + @node Indices, Insertions, Lists and Tables, Top @comment node-name, next, previous, up @chapter Creating Indices @@ -8075,8 +8296,8 @@ Text}).@refill @cindex Index font types -@cindex Predefined indexing commands -@cindex Indexing commands, predefined +@cindex Predefined indexing commands +@cindex Indexing commands, predefined The six indexing commands for predefined indices are: @table @code @@ -8236,7 +8457,7 @@ index into a concept index, all the function names are printed in the @code{@@code} font as you would expect.@refill -@node synindex, , syncodeindex, Combining Indices +@node synindex, , syncodeindex, Combining Indices @subsection @code{@@synindex} @findex synindex @@ -8249,10 +8470,10 @@ @xref{Printing Indices & Menus}, for information about printing an index at the end of a book or creating an index menu in an Info file.@refill -@node New Indices, , Combining Indices, Indices -@section Defining New Indices -@cindex Defining new indices -@cindex Indices, defining new +@node New Indices, , Combining Indices, Indices +@section Defining New Indices +@cindex Defining new indices +@cindex Indices, defining new @cindex New index defining @findex defindex @findex defcodeindex @@ -8349,84 +8570,101 @@ @end iftex @menu -* Braces Atsigns Periods:: How to insert braces, @samp{@@} and periods. -* dmn:: How to format a dimension. +* Braces Atsigns:: How to insert braces, @samp{@@}. +* Inserting Space:: How to insert the right amount of space + within a sentence. +* Inserting Accents:: How to insert accents and special characters. * Dots Bullets:: How to insert dots and bullets. -* TeX and copyright:: How to insert the @TeX{} logo +* TeX and copyright:: How to insert the @TeX{} logo and the copyright symbol. +* pounds:: How to insert the pounds currency symbol. * minus:: How to insert a minus sign. * math:: How to format a mathematical expression. @end menu -@node Braces Atsigns Periods, dmn, Insertions, Insertions -@comment node-name, next, previous, up -@section Inserting @samp{@@}, Braces, and Periods -@cindex Inserting @@, braces, and periods + +@node Braces Atsigns, Inserting Space, Insertions, Insertions +@section Inserting @@ and Braces +@cindex Inserting @@, braces @cindex Braces, inserting -@cindex Periods, inserting -@cindex Single characters, commands to insert -@cindex Commands to insert single characters - -@samp{@@} and curly braces are special characters in Texinfo. To -insert these characters so they appear in text, you must put an @samp{@@} in front -of these characters to prevent Texinfo from misinterpreting them.@refill - -Periods are also special. Depending on whether the period is inside -or at the end of a sentence, less or more space is inserted after a -period in a typeset manual. Since it is not always possible for -Texinfo to determine when a period ends a sentence and when it is used -in an abbreviation, special commands are needed in some circumstances. -(Usually, Texinfo can guess how to handle periods, so you do not need -to use the special commands; you just enter a period as you would if -you were using a typewriter, which means you put two spaces after the -period, question mark, or exclamation mark that ends a -sentence.)@refill +@cindex Special characters, commands to insert +@cindex Commands to insert special characters + +@samp{@@} and curly braces are special characters in Texinfo. To insert +these characters so they appear in text, you must put an @samp{@@} in +front of these characters to prevent Texinfo from misinterpreting +them. Do not put braces after any of these commands; they are not -necessary.@refill +necessary. @menu -* Inserting An Atsign:: -* Inserting Braces:: How to insert @samp{@{} and @samp{@}} -* Controlling Spacing:: How to insert the right amount of space - after punctuation within a sentence. +* Inserting An Atsign:: How to insert @samp{@@}. +* Inserting Braces:: How to insert @samp{@{} and @samp{@}}. @end menu -@node Inserting An Atsign, Inserting Braces, Braces Atsigns Periods, Braces Atsigns Periods -@comment node-name, next, previous, up +@node Inserting An Atsign, Inserting Braces, Braces Atsigns, Braces Atsigns @subsection Inserting @samp{@@} with @@@@ @findex @@ @r{(single @samp{@@})} @code{@@@@} stands for a single @samp{@@} in either printed or Info -output.@refill - -Do not put braces after an @code{@@@@} command.@refill - -@node Inserting Braces, Controlling Spacing, Inserting An Atsign, Braces Atsigns Periods -@comment node-name, next, previous, up +output. + +Do not put braces after an @code{@@@@} command. + +@node Inserting Braces, , Inserting An Atsign, Braces Atsigns @subsection Inserting @samp{@{} and @samp{@}}with @@@{ and @@@} @findex @{ @r{(single @samp{@{})} @findex @} @r{(single @samp{@}})} @code{@@@{} stands for a single @samp{@{} in either printed or Info -output.@refill +output. @code{@@@}} stands for a single @samp{@}} in either printed or Info -output.@refill - -Do not put braces after either an @code{@@@{} or an @code{@@@}} -command.@refill - -@node Controlling Spacing, , Inserting Braces, Braces Atsigns Periods -@comment node-name, next, previous, up -@subsection Spacing After Colons and Periods +output. + +Do not put braces after either an @code{@@@{} or an @code{@@@}} +command. + + +@node Inserting Space, Inserting Accents, Braces Atsigns, Insertions +@section Inserting Space + +@cindex Inserting space +@cindex Spacing, inserting +@cindex Whitespace, inserting +The following sections describe commands that control spacing of various +kinds within and after sentences. + +@menu +* Not Ending a Sentence:: Sometimes a . doesn't end a sentence. +* Ending a Sentence:: Sometimes it does. +* Multiple Spaces:: Inserting multiple spaces. +* dmn:: How to format a dimension. +@end menu + +@node Not Ending a Sentence, Ending a Sentence, Inserting Space, Inserting Space +@subsection Not Ending a Sentence + +@cindex Not ending a sentence +@cindex Sentence non-ending punctuation +@cindex Periods, inserting +Depending on whether a period or exclamation point or question mark is +inside or at the end of a sentence, less or more space is inserted after +a period in a typeset manual. Since it is not always possible for +Texinfo to determine when a period ends a sentence and when it is used +in an abbreviation, special commands are needed in some circumstances. +(Usually, Texinfo can guess how to handle periods, so you do not need to +use the special commands; you just enter a period as you would if you +were using a typewriter, which means you put two spaces after the +period, question mark, or exclamation mark that ends a sentence.) + @findex : @r{(suppress widening)} - Use the @code{@@:}@: command after a period, question mark, exclamation mark, or colon that should not be followed by extra space. For example, use @code{@@:}@: after periods that end abbreviations which are not at the ends of sentences. @code{@@:}@: has no effect on -the Info file output.@refill +the Info file output. @need 700 For example, @@ -8452,14 +8690,26 @@ @end quotation @noindent -@kbd{@@:} has no effect on the Info output. (@samp{s.o.p} is an acronym -for ``Standard Operating Procedure''.) - -@findex . @r{(true end of sentence)} -Use @code{@@.}@: instead of a period at the end of a sentence that -ends with a single capital letter. Otherwise, @TeX{} will think the -letter is an abbreviation and will not insert the correct -end-of-sentence spacing. Here is an example:@refill +@kbd{@@:} has no effect on the Info output. (@samp{s.o.p.} is an +abbreviation for ``Standard Operating Procedure''.) + +Do not put braces after @code{@@:}. + + +@node Ending a Sentence, Multiple Spaces, Not Ending a Sentence, Inserting Space +@subsection Ending a Sentence + +@cindex Ending a Sentence +@cindex Sentence ending punctuation + +@findex . @r{(end of sentence)} +@findex ! @r{(end of sentence)} +@findex ? @r{(end of sentence)} +Use @code{@@.}@: instead of a period, @code{@@!}@: instead of an +exclamation point, and @code{@@?}@: instead of a question mark at the end +of a sentence that ends with a single capital letter. Otherwise, @TeX{} +will think the letter is an abbreviation and will not insert the correct +end-of-sentence spacing. Here is an example: @example Give it to M.I.B. and to M.E.W@@. Also, give it to R.J.C@@. @@ -8473,7 +8723,7 @@ @iftex produces the following. If you look carefully at this printed output, you will see a little more whitespace after the @samp{W} in the first -line.@refill +line. @end iftex @quotation @@ -8482,17 +8732,61 @@ @end quotation In the Info file output, @code{@@.}@: is equivalent to a simple -@samp{.}.@refill - -The meanings of @code{@@:}@: and @code{@@.}@: in Texinfo are designed -to work well with the Emacs sentence motion commands. This made it -necessary for them to be incompatible with some other formatting -systems that use @@-commands.@refill - -Do not put braces after either an @code{@@:} or an @code{@@.} command.@refill - -@node dmn, Dots Bullets, Braces Atsigns Periods, Insertions -@section @code{@@dmn}@{@var{dimension}@}: Format a Dimension +@samp{.}; likewise for @code{@@!}@: and @code{@@?}@:. + +The meanings of @code{@@:} and @code{@@.}@: in Texinfo are designed to +work well with the Emacs sentence motion commands (@pxref{Sentences,,, +emacs, GNU Emacs}). This made it necessary for them to be incompatible +with some other formatting systems that use @@-commands. + +Do not put braces after any of these commands. + + +@node Multiple Spaces, dmn, Ending a Sentence, Inserting Space +@subsection Multiple Spaces + +@cindex Multiple spaces +@cindex Whitespace, inserting +@findex (space) +@findex (tab) +@findex (newline) + +Ordinarily, @TeX{} collapses multiple whitespace characters (space, tab, +and newline) into a single space. (Info output, on the other hand, +preserves whitespace as you type it, except for changing a newline into +a space; this is why it is important to put two spaces at the end of +sentences in Texinfo documents.) + +Occasionally, you may want to actually insert several consecutive +spaces, either for purposes of example (what your program does with +multiple spaces as input), or merely for purposes of appearance in +headings or lists. Texinfo supports three commands: @code{@@ }, +@code{@@@kbd{TAB}}, and @code{@@@kbd{NL}}, all of which insert a single +space into the output. (Here, @kbd{TAB} and @kbd{NL} represent the tab +character and end-of-line, i.e., when @samp{@@} is the last character on +a line.) + +For example, +@example +Spacey@@ @@ @@ @@ +example. +@end example + +@noindent produces + +@example +Spacey@ @ @ @ +example. +@end example + +Other possible uses of @code{@@ } have been subsumed by @code{@@multitable} +(@pxref{Multi-column Tables}). + +Do not follow any of these commands with braces. + + +@node dmn, , Multiple Spaces, Inserting Space +@subsection @code{@@dmn}@{@var{dimension}@}: Format a Dimension @cindex Thin space between number, dimension @cindex Dimension formatting @cindex Format a dimension @@ -8530,11 +8824,123 @@ formatters may insert a line break between the number and the dimension. Also, if you write a period after an abbreviation within a sentence, you should write @samp{@@:} after the period to prevent -@TeX{} from inserting extra whitespace. @xref{Controlling Spacing, , -Spacing After Colons and Periods}.)@refill - -@node Dots Bullets, TeX and copyright, dmn, Insertions -@comment node-name, next, previous, up +@TeX{} from inserting extra whitespace. @xref{Inserting Space}. + + +@node Inserting Accents, Dots Bullets, Inserting Space, Insertions +@section Inserting Accents + +@cindex Inserting accents +@cindex Accents, inserting +@cindex Floating accents, inserting + +Here is a table with the commands Texinfo provides for inserting +floating accents. The commands with non-alphabetic names do not take +braces around their argument (which is taken to be the next character). +(Exception: @code{@@,} @emph{does} take braces around its argument.) +This is so as to make the source as convenient to type and read as +possible, since accented characters are very common in some languages. + +@findex " +@cindex Umlaut accent +@findex ' +@cindex Acute accent +@findex = +@cindex Macron accent +@findex ^ +@cindex Circumflex accent +@findex ` +@cindex Grave accent +@findex ~ +@cindex Tilde accent +@findex , +@cindex Cedilla accent +@findex dotaccent +@cindex Dot accent +@findex H +@cindex Hungariam umlaut accent +@findex ringaccent +@cindex Ring accent +@findex tieaccent +@cindex Tie-after accent +@findex u +@cindex Breve accent +@findex ubaraccent +@cindex Underbar accent +@findex udotaccent +@cindex Underdot accent +@findex v +@cindex Check accent +@multitable {@@questiondown@{@}} {Output} {macron/overbar accent} +@item Command @tab Output @tab What +@item @t{@@"o} @tab @"o @tab umlaut accent +@item @t{@@'o} @tab @'o @tab acute accent +@item @t{@@,@{c@}} @tab @,{c} @tab cedilla accent +@item @t{@@=o} @tab @=o @tab macron/overbar accent +@item @t{@@^o} @tab @^o @tab circumflex accent +@item @t{@@`o} @tab @`o @tab grave accent +@item @t{@@~o} @tab @~o @tab tilde accent +@item @t{@@dotaccent@{o@}} @tab @dotaccent{o} @tab overdot accent +@item @t{@@H@{o@}} @tab @H{o} @tab long Hungarian umlaut +@item @t{@@ringaccent@{o@}} @tab @ringaccent{o} @tab ring accent +@item @t{@@tieaccent@{oo@}} @tab @tieaccent{oo} @tab tie-after accent +@item @t{@@u@{o@}} @tab @u{o} @tab breve accent +@item @t{@@ubaraccent@{o@}} @tab @ubaraccent{o} @tab underbar accent +@item @t{@@udotaccent@{o@}} @tab @udotaccent{o} @tab underdot accent +@item @t{@@v@{o@}} @tab @v{o} @tab hacek or check accent +@end multitable + +This table lists the Texinfo commands for inserting other characters +commonly used in languages other than English. + +@findex questiondown +@cindex @questiondown{} +@findex exclamdown +@cindex @exclamdown{} +@findex aa +@cindex @aa{} +@findex AA +@cindex @AA{} +@findex ae +@cindex @ae{} +@findex AE +@cindex @AE{} +@findex dotless +@cindex @dotless{i} +@cindex @dotless{j} +@cindex Dotless i, j +@findex l +@cindex @l{} +@findex L +@cindex @L{} +@findex o +@cindex @o{} +@findex O +@cindex @O{} +@findex oe +@cindex @oe{} +@findex OE +@cindex @OE{} +@findex ss +@cindex @ss{} +@cindex Es-zet +@cindex Sharp S +@cindex German S +@multitable {@@questiondown@{@}} {oe,OE} {es-zet or sharp S} +@item @t{@@exclamdown@{@}} @tab @exclamdown{} @tab upside-down ! +@item @t{@@questiondown@{@}} @tab @questiondown{} @tab upside-down ? +@item @t{@@aa@{@},@@AA@{@}} @tab @aa{},@AA{} @tab A,a with circle +@item @t{@@ae@{@},@@AE@{@}} @tab @ae{},@AE{} @tab ae,AE ligatures +@item @t{@@dotless@{i@}} @tab @dotless{i} @tab dotless i +@item @t{@@dotless@{j@}} @tab @dotless{j} @tab dotless j +@item @t{@@l@{@},@@L@{@}} @tab @l{},@L{} @tab suppressed-L,l +@item @t{@@o@{@},@@O@{@}} @tab @o{},@O{} @tab O,o with slash +@item @t{@@oe@{@},@@OE@{@}} @tab @oe{},@OE{} @tab OE,oe ligatures +@item @t{@@ss@{@}} @tab @ss{} @tab es-zet or sharp S +@end multitable + + +@node Dots Bullets, TeX and copyright, Inserting Accents, Insertions @section Inserting Ellipsis, Dots, and Bullets @cindex Dots, inserting @cindex Bullets, inserting @@ -8569,21 +8975,20 @@ three dots in a row, appropriately spaced, like this: `@dots{}'. Do not simply write three periods in the input file; that would work for the Info file output, but would produce the wrong amount of space -between the periods in the printed manual.@refill - -Similarly, the @code{@@enddots@{@}} command helps you correctly set an -end-of-sentence ellipsis (four dots). +between the periods in the printed manual. + +Similarly, the @code{@@enddots@{@}} command generates an +end-of-sentence ellipsis (four dots) @enddots{} @iftex Here is an ellipsis: @dots{} - Here are three periods in a row: ... In printed output, the three periods in a row are closer together than the dots in the ellipsis. @end iftex -@node bullet, , dots, Dots Bullets +@node bullet, , dots, Dots Bullets @comment node-name, next, previous, up @subsection @code{@@bullet}@{@} @findex bullet @@ -8594,10 +8999,10 @@ Here is a bullet: @bullet{} When you use @code{@@bullet} in @code{@@itemize}, you do not need to -type the braces, because @code{@@itemize} supplies them. +type the braces, because @code{@@itemize} supplies them. (@xref{itemize, , @code{@@itemize}}.)@refill -@node TeX and copyright, minus, Dots Bullets, Insertions +@node TeX and copyright, pounds, Dots Bullets, Insertions @comment node-name, next, previous, up @section Inserting @TeX{} and the Copyright Symbol @@ -8621,9 +9026,9 @@ manual, this is a special logo that is different from three ordinary letters. In Info, it just looks like @samp{TeX}. The @code{@@TeX@{@}} command is unique among Texinfo commands in that the -@key{T} and the @key{X} are in upper case.@refill - -@node copyright symbol, , tex, TeX and copyright +@kbd{T} and the @kbd{X} are in upper case.@refill + +@node copyright symbol, , tex, TeX and copyright @comment node-name, next, previous, up @subsection @code{@@copyright}@{@} @findex copyright @@ -8632,7 +9037,16 @@ a printed manual, this is a @samp{c} inside a circle, and in Info, this is @samp{(C)}.@refill -@node minus, math, TeX and copyright, Insertions +@node pounds, minus, TeX and copyright, Insertions +@section @code{@@pounds}@{@} +@findex pounds + +Use the @code{@@pounds@{@}} command to generate `@pounds{}'. In a +printed manual, this is the symbol for the currency pounds sterling. +In Info, it is a @samp{#}. Other currency symbols are unfortunately not +available. + +@node minus, math, pounds, Insertions @section @code{@@minus}@{@}: Inserting a Minus Sign @findex minus @@ -8661,7 +9075,7 @@ an itemized list, you do not need to type the braces (@pxref{itemize, , @code{@@itemize}}.)@refill -@node math, , minus, Insertions +@node math, , minus, Insertions @comment node-name, next, previous, up @section @code{@@math}: Inserting Mathematical Expressions @findex math @@ -8708,14 +9122,14 @@ @node Glyphs, Breaks, Insertions, Top @comment node-name, next, previous, up -@chapter Glyphs for Examples +@chapter Glyphs for Examples @cindex Glyphs In Texinfo, code is often illustrated in examples that are delimited by @code{@@example} and @code{@@end example}, or by @code{@@lisp} and @code{@@end lisp}. In such examples, you can indicate the results of evaluation or an expansion using @samp{@result{}} or -@samp{@expansion{}}. Likewise, there are commands to insert glyphs +@samp{@expansion{}}. Likewise, there are commands to insert glyphs to indicate printed output, error messages, equivalence of expressions, and the location of point.@refill @@ -8833,7 +9247,7 @@ @end lisp @noindent -which may be read as: +which may be read as: @quotation @code{(third '(a b c))} expands to @code{(car (cdr (cdr '(a b c))))}; @@ -8970,7 +9384,7 @@ identical results to evaluating @code{(list 'keymap)}. @c Cannot write point command here because it causes trouble with TOC. -@node Point Glyph, , Equivalence, Glyphs +@node Point Glyph, , Equivalence, Glyphs @section Indicating Point in a Buffer @cindex Point, indicating it in a buffer @@ -9055,7 +9469,8 @@ @menu * Break Commands:: Cause and prevent splits. * Line Breaks:: How to force a single line to use two lines. -* w:: How to prevent unwanted line breaks. +* - and hyphenation:: How to tell TeX about hyphenation points. +* w:: How to prevent unwanted line breaks. * sp:: How to insert blank lines. * page:: How to force the start of a new page. * group:: How to prevent unwanted page breaks. @@ -9070,7 +9485,7 @@ @sp 1 @end iftex -The break commands create line and paragraph breaks:@refill +The break commands create or allow line and paragraph breaks:@refill @table @code @item @@* @@ -9078,10 +9493,13 @@ @item @@sp @var{n} Skip @var{n} blank lines.@refill -@end table -@iftex -@sp 1 -@end iftex + +@item @@- +Insert a discretionary hyphen. + +@item @@hyphenation@{@var{hy-phen-a-ted words}@} +Define hyphen points in @var{hy-phen-a-ted words}. +@end table The line-break-prevention command holds text together all on one line:@refill @@ -9108,7 +9526,7 @@ Start a new printed page if not enough space on this one.@refill @end table -@node Line Breaks, w, Break Commands, Breaks +@node Line Breaks, - and hyphenation, Break Commands, Breaks @comment node-name, next, previous, up @section @code{@@*}: Generate Line Breaks @findex * @r{(force line break)} @@ -9164,11 +9582,46 @@ break.@refill @end quotation -@node w, sp, Line Breaks, Breaks +@node - and hyphenation, w, Line Breaks, Breaks +@section @code{@@-} and @code{@@hyphenation}: Helping @TeX{} hyphenate + +@findex - +@findex hyphenation +@cindex Hyphenation, helping @TeX{} do +@cindex Fine-tuning, and hyphenation + +Although @TeX{}'s hyphenation algorithm is generally pretty good, it +does miss useful hyphenation points from time to time. (Or, far more +rarely, insert an incorrect hyphenation.) So, for documents with an +unusual vocabulary or when fine-tuning for a printed edition, you may +wish to help @TeX{} out. Texinfo supports two commands for this: + +@table @code +@item @@- +Insert a discretionary hyphen, i.e., a place where @TeX{} can (but does +not have to) hyphenate. This is especially useful when you notice +an overfull hbox is due to @TeX{} missing a hyphenation (@pxref{Overfull +hboxes}). @TeX{} will not insert any hyphenation points in a word +containing @code{@@-}. + +@item @@hyphenation@{@var{hy-phen-a-ted words}@} +Tell @TeX{} how to hyphenate @var{hy-phen-a-ted words}. As shown, you +put a @samp{-} at each hyphenation point. For example: +@example +@@hyphenation@{man-u-script man-u-scripts@} +@end example +@noindent @TeX{} only uses the specified hyphenation points when the +words match exactly, so give all necessary variants. +@end table + +Info output is not hyphenated, so these commands have no effect there. + +@node w, sp, - and hyphenation, Breaks @comment node-name, next, previous, up @section @code{@@w}@{@var{text}@}: Prevent Line Breaks @findex w @r{(prevent line break)} @cindex Line breaks, preventing +@cindex Hyphenation, preventing @code{@@w@{@var{text}@}} outputs @var{text} and prohibits line breaks within @var{text}.@refill @@ -9188,9 +9641,6 @@ You can copy GNU software from @w{@file{prep.ai.mit.edu}}. @end quotation -In the Texinfo file, you must write the @code{@@w} command and its -argument (all the affected text) all on one line.@refill - @quotation @strong{Caution:} Do not write an @code{@@refill} command at the end of a paragraph containing an @code{@@w} command; it will cause the @@ -9216,7 +9666,7 @@ @end example @noindent -generates two blank lines. +generates two blank lines. The @code{@@sp} command is most often used in the title page.@refill @@ -9249,7 +9699,7 @@ @example @group -This line +This line contains and is ended by paragraph breaks @@ -9328,7 +9778,7 @@ @code{@@end group} if you get incomprehensible error messages in @TeX{}.@refill -@node need, , group, Breaks +@node need, , group, Breaks @comment node-name, next, previous, up @section @code{@@need @var{mils}}: Prevent Page Breaks @cindex Need space at page bottom @@ -9422,7 +9872,7 @@ @example @group @@deffn Command forward-word count -This command moves point forward @@var@{count@} words +This command moves point forward @@var@{count@} words (or backward if @@var@{count@} is negative). @dots{} @@end deffn @end group @@ -9444,8 +9894,8 @@ @example @group -@@deffn @{Interactive Command@} isearch-forward -@dots{} +@@deffn @{Interactive Command@} isearch-forward +@dots{} @@end deffn @end group @end example @@ -9471,7 +9921,7 @@ @example @group -@@defun @var{name} @var{arguments}@dots{} +@@defun @var{name} @var{arguments}@dots{} @var{body-of-definition} @@end defun @end group @@ -9482,10 +9932,10 @@ @example @group -@@defun buffer-end flag +@@defun buffer-end flag This function returns @@code@{(point-min)@} if @@var@{flag@} is less than 1, @@code@{(point-max)@} otherwise. -@dots{} +@dots{} @@end defun @end group @end example @@ -9526,22 +9976,22 @@ An argument enclosed within square brackets is optional. Thus, the phrase @samp{@code{@r{[}@var{optional-arg}@r{]}}} means that -@var{optional-arg} is optional. +@var{optional-arg} is optional. An argument followed by an ellipsis is optional -and may be repeated more than once. +and may be repeated more than once. @c This is consistent with Emacs Lisp Reference manual -Thus, @samp{@var{repeated-args}@dots{}} stands for zero or more arguments. +Thus, @samp{@var{repeated-args}@dots{}} stands for zero or more arguments. Parentheses are used when several arguments are grouped -into additional levels of list structure in Lisp. +into additional levels of list structure in Lisp. @end iftex @c The following looks better in Info (no `r', `samp' and `code'): @ifinfo -An argument enclosed within square brackets is optional. -Thus, [@var{optional-arg}] means that @var{optional-arg} is optional. -An argument followed by an ellipsis is optional -and may be repeated more than once. +An argument enclosed within square brackets is optional. +Thus, [@var{optional-arg}] means that @var{optional-arg} is optional. +An argument followed by an ellipsis is optional +and may be repeated more than once. @c This is consistent with Emacs Lisp Reference manual -Thus, @var{repeated-args}@dots{} stands for zero or more arguments. +Thus, @var{repeated-args}@dots{} stands for zero or more arguments. Parentheses are used when several arguments are grouped into additional levels of list structure in Lisp. @end ifinfo @@ -9598,9 +10048,9 @@ @example @group -@@deffn @{Interactive Command@} isearch-forward +@@deffn @{Interactive Command@} isearch-forward @@deffnx @{Interactive Command@} isearch-backward -These two search commands are similar except @dots{} +These two search commands are similar except @dots{} @@end deffn @end group @end example @@ -9608,9 +10058,9 @@ @noindent produces -@deffn {Interactive Command} isearch-forward +@deffn {Interactive Command} isearch-forward @deffnx {Interactive Command} isearch-backward -These two search commands are similar except @dots{} +These two search commands are similar except @dots{} @end deffn Each of the other definition commands has an `x' form: @code{@@defunx}, @@ -9666,7 +10116,7 @@ @example @group -@@deffn Command forward-char nchars +@@deffn Command forward-char nchars Move point forward @@var@{nchars@} characters. @@end deffn @end group @@ -9688,7 +10138,7 @@ @example @group @@deffn @var{category} @var{name} @var{arguments}@dots{} -@var{body-of-definition} +@var{body-of-definition} @@end deffn @end group @end example @@ -9723,7 +10173,7 @@ @example @group -@@defun @var{function-name} @var{arguments}@dots{} +@@defun @var{function-name} @var{arguments}@dots{} @var{body-of-definition} @@end defun @end group @@ -9769,10 +10219,10 @@ @example @group -@@defvr @{User Option@} fill-column -This buffer-local variable specifies -the maximum width of filled lines. -@dots{} +@@defvr @{User Option@} fill-column +This buffer-local variable specifies +the maximum width of filled lines. +@dots{} @@end defvr @end group @end example @@ -9784,8 +10234,8 @@ @example @group -@@defvr @var{category} @var{name} -@var{body-of-definition} +@@defvr @var{category} @var{name} +@var{body-of-definition} @@end defvr @end group @end example @@ -9803,8 +10253,8 @@ @example @group -@@defvar kill-ring -@dots{} +@@defvar kill-ring +@dots{} @@end defvar @end group @end example @@ -9813,8 +10263,8 @@ @example @group -@@defvar @var{name} -@var{body-of-definition} +@@defvar @var{name} +@var{body-of-definition} @@end defvar @end group @end example @@ -9852,7 +10302,7 @@ @example @group -@@deftypefn @{Library Function@} int foobar +@@deftypefn @{Library Function@} int foobar (int @@var@{foo@}, float @@var@{bar@}) @dots{} @@end deftypefn @@ -9918,8 +10368,8 @@ @example @group -@@deftypefn stacks private push - (@@var@{s@}:in out stack; +@@deftypefn stacks private push + (@@var@{s@}:in out stack; @@var@{n@}:in integer) @dots{} @@end deftypefn @@ -10185,7 +10635,7 @@ @findex defop @item @@defop @var{category} @var{class} @var{name} @var{arguments}@dots{} The @code{@@defop} command is the general definition command for -entities that may resemble methods in object-oriented programming. +entities that may resemble methods in object-oriented programming. These entities take arguments, as functions do, but are associated with particular classes of objects.@refill @@ -10277,7 +10727,7 @@ @code{bar-class}', in the index of functions.@refill @end table -@node Data Types, , Abstract Objects, Def Cmds in Detail +@node Data Types, , Abstract Objects, Def Cmds in Detail @subsection Data Types Here is the command for data types:@refill @@ -10334,7 +10784,7 @@ contains the name of a type, such as @var{integer}, take care that the argument actually is of that type.@refill -@node Sample Function Definition, , Def Cmd Conventions, Definition Commands +@node Sample Function Definition, , Def Cmd Conventions, Definition Commands @section A Sample Function Definition @cindex Function definitions @cindex Command definitions @@ -10448,10 +10898,18 @@ see @cite{The Chicago Manual of Style}, which is published by the University of Chicago Press.}@refill +@menu +* Footnote Commands:: How to write a footnote in Texinfo. +* Footnote Styles:: Controlling how footnotes appear in Info. +@end menu + +@node Footnote Commands, Footnote Styles, Footnotes, Footnotes +@section Footnote Commands + In Texinfo, footnotes are created with the @code{@@footnote} command. This command is followed immediately by a left brace, then by the text of the footnote, and then by a terminating right brace. The template -is: +is: @example @@footnote@{@var{text}@} @@ -10464,23 +10922,31 @@ source, it looks like this:@refill @example -@dots{}a sample footnote @@footnote@{Here is the sample +@dots{}a sample footnote @@footnote@{Here is the sample footnote.@}; in the Texinfo source@dots{} @end example +@strong{Warning:} Don't use footnotes in the argument of the +@code{@@item} command for a @code{@@table} table. This doesn't work; +because of limitations of @TeX{}, there is no way to fix it. To avoid +the problem, move the footnote into the body text of the table. + In a printed manual or book, the reference mark for a footnote is a -small, superscripted number; the text of the footnote is written at -the bottom of the page, below a horizontal line.@refill +small, superscripted number; the text of the footnote appears at the +bottom of the page, below a horizontal line.@refill In Info, the reference mark for a footnote is a pair of parentheses with the footnote number between them, like this: @samp{(1)}.@refill +@node Footnote Styles, , Footnote Commands, Footnotes +@section Footnote Styles + Info has two footnote styles, which determine where the text of the footnote is located:@refill @itemize @bullet @cindex @samp{@r{End}} node footnote style -@item +@item In the `End' node style, all the footnotes for a single node are placed at the end of that node. The footnotes are separated from the rest of the node by a line of dashes with the word @@ -10500,7 +10966,7 @@ @end example @cindex @samp{@r{Separate}} footnote style -@item +@item In the `Separate' node style, all the footnotes for a single node are placed in an automatically constructed node of their own. In this style, a ``footnote reference'' follows @@ -10523,7 +10989,7 @@ @group File: texinfo.info Node: Overview-Footnotes, Up: Overview -(1) Note that the first syllable of "Texinfo" is +(1) Note that the first syllable of "Texinfo" is pronounced like "speck", not "hex". @dots{} @end group @end smallexample @@ -10536,7 +11002,7 @@ Use the @code{@@footnotestyle} command to specify an Info file's footnote style. Write this command at the beginning of a line followed by an argument, either @samp{end} for the end node style or -@samp{separate} for the separate node style. +@samp{separate} for the separate node style. @need 700 For example, @@ -10598,13 +11064,14 @@ @end ignore This chapter contains two footnotes.@refill -@node Conditionals, Format/Print Hardcopy, Footnotes, Top +@node Conditionals, Macros, Footnotes, Top @comment node-name, next, previous, up @chapter Conditionally Visible Text @cindex Conditionally visible text @cindex Text, conditionally visible @cindex Visibility of conditional text @cindex If text conditionally visible +@findex ifhtml @findex ifinfo @findex iftex @@ -10614,7 +11081,7 @@ and which is for the Info file.@refill @menu -* Conditional Commands:: How to specify text for Info or @TeX{}. +* Conditional Commands:: How to specify text for HTML, Info, or @TeX{}. * Using Ordinary TeX Commands:: You can use any and all @TeX{} commands. * set clear value:: How to designate which text to format (for both Info and @TeX{}); and how to set a @@ -10626,9 +11093,9 @@ @heading Using @code{@@ifinfo} and @code{@@iftex} @end ifinfo -@code{@@ifinfo} begins segments of text that should be ignored +@code{@@ifinfo} begins segments of text that should be ignored by @TeX{} when it -typesets the printed manual. The segment of text appears only +typesets the printed manual. The segment of text appears only in the Info file. The @code{@@ifinfo} command should appear on a line by itself; end the Info-only text with a line containing @code{@@end ifinfo} by @@ -10639,7 +11106,8 @@ The @code{@@iftex} and @code{@@end iftex} commands are similar to the @code{@@ifinfo} and @code{@@end ifinfo} commands, except that they specify text that will appear in the printed manual but not in the Info -file.@refill +file. Likewise for @code{@@ifhtml} and @code{@@end ifhtml}, which +specify text to appear only in HTML output.@refill @need 700 For example, @@ -10680,10 +11148,10 @@ @cindex @TeX{} commands, using ordinary @cindex Ordinary @TeX{} commands, using @cindex Commands using ordinary @TeX{} -@cindex Plain@TeX{} +@cindex plain @TeX{} Inside a region delineated by @code{@@iftex} and @code{@@end iftex}, -you can embed some Plain@TeX{} commands. Info will ignore these +you can embed some plain @TeX{} commands. Info will ignore these commands since they are only in that part of the file which is seen by @TeX{}. You can write the @TeX{} commands as you would write them in a normal @TeX{} file, except that you must replace the @samp{\} used @@ -10693,11 +11161,11 @@ command causes Info to ignore the region automatically, as it does with the @code{@@iftex} command.)@refill -However, many features of Plain@TeX{} will not work, as they are +However, many features of plain @TeX{} will not work, as they are overridden by features of Texinfo. @findex tex -You can enter Plain@TeX{} completely, and use @samp{\} in the @TeX{} +You can enter plain @TeX{} completely, and use @samp{\} in the @TeX{} commands, by delineating a region with the @code{@@tex} and @code{@@end tex} commands. (The @code{@@tex} command also causes Info to ignore the region, like the @code{@@iftex} @@ -10705,12 +11173,12 @@ @cindex Mathematical expressions For example, here is a mathematical expression written in -Plain@TeX{}:@refill +plain @TeX{}:@refill @example @@tex -$$ \chi^2 = \sum_@{i=1@}^N - \left (y_i - (a + b x_i) +$$ \chi^2 = \sum_@{i=1@}^N + \left (y_i - (a + b x_i) \over \sigma_i\right)^2 $$ @@end tex @end example @@ -10725,12 +11193,12 @@ @end iftex @tex -$$ \chi^2 = \sum_{i=1}^N - \left(y_i - (a + b x_i) +$$ \chi^2 = \sum_{i=1}^N + \left(y_i - (a + b x_i) \over \sigma_i\right)^2 $$ @end tex -@node set clear value, , Using Ordinary TeX Commands, Conditionals +@node set clear value, , Using Ordinary TeX Commands, Conditionals @comment node-name, next, previous, up @section @code{@@set}, @code{@@clear}, and @code{@@value} @@ -10746,7 +11214,7 @@ @menu * ifset ifclear:: Format a region if a flag is set. -* value:: Replace a flag with a string. +* value:: Replace a flag with a string. * value Example:: An easy way to update edition information. @end menu @@ -10763,7 +11231,7 @@ @var{flag}; a @dfn{flag} can be any single word. The format for the command looks like this:@refill @findex set - + @example @@set @var{flag} @end example @@ -10783,7 +11251,7 @@ a manual for a `large' and `small' model:@refill @example -You can use this machine to dig up shrubs +You can use this machine to dig up shrubs without hurting them. @@set large @@ -10856,7 +11324,7 @@ If @var{flag} is cleared, tell the Texinfo formatting commands to ignore text up to the following @code{@@end ifset} command.@refill -@item @@ifclear @var{flag} +@item @@ifclear @var{flag} If @var{flag} is set, tell the Texinfo formatting commands to ignore the text up to the following @code{@@end ifclear} command.@refill @@ -10946,11 +11414,11 @@ @end group @end example -@node value Example, , value, set clear value +@node value Example, , value, set clear value @subsection @code{@@value} Example You can use the @code{@@value} command to limit the number of places you -need to change when you record an update to a manual. +need to change when you record an update to a manual. Here is how it is done in @cite{The GNU Make Manual}: @need 1000 @@ -10973,9 +11441,9 @@ @example @group -This is Edition @@value@{EDITION@}, +This is Edition @@value@{EDITION@}, last updated @@value@{UPDATED@}, -of @@cite@{The GNU Make Manual@}, +of @@cite@{The GNU Make Manual@}, for @@code@{make@}, Version @@value@{VERSION@}. @end group @end example @@ -11005,7 +11473,7 @@ @example @group -This is Edition @@value@{EDITION@} +This is Edition @@value@{EDITION@} of the @@cite@{GNU Make Manual@}, last updated @@value@{UPDATED@} for @@code@{make@} Version @@value@{VERSION@}. @@ -11018,7 +11486,7 @@ @example @group -This is Edition 0.35 Beta, last updated 14 August 1992, +This is Edition 0.35 Beta, last updated 14 August 1992, of `The GNU Make Manual', for `make', Version 3.63 Beta. @end group @end example @@ -11026,7 +11494,133 @@ When you update the manual, change only the values of the flags; you do not need to rewrite the three sections. -@node Format/Print Hardcopy, Create an Info File, Conditionals, Top + +@node Macros, Format/Print Hardcopy, Conditionals, Top +@chapter Macros: Defining New Texinfo Commands +@cindex Macros +@cindex Defining new Texinfo commands +@cindex New Texinfo commands, defining +@cindex Texinfo commands, defining new +@cindex User-defined Texinfo commands + +A Texinfo @dfn{macro} allows you to define a new Texinfo command as any +sequence of text and/or existing commands (including other macros). The +macro can have any number of @dfn{parameters}---text you supply each +time you use the macro. (This has nothing to do with the +@code{@@defmac} command, which is for documenting macros in the subject +of the manual; @pxref{Def Cmd Template}.) + +@menu +* Defining Macros:: Both defining and undefining new commands. +* Invoking Macros:: Using a macro, once you've defined it. +@end menu + + +@node Defining Macros, Invoking Macros, Macros, Macros +@section Defining Macros +@cindex Defining macros +@cindex Macro definitions + +@findex macro +You use the Texinfo @code{@@macro} command to define a macro. For example: + +@example +@@macro @var{macro-name}@{@var{param1}, @var{param2}, @dots{}@} +@var{text} @dots{} \@var{param1}\ @dots{} +@@end macro +@end example + +The @dfn{parameters} @var{param1}, @var{param2}, @dots{} correspond to +arguments supplied when the macro is subsequently used in the document +(see the next section). + +If a macro needs no parameters, you can define it either with an empty +list (@samp{@@macro foo @{@}}) or with no braces at all (@samp{@@macro +foo}). + +@cindex Body of a macro +@cindex Mutually recursive macros +@cindex Recursion, mutual +The definition or @dfn{body} of the macro can contain any Texinfo +commands, including previously-defined macros. (It is not possible to +have mutually recursive Texinfo macros.) In the body, instances of a +parameter name surrounded by backslashes, as in @samp{\@var{param1}\} in +the example above, are replaced by the corresponding argument from the +macro invocation. + +@findex unmacro +@cindex Macros, undefining +@cindex Undefining macros +You can undefine a macro @var{foo} with @code{@@unmacro @var{foo}}. +It is not an error to undefine a macro that is already undefined. +For example: + +@example +@@unmacro foo +@end example + + +@node Invoking Macros, , Defining Macros, Macros +@section Invoking Macros +@cindex Invoking macros +@cindex Macro invocation + +After a macro is defined (see the previous section), you can use +(@dfn{invoke}) it in your document like this: + +@example +@@@var{macro-name} @{@var{arg1}, @var{arg2}, @dots{}@} +@end example + +@noindent and the result will be just as if you typed the body of +@var{macro-name} at that spot. For example: + +@example +@@macro foo @{p, q@} +Together: \p\ & \q\. +@@end macro +@@foo@{a, b@} +@end example + +@noindent produces: + +@display +Together: a & b. +@end display + +@cindex Backslash, and macros +Thus, the arguments and parameters are separated by commas and delimited +by braces; any whitespace after (but not before) a comma is ignored. To +insert a comma, brace, or backslash in an argument, prepend a backslash, +as in + +@example +@@@var{macro-name} @{\\\@{\@}\,@} +@end example + +@noindent +which will pass the (almost certainly error-producing) argument +@samp{\@{@},} to @var{macro-name}. + +If the macro is defined to take a single argument, and is invoked +without any braces, the entire rest of the line after the macro name is +supplied as the argument. For example: + +@example +@@macro bar @{p@} +Twice: \p\, \p\. +@@end macro +@@bar aah +@end example + +@noindent produces: + +@display +Twice: aah, aah. +@end display + + +@node Format/Print Hardcopy, Create an Info File, Macros, Top @comment node-name, next, previous, up @chapter Format and Print Hardcopy @cindex Format and print hardcopy @@ -11035,7 +11629,7 @@ @cindex Sorting indices @cindex Indices, sorting @cindex @TeX{} index sorting -@findex texindex +@pindex texindex There are three major shell commands for making a printed manual from a Texinfo file: one for converting the Texinfo file into a file that will be @@ -11104,7 +11698,7 @@ indices. (The source file @file{texindex.c} comes as part of the standard GNU distribution and is usually installed when Emacs is installed.)@refill -@findex texindex +@pindex texindex @ignore Usage: texindex [-k] [-T tempdir] infile [-o outfile] ... @@ -11158,21 +11752,21 @@ However, cross references to indices are rare.}@refill To summarize, this is a three step process: - + @enumerate -@item +@item Run the @code{tex} formatting command on the Texinfo file. This generates the formatted @sc{dvi} file as well as the raw index files with two letter extensions.@refill -@item +@item Run the shell command @code{texindex} on the raw index files to sort them. This creates the corresponding sorted index files.@refill -@item +@item Rerun the @code{tex} formatting command on the Texinfo file. This regenerates a formatted @sc{dvi} file with the index entries in the -correct order. This second run also corrects the page numbers for +correct order. This second run also corrects the page numbers for the cross references. (The tables of contents are always correct.)@refill @end enumerate @@ -11185,26 +11779,26 @@ @node Format with texi2dvi, Print with lpr, Format with tex/texindex, Format/Print Hardcopy @comment node-name, next, previous, up @section Format using @code{texi2dvi} -@findex texi2dvi @r{(shell script)} +@pindex texi2dvi @r{(shell script)} The @code{texi2dvi} command is a shell script that automatically runs -both @code{tex} and @code{texindex} as needed to produce a @sc{dvi} file -with up-to-date, sorted indices. It simplifies the -@code{tex}---@code{texindex}---@code{tex} sequence described in the +both @code{tex} and @code{texindex} as many times as necessary to +produce a @sc{dvi} file with up-to-date, sorted indices. It simplifies +the @code{tex}---@code{texindex}---@code{tex} sequence described in the previous section. @need 1000 -The syntax for @code{texi2dvi} is like this (where @samp{%} is the +The syntax for @code{texi2dvi} is like this (where @samp{prompt$} is the shell prompt):@refill @example -% texi2dvi @var{filename}@dots{} +prompt$ @kbd{texi2dvi @var{filename}@dots{}} @end example @node Print with lpr, Within Emacs, Format with texi2dvi, Format/Print Hardcopy @comment node-name, next, previous, up @section Shell Print Using @code{lpr -d} -@findex lpr @r{(@sc{dvi} print command)} +@pindex lpr @r{(@sc{dvi} print command)} You can print a @sc{dvi} file with the @sc{dvi} print command. The precise printing command to use depends on your system; @samp{lpr -d} is @@ -11291,7 +11885,7 @@ @itemx M-x texinfo-tex-buffer Run @code{texi2dvi} on the current buffer.@refill -@item C-c C-t C-r +@item C-c C-t C-r @itemx M-x texinfo-tex-region Run @TeX{} on the current region.@refill @@ -11348,7 +11942,7 @@ The Texinfo mode @TeX{} formatting commands start a subshell in Emacs called the @file{*tex-shell*}. The @code{texinfo-tex-command}, @code{texinfo-texindex-command}, and @code{tex-dvi-print-command} -commands are all run in this shell. +commands are all run in this shell. You can watch the commands operate in the @samp{*tex-shell*} buffer, and you can switch to and from and use the @samp{*tex-shell*} buffer @@ -11412,21 +12006,23 @@ @node Requirements Summary, Preparing for TeX, Compile-Command, Format/Print Hardcopy @comment node-name, next, previous, up @section @TeX{} Formatting Requirements Summary -@cindex Requirements for formatting +@cindex Requirements for formatting @cindex Formatting requirements Every Texinfo file that is to be input to @TeX{} must begin with a -@code{\input} command and contain an @code{@@settitle} command:@refill +@code{\input} command and must contain an @code{@@setfilename} command and +an @code{@@settitle} command:@refill @example \input texinfo +@@setfilename @var{arg-not-used-by-@TeX{}} @@settitle @var{name-of-manual} @end example @noindent The first command instructs @TeX{} to load the macros it needs to -process a Texinfo file and the second command specifies the title of -printed manual.@refill +process a Texinfo file, the second command opens auxiliary files, and +the third specifies the title of printed manual. @need 1000 Every Texinfo file must end with a line that terminates @TeX{} @@ -11436,17 +12032,16 @@ @@bye @end example -Strictly speaking, these three lines are all a Texinfo file needs for +Strictly speaking, these four lines are all a Texinfo file needs for @TeX{}, besides the body. (The @code{@@setfilename} line is the only line that a Texinfo file needs for Info formatting.)@refill Usually, the file's first line contains an @samp{@@c -*-texinfo-*-} comment that causes Emacs to switch to Texinfo mode when you edit the file. In addition, the beginning usually includes an -@code{@@setfilename} for Info formatting, an @code{@@setchapternewpage} -command, a title page, a copyright page, and permissions. Besides an -@code{@@bye}, the end of a file usually includes indices and a table of -contents.@refill +@code{@@setchapternewpage} command, a title page, a copyright page, and +permissions. Besides an @code{@@bye}, the end of a file usually +includes indices and a table of contents.@refill @iftex For more information, see @@ -11484,8 +12079,8 @@ included in the standard GNU distributions.)@refill Usually, the @file{texinfo.tex} file is put in the default directory -that contains @TeX{} macros (the @file{/usr/lib/tex/macros} -directory) when GNU Emacs or other GNU software is installed. +that contains @TeX{} macros (the @file{/usr/lib/tex/macros} +directory) when GNU Emacs or other GNU software is installed. In this case, @TeX{} will find the file and you do not need to do anything special. Alternatively, you can put @file{texinfo.tex} in the directory in @@ -11553,7 +12148,7 @@ @TeX{} also provides the line number in the Texinfo source file and the text of the offending line, which is marked at all the places that -@TeX{} knows how to hyphenate words. +@TeX{} knows how to hyphenate words. @xref{Debugging with TeX, , Catching Errors with @TeX{} Formatting}, for more information about typesetting errors.@refill @@ -11565,7 +12160,7 @@ @cindex Black rectangle in hardcopy @cindex Rectangle, ugly, black in hardcopy However, unless told otherwise, @TeX{} will print a large, ugly, black -rectangle beside the line that contains the overful hbox. This is so +rectangle beside the line that contains the overfull hbox. This is so you will notice the location of the problem if you are correcting a draft.@refill @@ -11644,11 +12239,11 @@ @end group @end example -@node Cropmarks and Magnification, , A4 Paper, Format/Print Hardcopy +@node Cropmarks and Magnification, , A4 Paper, Format/Print Hardcopy @comment node-name, next, previous, up @section Cropmarks and Magnification -@findex cropmarks +@findex cropmarks @cindex Cropmarks for printing @cindex Printing cropmarks You can attempt to direct @TeX{} to print cropmarks at the corners of @@ -11681,7 +12276,7 @@ usual with the @code{\mag} @TeX{} command. Everything that is typeset is scaled proportionally larger or smaller. (@code{\mag} stands for ``magnification''.) This is @emph{not} a Texinfo @@-command, but is a -Plain@TeX{} command that is prefixed with a backslash. You have to +plain @TeX{} command that is prefixed with a backslash. You have to write this command between @code{@@tex} and @code{@@end tex} (@pxref{Using Ordinary TeX Commands, , Using Ordinary @TeX{} Commands}).@refill @@ -11729,10 +12324,10 @@ * Pointer Validation:: How to check that pointers point somewhere. * makeinfo in Emacs:: How to run @code{makeinfo} from Emacs. * texinfo-format commands:: Two Info formatting commands written - in Emacs Lisp are an alternative + in Emacs Lisp are an alternative to @code{makeinfo}. * Batch Formatting:: How to format for Info in Emacs Batch mode. -* Tag and Split Files:: How tagged and split files help Info +* Tag and Split Files:: How tagged and split files help Info to run better. @end menu @@ -11829,7 +12424,7 @@ @need 100 @table @code @item -D @var{var} -Cause @var{var} to be defined. This is equivalent to +Cause @var{var} to be defined. This is equivalent to @code{@@set @var{var}} in the Texinfo file. @need 150 @@ -11939,7 +12534,7 @@ @need 150 @item -U @var{var} -Cause @var{var} to be undefined. This is equivalent to +Cause @var{var} to be undefined. This is equivalent to @code{@@clear @var{var}} in the Texinfo file. @need 100 @@ -11970,7 +12565,7 @@ @file{(dir)}, then the referenced node must exist.@refill @item -In every node, if the `Previous' node is different from the `Up' node, +In every node, if the `Previous' node is different from the `Up' node, then the `Previous' node must also be pointed to by a `Next' node.@refill @item @@ -12065,8 +12660,8 @@ @example @group -(setq makeinfo-options - "--paragraph-indent=0 --no-split +(setq makeinfo-options + "--paragraph-indent=0 --no-split --fill-column=70 --verbose") @end group @end example @@ -12157,7 +12752,7 @@ @code{texinfo-format-region} or @code{texinfo-format-buffer}, you cannot use that Emacs for anything else until the command finishes.)@refill -@node Tag and Split Files, , Batch Formatting, Create an Info File +@node Tag and Split Files, , Batch Formatting, Create an Info File @comment node-name, next, previous, up @section Tag Files and Split Files @cindex Making a tag table automatically @@ -12246,6 +12841,7 @@ validate the structure of the nodes, see @ref{Using Info-validate}.@refill + @node Install an Info File, Command List, Create an Info File, Top @comment node-name, next, previous, up @chapter Installing an Info File @@ -12260,8 +12856,11 @@ @menu * Directory file:: The top level menu for all Info files. * New Info File:: Listing a new info file. -* Other Info Directories:: How to specify Info files that are +* Other Info Directories:: How to specify Info files that are located in other directories. +* Installing Dir Entries:: How to specify what menu entry to add + to the Info directory. +* Invoking install-info:: @code{install-info} options. @end menu @node Directory file, New Info File, Install an Info File, Install an Info File @@ -12286,8 +12885,8 @@ * Info: (info). Documentation browsing system. * Emacs: (emacs). The extensible, self-documenting text editor. -* Texinfo: (texinfo). With one source file, make - either a printed manual using +* Texinfo: (texinfo). With one source file, make + either a printed manual using TeX or an Info file. @dots{} @end group @@ -12316,11 +12915,11 @@ case letters---it can be written in either upper or lower case. Info has a feature that it will change the case of the file name to lower case if it cannot find the name as written.)@refill - -@c !!! Can any file name be written in upper or lower case, +@c !!! Can any file name be written in upper or lower case, @c or is dir a special case? @c Yes, apparently so, at least with Gillespie's Info. --rjc 24mar92 -@c + + @node New Info File, Other Info Directories, Directory file, Install an Info File @section Listing a New Info File @cindex Adding a new info file @@ -12329,11 +12928,10 @@ @cindex Info file, listing new one @cindex @file{dir} file listing -To add a new Info file to your system, write a menu entry for it in the -menu in the @file{dir} file in the @file{info} directory. Also, move -the new Info file itself to the @file{info} directory. For example, if -you were adding documentation for GDB, you would write the following new -entry:@refill +To add a new Info file to your system, you must write a menu entry to +add to the menu in the @file{dir} file in the @file{info} directory. +For example, if you were adding documentation for GDB, you would write +the following new entry:@refill @example * GDB: (gdb). The source-level C debugger. @@ -12342,22 +12940,17 @@ @noindent The first part of the menu entry is the menu entry name, followed by a colon. The second part is the name of the Info file, in parentheses, -followed by a period. The third part is the description.@refill - -Conventionally, the name of an Info file has a @file{.info} extension. -Thus, you might list the name of the file like this: - -@example -* GDB: (gdb.info). The source-level C debugger. -@end example - -@noindent -However, Info will look for a file with a @file{.info} extension if it -does not find the file under the name given in the menu. This means -that you can refer to the file @file{gdb.info} as @file{gdb}, as shown -in the first example. This looks better. - -@node Other Info Directories, , New Info File, Install an Info File +followed by a period. The third part is the description. + +The name of an Info file often has a @file{.info} extension. Thus, the +Info file for GDB might be called either @file{gdb} or @file{gdb.info}. +The Info reader programs automatically try the file name both with and +without @file{.info}; so it is better to avoid clutter and not to write +@samp{.info} explicitly in the menu entry. For example, the GDB menu +entry should use just @samp{gdb} for the file name, not @samp{gdb.info}. + + +@node Other Info Directories, Installing Dir Entries, New Info File, Install an Info File @comment node-name, next, previous, up @section Info Files in Other Directories @cindex Installing Info in another directory @@ -12378,17 +12971,18 @@ @code{Info-directory-list} variable in your personal or site initialization file. -This tells Emacs's Info reader reader where to look for @file{dir} +This tells Emacs's Info reader where to look for @file{dir} files. Emacs merges the files named @file{dir} from each of the listed directories. (In Emacs Version 18, you can set the @code{Info-directory} variable to the name of only one directory.)@refill @item -Specify the @file{info} directory name in an environment variable in -your @file{.profile} or @file{.cshrc} initialization file. (Only you -and others who set this environment variable will be able to find Info -files whose location is specified this way.)@refill +Specify the @file{info} directory name in the @code{INFOPATH} +environment variable in your @file{.profile} or @file{.cshrc} +initialization file. (Only you and others who set this environment +variable will be able to find Info files whose location is specified +this way.)@refill @end itemize For example, to reach a test file in the @file{~bob/manuals} @@ -12396,31 +12990,31 @@ @file{dir} file:@refill @example -* Test: (/usr/bob/manuals/info-test). Bob's own test file. +* Test: (/home/bob/manuals/info-test). Bob's own test file. @end example @noindent In this case, the absolute file name of the @file{info-test} file is written as the second part of the menu entry.@refill -@vindex Info-directory-list +@vindex Info-directory-list Alternatively, you could write the following in your @file{.emacs} file:@refill @example @group (setq Info-directory-list - '("/usr/bob/manuals" + '("/home/bob/manuals" "/usr/local/emacs/info")) @end group @end example @c reworded to avoid overfill hbox This tells Emacs to merge the @file{dir} file from the -@file{/usr/bob/manuals} directory with the @file{dir} file from the +@file{/home/bob/manuals} directory with the @file{dir} file from the @file{"/usr/local/emacs/info}" directory. Info will list the -@file{/usr/bob/manuals/info-test} file as a menu entry in the -@file{/usr/bob/manuals/dir} file.@refill +@file{/home/bob/manuals/info-test} file as a menu entry in the +@file{/home/bob/manuals/dir} file.@refill @vindex INFOPATH Finally, you can tell Info where to look by setting the @@ -12431,7 +13025,7 @@ you must set the @code{INFOPATH} environment variable in the @file{.profile} initialization file; but if you use @code{csh}, you must set the variable in the @file{.cshrc} initialization file. The two -files require slightly different command formats.@refill +files use slightly different command formats.@refill @itemize @bullet @item @@ -12457,6 +13051,145 @@ @code{INFOPATH} environment variable to initialize the value of Emacs's own @code{Info-directory-list} variable. + +@node Installing Dir Entries, Invoking install-info, Other Info Directories, Install an Info File +@section Installing Info Directory Files + +When you install an Info file onto your system, you can use the program +@code{install-info} to update the Info directory file @file{dir}. +Normally the makefile for the package runs @code{install-info}, just +after copying the Info file into its proper installed location. + +@findex dircategory +@findex direntry +In order for the Info file to work with @code{install-info}, you should +use the commands @code{@@dircategory} and @code{@@direntry} in the +Texinfo source file. Use @code{@@direntry} to specify the menu entry to +add to the Info directory file, and use @code{@@dircategory} to specify +which part of the Info directory to put it in. Here is how these +commands are used in this manual: + +@smallexample +@@dircategory Texinfo documentation system +@@direntry +* Texinfo: (texinfo). The GNU documentation format. +* install-info: (texinfo)Invoking install-info. @dots{} +@dots{} +@@end direntry +@end smallexample + +Here's what this produces in the Info file: + +@smallexample +INFO-DIR-SECTION Texinfo documentation system +START-INFO-DIR-ENTRY +* Texinfo: (texinfo). The GNU documentation format. +* install-info: (texinfo)Invoking install-info. @dots{} +@dots{} +END-INFO-DIR-ENTRY +@end smallexample + +@noindent +The @code{install-info} program sees these lines in the Info file, and +that is how it knows what to do. + +Always use the @code{@@direntry} and @code{@@dircategory} commands near +the beginning of the Texinfo input, before the first @code{@@node} +command. If you use them later on in the input, @code{install-info} +will not notice them. + +If you use @code{@@dircategory} more than once in the Texinfo source, +each usage specifies one category; the new menu entry is added to the +Info directory file in each of the categories you specify. If you use +@code{@@direntry} more than once, each usage specifies one menu entry; +each of these menu entries is added to the directory in each of the +specified categories. + + +@node Invoking install-info, , Installing Dir Entries, Install an Info File +@section Invoking install-info + +@pindex install-info + +@code{install-info} inserts menu entries from an Info file into the +top-level @file{dir} file in the Info system (see the previous sections +for an explanation of how the @file{dir} file works). It's most often +run as part of software installation, or when constructing a dir file +for all manuals on a system. Synopsis: + +@example +install-info [@var{option}]@dots{} [@var{info-file} [@var{dir-file}]] +@end example + +If @var{info-file} or @var{dir-file} are not specified, the various +options (described below) that define them must be. There are no +compile-time defaults, and standard input is never used. +@code{install-info} can read only one info file and write only one dir +file per invocation. + +Options: + +@table @samp +@item --delete +@opindex --delete +Only delete existing entries in @var{info-file}; don't insert any new +entries. + +@item --dir-file=@var{name} +@opindex --dir-file=@var{name} +Specify file name of the Info directory file. This is equivalent to +using the @var{dir-file} argument. + +@item --entry=@var{text} +@opindex --entry=@var{text} +Insert @var{text} as an Info directory entry; @var{text} should have the +form of an Info menu item line plus zero or more extra lines starting +with whitespace. If you specify more than one entry, they are all +added. If you don't specify any entries, they are determined from +information in the Info file itself. + +@item --help +@opindex --help +Display a usage message listing basic usage and all available options, +then exit successfully. + +@item --info-file=@var{file} +@opindex --info-file=@var{file} +Specify Info file to install in the directory. +This is equivalent to using the @var{info-file} argument. + +@item --info-dir=@var{dir} +@opindex --info-dir=@var{dir} +Equivalent to @samp{--dir-file=@var{dir}/dir}. + +@item --item=@var{text} +@opindex --item=@var{text} +Same as --entry=@var{text}. An Info directory entry is actually a menu +item. + +@item --quiet +@opindex --quiet +Suppress warnings. + +@item --remove +@opindex --remove +Same as --delete. + +@item --section=@var{sec} +@opindex --section=@var{sec} +Put this file's entries in section @var{sec} of the directory. If you +specify more than one section, all the entries are added in each of the +sections. If you don't specify any sections, they are determined from +information in the Info file itself. + +@item --version +@opindex --version +@cindex version number, finding +Display version information and exit successfully. + +@end table + + @c ================ Appendix starts here ================ @node Command List, Tips, Install an Info File, Top @@ -12471,32 +13204,80 @@ @sp 1 @table @code +@item @@@var{whitespace} +An @code{@@} followed by a space, tab, or newline produces a normal, +stretchable, interword space. @xref{Multiple Spaces}. + +@item @@! +Generate an exclamation point that really does end a sentence (usually +after an end-of-sentence capital letter). @xref{Ending a Sentence}. + +@item @@" +@itemx @@' +Generate an umlaut or acute accent, respectively, over the next +character, as in @"o and @'o. @xref{Inserting Accents}. + @item @@* Force a line break. Do not end a paragraph that uses @code{@@*} with an @code{@@refill} command. @xref{Line Breaks}.@refill +@item @@,@{@var{c}@} +Generate a cedilla accent under @var{c}, as in @,{c}. @xref{Inserting +Accents}. + +@item @@- +Insert a discretionary hyphenation point. @xref{- and hyphenation}. + @item @@. -Stands for a period that really does end a sentence (usually after an -end-of-sentence capital letter). @xref{Controlling Spacing}.@refill +Produce a period that really does end a sentence (usually after an +end-of-sentence capital letter). @xref{Ending a Sentence}. @item @@: Indicate to @TeX{} that an immediately preceding period, question mark, exclamation mark, or colon does not end a sentence. Prevent @TeX{} from inserting extra whitespace as it does at the end of a sentence. The command has no effect on the Info file output. -@xref{Controlling Spacing}.@refill +@xref{Not Ending a Sentence}.@refill + +@item @@= +Generate a macro (bar) accent over the next character, as in @=o. +@xref{Inserting Accents}. + +@item @@? +Generate a question mark that really does end a sentence (usually after +an end-of-sentence capital letter). @xref{Ending a Sentence}. @item @@@@ -Stands for @samp{@@}. @xref{Braces Atsigns Periods, , Inserting -@samp{@@}}.@refill +Stands for an at sign, @samp{@@}.@* +@xref{Braces Atsigns, , Inserting @@ and braces}. + +@item @@^ +@itemx @@` +Generate a circumflex (hat) or grave accent, respectively, over the next +character, as in @^o. +@xref{Inserting Accents}. @item @@@{ -Stands for a left-hand brace, @samp{@{}.@* -@xref{Braces Atsigns Periods, , Inserting @@ braces and periods}.@refill +Stands for a left brace, @samp{@{}.@* +@xref{Braces Atsigns, , Inserting @@ and braces}. @item @@@} Stands for a right-hand brace, @samp{@}}.@* -@xref{Braces Atsigns Periods, , Inserting @@ braces and periods}.@refill +@xref{Braces Atsigns, , Inserting @@ and braces}. + +@item @@= +Generate a tilde accent over the next character, as in @~N. +@xref{Inserting Accents}. + +@item @@AA@{@} +@itemx @@aa@{@} +Generate the uppercase and lowercase Scandinavian A-ring letters, +respectively: @AA{}, @aa{}. @xref{Inserting Accents}. + +@item @@AE@{@} +@itemx @@ae@{@} +Generate the uppercase and lowercase AE ligatures, respectively: +@AE{}, @ae{}. @xref{Inserting Accents}. @item @@appendix @var{title} Begin an appendix. The title appears in the table @@ -12565,10 +13346,9 @@ Center the line of text following the command. @xref{titlefont center sp, , @code{@@center}}.@refill -@item @@lowersections -Change subsequent chapters to sections, sections to subsections, and so -on. @xref{Raise/lower sections, , @code{@@raisesections} and -@code{@@lowersections}}.@refill +@item @@centerchap @var{line-of-text} +Like @code{@@chapter}, but centers the chapter title. @xref{chapter,, +@code{@@chapter}}. @item @@chapheading @var{title} Print a chapter-like heading in the text, but not in the table of @@ -12594,7 +13374,7 @@ formatting text between subsequent pairs of @code{@@ifset @var{flag}} and @code{@@end ifset} commands, and preventing @code{@@value@{@var{flag}@}} from expanding to the value to which -@var{flag} is set. +@var{flag} is set. @xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill @item @@code@{@var{sample-code}@} @@ -12627,12 +13407,14 @@ Indices}.@refill @item @@defcv @var{category} @var{class} @var{name} +@itemx @@defcvx @var{category} @var{class} @var{name} Format a description for a variable associated with a class in object-oriented programming. Takes three arguments: the category of thing being defined, the class to which it belongs, and its name. -@xref{Definition Commands}.@refill +@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}. @item @@deffn @var{category} @var{name} @var{arguments}@dots{} +@itemx @@deffnx @var{category} @var{name} @var{arguments}@dots{} Format a description for a function, interactive command, or similar entity that may take arguments. @code{@@deffn} takes as arguments the category of entity being described, the name of this particular @@ -12642,6 +13424,7 @@ Define a new index and its indexing command. Print entries in a roman font. @xref{New Indices, , Defining New Indices}.@refill +@c Unused so far as I can see and unsupported by makeinfo -- karl, 15sep96. @item @@definfoenclose @var{new-command}, @var{before}, @var{after}, Create new @@-command for Info that marks text by enclosing it in strings that precede and follow the text. Write definition inside of @@ -12649,110 +13432,150 @@ Highlighting}.@refill @item @@defivar @var{class} @var{instance-variable-name} +@itemx @@defivarx @var{class} @var{instance-variable-name} This command formats a description for an instance variable in object-oriented programming. The command is equivalent to @samp{@@defcv -@{Instance Variable@} @dots{}}. @xref{Definition Commands}.@refill +@{Instance Variable@} @dots{}}. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. @item @@defmac @var{macro-name} @var{arguments}@dots{} +@itemx @@defmacx @var{macro-name} @var{arguments}@dots{} Format a description for a macro. The command is equivalent to -@samp{@@deffn Macro @dots{}}. @xref{Definition Commands}.@refill +@samp{@@deffn Macro @dots{}}. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. @item @@defmethod @var{class} @var{method-name} @var{arguments}@dots{} +@itemx @@defmethodx @var{class} @var{method-name} @var{arguments}@dots{} Format a description for a method in object-oriented programming. The command is equivalent to @samp{@@defop Method @dots{}}. Takes as arguments the name of the class of the method, the name of the -method, and its arguments, if any. @xref{Definition Commands}.@refill +method, and its arguments, if any. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. @item @@defop @var{category} @var{class} @var{name} @var{arguments}@dots{} +@itemx @@defopx @var{category} @var{class} @var{name} @var{arguments}@dots{} Format a description for an operation in object-oriented programming. @code{@@defop} takes as arguments the overall name of the category of operation, the name of the class of the operation, the name of the operation, and its arguments, if any. @xref{Definition -Commands}.@refill - -@need 100 +Commands}, and @ref{deffnx,, Def Cmds in Detail}. + @item @@defopt @var{option-name} +@itemx @@defoptx @var{option-name} Format a description for a user option. The command is equivalent to -@samp{@@defvr @{User Option@} @dots{}}. @xref{Definition Commands}.@refill - -@need 100 +@samp{@@defvr @{User Option@} @dots{}}. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. + @item @@defspec @var{special-form-name} @var{arguments}@dots{} +@itemx @@defspecx @var{special-form-name} @var{arguments}@dots{} Format a description for a special form. The command is equivalent to -@samp{@@deffn @{Special Form@} @dots{}}. @xref{Definition Commands}.@refill - -@need 200 +@samp{@@deffn @{Special Form@} @dots{}}. @xref{Definition Commands}, +and @ref{deffnx,, Def Cmds in Detail}. + @item @@deftp @var{category} @var{name-of-type} @var{attributes}@dots{} -Format a description for a data type. @code{@@deftp} takes as -arguments the category, the name of the type (which is a word like -@samp{int} or @samp{float}), and then the names of attributes of -objects of that -type. @xref{Definition Commands}.@refill +@itemx @@deftpx @var{category} @var{name-of-type} @var{attributes}@dots{} +Format a description for a data type. @code{@@deftp} takes as arguments +the category, the name of the type (which is a word like @samp{int} or +@samp{float}), and then the names of attributes of objects of that type. +@xref{Definition Commands}, and @ref{deffnx,, Def Cmds in Detail}. @item @@deftypefn @var{classification} @var{data-type} @var{name} @var{arguments}@dots{} +@itemx @@deftypefnx @var{classification} @var{data-type} @var{name} @var{arguments}@dots{} Format a description for a function or similar entity that may take -arguments and that is typed. @code{@@deftypefn} takes as arguments -the classification of entity being described, the type, the name of -the entity, and its arguments, if any. @xref{Definition -Commands}.@refill +arguments and that is typed. @code{@@deftypefn} takes as arguments the +classification of entity being described, the type, the name of the +entity, and its arguments, if any. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. @item @@deftypefun @var{data-type} @var{function-name} @var{arguments}@dots{} +@itemx @@deftypefunx @var{data-type} @var{function-name} @var{arguments}@dots{} Format a description for a function in a typed language. The command is equivalent to @samp{@@deftypefn Function @dots{}}. -@xref{Definition Commands}.@refill +@xref{Definition Commands}, +and @ref{deffnx,, Def Cmds in Detail}. @item @@deftypevr @var{classification} @var{data-type} @var{name} +@itemx @@deftypevrx @var{classification} @var{data-type} @var{name} Format a description for something like a variable in a typed language---an entity that records a value. Takes as arguments the -classification of entity being described, the type, and the name of -the entity. @xref{Definition Commands}.@refill +classification of entity being described, the type, and the name of the +entity. @xref{Definition Commands}, and @ref{deffnx,, Def Cmds in +Detail}. @item @@deftypevar @var{data-type} @var{variable-name} +@itemx @@deftypevarx @var{data-type} @var{variable-name} Format a description for a variable in a typed language. The command is equivalent to @samp{@@deftypevr Variable @dots{}}. @xref{Definition -Commands}.@refill +Commands}, and @ref{deffnx,, Def Cmds in Detail}. @item @@defun @var{function-name} @var{arguments}@dots{} +@itemx @@defunx @var{function-name} @var{arguments}@dots{} Format a description for functions. The command is equivalent to -@samp{@@deffn Function @dots{}}. @xref{Definition Commands}.@refill +@samp{@@deffn Function @dots{}}. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. @item @@defvar @var{variable-name} +@itemx @@defvarx @var{variable-name} Format a description for variables. The command is equivalent to -@samp{@@defvr Variable @dots{}}. @xref{Definition Commands}.@refill +@samp{@@defvr Variable @dots{}}. @xref{Definition Commands}, and +@ref{deffnx,, Def Cmds in Detail}. @item @@defvr @var{category} @var{name} +@itemx @@defvrx @var{category} @var{name} Format a description for any kind of variable. @code{@@defvr} takes as arguments the category of the entity and the name of the entity. -@xref{Definition Commands}.@refill +@xref{Definition Commands}, +and @ref{deffnx,, Def Cmds in Detail}. + +@item @@detailmenu@{@} +Use to avoid Makeinfo confusion stemming from the detailed node listing +in a master menu. @xref{Master Menu Parts}. @item @@dfn@{@var{term}@} Highlight the introductory or defining use of a term. @xref{dfn, , @code{@@dfn}}.@refill +@item @@dircategory @var{dirpart} +Specify a part of the Info directory menu where this file's entry should +go. @xref{Installing Dir Entries}. + +@item @@direntry +Begin the Info directory menu entry for this file. +@xref{Installing Dir Entries}. + @need 100 @item @@display Begin a kind of example. Indent text, do not fill, do not select a new font. Pair with @code{@@end display}. @xref{display, , @code{@@display}}.@refill -@need 100 @item @@dmn@{@var{dimension}@} -Format a dimension. Cause @TeX{} to insert a narrow space before -@var{dimension}. No effect in Info. Use for writing a number -followed by an abbreviation of a dimension name, such as -@samp{12@dmn{pt}}, written as @samp{12@@dmn@{pt@}}, with no space -between the number and the @code{@@dmn} command. @xref{dmn, , -@code{@@dmn}}.@refill +Format a unit of measure, as in 12@dmn{pt}. Causes @TeX{} to insert a +thin space before @var{dimension}. No effect in Info. +@xref{dmn, , @code{@@dmn}}.@refill @need 100 @item @@dots@{@} Insert an ellipsis: @samp{@dots{}}. @xref{dots, , @code{@@dots}}.@refill +@item @@email@{@var{address}@} +Indicate an electronic mail address. +@xref{email, , @code{@@email}}.@refill + @need 100 @item @@emph@{@var{text}@} Highlight @var{text}; text is displayed in @emph{italics} in printed output, and surrounded by asterisks in Info. @xref{Emphasis, , Emphasizing Text}.@refill +@item @@end @var{environment} +Ends @var{environment}, as in @samp{@@end example}. @xref{Formatting +Commands,,@@-commands}. + +@item @@enddots@{@} +Generate an end-of-sentence of ellipsis, like this @enddots{} +@xref{dots,,@code{@@dots@{@}}}. + @need 100 @item @@enumerate [@var{number-or-letter}] Begin a numbered list, using @code{@@item} for each entry. @@ -12774,29 +13597,30 @@ Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill @item @@evenheading [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page headings for even-numbered (left-hand) pages. Not relevant to -Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill +Specify page headings for even-numbered (left-hand) pages. Only +supported within @code{@@iftex}. @xref{Custom Headings, , How to Make +Your Own Headings}.@refill @item @@everyfooting [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page footings for every page. Not relevant to Info. @xref{Custom -Headings, , How to Make Your Own Headings}.@refill - -@item @@everyheading [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page headings for every page. Not relevant to Info. @xref{Custom -Headings, , How to Make Your Own Headings}.@refill +@itemx @@everyheading [@var{left}] @@| [@var{center}] @@| [@var{right}] +Specify page footings resp.@: headings for every page. Not relevant to +Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill @item @@example Begin an example. Indent text, do not fill, and select fixed-width font. Pair with @code{@@end example}. @xref{example, , @code{@@example}}.@refill +@item @@exclamdown@{@} +Generate an upside-down exclamation point. @xref{Inserting Accents}. + @item @@exdent @var{line-of-text} Remove any indentation a line might have. @xref{exdent, , Undoing the Indentation of a Line}.@refill @item @@expansion@{@} Indicate the result of a macro expansion to the reader with a special -glyph: @samp{@expansion{}}. +glyph: @samp{@expansion{}}. @xref{expansion, , @expansion{} Indicating an Expansion}.@refill @item @@file@{@var{filename}@} @@ -12814,15 +13638,10 @@ @need 200 @item @@flushleft +@itemx @@flushright Left justify every line but leave the right end ragged. Leave font as is. Pair with @code{@@end flushleft}. -@xref{flushleft & flushright, , @code{@@flushleft} and -@code{@@flushright}}.@refill - -@need 200 -@item @@flushright -Right justify every line but leave the left end ragged. -Leave font as is. Pair with @code{@@end flushright}. +@code{@@flushright} analogous. @xref{flushleft & flushright, , @code{@@flushleft} and @code{@@flushright}}.@refill @@ -12855,6 +13674,9 @@ @code{@@end group}. Not relevant to Info. @xref{group, , @code{@@group}}.@refill +@item @@H@{@var{c}@} +Generate the long Hungarian umlaut accent over @var{c}, as in @H{o}. + @item @@heading @var{title} Print an unnumbered section-like heading in the text, but not in the table of contents of a printed manual. In Info, the title is @@ -12862,10 +13684,9 @@ , Section Commands}.@refill @item @@headings @var{on-off-single-double} -Turn page headings on or off, or specify single-sided or double-sided -page headings for printing. @code{@@headings on} is synonymous with -@code{@@headings double}. @xref{headings on off, , The -@code{@@headings} Command}.@refill +Turn page headings on or off, and/or specify single-sided or double-sided +page headings for printing. @xref{headings on off, , The +@code{@@headings} Command}. @item @@i@{@var{text}@} Print @var{text} in @i{italic} font. No effect in Info. @@ -12877,11 +13698,12 @@ ifclear} command. @xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill -@item @@ifinfo -Begin a stretch of text that will be ignored by @TeX{} when it -typesets the printed manual. The text appears only in the Info file. -Pair with @code{@@end ifinfo}. @xref{Conditionals, , Conditionally -Visible Text}.@refill +@item @@ifhtml +@itemx @@ifinfo +Begin a stretch of text that will be ignored by @TeX{} when it typesets +the printed manual. The text appears only in the HTML resp.@: Info +file. Pair with @code{@@end ifhtml} resp.@: @code{@@end ifinfo}. +@xref{Conditionals, , Conditionally Visible Text}.@refill @item @@ifset @var{flag} If @var{flag} is set, the Texinfo formatting commands format text @@ -12912,7 +13734,7 @@ Use the specified macro definitions file. This command is used only in the first line of a Texinfo file to cause @TeX{} to make use of the @file{texinfo} macro definitions file. The backslash in @code{\input} -is used instead of an @code{@@} because @TeX{} does not properly +is used instead of an @code{@@} because @TeX{} does not recognize @code{@@} until after it has read the definitions file. @xref{Header, , The Texinfo File Header}.@refill @@ -12932,17 +13754,23 @@ item text. @xref{itemx, , @code{@@itemx}}.@refill @item @@kbd@{@var{keyboard-characters}@} -Indicate text that consists of characters of input to be typed by +Indicate text that is characters of input to be typed by users. @xref{kbd, , @code{@@kbd}}.@refill @item @@key@{@var{key-name}@} -Highlight @var{key-name}, a conventional name for a key on a keyboard. +Highlight @var{key-name}, a name for a key on a keyboard. @xref{key, , @code{@@key}}.@refill @item @@kindex @var{entry} Add @var{entry} to the index of keys. @xref{Index Entries, , Defining the Entries of an Index}.@refill +@item @@L@{@} +@itemx @@l@{@} +Generate the uppercase and lowercase Polish suppressed-L letters, +respectively: @L{}, @l{}. + +@c Possibly this can be tossed now that we have macros. --karl, 16sep96. @item @@global@@let@var{new-command}=@var{existing-command} Equate a new highlighting command with an existing one. Only for @TeX{}. Write definition inside of @code{@@iftex} @dots{} @code{@@end @@ -12953,7 +13781,16 @@ fixed-width font. Pair with @code{@@end lisp}. @xref{Lisp Example, , @code{@@lisp}}.@refill -@item @@majorheading @var{title} +@item @@lowersections +Change subsequent chapters to sections, sections to subsections, and so +on. @xref{Raise/lower sections, , @code{@@raisesections} and +@code{@@lowersections}}.@refill + +@item @@macro @var{macro-name} @{@var{params}@} +Define a new Texinfo command @code{@@@var{macro-name}@{@var{params}@}}. +Only supported by Makeinfo and Texi2dvi. @xref{Defining Macros}. + +@item @@majorheading @var{title} Print a chapter-like heading in the text, but not in the table of contents of a printed manual. Generate more vertical whitespace before the heading than the @code{@@chapheading} command. In Info, the chapter @@ -12969,7 +13806,11 @@ manual. Pair with @code{@@end menu}. @xref{Menus}.@refill @item @@minus@{@} -Generate a minus sign. @xref{minus, , @code{@@minus}}.@refill +Generate a minus sign, `@minus{}'. @xref{minus, , @code{@@minus}}.@refill + +@item @@multitable @var{column-width-spec} +Begin a multi-column table. Pair with @code{@@end multitable}. +@xref{Multitable Column Widths}. @item @@need @var{n} Start a new page in a printed manual if fewer than @var{n} mils @@ -12980,18 +13821,25 @@ Define the beginning of a new node in Info, and serve as a locator for references for @TeX{}. @xref{node, , @code{@@node}}.@refill -@need 200 @item @@noindent Prevent text from being indented as if it were a new paragraph. @xref{noindent, , @code{@@noindent}}.@refill +@item @@O@{@} +@itemx @@o@{@} +Generate the uppercase and lowercase Owith-slash letters, respectively: +@O{}, @o{}. + @item @@oddfooting [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page footings for odd-numbered (right-hand) pages. Not relevant to -Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill - -@item @@oddheading [@var{left}] @@| [@var{center}] @@| [@var{right}] -Specify page headings for odd-numbered (right-hand) pages. Not relevant to -Info. @xref{Custom Headings, , How to Make Your Own Headings}.@refill +@itemx @@oddheading [@var{left}] @@| [@var{center}] @@| [@var{right}] +Specify page footings resp.@: headings for odd-numbered (right-hand) +pages. Only allowed inside @code{@@iftex}. @xref{Custom Headings, , +How to Make Your Own Headings}.@refill + +@item @@OE@{@} +@itemx @@oe@{@} +Generate the uppercase and lowercase OE ligatures, respectively: +@OE{}, @oe{}. @xref{Inserting Accents}. @item @@page Start a new page in a printed manual. No effect in Info. @@ -13012,6 +13860,10 @@ glyph: @samp{@point{}}. @xref{Point Glyph, , Indicating Point in a Buffer}.@refill +@item @@pounds@{@} +Generate the pounds sterling currency sign. +@xref{pounds,,@code{@@pounds@{@}}}. + @item @@print@{@} Indicate printed output to the reader with a glyph: @samp{@print{}}. @xref{Print Glyph}.@refill @@ -13024,11 +13876,13 @@ @item @@pxref@{@var{node-name}, [@var{entry}], [@var{topic-or-title}], [@var{info-file}], [@var{manual}]@} Make a reference that starts with a lower case `see' in a printed manual. Use within parentheses only. Do not follow command with a -punctuation mark. The Info formatting commands automatically insert -terminating punctuation as needed, which is why you do not need to -insert punctuation. Only the first argument is mandatory. +punctuation mark---the Info formatting commands automatically insert +terminating punctuation as needed. Only the first argument is mandatory. @xref{pxref, , @code{@@pxref}}.@refill +@item @@questiondown@{@} +Generate an upside-down question mark. @xref{Inserting Accents}. + @item @@quotation Narrow the margins to indicate text that is quoted from another real or imaginary work. Write command on a line of its own. Pair with @@ -13063,6 +13917,10 @@ Indicate the result of an expression to the reader with a special glyph: @samp{@result{}}. @xref{result, , @code{@@result}}.@refill +@item @@ringaccent@{@var{c}@} +Generate a ring accent over the next character, as in @ringaccent{o}. +@xref{Inserting Accents}. + @item @@samp@{@var{text}@} Highlight @var{text} that is a literal example of a sequence of characters. Used for single characters, for statements, and often for @@ -13091,10 +13949,10 @@ odd-numbered (right-hand) new pages. @xref{setchapternewpage, , @code{@@setchapternewpage}}.@refill -@c awkward wording prevents overfull hbox @item @@setfilename @var{info-file-name} -Provide a name to be used by the Info file. @xref{setfilename, , -@code{@@setfilename}}.@refill +Provide a name to be used by the Info file. This command is essential +for @TeX{} formatting as well, even though it produces no output. +@xref{setfilename, , @code{@@setfilename}}.@refill @item @@settitle @var{title} Provide a title for page headers in a printed manual. @@ -13106,6 +13964,9 @@ @code{@@summarycontents}. @xref{Contents, , Generating a Table of Contents}.@refill +@item @@shorttitlepage@{@var{title}@} +Generate a minimal title page. @xref{titlepage,,@code{@@titlepage}}. + @need 400 @item @@smallbook Cause @TeX{} to produce a printed manual in a 7 by 9.25 inch format @@ -13132,8 +13993,11 @@ @item @@sp @var{n} Skip @var{n} blank lines. @xref{sp, , @code{@@sp}}.@refill +@item @@ss@{@} +Generate the German sharp-S es-zet letter, @ss{}. @xref{Inserting Accents}. + @need 700 -@item @@strong @var{text} +@item @@strong @var{text} Emphasize @var{text} by typesetting it in a @strong{bold} font for the printed manual and by surrounding it with asterisks for Info. @xref{emph & strong, , Emphasizing Text}.@refill @@ -13192,6 +14056,9 @@ Print @var{text} in a @t{fixed-width}, typewriter-like font. No effect in Info. @xref{Fonts}.@refill +@item @@tab +Separate columns in a multitable. @xref{Multitable Rows}. + @need 400 @item @@table @var{formatting-command} Begin a two-column table, using @code{@@item} for each entry. Write @@ -13199,7 +14066,7 @@ column entries are printed in the font resulting from @var{formatting-command}. Pair with @code{@@end table}. @xref{Two-column Tables, , Making a Two-column Table}. -Also see @ref{ftable vtable, , @code{@@ftable} and @code{@@vtable}}, +Also see @ref{ftable vtable, , @code{@@ftable} and @code{@@vtable}}, and @ref{itemx, , @code{@@itemx}}.@refill @item @@TeX@{@} @@ -13211,35 +14078,16 @@ Ordinary TeX Commands, , Using Ordinary @TeX{} Commands}.@refill @item @@thischapter -In a heading or footing, stands for the number and name of the current -chapter, in the format `Chapter 1: Title'. @xref{Custom -Headings, , How to Make Your Own Headings}.@refill - -@item @@thischaptername -In a heading or footing, stands for the name of the current chapter. -@xref{Custom Headings, , How to Make Your Own Headings}.@refill - -@item @@thisfile -In a heading or footing, stands for the name of the current -@code{@@include} file. Does not insert anything if not within an -@code{@@include} file. @xref{Custom Headings, , How to Make Your Own +@itemx @@thischaptername +@itemx @@thisfile +@itemx @@thispage +@itemx @@thistitle +Only allowed in a heading or footing. Stands for the number and name of +the current chapter (in the format `Chapter 1: Title'), the chapter name +only, the filename, the current page number, and the title of the +document, respectively. @xref{Custom Headings, , How to Make Your Own Headings}.@refill -@item @@thispage -In a heading or footing, stands for the current page number. -@xref{Custom Headings, , How to Make Your Own Headings}.@refill - -@ignore -@item @@thissection -In a heading or footing, stands for the title of the current section. -@xref{Custom Headings, , How to Make Your Own Headings}.@refill -@end ignore - -@item @@thistitle -In a heading or footing, stands for the name of the document, as specified -by the @code{@@settitle} command. @xref{Custom Headings, , How to -Make Your Own Headings}.@refill - @item @@tindex @var{entry} Add @var{entry} to the index of data types. @xref{Index Entries, , Defining the Entries of an Index}.@refill @@ -13281,6 +14129,13 @@ command is merely a synonym for @code{@@unnumbered}. @xref{makeinfo Pointer Creation, , Creating Pointers with @code{makeinfo}}. +@item @@u@var{c} +@itemx @@ubaraccent@var{c} +@itemx @@udotaccent@var{c} +Generate a breve, underbar, or underdot accent, respectively, over or +under the character @var{c}, as in @u{o}, @ubaraccent{o}, +@udotaccent{o}. @xref{Inserting Accents}. + @item @@unnumbered @var{title} In a printed manual, begin a chapter that appears without chapter numbers of any kind. The title appears in the table of contents of a @@ -13308,6 +14163,14 @@ manual. In Info, the title is underlined with periods. @xref{subsubsection, , The `subsub' Commands}.@refill +@item @@url@{@var{url}@} +Highlight text that is a uniform resource locator for the World Wide +Web. @xref{url, , @code{@@url}}.@refill + +@item @@v@var{c} +Generate check accent over the character @var{c}, as in @v{o}. +@xref{Inserting Accents}. + @item @@value@{@var{flag}@} Replace @var{flag} with the value to which it is set by @code{@@set @var{flag}}. @@ -13344,7 +14207,6 @@ @item @@w@{@var{text}@} Prevent @var{text} from being split across two lines. Do not end a paragraph that uses @code{@@w} with an @code{@@refill} command. -In the Texinfo file, keep @var{text} on one line. @xref{w, , @code{@@w}}.@refill @need 400 @@ -13378,7 +14240,7 @@ Include a copyright notice and copying permissions. @end itemize -@subsubheading Index, index, index! +@subsubheading Index, index, index! Write many index entries, in different ways. Readers like indices; they are helpful and convenient. @@ -13394,8 +14256,7 @@ @itemize @bullet @item Write each index entry differently, so each entry refers to a different -place in the document. The index of an Info file lists only one -location for each entry. +place in the document. @item Write index entries only where a topic is discussed significantly. For @@ -13416,7 +14277,7 @@ use the appropriate case for case-sensitive names, such as those in C or Lisp. -@item +@item Write the indexing commands that refer to a whole section immediately after the section command, and write the indexing commands that refer to the paragraph before the paragraph. @@ -13458,7 +14319,7 @@ @item Always insert a blank line before an @code{@@table} command and after an @code{@@end table} command; but never insert a blank line after an -@code{@@table} command or before an @code{@@end table} command. +@code{@@table} command or before an @code{@@end table} command. @need 1000 For example, @@ -13532,8 +14393,8 @@ @example @group @@c ===> NOTE! <== -@@c Specify the edition and version numbers and date -@@c in *three* places: +@@c Specify the edition and version numbers and date +@@c in *three* places: @@c 1. First ifinfo section 2. title page 3. top node @@c To find the locations, search for !!set @end group @@ -13541,14 +14402,14 @@ @group @@ifinfo @@c !!set edition, date, version -This is Edition 4.03, January 1992, +This is Edition 4.03, January 1992, of the @@cite@{GDB Manual@} for GDB Version 4.3. @dots{} @end group @end example @noindent ----or use @code{@@set} and @code{@@value} +---or use @code{@@set} and @code{@@value} (@pxref{value Example, , @code{@@value} Example}). @subsubheading Definition Commands @@ -13561,7 +14422,7 @@ @item Write just one definition command for each entity you define with a definition command. The automatic indexing feature creates an index -entry that leads the reader to the definition. +entry that leads the reader to the definition. @item Use @code{@@table} @dots{} @code{@@end table} in an appendix that @@ -13598,7 +14459,7 @@ @group @@kbd@{C-x v@} @@kbd@{M-x vc-next-action@} - Perform the next logical operation + Perform the next logical operation on the version-controlled file corresponding to the current buffer. @end group @@ -13633,7 +14494,7 @@ @item Use @code{@@code} around Lisp symbols, including command names. For example, - + @example The main function is @@code@{vc-next-action@}, @dots{} @end example @@ -13649,15 +14510,16 @@ @item Use three hyphens in a row, @samp{---}, to indicate a long dash. @TeX{} typesets these as a long dash and the Info formatters reduce three -hyphens to two. +hyphens to two. @end itemize @subsubheading Periods Outside of Quotes Place periods and other punctuation marks @emph{outside} of quotations, -unless the punctuation is part of the quotation. This practice goes against -convention, but enables the reader to distinguish between the contents -of the quotation and the whole passage. +unless the punctuation is part of the quotation. This practice goes +against publishing conventions in the United States, but enables the +reader to distinguish between the contents of the quotation and the +whole passage. For example, you should write the following sentence with the period outside the end quotation marks: @@ -13674,8 +14536,8 @@ @itemize @bullet @item -Introduce new terms so that a user who does not know them can understand -them from context; or write a definition for the term. +Introduce new terms so that a reader who does not know them can +understand them from context; or write a definition for the term. For example, in the following, the terms ``check in'', ``register'' and ``delta'' are all appearing for the first time; the example sentence should be @@ -13689,8 +14551,8 @@ @item Use the @code{@@dfn} command around a word being introduced, to indicate -that the user should not expect to know the meaning already, and should -expect to learn the meaning from this passage. +that the reader should not expect to know the meaning already, and +should expect to learn the meaning from this passage. @end itemize @subsubheading @@pxref @@ -13699,7 +14561,7 @@ @ignore By the way, it is okay to use pxref with something else in front of it within the parens, as long as the pxref is followed by the close -paren, and the material inside the parents is not part of a larger +paren, and the material inside the parens is not part of a larger sentence. Also, you can use xref inside parens as part of a complete sentence so long as you terminate the cross reference with punctuation. @end ignore @@ -13718,8 +14580,8 @@ sections are all different, readers find it hard to search for the section.@refill -Name such sections with a phrase beginning with the word -@w{`Invoking @dots{}'}, as in `Invoking Emacs'; this way +Name such sections with a phrase beginning with the word +@w{`Invoking @dots{}'}, as in `Invoking Emacs'; this way users can find the section easily. @subsubheading @sc{ansi c} Syntax @@ -13762,7 +14624,7 @@ in@} the new version.'' That flows better. @quotation -When you are done editing the file, you must perform a +When you are done editing the file, you must perform a @code{@@dfn}@{check in@}. @end quotation @@ -13808,7 +14670,7 @@ @sp 1 @example -\input texinfo @@c -*-texinfo-*- +\input texinfo @@c -*-texinfo-*- @@c %**start of header @@setfilename sample.info @@settitle Sample Document @@ -13837,7 +14699,7 @@ @@comment node-name, next, previous, up @@menu -* First Chapter:: The first chapter is the +* First Chapter:: The first chapter is the only chapter in this sample. * Concept Index:: This index has two entries. @@end menu @@ -13847,7 +14709,7 @@ @@chapter First Chapter @@cindex Sample index entry -This is the contents of the first chapter. +This is the contents of the first chapter. @@cindex Another sample index entry Here is a numbered list. @@ -13861,8 +14723,8 @@ @@end enumerate The @@code@{makeinfo@} and @@code@{texinfo-format-buffer@} -commands transform a Texinfo file such as this into -an Info file; and @@TeX@{@} typesets it for a printed +commands transform a Texinfo file such as this into +an Info file; and @@TeX@{@} typesets it for a printed manual. @@node Concept Index, , First Chapter, Top @@ -13961,7 +14823,7 @@ copies of this manual provided the copyright notice and this permission notice are preserved on all copies. -@@ignore +@@ignore Permission is granted to process this file through TeX and print the results, provided the printed document carries a copying permission notice identical to this @@ -13979,13 +14841,13 @@ one. Permission is granted to copy and distribute -translations of this manual into another language, -under the above conditions for modified versions, +translations of this manual into another language, +under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. @end example -@node Titlepage Permissions, , ifinfo Permissions, Sample Permissions +@node Titlepage Permissions, , ifinfo Permissions, Sample Permissions @comment node-name, next, previous, up @appendixsec Titlepage Copying Permissions @cindex Titlepage permissions @@ -14010,8 +14872,8 @@ one. Permission is granted to copy and distribute -translations of this manual into another language, -under the above conditions for modified versions, +translations of this manual into another language, +under the above conditions for modified versions, except that this permission notice may be stated in a translation approved by the Free Software Foundation. @end example @@ -14042,7 +14904,7 @@ @end menu @node Using Include Files, texinfo-multiple-files-update, Include Files, Include Files -@appendixsec How to Use Include Files +@appendixsec How to Use Include Files @findex include To include another file within a Texinfo file, write the @@ -14268,7 +15130,7 @@ menu with 417 entries and a list of 41 @code{@@include} files.@refill -@node Include Files Evolution, , Sample Include File, Include Files +@node Include Files Evolution, , Sample Include File, Include Files @comment node-name, next, previous, up @appendixsec Evolution of Include Files @@ -14282,7 +15144,7 @@ References from one file to another were made by referring to the file name as well as the node name. (@xref{Other Info Files, , Referring to -Other Info Files}. Also, see @ref{Four and Five Arguments, , +Other Info Files}. Also, see @ref{Four and Five Arguments, , @code{@@xref} with Four and Five Arguments}.)@refill Include files were designed primarily as a way to create a single, @@ -14451,28 +15313,28 @@ There are four possibilities:@refill @table @asis -@item No @code{@@setchapternewpage} command +@item No @code{@@setchapternewpage} command Cause @TeX{} to specify the single-sided heading format, with chapters on new pages. This is the same as @code{@@setchapternewpage on}.@refill -@item @code{@@setchapternewpage on} +@item @code{@@setchapternewpage on} Specify the single-sided heading format, with chapters on new pages.@refill -@item @code{@@setchapternewpage off} +@item @code{@@setchapternewpage off} Cause @TeX{} to start a new chapter on the same page as the last page of the preceding chapter, after skipping some vertical whitespace. Also cause @TeX{} to typeset for single-sided printing. (You can override the headers format with the @code{@@headings double} command; see @ref{headings on off, , The @code{@@headings} Command}.)@refill -@item @code{@@setchapternewpage odd} +@item @code{@@setchapternewpage odd} Specify the double-sided heading format, with chapters on new pages.@refill @end table @noindent Texinfo lacks an @code{@@setchapternewpage even} command.@refill -@node Custom Headings, , Heading Choice, Headings +@node Custom Headings, , Heading Choice, Headings @comment node-name, next, previous, up @appendixsec How to Make Your Own Headings @@ -14583,12 +15445,12 @@ chapter, in the format `Chapter 1: Title'.@refill @findex thistitle -@item @@thistitle +@item @@thistitle Expands to the name of the document, as specified by the @code{@@settitle} command.@refill @findex thisfile -@item @@thisfile +@item @@thisfile For @code{@@include} files only: expands to the name of the current @code{@@include} file. If the current Texinfo source file is not an @code{@@include} file, this command has no effect. This command does @@ -14714,10 +15576,10 @@ ---------- Buffer: *Info Region* ---------- * Menu: -* Using texinfo-show-structure:: How to use +* Using texinfo-show-structure:: How to use `texinfo-show-structure' to catch mistakes. -* Running Info-Validate:: How to check for +* Running Info-Validate:: How to check for unreferenced nodes. @@end menus @point{} @@ -14792,7 +15654,7 @@ @c appendixsubsec Using the Emacs Lisp Debugger @c index Using the Emacs Lisp debugger @c index Emacs Lisp debugger -@c index Debugger, using the Emacs Lisp +@c index Debugger, using the Emacs Lisp If an error is especially elusive, you can turn on the Emacs Lisp debugger and look at the backtrace; this tells you where in the @@ -14895,19 +15757,19 @@ @example ---------- Buffer: *tex-shell* ---------- Runaway argument? -@{sorting indices, for more information about sorting +@{sorting indices, for more information about sorting indices.) @@refill @@ETC. ! Paragraph ended before @@xref was complete. -<to be read again> - @@par -l.27 - -? +<to be read again> + @@par +l.27 + +? ---------- Buffer: *tex-shell* ---------- @end example In this case, @TeX{} produced an accurate and -understandable error message: +understandable error message: @example Paragraph ended before @@xref was complete. @@ -14930,7 +15792,7 @@ You can tell @TeX{} to continue running and ignore just this error by typing @key{RET} at the @samp{?} prompt.@refill -@item +@item You can tell @TeX{} to continue running and to ignore all errors as best it can by typing @kbd{r @key{RET}} at the @samp{?} prompt.@refill @@ -14940,8 +15802,8 @@ producing such an avalanche of error messages, type @kbd{C-d} (or @kbd{C-c C-d}, if you are running a shell inside Emacs.))@refill -@item -You can tell @TeX{} to stop this run by typing @kbd{x @key{RET}} +@item +You can tell @TeX{} to stop this run by typing @kbd{x @key{RET}} at the @samp{?} prompt.@refill @end enumerate @@ -14979,8 +15841,7 @@ The @samp{*} indicates that @TeX{} is waiting for input.@refill @example -This is TeX, Version 2.0 for Berkeley UNIX -(preloaded format=plain-cm 87.10.25) +This is TeX, Version 3.14159 (Web2c 7.0) (test.texinfo [1]) * @end example @@ -15006,7 +15867,7 @@ command lists all the lines that begin with the @@-commands that specify the structure: @code{@@chapter}, @code{@@section}, @code{@@appendix}, and so on. With an argument (@w{@kbd{C-u}} -as prefix argument, if interactive), +as prefix argument, if interactive), the command also shows the @code{@@node} lines. The @code{texinfo-show-structure} command is bound to @kbd{C-c C-s} in Texinfo mode, by default.@refill @@ -15018,7 +15879,7 @@ @example @group Lines matching "^@@\\(chapter \\|sect\\|subs\\|subh\\| - unnum\\|major\\|chapheading \\|heading \\|appendix\\)" + unnum\\|major\\|chapheading \\|heading \\|appendix\\)" in buffer texinfo.texi. @dots{} 4177:@@chapter Nodes @@ -15067,7 +15928,7 @@ @node Using occur, Running Info-Validate, Using texinfo-show-structure, Catching Mistakes @comment node-name, next, previous, up @appendixsec Using @code{occur} -@cindex Occurrences, listing with @code{@@occur} +@cindex Occurrences, listing with @code{@@occur} @findex occur Sometimes the @code{texinfo-show-structure} command produces too much @@ -15080,7 +15941,7 @@ @kbd{M-x occur} @end example -@noindent +@noindent and then, when prompted, type a @dfn{regexp}, a regular expression for the pattern you want to match. (@xref{Regexps, , Regular Expressions, emacs, The GNU Emacs Manual}.) The @code{occur} command works from @@ -15104,7 +15965,7 @@ @xref{Other Repeating Search, , Using Occur, emacs , The GNU Emacs Manual}, for more information.@refill -@node Running Info-Validate, , Using occur, Catching Mistakes +@node Running Info-Validate, , Using occur, Catching Mistakes @comment node-name, next, previous, up @appendixsec Finding Badly Referenced Nodes @findex Info-validate @@ -15112,7 +15973,7 @@ @cindex Checking for badly referenced nodes @cindex Looking for badly referenced nodes @cindex Finding badly referenced nodes -@cindex Badly referenced nodes +@cindex Badly referenced nodes You can use the @code{Info-validate} command to check whether any of the `Next', `Previous', `Up' or other node pointers fail to point to a @@ -15241,7 +16102,7 @@ @end example @noindent -(Note the upper case @key{I} in @code{Info-tagify}.) This creates an +(Note the upper case @samp{I} in @code{Info-tagify}.) This creates an Info file with a tag table that you can validate.@refill The third step is to validate the Info file:@refill @@ -15251,7 +16112,7 @@ @end example @noindent -(Note the upper case @key{I} in @code{Info-validate}.) +(Note the upper case @samp{I} in @code{Info-validate}.) In brief, the steps are:@refill @example @@ -15267,7 +16128,7 @@ tag table and split the file automatically, or you can make the tag table and split the file manually.@refill -@node Splitting, , Tagifying, Running Info-Validate +@node Splitting, , Tagifying, Running Info-Validate @comment node-name, next, previous, up @appendixsubsec Splitting a File Manually @cindex Splitting an Info file manually @@ -15321,8 +16182,8 @@ @node Refilling Paragraphs, Command Syntax, Catching Mistakes, Top @comment node-name, next, previous, up @appendix Refilling Paragraphs -@cindex Refilling paragraphs -@cindex Filling paragraphs +@cindex Refilling paragraphs +@cindex Filling paragraphs @findex refill The @code{@@refill} command refills and, optionally, indents the first @@ -15363,7 +16224,7 @@ @cindex @@-command syntax The character @samp{@@} is used to start special Texinfo commands. -(It has the same meaning that @samp{\} has in Plain@TeX{}.) Texinfo +(It has the same meaning that @samp{\} has in plain @TeX{}.) Texinfo has four types of @@-command:@refill @table @asis @@ -15425,17 +16286,23 @@ @cindex @TeX{}, how to obtain @c !!! Here is information about obtaining TeX. Update it whenever. -@c Last updated by RJC on 1 March 1995, conversation with Mackay. +@c !!! Also consider updating TeX.README on prep. +@c Updated by RJC on 1 March 1995, conversation with MacKay. +@c Updated by kb@cs.umb.edu on 29 July 1996. @TeX{} is freely redistributable. You can obtain @TeX{} for Unix systems via anonymous ftp or on tape or CD-ROM. The core material -consists of Karl Berry's @code{web2c} @TeX{} package. - -On-line retrieval instructions are in @code{ftp.cs.umb.edu} -@t{[158.121.104.33]} in @file{pub/tex/unixtex.ftp} - -The Free Software Foundation provides a core distribution on its -Source Code CD-ROM; the University of Washington maintains and -supports a tape distribution. +consists of Karl Berry's Web2c @TeX{} distribution. + +On-line retrieval instructions are available from either: +@example +@url{ftp://ftp.tug.org/tex/unixtex.ftp} +@url{http://www.tug.org/unixtex.ftp} +@end example + +The Free Software Foundation provides a core distribution on its Source +Code CD-ROM suitable for printing Texinfo manuals; the University of +Washington maintains and supports a tape distribution; the @TeX{} Users +Group co-sponsors a complete CD-ROM @TeX{} distribution. For the FSF Source Code CD-ROM, please contact: @@ -15444,7 +16311,7 @@ @group Free Software Foundation, Inc. 59 Temple Place Suite 330 -Boston, MA @w{ } 02111-1307 +Boston, MA w{ } 02111-1307 USA Telephone: @w{@t{+}1--617--542--5942} @@ -15452,7 +16319,7 @@ Free Dial Fax (in Japan): @w{ } @w{ } @w{ } 0031--13--2473 (KDD) @w{ } @w{ } @w{ } 0066--3382--0158 (IDC) -Electronic mail: @code{gnu@@prep.ai.mit.edu} +Electronic mail: @code{gnu@@prep.ai.mit.edu} @end group @end display @end iftex @@ -15469,21 +16336,27 @@ Free Dial Fax (in Japan): @w{ } @w{ } @w{ } 0031-13-2473 (KDD) @w{ } @w{ } @w{ } 0066-3382-0158 (IDC) -Electronic mail: @code{gnu@@prep.ai.mit.edu} +Electronic mail: @code{gnu@@prep.ai.mit.edu} @end group @end display @end ifinfo +To order a full distribution on CD-ROM, please see: +@display +@url{http://www.tug.org/tex-live.html} +@end display + +@noindent +(The distribution is also available by FTP; see the URL's above.) + To order a full distribution from the University of Washington on either a -1/4@dmn{inch} 4-track QIC-24 cartridge or a 4@dmn{mm} DAT cartridge, send -$210.00 to: - -@iftex +1/4@dmn{in} 4-track QIC-24 cartridge or a 4@dmn{mm} DAT cartridge, send +$210 to: + @display @group Pierre A. MacKay -Department of Classics -DH-10, Denny Hall 218 +Denny Hall, Mail Stop DH-10 University of Washington Seattle, WA @w{ } 98195 USA @@ -15492,22 +16365,6 @@ Electronic mail: @code{mackay@@cs.washington.edu} @end group @end display -@end iftex -@ifinfo -@display -@group -Pierre A. MacKay -Department of Classics -DH-10, Denny Hall 218 -University of Washington -Seattle, WA @w{ } 98195 -USA - -Telephone: @t{+}1-206-543-2268 -Electronic mail: @code{mackay@@cs.washington.edu} -@end group -@end display -@end ifinfo Please make checks payable to the University of Washington. Checks must be in U.S.@: dollars, drawn on a U.S.@: bank. @@ -15518,7 +16375,8 @@ Please check with the above for current prices and formats. -@node New Features, Command and Variable Index, Obtaining TeX, Top + +@node New Features, Command and Variable Index, Obtaining TeX, Top @appendix Second Edition Features @tex @@ -15726,7 +16584,7 @@ Insert node pointers in strict sequence. @end table -@node New Commands, , New Texinfo Mode Commands, New Features +@node New Commands, , New Texinfo Mode Commands, New Features @appendixsec New Texinfo @@-Commands The second edition of the Texinfo manual describes more than 50 @@ -15748,7 +16606,7 @@ Define a new index and its indexing command. See also the @code{@@defcodeindex} command. -@c written verbosely to avoid overful hbox +@c written verbosely to avoid overfull hbox @item @@synindex @var{from-index} @var{into-index} Merge the @var{from-index} index into the @var{into-index} index. See also the @code{@@syncodeindex} command. @@ -15784,11 +16642,11 @@ @xref{Glyphs}. @table @kbd -@item @@equiv@{@} +@item @@equiv@{@} @itemx @equiv{} Equivalence: -@item @@error@{@} +@item @@error@{@} @itemx @error{} Error message @@ -15796,15 +16654,15 @@ @itemx @expansion{} Macro expansion -@item @@point@{@} +@item @@point@{@} @itemx @point{} Position of point -@item @@print@{@} +@item @@print@{@} @itemx @print{} Printed output -@item @@result@{@} +@item @@result@{@} @itemx @result{} Result of an expression @end table @@ -15827,7 +16685,7 @@ @item @@evenheading, @@everyheading, @@oddheading, @dots{} Five other related commands. -@item @@thischapter +@item @@thischapter Insert name of chapter and chapter number. @item @@thischaptername, @@thisfile, @@thistitle, @@thispage @@ -15853,13 +16711,13 @@ @item @@exdent @var{line-of-text} Remove indentation. -@item @@flushleft +@item @@flushleft Left justify. @item @@flushright Right justify. -@item @@format +@item @@format Do not narrow nor change font. @item @@ftable @var{formatting-command} @@ -15869,7 +16727,7 @@ @item @@lisp For an example of Lisp code. -@item @@smallexample +@item @@smallexample @itemx @@smalllisp Like @@table and @@lisp @r{but for} @@smallbook. @end table @@ -15883,7 +16741,7 @@ @xref{set clear value, , @code{@@set} @code{@@clear} @code{@@value}}.@refill @table @kbd -@item @@set @var{flag} [@var{string}] +@item @@set @var{flag} [@var{string}] Set a flag. Optionally, set value of @var{flag} to @var{string}. @@ -15928,7 +16786,7 @@ @table @kbd @item @@r@{@var{text}@} Print in roman font. - + @item @@sc@{@var{text}@} Print in @sc{small caps} font. @end table @@ -15949,13 +16807,14 @@ see @ref{title subtitle author, , @code{@@title} @code{@@subtitle} and @code{@@author}}, and@* see @ref{Custom Headings, , How to Make Your Own Headings}. -@need 700 @table @kbd @item @@author @var{author} Typeset author's name. +@ignore @item @@definfoenclose @var{new-command}, @var{before}, @var{after}, Define a highlighting command for Info. (Info only.) +@end ignore @item @@finalout Produce cleaner printed output. @@ -15988,7 +16847,7 @@ Make a reference. In the printed manual, the reference does not start with the word `see'. -@item @@title @var{title} +@item @@title @var{title} Typeset @var{title} in the alternative title page format. @@ -16004,22 +16863,24 @@ \global\tableindent=.8in @end tex + @node Command and Variable Index, Concept Index, New Features, Top @comment node-name, next, previous, up @unnumbered Command and Variable Index -This is an alphabetical list of all the @@-commands and several -variables. To make the list easier to use, the commands are listed -without their preceding @samp{@@}.@refill +This is an alphabetical list of all the @@-commands, assorted Emacs Lisp +functions, and several variables. To make the list easier to use, the +commands are listed without their preceding @samp{@@}.@refill @printindex fn -@node Concept Index, , Command and Variable Index, Top -@comment node-name, next, previous, up + +@node Concept Index, , Command and Variable Index, Top @unnumbered Concept Index @printindex cp + @summarycontents @contents @bye
--- a/man/w3.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/w3.texi Mon Aug 13 09:18:39 2007 +0200 @@ -1,14 +1,14 @@ \input texinfo @c @c Please note that this file uses some constructs not supported by earlier -@c versions of TeXinfo. You must be running one of the newer TeXinfo +@c versions of TeX-info. You must be running one of the newer TeX-info @c releases (I currently use version 3.9 from ftp://prep.ai.mit.edu/pub/gnu/) @c @c Please do not send in bug reports about not being able to format the @c document with 'makeinfo' or 'tex', just upgrade your installation. @c @c Info formatted files are provided in the distribution, and you can -@c retrieve dvi, postscript, and PDF versions from the web site or ftp +@c retrieve dvi, postscript, and PDF versions from the web site or FTP @c site: http://www.cs.indiana.edu/elisp/w3/docs.html @c @setfilename w3.info @@ -246,7 +246,7 @@ @kindex b @kindex Meta-tab @findex w3-widget-backward -@item Meta-tab, b +@item Meta-tab, Shift-tab, b Attempts to move backward one link area in the current document. Signals an error if no previous links are found. @kindex f @@ -274,6 +274,7 @@ Kill this buffer. @kindex Q, u @findex w3-leave-buffer +@item Q, u Bury this buffer, but don't kill it @end table @@ -416,12 +417,11 @@ the same. @kindex M-s -@findex w3-search +@findex w3-save-as @item M-s -Perform a search, if this is a searchable index. Searching requires a -server - Emacs-W3 can not do local file searching, as there are too many -possible types of searches people could want to do. Generally, the only -@sc{url} types that allow searching are @sc{http}, gopher, and X-EXEC. +Save a document to the local disk as HTML Source, Formatted Text, LaTeX +Source, or Binary. + @kindex Hv @findex w3-show-history-list @vindex w3-keep-history @@ -605,7 +605,7 @@ @vindex w3-mode-hook :: WORK :: Document lynx emulation -@table @bullet +@table @kbd @item Down arrow Highlight next topic @item Up arrow @@ -976,7 +976,7 @@ application. @item simple selector A selector that matches elements based on the element type and/or -attributes, and not he element's position in the document +attributes, and not the element's position in the document structure. E.g., 'H1.initial' is a simple selector. @item style sheet A collection of rules. @@ -2890,36 +2890,6 @@ non-@code{nil}, or choose the `Use Cache Only' menu item (under `Options') -@cindex Caching options -@cindex Alternate caching method -Emacs-W3 caches files under the temporary directory specified by -@code{url-temporary-directory}, in a user-specific subdirectory -(determined by the @code{user-real-login-name} function). The cache -files are stored under their original names, so a @sc{url} like: -http://www.aventail.com/foo/bar/baz.html would be stored in a cache file -named: /tmp/wmperry/com/aventail/www/foo/bar/baz.html. Sometimes, -espcially with gopher links, there will be name conflicts, and an error -will be signalled. This cannot be avoided, and still have reasonable -performance at startup time (reading in an index file of all the cached -pages can take a long time on slow machines, or even fast machines with -large caches). When running XEmacs 19.12 or later, a different naming -scheme can be used. This avoids name conflicts, but loses the human -readability of the cache file names. The cache files will look like: -/tmp/wmperry/acbd18db4cc2f85cedef654fccc4a4d8, which is certainly -unique, but not very user-friendly. To turn this on, add this to the -@file{.emacs} file: - - -@example -(add-hook 'w3-load-hooks '(lambda () - (fset 'url-create-cached-filename - 'url-create-cached-filename-using-md5))) -@end example - -If other versions of emacs will not be sharing the cache, I highly -recommend this method of creating the cache filename. - - @node Interfacing to Mail/News, Debugging HTML, Disk Caching, Advanced Features @section Interfacing to Mail/News @cindex Interfacing to Mail/News @@ -2976,31 +2946,20 @@ These are the various hooks that can be used to customize some of Emacs-W3's behavior. They are arranged in the order in which they would -happen when retrieving a document. All of these are functions (or lists -of functions) that are called consecutively. +happen when retrieving a document. These are all 'normal hooks' in +standard Emacs-terminology, meaning they are functions (or lists of +functions) that are called consecutively. @table @code -@vindex w3-load-hooks -@item w3-load-hooks -These hooks are run by @code{w3-do-setup} the first time a @sc{url} is -fetched. All the w3 variables are initialized before this hook is -run. -@item w3-file-done-hooks -These hooks are run by @code{w3-prepare-buffer} after all parsing on a -document has been done. All @code{url-current-}@var{*} and -@code{w3-current-}@var{*} variables are initialized when this hook is run. -This is run before the buffer is shown, and before any inlined images -are downloaded and converted. -@item w3-file-prepare-hooks -These hooks are run by @code{w3-prepare-buffer} before any parsing is -done on the @sc{html} file. The @sc{http}/1.0 headers specified by -@code{w3-show-headers} have been inserted, and the syntax table has been -set to @code{w3-parse-args-syntax-table} by the time this hook is run. -@item w3-mode-hooks +@vindex w3-load-hook +@item w3-load-hook +These hooks are run the first time a @sc{url} is fetched. All the +Emacs-W3 variables are initialized before this hook is run. +@item w3-mode-hook These hooks are run after a buffer has been parsed and displayed, but before any inlined images are downloaded and converted. -@item w3-source-file-hooks -These hooks are run after displaying a document's source +@item w3-source-file-hook +These hooks are run after displaying a document's source. @end table @node Other Variables, , Hooks, Advanced Features
--- a/man/widget.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/widget.texi Mon Aug 13 09:18:39 2007 +0200 @@ -1,6 +1,6 @@ \input texinfo.tex -@c $Id: widget.texi,v 1.5 1997/03/04 08:01:33 steve Exp $ +@c $Id: widget.texi,v 1.6 1997/03/08 23:27:27 steve Exp $ @c %**start of header @setfilename widget @@ -15,7 +15,7 @@ @comment node-name, next, previous, up @top The Emacs Widget Library -Version: 1.50 +Version: 1.59 @menu * Introduction:: @@ -401,7 +401,7 @@ There is a standard widget keymap which you might find useful. @defvr Const widget-keymap -A keymap with the global keymap as its parent.@br +A keymap with the global keymap as its parent.@* @key{TAB} and @kbd{C-@key{TAB}} are bound to @code{widget-forward} and @code{widget-backward}, respectively. @kbd{@key{RET}} and @kbd{mouse-2} are bound to @code{widget-button-press} and @@ -533,6 +533,13 @@ @item :parent The parent of a nested widget (e.g. a @code{menu-choice} item or an element of a @code{editable-list} widget). + +@item :sibling-args +This keyword is only used for members of a @code{radio-button-choice} or +@code{checklist}. The value should be a list of extra keyword +arguments, which will be used when creating the @code{radio-button} or +@code{checkbox} associated with this item. + @end table @deffn {User Option} widget-glyph-directory @@ -635,7 +642,7 @@ @table @code @item :size -The width of the editable field.@br +The width of the editable field.@* By default the field will reach to the end of the line. @item :value-face @@ -754,6 +761,10 @@ Insert a literal @samp{%}. @end table +@item button-args +A list of keywords to pass to the radio buttons. Useful for setting +e.g. the @samp{:help-echo} for each button. + @item :buttons The widgets representing the radio buttons. @@ -881,6 +892,10 @@ Insert a literal @samp{%}. @end table +@item button-args +A list of keywords to pass to the checkboxes. Useful for setting +e.g. the @samp{:help-echo} for each checkbox. + @item :buttons The widgets representing the checkboxes. @@ -922,6 +937,16 @@ Insert a literal @samp{%}. @end table +@item :insert-button-args +A list of keyword arguments to pass to the insert buttons. + +@item :delete-button-args +A list of keyword arguments to pass to the delete buttons. + +@item :append-button-args +A list of keyword arguments to pass to the trailing insert button. + + @item :buttons The widgets representing the insert and delete buttons.
--- a/man/xemacs/custom.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/xemacs/custom.texi Mon Aug 13 09:18:39 2007 +0200 @@ -888,7 +888,7 @@ @subsubsection Using Strings for Changing Key Bindings For backward compatibility, you can still use strings to represent -key sequences. Thus you can use comands like the following: +key sequences. Thus you can use commands like the following: @example ;;; Bind @code{end-of-line} to @kbd{C-f}
--- a/man/xemacs/killing.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/xemacs/killing.texi Mon Aug 13 09:18:39 2007 +0200 @@ -557,7 +557,7 @@ region. Moving the cursor with normal motion commands (@kbd{C-n}, @kbd{C-p}, etc.) will cause the region between point and the recently-pushed mark to be highlighted. It will remain highlighted -until some non-motion comand is executed. +until some non-motion command is executed. @code{exchange-point-and-mark} (@kbd{C-x C-x}) activates the region. So if you mark a region and execute a command that operates on it, you
--- a/man/xemacs/sending.texi Mon Aug 13 09:17:27 2007 +0200 +++ b/man/xemacs/sending.texi Mon Aug 13 09:18:39 2007 +0200 @@ -223,7 +223,7 @@ @end example Aliases may contain forward references; the alias of @samp{everybody} in the -example above can preceed the aliases of @samp{group1} and @samp{group2}. +example above can precede the aliases of @samp{group1} and @samp{group2}. In this version of Emacs, you can use the @code{source} @file{.mailrc} command for reading aliases from some other file as well.
--- a/src/ChangeLog Mon Aug 13 09:17:27 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:18:39 2007 +0200 @@ -1,3 +1,25 @@ +Thu Mar 6 19:15:29 1997 Steven L Baur <steve@altair.xemacs.org> + + * data.c (eq_with_ebola_notice): Unobfuscate Ebola warning!!! + message. + +Wed Mar 5 16:11:22 1997 Steven L Baur <steve@altair.xemacs.org> + + * process.c (get_internet_address): Put upper bounds on attempting + to get system name (similar to nearly identical processing in + sysdep.c. + +Tue Mar 4 17:30:48 1997 Steven L Baur <steve@altair.xemacs.org> + + * puresize.h (PURESIZE): *Must* use angle brackets for + puresize_adjust.h or build will lose with --srcdir. + + * alloc.c (report_pure_usage): Adjust error message printed when + too low on PURESIZE. + + * Makefile.in.in: Move site-packages. + Add vpath correction for puresize_adjust.h. + Mon Mar 3 20:37:54 1997 Steven L Baur <steve@altair.xemacs.org> * Makefile.in.in (lisp): Remove custom-xmas.elc.
--- a/src/EmacsFrame.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/EmacsFrame.c Mon Aug 13 09:18:39 2007 +0200 @@ -103,10 +103,10 @@ {XtNrightToolBarWidth, XtCRightToolBarWidth, XtRInt, sizeof (int), offset (right_toolbar_width), XtRImmediate, (XtPointer)-1}, {XtNtopToolBarShadowColor, XtCTopToolBarShadowColor, XtRPixel, sizeof(Pixel), - offset(top_toolbar_shadow_pixel), XtRString, (String) "Gray90"}, + offset(top_toolbar_shadow_pixel), XtRString, (String) "black"}, {XtNbottomToolBarShadowColor, XtCBottomToolBarShadowColor, XtRPixel, sizeof(Pixel), offset(bottom_toolbar_shadow_pixel), XtRString, - (String) "Gray40"}, + (String) "black"}, {XtNbackgroundToolBarColor, XtCBackgroundToolBarColor, XtRPixel, sizeof(Pixel), offset(background_toolbar_pixel), XtRString, (String) "Gray75"},
--- a/src/Makefile.in.in Mon Aug 13 09:17:27 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:18:39 2007 +0200 @@ -83,7 +83,7 @@ vpath config.h vpath paths.h vpath Emacs.ad.h -vpath PURESIZE.h +vpath puresize_adjust.h #else VPATH=@srcdir@ #endif @@ -1377,7 +1377,7 @@ ${libsrc}DOC: ${libsrc}make-docfile ${obj_src} ${mule_obj_src} ${lisp} #endif rm -f ${libsrc}DOC - ${libsrc}make-docfile -d ${srcdir} -i ${lispdir}site-packages \ + ${libsrc}make-docfile -d ${srcdir} -i ${lispdir}../site-packages \ ${obj_src} ${mule_obj_src} \ ${mallocdocsrc} ${rallocdocsrc} ${lispdir}version.el \ ${lisp} > ${libsrc}DOC
--- a/src/alloc.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:18:39 2007 +0200 @@ -2614,7 +2614,7 @@ } write(fd, WARNING, strlen(WARNING)); - sprintf(define_PURESIZE, "# define PURESIZE_ADJUSTMENT %ld\n", + sprintf(define_PURESIZE, "# define PURESIZE_ADJUSTMENT (%ld)\n", puresize - RAW_PURESIZE); write(fd, define_PURESIZE, strlen(define_PURESIZE)); close(fd); @@ -2631,11 +2631,9 @@ CONST long report_round = 5000; message ("\n****\tPure Lisp storage exhausted!\n" - "\tAn additional %ld bytes will guarantee enough pure space;\n" - "\ta smaller increment may work (due to structure-sharing).\n" +"\tPurespace usage: %ld of %ld\n" "****", - (((pure_lossage + report_round - 1) - / report_round) * report_round)); + PURESIZE+pure_lossage, PURESIZE); if (die_if_pure_storage_exceeded) { PURESIZE_h(PURESIZE + pure_lossage); rc = -1;
--- a/src/buffer.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/buffer.c Mon Aug 13 09:18:39 2007 +0200 @@ -2511,7 +2511,7 @@ and `file-coding-system-alist' for that. From a Lisp program, if you wish to unilaterally specify the coding system used for one particular operation, you should bind the variable -`overriding-file-coding-system' rather than changing the other two +`coding-system-for-read' rather than changing the other two variables just mentioned, which are intended to be used for global environment specification. */ );
--- a/src/console-tty.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/console-tty.c Mon Aug 13 09:18:39 2007 +0200 @@ -42,6 +42,7 @@ DEFINE_CONSOLE_TYPE (tty); Lisp_Object Qterminal_type; +Lisp_Object Qcontrolling_process; extern Lisp_Object Vstdio_str; /* in console-stream.c */ @@ -62,14 +63,16 @@ static void tty_init_console (struct console *con, Lisp_Object props) { - Lisp_Object tty = CONSOLE_CONNECTION (con), terminal_type = Qnil; + Lisp_Object tty = CONSOLE_CONNECTION (con); + Lisp_Object terminal_type = Qnil, controlling_process = Qnil; int infd, outfd; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; - GCPRO1 (terminal_type); + GCPRO2 (terminal_type, controlling_process); terminal_type = Fplist_get (props, Qterminal_type, Qnil); - + controlling_process = Fplist_get(props, Qcontrolling_process, Qnil); + /* Determine the terminal type */ if (!NILP (terminal_type)) @@ -86,6 +89,10 @@ terminal_type = build_string (temp_type); } + /* Determine the controlling process */ + if (!NILP (controlling_process)) + CHECK_INT (controlling_process); + /* Open the specified console */ allocate_tty_console_struct (con); @@ -119,6 +126,7 @@ Fget_coding_system (Vterminal_coding_system)); #endif /* MULE */ CONSOLE_TTY_DATA (con)->terminal_type = terminal_type; + CONSOLE_TTY_DATA (con)->controlling_process = controlling_process; if (NILP (CONSOLE_NAME (con))) CONSOLE_NAME (con) = Ffile_name_nondirectory (tty); { @@ -206,6 +214,14 @@ return CONSOLE_TTY_DATA (decode_tty_console (console))->terminal_type; } +DEFUN ("console-tty-controlling-process", Fconsole_tty_controlling_process, 0, 1, 0, /* +Return the controlling process of TTY console CONSOLE. +*/ + (console)) +{ + return CONSOLE_TTY_DATA (decode_tty_console (console))->controlling_process; +} + extern Lisp_Object stream_semi_canonicalize_console_connection(Lisp_Object, Error_behavior); Lisp_Object @@ -247,7 +263,9 @@ syms_of_console_tty (void) { DEFSUBR (Fconsole_tty_terminal_type); + DEFSUBR (Fconsole_tty_controlling_process); defsymbol (&Qterminal_type, "terminal-type"); + defsymbol (&Qcontrolling_process, "controlling-process"); } void
--- a/src/console-tty.h Mon Aug 13 09:17:27 2007 +0200 +++ b/src/console-tty.h Mon Aug 13 09:18:39 2007 +0200 @@ -43,6 +43,7 @@ int infd, outfd; Lisp_Object instream, outstream; Lisp_Object terminal_type; + Lisp_Object controlling_process; char *term_entry_buffer; /* Physical location of cursor on this console. */
--- a/src/console.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/console.c Mon Aug 13 09:18:39 2007 +0200 @@ -904,6 +904,81 @@ #endif /* BSD */ } +DEFUN ("suspend-console", Fsuspend_console, 0, 1, "", /* +Suspend a console. For tty consoles, it sends a signal to suspend +the process in charge of the tty, and removes the devices and +frames of that console from the display. + +If optional arg CONSOLE is non-nil, it is the console to be suspended. +Otherwise it is assumed to be the selected console. + +Some operating systems cannot stop processes and resume them later. +On such systems, who knows what will happen. +*/ + (console)) +{ + Lisp_Object devcons; + Lisp_Object framecons; + struct console *c; + struct gcpro gcpro1; + + if (NILP (console)) + console=Fselected_console(); + + GCPRO1 (console); + + c = decode_console(console); + + if (CONSOLE_TTY_P (c)) + { + CONSOLE_DEVICE_LOOP (devcons, c) + { + struct device *d = XDEVICE (XCAR (devcons)); + DEVICE_FRAME_LOOP (framecons, d) + { + Fmake_frame_invisible(XCAR(framecons), Qt); + } + } + reset_one_console(c); + sys_suspend_process(XINT(Fconsole_tty_controlling_process(console))); + } + + UNGCPRO; + return Qnil; +} + +DEFUN ("resume-console", Fresume_console, 1, 1, "", /* +Re-initialize a previously suspended console. For tty consoles, +do stuff to the tty to make it sane again. +*/ + (console)) +{ + Lisp_Object devcons; + Lisp_Object framecons; + struct console *c; + struct gcpro gcpro1, gcpro2, gcpro3; + + GCPRO2 (console, devcons); + + c = decode_console(console); + + if (CONSOLE_TTY_P(c)) + { + CONSOLE_DEVICE_LOOP (devcons, c) + { + struct device *d = XDEVICE (XCAR (devcons)); + DEVICE_FRAME_LOOP (framecons, d) + { + Fmake_frame_visible(XCAR(framecons)); + } + } + init_one_console(c); + } + + UNGCPRO; + return Qnil; +} + DEFUN ("set-input-mode", Fset_input_mode, 3, 5, 0, /* Set mode of reading keyboard input. First arg is ignored, for backward compatibility. @@ -1007,7 +1082,9 @@ DEFSUBR (Fconsole_enable_input); DEFSUBR (Fconsole_disable_input); DEFSUBR (Fconsole_on_window_system_p); - + DEFSUBR (Fsuspend_console); + DEFSUBR (Fresume_console); + DEFSUBR (Fsuspend_emacs); DEFSUBR (Fset_input_mode); DEFSUBR (Fcurrent_input_mode);
--- a/src/data.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/data.c Mon Aug 13 09:18:39 2007 +0200 @@ -84,7 +84,10 @@ && (debug_issue_ebola_notices >= 2 || XREALINT (obj1) == XREALINT (obj2))) { - stderr_out ("Ebola warning!! ("); + /* Continuing the joke by printing `Ebola warning!!!' confuses */ + /* too many people. The message must be printed because Emacs used */ + /* to work differently for two decades. */ + stderr_out("Comparison between integer and character is constant nil ("); Fprinc (obj1, Qexternal_debugging_output); stderr_out (" and "); Fprinc (obj2, Qexternal_debugging_output);
--- a/src/event-Xt.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/event-Xt.c Mon Aug 13 09:18:39 2007 +0200 @@ -1101,7 +1101,8 @@ handle_focus_event_1 (f, event->type == FocusIn); } -/* both MapNotify and VisibilityNotify can cause this */ +/* both MapNotify and VisibilityNotify can cause this + JV is_visible has the same semantics as f->visible*/ static void change_frame_visibility (struct frame *f, int is_visible) { @@ -1111,7 +1112,7 @@ if (!FRAME_VISIBLE_P (f) && is_visible) { - FRAME_VISIBLE_P (f) = 1; + FRAME_VISIBLE_P (f) = is_visible; /* This improves the double flicker when uniconifying a frame some. A lot of it is not showing a buffer which has changed while the frame was iconified. To fix it further requires @@ -1130,6 +1131,16 @@ dispatch_epoch_event (f, event, Qx_unmap); #endif } + else if (FRAME_VISIBLE_P (f) * is_visible < 0) + { + FRAME_VISIBLE_P(f) = - FRAME_VISIBLE_P(f); + if (FRAME_REPAINT_P(f)) + MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f); + va_run_hook_with_args (Qmap_frame_hook, 1, frame); +#ifdef EPOCH + dispatch_epoch_event (f, event, Qx_map); +#endif + } } static void @@ -1352,8 +1363,9 @@ factored out some code to change_frame_visibility(). This triggers the necessary redisplay and runs (un)map-frame-hook. - dkindred@cs.cmu.edu */ + /* Changed it again to support the tristate visibility flag */ change_frame_visibility (f, (event->xvisibility.state - != VisibilityFullyObscured)); + != VisibilityFullyObscured) ? 1 : -1); } break;
--- a/src/event-stream.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:18:39 2007 +0200 @@ -262,8 +262,6 @@ Chained through event_next() command_event_queue_tail is a pointer to the last-added element. */ -static Lisp_Object process_event_queue; -static Lisp_Object process_event_queue_tail; static Lisp_Object command_event_queue; static Lisp_Object command_event_queue_tail; @@ -280,6 +278,13 @@ int emacs_is_blocking; +/* Handlers which run during sit-for, sleep-for and accept-process-output + are not allowed to recursively call these routines. We record here + if we are in that situation. */ + +static Lisp_Object recursive_sit_for; + + /**********************************************************************/ /* Command-builder object */ @@ -1454,19 +1459,6 @@ /* enqueuing and dequeuing events */ /**********************************************************************/ -/* Add an event to the back of the process_event_queue */ -void -enqueue_process_event (Lisp_Object event) -{ - enqueue_event (event, &process_event_queue, &process_event_queue_tail); -} - -Lisp_Object -dequeue_process_event (void) -{ - return dequeue_event (&process_event_queue, &process_event_queue_tail); -} - /* Add an event to the back of the command-event queue: it will be the next event read after all pending events. This only works on keyboard, mouse-click, misc-user, and eval events. @@ -1856,8 +1848,7 @@ Charcount num_input_chars; static void -next_event_internal (Lisp_Object target_event, int allow_queued, - int allow_deferred) +next_event_internal (Lisp_Object target_event, int allow_queued) { struct gcpro gcpro1; /* QUIT; This is incorrect - the caller must do this because some @@ -1883,21 +1874,6 @@ } #endif } - else if (allow_deferred && !NILP (process_event_queue)) - { - Lisp_Object event = dequeue_process_event (); - Fcopy_event (event, target_event); - Fdeallocate_event (event); -#ifdef DEBUG_EMACS - if (debug_emacs_events) - { - write_c_string ("(process event queue) ", - Qexternal_debugging_output); - print_internal (target_event, Qexternal_debugging_output, 1); - write_c_string ("\n", Qexternal_debugging_output); - } -#endif - } else { struct Lisp_Event *e = XEVENT (target_event); @@ -2134,7 +2110,7 @@ { run_pre_idle_hook (); redisplay (); - next_event_internal (event, 1, 1); + next_event_internal (event, 1); Vquit_flag = Qnil; /* Read C-g as an event. */ store_this_key = 1; } @@ -2335,7 +2311,7 @@ /* This will take stuff off the command_event_queue, or read it from the event_stream, but it will not block. */ - next_event_internal (event, 1, 1); + next_event_internal (event, 1); Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it). It is vitally important that we reset Vquit_flag here. Otherwise, if we're @@ -2389,6 +2365,31 @@ /* pausing until an action occurs */ /**********************************************************************/ +/* This is used in accept-process-output, sleep-for and sit-for. + Before running any process_events in these routines, we set + recursive_sit_for to Qt, and use this unwind protect to reset it to + Qnil upon exit. When recursive_sit_for is Qt, calling any of these + three routines will cause them to return immediately no matter what + their arguments were. + + All of these routines install timeouts, so we clear the installed + timeout as well. + + Note: It's very easy to break the desired behaviours of these + 3 routines. If you make any changes to anything in this area, run + the regression tests at the bottom of the file. -- dmoore */ + + +static Lisp_Object +sit_for_unwind (Lisp_Object timeout_id) +{ + if (!NILP(timeout_id)) + Fdisable_timeout (timeout_id); + + recursive_sit_for = Qnil; + return Qnil; +} + /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)? */ @@ -2405,6 +2406,13 @@ If the third arg is non-nil, it is a number of milliseconds that is added to the second arg. (This exists only for compatibility.) Return non-nil iff we received any output before the timeout expired. + +If a filter function or timeout handler (such as installed by `add-timeout') + calls any of accept-process-output, sleep-for, or sit-for, those calls + will return nil immediately (regardless of their arguments) in recursive + situations. It is recommended that you never call accept-process-output + from inside of a process filter function or timer event (either synchronous + or asynchronous). */ (process, timeout_secs, timeout_msecs)) { @@ -2416,6 +2424,11 @@ int timeout_enabled = 0; int done = 0; struct buffer *old_buffer = current_buffer; + int count; + + /* Recusive call from a filter function or timeout handler. */ + if (!NILP(recursive_sit_for)) + return Qnil; /* We preserve the current buffer but nothing else. If a focus change alters the selected window then the top level event loop @@ -2446,6 +2459,11 @@ event = Fmake_event (); + count = specpdl_depth (); + record_unwind_protect (sit_for_unwind, + timeout_enabled ? make_int (timeout_id) : Qnil); + recursive_sit_for = Qt; + while (!done && ((NILP (process) && timeout_enabled) || (NILP (process) && event_stream_event_pending_p (0)) || @@ -2478,7 +2496,7 @@ less likely that the filter will actually be aborted. */ - next_event_internal (event, 0, 1); + next_event_internal (event, 0); /* If C-g was pressed while we were waiting, Vquit_flag got set and next_event_internal() also returns C-g. When we enqueue the C-g below, it will get discarded. The @@ -2517,9 +2535,7 @@ } } - /* If our timeout has not been signalled yet, disable it. */ - if (timeout_enabled) - event_stream_disable_wakeup (timeout_id, 0); + unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil); Fdeallocate_event (event); UNGCPRO; @@ -2530,6 +2546,13 @@ DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /* Pause, without updating display, for ARG seconds. ARG may be a float, meaning pause for some fractional part of a second. + +If a filter function or timeout handler (such as installed by `add-timeout') + calls any of accept-process-output, sleep-for, or sit-for, those calls + will return nil immediately (regardless of their arguments) in recursive + situations. It is recommended that you never call sleep-for from inside + of a process filter function or timer event (either synchronous or + asynchronous). */ (seconds)) { @@ -2537,12 +2560,22 @@ unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); int id; Lisp_Object event = Qnil; + int count; struct gcpro gcpro1; + /* Recusive call from a filter function or timeout handler. */ + if (!NILP(recursive_sit_for)) + return Qnil; + GCPRO1 (event); id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); event = Fmake_event (); + + count = specpdl_depth (); + record_unwind_protect (sit_for_unwind, make_int (id)); + recursive_sit_for = Qt; + while (1) { /* If our timeout has arrived, we move along. */ @@ -2557,21 +2590,14 @@ consumer as well. We don't care about command and eval-events anyway. */ - next_event_internal (event, 0, 0); /* blocks */ + next_event_internal (event, 0); /* blocks */ /* See the comment in accept-process-output about Vquit_flag */ switch (XEVENT_TYPE (event)) { - case process_event: - { - /* Avoid calling filter functions recursively by squirreling - away process events */ - enqueue_process_event (Fcopy_event (event, Qnil)); - goto DONE_LABEL; - } - case timeout_event: /* We execute the event even if it's ours, and notice that it's happened above. */ + case process_event: case pointer_motion_event: case magic_event: { @@ -2587,6 +2613,7 @@ } } DONE_LABEL: + unbind_to (count, make_int (id)); Fdeallocate_event (event); UNGCPRO; return Qnil; @@ -2597,8 +2624,15 @@ ARG may be a float, meaning a fractional part of a second. Optional second arg non-nil means don't redisplay, just wait for input. Redisplay is preempted as always if user input arrives, and does not -happen if input is available before it starts. + happen if input is available before it starts. Value is t if waited the full time with no input arriving. + +If a filter function or timeout handler (such as installed by `add-timeout') + calls any of accept-process-output, sleep-for, or sit-for, those calls + will return nil immediately (regardless of their arguments) in recursive + situations. It is recommended that you never call sit-for from inside + of a process filter function or timer event (either synchronous or + asynchronous) with an argument other than 0. */ (seconds, nodisplay)) { @@ -2607,6 +2641,11 @@ Lisp_Object event, result; struct gcpro gcpro1; int id; + int count; + + /* Recusive call from a filter function or timeout handler. */ + if (!NILP(recursive_sit_for)) + return Qnil; /* The unread-command-events count as pending input */ if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) @@ -2633,8 +2672,8 @@ Do this loop at least once even if (sit-for 0) so that we redisplay when no input pending. */ + GCPRO1 (event); event = Fmake_event (); - GCPRO1 (event); /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc. events get processed. The old (pre-19.12) code special-cased this @@ -2644,6 +2683,10 @@ id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); + count = specpdl_depth (); + record_unwind_protect (sit_for_unwind, make_int (id)); + recursive_sit_for = Qt; + while (1) { /* If there is no user input pending, then redisplay. @@ -2669,11 +2712,16 @@ consumer as well. In fact, we know there's nothing on the command_event_queue that we didn't just put there. */ - next_event_internal (event, 0, 0); /* blocks */ + next_event_internal (event, 0); /* blocks */ /* See the comment in accept-process-output about Vquit_flag */ if (command_event_p (event)) { + QUIT; /* If the command was C-g check it here + so that we abort out of the sit-for, + not the next command. sleep-for and + accept-process-output continue looping + so they check QUIT again implicitly.*/ result = Qnil; goto DONE_LABEL; } @@ -2685,13 +2733,6 @@ enqueue_command_event (Fcopy_event (event, Qnil)); break; } - - case process_event: - { - /* Avoid recursive calls to process filters */ - enqueue_process_event (Fcopy_event (event, Qnil)); - break; - } case timeout_event: /* We execute the event even if it's ours, and notice that it's @@ -2706,9 +2747,7 @@ } DONE_LABEL: - /* If our timeout has not been signalled yet, disable it. */ - if (NILP (result)) - event_stream_disable_wakeup (id, 0); + unbind_to (count, make_int (id)); /* Put back the event (if any) that made Fsit_for() exit before the timeout. Note that it is being added to the back of the queue, which @@ -2747,7 +2786,7 @@ command_event_queue; there are only user and eval-events there, and we'd just have to put them back anyway. */ - next_event_internal (event, 0, 1); + next_event_internal (event, 0); /* See the comment in accept-process-output about Vquit_flag */ if (command_event_p (event) || (XEVENT_TYPE (event) == eval_event) @@ -4183,10 +4222,6 @@ staticpro (&command_event_queue); command_event_queue_tail = Qnil; - process_event_queue = Qnil; - staticpro (&process_event_queue); - process_event_queue_tail = Qnil; - Vlast_selected_frame = Qnil; staticpro (&Vlast_selected_frame); @@ -4208,6 +4243,8 @@ last_point_position_buffer = Qnil; staticpro (&last_point_position_buffer); + recursive_sit_for = Qnil; + DEFVAR_INT ("echo-keystrokes", &echo_keystrokes /* *Nonzero means echo unfinished commands after this many seconds of pause. */ ); @@ -4552,8 +4589,9 @@ ;do it with sleep-for. move cursor into foo, then back into *scratch* ;before typing. - -;make sure ^G aborts both sit-for and sleep-for. +;repeat also with (accept-process-output nil 20) + +;make sure ^G aborts sit-for, sleep-for and accept-process-output: (defun tst () (list (condition-case c @@ -4565,6 +4603,9 @@ (tst)^J^Ga ==> ((quit) 97) with no signal (tst)^Jabc^G ==> ((quit) 97) with no signal, and "bc" inserted in buffer +; with sit-for only do the 2nd test. +; Do all 3 tests with (accept-proccess-output nil 20) + Do this: (setq enable-recursive-minibuffers t minibuffer-max-depth nil) @@ -4579,3 +4620,61 @@ ;do it all in both v18 and v19 and make sure all results are the same. ;all of these cases matter a lot, but some in quite subtle ways. */ + +/* +Additional test cases for accept-process-output, sleep-for, sit-for. +Be sure you do all of the above checking for C-g and focus, too! + +; Make sure that timer handlers are run during, not after sit-for: +(defun timer-check () + (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil) + (sit-for 5) + (message "after sit-for")) + +; The first message should appear after 2 seconds, and the final message +; 3 seconds after that. +; repeat above test with (sleep-for 5) and (accept-process-output nil 5) + + + +; Make sure that process filters are run during, not after sit-for. +(defun fubar () + (message "sit-for = %s" (sit-for 30))) +(add-hook 'post-command-hook 'fubar) + +; Now type M-x shell RET +; wait for the shell prompt then send: ls RET +; the output of ls should fill immediately, and not wait 30 seconds. + +; repeat above test with (sleep-for 30) and (accept-process-output nil 30) + + + +; Make sure that recursive invocations return immediately: +(defmacro test-diff-time (start end) + `(+ (* (- (car ,end) (car ,start)) 65536.0) + (- (cadr ,end) (cadr ,start)) + (/ (- (caddr ,end) (caddr ,start)) 1000000.0))) + +(defun testee (ignore) + ;; All three of these should return immediately. + (sit-for 10) + (sleep-for 10) + (accept-process-output nil 10)) + +(defun test-them () + (let ((start (current-time)) + end) + (add-timeout 2 'testee nil) + (sit-for 5) + (add-timeout 2 'testee nil) + (sleep-for 5) + (add-timeout 2 'testee nil) + (accept-process-output nil 5) + (setq end (current-time)) + (test-diff-time start end))) + +(test-them) should sit for 15 seconds, not 105 or 96. + + +*/
--- a/src/frame-tty.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/frame-tty.c Mon Aug 13 09:18:39 2007 +0200 @@ -62,6 +62,31 @@ call1 (Qinit_post_tty_win, FRAME_CONSOLE (f)); } +/* Change from withdrawn state to mapped state. */ +static void +tty_make_frame_visible (struct frame *f) +{ + if (!FRAME_VISIBLE_P(f)) + { + SET_FRAME_CLEAR(f); + f->visible = 1; + } + +} + +/* Change from mapped state to withdrawn state. */ +static void +tty_make_frame_invisible (struct frame *f) +{ + f->visible = 0; +} + +static int +tty_frame_visible_p (struct frame *f) +{ + return FRAME_VISIBLE_P(f); +} + /************************************************************************/ /* initialization */ @@ -72,6 +97,9 @@ { CONSOLE_HAS_METHOD (tty, init_frame_1); CONSOLE_HAS_METHOD (tty, after_init_frame); + CONSOLE_HAS_METHOD (tty, make_frame_visible); + CONSOLE_HAS_METHOD (tty, make_frame_invisible); + CONSOLE_HAS_METHOD (tty, frame_visible_p); } void
--- a/src/frame-x.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/frame-x.c Mon Aug 13 09:18:39 2007 +0200 @@ -2200,7 +2200,7 @@ unsigned int flags; Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - if (f->visible || force) + if (FRAME_VISIBLE_P(f) || force) { emacs_window = XtWindow (FRAME_X_SHELL_WIDGET (f)); /* first raises all the dialog boxes, then put emacs just below the @@ -2239,7 +2239,7 @@ XWindowChanges xwc; unsigned int flags; - if (f->visible) + if (FRAME_VISIBLE_P(f)) { xwc.stack_mode = Below; flags = CWStackMode; @@ -2255,7 +2255,7 @@ { Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - if (!f->visible) + if (!FRAME_VISIBLE_P(f)) XMapRaised (display, XtWindow (FRAME_X_SHELL_WIDGET (f))); else x_raise_frame_1 (f, 0); @@ -2267,7 +2267,7 @@ { Display *display = DEVICE_X_DISPLAY (XDEVICE (f->device)); - if (!f->visible) + if (!FRAME_VISIBLE_P(f)) return; if (!XWithdrawWindow (display, @@ -2283,15 +2283,40 @@ XWindowAttributes xwa; int result; + /* JV: + This is bad, very bad :-( + It is not compatible with our tristate visible and + it should never ever change the visibility for us, this leads to + the frame-freeze problem under fvwm because with the pager + + Mappedness != Viewability != Visibility != Emacs f->visible + + This first unequalness is the reason for the frame freezing problem + under fvwm (it happens when the frame is another fvwm-page) + + The second unequalness happen when it is on the same fvwm-page + but in an invisible part of the visible screen. + + For now we just return the XEmacs internal value --- which might not be up + to date. Is that a problem? ---. Otherwise we should + use async visibility like in standard Emacs. + */ + +#if 0 if (!XGetWindowAttributes (display, XtWindow (FRAME_X_SHELL_WIDGET (f)), &xwa)) result = 0; else result = xwa.map_state == IsViewable; - + /* In this implementation it should at least be != IsUnmapped + JV */ + f->visible = result; return result; +#endif + + return f->visible; } static int @@ -2320,6 +2345,7 @@ { XWindowAttributes xwa; Widget shell_widget; + int viewable; assert (FRAME_X_P (f)); @@ -2343,9 +2369,15 @@ if (XGetWindowAttributes (XtDisplay (shell_widget), XtWindow (shell_widget), &xwa)) - f->visible = xwa.map_state == IsViewable; + /* JV: it is bad to change the visibility like this, so we don't for the + moment, at least change_frame_visibility should be called + Note also that under fvwm a frame can me Viewable (and thus Mapped) + but still X-invisible + f->visible = xwa.map_state == IsViewable; */ + viewable = xwa.map_state == IsViewable; + - if (f->visible) + if (viewable) { Window focus; int revert_to;
--- a/src/frame.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/frame.c Mon Aug 13 09:18:39 2007 +0200 @@ -103,6 +103,8 @@ Lisp_Object Vframe_icon_glyph; +Lisp_Object Qhidden; + Lisp_Object Qvisible, Qiconic, Qinvisible, Qvisible_iconic, Qinvisible_iconic; Lisp_Object Qnomini, Qvisible_nomini, Qiconic_nomini, Qinvisible_nomini; Lisp_Object Qvisible_iconic_nomini, Qinvisible_iconic_nomini; @@ -1866,15 +1868,20 @@ /* FSF returns 'icon for iconized frames. What a crock! */ DEFUN ("frame-visible-p", Fframe_visible_p, 0, 1, 0, /* -Return t if FRAME is now \"visible\" (actually in use for display). +Return non NIL if FRAME is now \"visible\" (actually in use for display). A frame that is not visible is not updated, and, if it works through a window system, may not show at all. +N.B. Under X \"visible\" means Mapped. It the window is mapped but not +actually visible on screen then frame_visible returns 'hidden. */ (frame)) { + int visible; + struct frame *f = decode_frame (frame); - return (FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible) - ? Qt : Qnil); + visible = FRAMEMETH_OR_GIVEN (f, frame_visible_p, (f), f->visible); + return ( visible ? ( visible > 0 ? Qt : Qhidden ) + : Qnil); } DEFUN ("frame-totally-visible-p", Fframe_totally_visible_p, 0, 1, 0, /* @@ -1907,6 +1914,8 @@ DEFUN ("visible-frame-list", Fvisible_frame_list, 0, 1, 0, /* Return a list of all frames now \"visible\" (being updated). If DEVICE is specified only frames on that device will be returned. +Note that under virtual window managers not all these frame are necessarily +really updated. */ (device)) { @@ -1928,7 +1937,7 @@ { Lisp_Object frame = XCAR (frmcons); f = XFRAME (frame); - if (f->visible) + if (FRAME_VISIBLE_P(f)) value = Fcons (frame, value); } } @@ -2835,6 +2844,7 @@ defsymbol (&Qframe_title_format, "frame-title-format"); defsymbol (&Qframe_icon_title_format, "frame-icon-title-format"); + defsymbol (&Qhidden, "hidden"); defsymbol (&Qvisible, "visible"); defsymbol (&Qiconic, "iconic"); defsymbol (&Qinvisible, "invisible");
--- a/src/frame.h Mon Aug 13 09:17:27 2007 +0200 +++ b/src/frame.h Mon Aug 13 09:18:39 2007 +0200 @@ -112,6 +112,16 @@ #include "frameslots.h" #undef MARKED_SLOT + /* Nonzero if frame is currently displayed. + Mutally exclusive with iconfied + JV: This now a tristate flag: +Value : Emacs meaning :f-v-p : X meaning +0 : not displayed : nil : unmapped +>0 : user can access it,needs repainting : t : mapped and visible +<0 : user can access it,needs no repainting : hidden :mapped and invisible + where f-v-p is the return value of frame-visible-p */ + int visible; + /* one-bit flags: */ /* Are we finished initializing? */ @@ -126,9 +136,6 @@ /* Nonzero if last attempt at redisplay on this frame was preempted. */ unsigned int display_preempted :1; - /* Nonzero if frame is currently displayed. */ - unsigned int visible :1; - /* Nonzero if window is currently iconified. This and visible are mutually exclusive. */ unsigned int iconified :1; @@ -332,6 +339,7 @@ #define FRAME_CURSOR_X(f) ((f)->cursor_x) #define FRAME_CURSOR_Y(f) ((f)->cursor_y) #define FRAME_VISIBLE_P(f) ((f)->visible) +#define FRAME_REPAINT_P(f) ((f)->visible>0) #define FRAME_NO_SPLIT_P(f) ((f)->no_split) #define FRAME_ICONIFIED_P(f) ((f)->iconified) #define FRAME_FOCUS_FRAME(f) ((f)->focus_frame)
--- a/src/process.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/process.c Mon Aug 13 09:18:39 2007 +0200 @@ -1293,6 +1293,9 @@ Error_behavior errb) { struct hostent *host_info_ptr; +#ifdef TRY_AGAIN + int count = 0; +#endif #ifndef HAVE_TERM memset (address, 0, sizeof (*address)); @@ -1300,6 +1303,7 @@ while (1) { #ifdef TRY_AGAIN + if (count++ > 10) break; h_errno = 0; #endif /* Some systems can't handle SIGIO/SIGALARM in gethostbyname. */
--- a/src/puresize.h Mon Aug 13 09:17:27 2007 +0200 +++ b/src/puresize.h Mon Aug 13 09:18:39 2007 +0200 @@ -167,7 +167,7 @@ #endif /* !RAW_PURESIZE */ -#include "puresize_adjust.h" +#include <puresize_adjust.h> #define PURESIZE ((RAW_PURESIZE) + (PURESIZE_ADJUSTMENT))
--- a/src/redisplay.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/redisplay.c Mon Aug 13 09:18:39 2007 +0200 @@ -5257,7 +5257,7 @@ { struct frame *f = XFRAME (XCAR (frmcons)); - if (FRAME_VISIBLE_P (f)) + if (FRAME_REPAINT_P (f)) map_windows (f, reset_buffer_changes_mapfun, 0); } } @@ -5462,7 +5462,7 @@ if (f->icon_changed || f->windows_changed) update_frame_icon (f); - if (FRAME_VISIBLE_P (f)) + if (FRAME_REPAINT_P (f)) { if (f->buffers_changed || f->clip_changed || f->extents_changed || f->faces_changed || f->frame_changed || f->menubar_changed @@ -5496,7 +5496,7 @@ if (f->icon_changed || f->windows_changed) update_frame_icon (f); - if (FRAME_VISIBLE_P (f)) + if (FRAME_REPAINT_P (f)) { if (f->buffers_changed || f->clip_changed || f->extents_changed || f->faces_changed || f->frame_changed || f->menubar_changed @@ -7761,7 +7761,7 @@ { struct frame *f = XFRAME (XCAR (frmcons)); - if (FRAME_VISIBLE_P (f) && FRAME_HAS_MINIBUF_P (f)) + if (FRAME_REPAINT_P (f) && FRAME_HAS_MINIBUF_P (f)) { Lisp_Object window = FRAME_MINIBUF_WINDOW (f); redisplay_window (window, 0);
--- a/src/s/linux.h Mon Aug 13 09:17:27 2007 +0200 +++ b/src/s/linux.h Mon Aug 13 09:18:39 2007 +0200 @@ -236,13 +236,20 @@ /* XEmacs addition: */ /* Linux defines these in <values.h>, but they can't be used in #if's - Include values.h now so that we don't get complaints if it's included later. */ + Include values.h now so that we don't get complaints if it's included + later. This loses with glibc-2 (libc-6) */ + +/* # include <features.h> */ +#if 0 +#if !(defined (__GLIBC__) && (__GLIBC__ >= 2)) #include <values.h> #undef SHORTBITS #undef INTBITS #undef LONGBITS +#endif +#endif /* The regex.o routines are a part of the GNU C-library used with Linux. */ /* However, sometimes they disagree with the src/regex.h that comes with Emacs, and that can make trouble in etags.c because it gets the regex.h from Emacs
--- a/src/sysdep.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/sysdep.c Mon Aug 13 09:18:39 2007 +0200 @@ -740,6 +740,20 @@ #endif } +/* Suspend a process if possible; give terminal to its superior. */ +void +sys_suspend_process (process) + int process; +{ + /* I don't doubt that it is possible to suspend processes on + * VMS machines or thost that use USG_JOBCTRL, + * but I don't know how to do it, so... + */ +#if defined (SIGTSTP) && !defined (MSDOS) + kill(process, SIGTSTP); +#endif +} + /* Set the logical window size associated with descriptor FD to HEIGHT and WIDTH. This is used mainly with ptys. */
--- a/src/sysdep.h Mon Aug 13 09:17:27 2007 +0200 +++ b/src/sysdep.h Mon Aug 13 09:18:39 2007 +0200 @@ -60,6 +60,8 @@ /* Suspend the Emacs process; give terminal to its superior. */ void sys_suspend (void); +/* Suspend a process if possible; give termianl to its superior. */ +void sys_suspend_process (int process); void request_sigio (void); void unrequest_sigio (void);
--- a/src/sysfloat.h Mon Aug 13 09:17:27 2007 +0200 +++ b/src/sysfloat.h Mon Aug 13 09:18:39 2007 +0200 @@ -34,7 +34,8 @@ # define _NMAXLDBL THIS_FILENAME ## _nmaxldbl # endif -#ifdef MSDOS +#if defined(MSDOS) || (defined(LINUX) && \ + !(defined (__GLIBC__) && (__GLIBC__ >= 2))) /* These are redefined (correctly, but differently) in values.h. */ #undef INTBITS #undef LONGBITS
--- a/src/toolbar-x.c Mon Aug 13 09:17:27 2007 +0200 +++ b/src/toolbar-x.c Mon Aug 13 09:18:39 2007 +0200 @@ -673,12 +673,12 @@ FRAME_X_TOOLBAR_BLANK_BACKGROUND_GC (f) = XtGetGC ((Widget) ef, flags, &gcv); - if (ef->emacs_frame.top_toolbar_shadow_pixel == -1) + if (ef->emacs_frame.top_toolbar_shadow_pixel == 0) { ef->emacs_frame.top_toolbar_shadow_pixel = ef->emacs_frame.background_toolbar_pixel; } - if (ef->emacs_frame.bottom_toolbar_shadow_pixel == -1) + if (ef->emacs_frame.bottom_toolbar_shadow_pixel == 0) { ef->emacs_frame.bottom_toolbar_shadow_pixel = ef->emacs_frame.background_toolbar_pixel;
--- a/src/tooltalk.doc Mon Aug 13 09:17:27 2007 +0200 +++ b/src/tooltalk.doc Mon Aug 13 09:18:39 2007 +0200 @@ -1,7 +1,7 @@ Emacs Tooltalk API Summary -The Emacs Lisp interface to Tooltalk is similar, atleast in spirit, +The Emacs Lisp interface to Tooltalk is similar, at least in spirit, to the standard C Tootalk API. Only the message and pattern parts of the API are supported at present, more of the API could be added if needed. The Lisp interface departs from the C API in a few ways: @@ -195,7 +195,7 @@ protocol you're using need to agree what types mean (if anything). Conventionally "string" is used for strings and "int" for 32 bit integers. Arguments can initialized by providing a value or with -set-tooltalk-message-attribute, the latter is neccessary if you +set-tooltalk-message-attribute, the latter is necessary if you want to initialize the argument with a string that can contain embedded nulls (use 'arg_bval). @@ -210,7 +210,7 @@ (destroy-tooltalk-message msg) -Apply tt_message_destroy to the message. It's not neccessary +Apply tt_message_destroy to the message. It's not necessary to destroy messages after they've been proccessed by a message or pattern callback, the Lisp/Tooltalk callback machinery does this for you.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tests/frame.el Mon Aug 13 09:18:39 2007 +0200 @@ -0,0 +1,27 @@ +;;; Test geometry settings for frames +(defmacro check-frame-geometry (xx yy) + `(loop for frame in (list nil (selected-frame)) + do + (assert (eq (frame-property frame 'top) ,yy)) + (assert (eq (frame-property frame 'left) ,xx)) + (assert (eq (frame-property frame 'top) ,yy)) + (assert (eq (frame-property frame 'left) ,xx)) + (loop for plist in + (list (frame-properties) + (frame-properties nil) + (frame-properties (selected-frame))) + do + (assert (eq (plist-get plist 'top) ,yy)) + (assert (eq (plist-get plist 'left) ,xx))))) + +(loop for (x y) in '((0 0) (1 1) (3 3) (9 9) (10 20) (20 40) (40 80) (100 200)) + do + (loop for frame in (list nil (selected-frame)) + do + (set-frame-properties frame `(left ,x top ,y)) + (check-frame-geometry x y) + (set-frame-property frame 'top (+ y 3)) + (check-frame-geometry x (+ y 3)) + (set-frame-property frame 'left (+ x 3)) + (check-frame-geometry (+ x 3) (+ y 3)))) +