#!/bin/sh #### Patch script - GNU Emacs - version 19.31 to 19.32 #### This file contains patches to turn version 19.31 of GNU Emacs into #### 19.32. To apply them, cd to the top of the Emacs source tree, and #### then type 'sh '. #### After this script applies the patches, it will attempt to use an #### existing Emacs to recompile the changed Emacs Lisp files. (You may #### use the environment variable $emacs to specify the location of the #### binary, if it's not in your search path.) When this is finished, #### you can build the new Emacs version. #### We don't include patches for Info files since you can #### regenerate them from the Texinfo files that we do include. #### To update the changed info files, do #### (cd man; make) if [ "$0" = sh -o ! -f "$0" ]; then echo "use \`sh PATCHKIT', not \`sh &2 exit 1 fi if [ -d lisp ] ; then me=$0 elif [ -d emacs-19.31/lisp ] ; then cd emacs-19.31 case $0 in /*) me=$0;; *) me=../$0;; esac else (echo "$0: In order to apply this patch, the current directory" echo "must be the top of the Emacs distribution tree.") >&2 exit 1 fi ### moves and renames rm -f etc/MSDOS rm -f lib-src/getdate.c rm -f lib-src/getdate.y rm -f lib-src/timer.c rm -f lib-src/wakeup.c mv src/s/lignux.h src/s/gnu-linux.h ### delete and rebuild these, to avoid confusing the byte-compiler. rm -f lisp/ediff-mult.elc lisp/ediff-util.elc lisp/gnus-cache.elc lisp/gnus.elc tail +86 $me | patch -p1 cd lisp for e in $emacs ../src/emacs emacs emacs19 emacs-19 ''; do if [ -n "$e" ]; then v=`$e --version /dev/null | sed -e 's/.* //' -e 's/\.[0-9]*$//'` case $v in 19.29*|19.[3-9][0-9]*) break;; esac fi done if [ -z "$e" ]; then (echo "I can't find an Emacs to execute." echo "You'll have to byte-compile the lisp directory by hand.") >&2 exit 0 fi echo "byte compiling with $e (version $v)..." >&2 loadpath=${TMPDIR-/tmp}/$$.el trap "rm -f $loadpath; exit 1" 1 2 3 15 echo "(setq load-path (cons \"`pwd`\" load-path))" >$loadpath # First do the new files, and any older files that might need to be compiled # in a particular order. Then do the rest of the directory. set dired.el vc.el \ viper-util.el viper-ex.el viper-keym.el viper-macs.el viper-mous.el \ viper.el ediff-hook.el ediff-init.el ediff-ptch.el ediff-vers.el \ ediff-diff.el ediff-merg.el ediff-wind.el ediff-mult.el ediff-util.el \ ediff.el gnus-ems.el gnus-setup.el nnoo.el timezone.el browse-url.el \ custom.el gnus-cus.el easymenu.el sendmail.el mailheader.el font-lock.el \ lazy-lock.el lisp-mode.el mail-utils.el nnheader.el rmail.el message.el \ nnmail.el gnus.el gnus-cache.el gnus-msg.el gnus-cite.el gnus-demon.el \ gnus-score.el gnus-edit.el gnus-gl.el gnus-kill.el gnus-mh.el \ gnus-nocem.el gnus-salt.el gnus-soup.el gnus-srvr.el gnus-topic.el \ gnus-uu.el gnus-vis.el gnus-vm.el nnsoup.el nntp.el nndb.el \ score-mode.el smtpmail.el for f do echo Compiling $f... $e -batch -l $loadpath -f batch-byte-compile $f done $e -batch -l $loadpath -f batch-byte-recompile-directory . rm $loadpath exit 0 # The rest of this file is the patch kit. It seems to be too big for # some shells to handle as a here-document. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/ChangeLog emacs-19.32/ChangeLog *** emacs-19.31/ChangeLog Sat May 25 15:30:21 1996 --- emacs-19.32/ChangeLog Wed Jul 31 15:09:17 1996 *************** *** 1,2 **** --- 1,99 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + * configure.in (*-sco3.2v5*): + Set OVERRIDE_CPPFLAG to a string of one space. + Fix the code that uses OVERRIDE_CPPFLAG. + + Tue Jul 16 18:06:01 1996 Karl Heuer + + * configure.in: Undo previous change. + + Tue Jul 16 01:42:44 1996 Richard Stallman + + * config.sub: Use `pc', not `unknown', when canonicalizing + the vendor for ...86. + + Mon Jul 15 17:09:09 1996 David Mosberger-Tang + + * configure.in: Check for termios.h header. + + Thu Jul 11 19:32:03 1996 Bill Mann + + * configure.in: Use s/usg5-4-3.h for ncr-i[3456]86-sysv4.3 + + Sun Jul 7 18:21:21 1996 Karl Heuer + + * configure.in: Split bsdos2 and bsdos2-1. + + Sat Jul 6 10:33:55 1996 Richard Stallman + + * config.sub: If last two words are not a recognized + KERNEL-OS pair, use just the last word as OS, as in 19.31. + Make conversion of gnu/linux to linux-gnu really work. + + * config.sub: If vendor unspecified with i386, use `pc' not `unknown'. + + Sun Jun 30 03:05:19 1996 Richard Stallman + + * configure.in (check for using Lucid widgets by default): + Eliminate indentation that confuses some compilers. + + Sat Jun 29 03:00:59 1996 Richard Stallman + + * config.sub: Convert linux and gnu/linux to linux-gnu. + + * make-dist: Don't update getdate.c. + Ignore =... files when checking for too-long Lisp file names. + + Fri Jun 28 03:00:59 1996 Richard Stallman + + * configure.in (euidaccess): Check for that, not for eaccess. + + Thu Jun 27 02:14:13 1996 Richard Stallman + + * configure.in (sunos4.1.[3-9]*noshare): Eliminate dash from + before `noshare'. + (mips-sgi-irix6*): Specify NON_GCC_TEST_OPTIONS. + + Fri Jun 21 17:36:42 1996 Richard Stallman + + * configure.in: Rename lignux to linux-gnu in configuration names. + Use gnu-linux as the opsys value (s/ file name). + Allow i686 just like i386, i486, i586. + + Thu Jun 20 13:26:35 1996 Richard Stallman + + * configure.in (i*86-*-sco3.2v5): New alternative. + (OVERRIDE_CPPFLAG): New variable. + (CPPFLAGS): If OVERRIDE_CPPFLAG is set, use that. + + * configure.in: Specify vpath for .texi files. + + Sun Jun 9 16:52:05 1996 Richard Stallman + + * configure.in: Always check for HAVE_X11R5. + Separately decide whether to use a toolkit by default. + + Tue Jun 4 11:34:09 1996 Bill Mann + + * configure.in: If X11R5 is missing the Xaw headers, + default to --with-x-toolkit=no. + + Fri May 31 01:37:44 1996 Richard Stallman + + * configure.in (powerpc-*-solaris2*): Use ibmrs6000, not rs6000. + + Thu May 30 22:09:53 1996 Richard Stallman + + * Makefile.in (install-arch-indep): If cd etc makes output, + don't treat that as part of the tar data. + Check that ./lisp actually exists. + + Wed May 29 10:54:17 1996 Karl Heuer + + * make-dist: Check for long file names. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/INSTALL emacs-19.32/INSTALL *** emacs-19.31/INSTALL Tue May 7 15:00:45 1996 --- emacs-19.32/INSTALL Thu Aug 1 17:31:33 1996 *************** Installation on MSDOG (a.k.a. MSDOS) *** 512,543 **** To install on MSDOG, you need to have the GNU C compiler for MSDOG ! (also known as djgpp), GNU Make, rm, mv, chmod, and sed. See the ! remarks in config.bat for more information about locations and ! versions. ! ! If you are compiling on an MSDOG-like system which has long file ! names, you may need to do `SET LFN=y' for some of the commands, ! especially the compilation commands. It might be more convenient to ! unpack the Emacs distribution with djtar, which comes with djgpp; if ! you do `SET LFN=n' before unpacking, djtar truncates file names to 8.3 ! naming as it extracts files, even if the system allows long file ! names, and this ensures that build procedures designed for 8.3 file ! names still work. Use djtar with the command `djtar -x foo.tar' or ! `djtar -x foo.tgz'. ! ! Some users report that running Emacs 19.29 requires dpmi memory ! management. We do not know why this is so, since 19.28 did not need ! it. If we find out what change introduced this requirement, we may ! try to eliminate it. ("May" because perhaps djgpp version 2's ! improved dpmi handling means this is no longer a problem.) ! ! It is possible that this problem happens only when there is not enough ! physical memory on the machine. ! ! You can find out if you have a dpmi host by running go32 (part of ! djgpp) without arguments; it will tell you if it uses dpmi memory. ! For more information about dpmi memory, consult the djgpp FAQ. ! ! To build and install Emacs, type these commands: config msdos --- 512,571 ---- To install on MSDOG, you need to have the GNU C compiler for MSDOG ! (also known as djgpp), GNU Make, rm, mv, and sed. See the remarks in ! config.bat for more information about locations and versions. The ! file etc/FAQ includes pointers to Internet sites where you can find ! the necessary utilities; search for "MS-DOS". The configuration step ! (see below) will test for these utilities and will refuse to continue ! if any of them isn't found. ! ! If you are building the MSDOG version of Emacs on an MSDOG-like system ! which supports long file names (e.g. Windows 95), you need to make ! sure that long file names are handled consistently both when you ! unpack the distribution and compile it. If you intend to compile with ! DJGPP v2.0 or later, and long file names support is enabled (LFN=y in ! the environment), you need to unpack Emacs distribution in a way that ! doesn't truncate the original long filenames to the DOS 8.3 namespace; ! the easiest way to do this is to use djtar program which comes with ! DJGPP, since it will note the LFN setting and behave accordingly. ! DJGPP v1 doesn't support long filenames, so you must unpack Emacs with ! a program that truncates the filenames to 8.3 naming as it extracts ! files; again, using djtar after setting LFN=n is the recommended way. ! You can build Emacs with LFN=n even if you use DJGPP v2, if some of ! your tools don't support long file names: just ensure that LFN is set ! to `n' during both unpacking and compiling. ! ! (By the time you read this, you have already unpacked the Emacs ! distribution, but if the explanations above imply that you should have ! done it differently, it's safer to delete the directory tree created ! by the unpacking program and unpack Emacs again, than to risk running ! into problems during the build process.) ! ! It is important to understand that the runtime support of long file ! names by the Emacs binary is NOT affected by the LFN setting during ! compilation; Emacs compiled with DJGPP v2.0 or later will always ! support long file names on Windows 95 no matter what was the setting ! of LFN at compile time. However, if you compiled with LFN disabled ! and want to enable LFN support after Emacs was already built, you need ! to make sure that the support files in the lisp, etc and info ! directories are called by their original long names as found in the ! distribution. You can do this either by renaming the files manually, ! or by extracting them from the original distribution archive with ! djtar after you set LFN=y in the environment. ! ! To unpack Emacs with djtar, type this command: ! ! djtar -x emacs.tgz ! ! (This assumes that the Emacs distribution is called `emacs.tgz' on ! your system.) There are a few files in the archive whose names ! collide with other files under the 8.3 DOS naming. On native MSDOS, ! or if you have set LFN=n on Win95, djtar will ask you to supply ! alternate names for these files; you can just press `Enter' when this ! happens (which makes djtar skip these files) because they aren't ! required for MS-DOS. ! ! When unpacking is done, a directory called `emacs-XX.YY' will be ! created, where XX.YY is the Emacs version. To build and install ! Emacs, chdir to that directory and type these commands: config msdos *************** sibling directory called bin. For examp *** 550,554 **** /emacs/lib-src to the directory /emacs/bin, so you can then delete the subdirectories /emacs/src and /emacs/lib-src if you wish. The only ! subdirectories you need to keep are bin, lisp, etc and info. Emacs on MSDOS finds the lisp, etc and info directories by looking in --- 578,585 ---- /emacs/lib-src to the directory /emacs/bin, so you can then delete the subdirectories /emacs/src and /emacs/lib-src if you wish. The only ! subdirectories you need to keep are bin, lisp, etc and info. The bin ! subdirectory should be added to your PATH. The msdos subdirectory ! includes a PIF and an icon file for Emacs which you might find useful ! if you run Emacs under MS Windows. Emacs on MSDOS finds the lisp, etc and info directories by looking in *************** MSDOG is a not a multitasking operating *** 561,562 **** --- 592,599 ---- as asynchronous subprocesses that depend on multitasking will not work. Synchronous subprocesses do work. + + The current version of djgpp 2.0 (as of August 1996) has two bugs that + affect Emacs. We've included corrected versions of two files from + djgpp in the msdos subdirectory: is-exec.c and sigaction.c. To work + around the bugs, compile these files and link them into temacs. The + next version of djgpp should have these bugs fixed. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/Makefile.in emacs-19.32/Makefile.in *** emacs-19.31/Makefile.in Fri Mar 22 23:25:01 1996 --- emacs-19.32/Makefile.in Mon Jun 3 16:05:39 1996 *************** install-arch-indep: mkdir *** 355,362 **** then \ echo "Copying etc/DOC-* to ${docdir} ..." ; \ ! (cd etc; tar -cf - DOC*)|(cd ${docdir}; umask 0; tar -xvf - ); \ (cd $(docdir); chmod a+r DOC*; rm DOC) \ else true; fi ! if [ x`(cd ./lisp; /bin/pwd)` != x`(cd ${lispdir}; /bin/pwd)` ] \ && [ x`(cd ${srcdir}/lisp; /bin/pwd)` != x`(cd ./lisp; /bin/pwd)` ]; \ then \ --- 355,363 ---- then \ echo "Copying etc/DOC-* to ${docdir} ..." ; \ ! (cd ./etc; tar -cf - DOC*)|(cd ${docdir}; umask 0; tar -xvf - ); \ (cd $(docdir); chmod a+r DOC*; rm DOC) \ else true; fi ! if [ -r ./lisp ] \ ! && [ x`(cd ./lisp; /bin/pwd)` != x`(cd ${lispdir}; /bin/pwd)` ] \ && [ x`(cd ${srcdir}/lisp; /bin/pwd)` != x`(cd ./lisp; /bin/pwd)` ]; \ then \ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/PROBLEMS emacs-19.32/PROBLEMS *** emacs-19.31/PROBLEMS Thu May 23 12:14:03 1996 --- emacs-19.32/PROBLEMS Thu Aug 1 21:59:12 1996 *************** This file describes various problems tha *** 2,5 **** --- 2,115 ---- in compiling, installing and running GNU Emacs. + * Problems running Perl under Emacs on Windows NT/95. + + `perl -de 0' just hangs when executed in an Emacs subshell. + The fault lies with Perl (indirectly with Windows NT/95). + + The problem is that the Perl debugger explicitly opens a connection to + "CON", which is the DOS/NT equivalent of "/dev/tty", for interacting + with the user. + + On Unix, this is okay, because Emacs (or the shell?) creates a + pseudo-tty so that /dev/tty is really the pipe Emacs is using to + communicate with the subprocess. + + On NT, this fails because CON always refers to the handle for the + relevant console (approximately equivalent to a tty), and cannot be + redirected to refer to the pipe Emacs assigned to the subprocess as + stdin. + + A workaround is to modify perldb.pl to use STDIN/STDOUT instead of CON. + + For Perl 4: + + *** PERL/LIB/PERLDB.PL.orig Wed May 26 08:24:18 1993 + --- PERL/LIB/PERLDB.PL Mon Jul 01 15:28:16 1996 + *************** + *** 68,74 **** + $rcfile=".perldb"; + } + else { + ! $console = "con"; + $rcfile="perldb.ini"; + } + + --- 68,74 ---- + $rcfile=".perldb"; + } + else { + ! $console = ""; + $rcfile="perldb.ini"; + } + + + For Perl 5: + *** perl/5.001/lib/perl5db.pl.orig Sun Jun 04 21:13:40 1995 + --- perl/5.001/lib/perl5db.pl Mon Jul 01 17:00:08 1996 + *************** + *** 22,28 **** + $rcfile=".perldb"; + } + elsif (-e "con") { + ! $console = "con"; + $rcfile="perldb.ini"; + } + else { + --- 22,28 ---- + $rcfile=".perldb"; + } + elsif (-e "con") { + ! $console = ""; + $rcfile="perldb.ini"; + } + else { + + * Problems running DOS programs on Windows NT versions earlier than 3.51. + + Some DOS programs, such as pkzip/pkunzip will not work at all, while + others will only work if their stdin is redirected from a file or NUL. + + When a DOS program does not work, a new process is actually created, but + hangs. It cannot be interrupted from Emacs, and might need to be killed + by an external program if Emacs is hung waiting for the process to + finish. If Emacs is not waiting for it, you should be able to kill the + instance of ntvdm that is running the hung process from Emacs, if you + can find out the process id. + + It is safe to run most DOS programs using call-process (eg. M-! and + M-|) since stdin is then redirected from a file, but not with + start-process since that redirects stdin to a pipe. Also, running DOS + programs in a shell buffer prompt without redirecting stdin does not + work. + + * Problems on MS-DOG if DJGPP v2.0 is used to compile Emacs: + + There are two DJGPP library bugs which cause problems: + + * Running `shell-command' (or `compile', or `grep') you get + `Searching for program: permission denied (EACCES), c:/command.com'; + * After you shell to DOS, Ctrl-Break kills Emacs. + + To work around these bugs, you can use two files in the msdos + subdirectory: `is-exec.c' and `sigaction.c'. Compile them and link + them into the Emacs executable `temacs'; then they will replace the + incorrect library functions. + + * When compiling with DJGPP on Windows 95, Make fails for some targets + like make-docfile. + + This can happen if long file name support (the setting of environment + variable LFN) when Emacs distribution was unpacked and during + compilation are not the same. See the MSDOG section of INSTALL for + the explanation of how to avoid this problem. + + * Emacs compiled for MSDOS cannot find some Lisp files, or other + run-time support files, when long filename support is enabled. + + This can happen if the Emacs distribution was unzipped without LFN + support, thus causing long filenames to be truncated to the 8+3 DOS + namespace. You should unzip the files again with a utility that + supports long filenames (such as djtar from DJGPP). + * On Windows 95, Alt-f6 does not get through to Emacs. *************** by removing this patch and installing pa *** 58,64 **** However, that linker version won't work with CDE. ! On Solaris 2.5, the linker has this bug and there is no patch you ! could remove to get rid of the bug. However, the GNU linker does ! work. * Emacs dumps core if lisp-complete-symbol is called, on Solaris. --- 168,184 ---- However, that linker version won't work with CDE. ! Solaris 2.5 comes with a linker that has this bug. It is reported that if ! you install all the latest patches (as of June 1996), the bug is fixed. ! We suspect the crucial patch is one of these, but we don't know ! for certain. ! ! 103093-03: [README] SunOS 5.5: kernel patch (2140557 bytes) ! 102832-01: [README] OpenWindows 3.5: Xview Jumbo Patch (4181613 bytes) ! ! If you can determine which patch does fix the bug, please tell ! bug-gnu-emacs@prep.ai.mit.edu. ! ! Meanwhile, the GNU linker links Emacs properly on both Solaris 2.4 and ! Solaris 2.5. * Emacs dumps core if lisp-complete-symbol is called, on Solaris. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/README emacs-19.32/README *** emacs-19.31/README Sat May 25 20:17:36 1996 --- emacs-19.32/README Thu Aug 1 22:02:47 1996 *************** *** 1,3 **** ! This directory tree holds version 19.31 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. --- 1,3 ---- ! This directory tree holds version 19.32 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/config.bat emacs-19.32/config.bat *** emacs-19.31/config.bat Mon Apr 15 14:40:49 1996 --- emacs-19.32/config.bat Sat Jul 20 13:56:54 1996 *************** rem GNU General Public License for mor *** 17,22 **** rem You should have received a copy of the GNU General Public License ! rem along with GNU Emacs; see the file COPYING. If not, write to ! rem the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. rem ---------------------------------------------------------------------- rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS: --- 17,23 ---- rem You should have received a copy of the GNU General Public License ! rem along with GNU Emacs; see the file COPYING. If not, write to the ! rem Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! rem Boston, MA 02111-1307, USA. rem ---------------------------------------------------------------------- rem YOU'LL NEED THE FOLLOWING UTILITIES TO MAKE EMACS: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/config.guess emacs-19.32/config.guess *** emacs-19.31/config.guess Sat May 25 20:17:34 1996 --- emacs-19.32/config.guess Thu Aug 1 22:02:46 1996 *************** case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ *** 82,86 **** exit 0 ;; i86pc:SunOS:5.*:*) ! echo i386-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:6*:*) --- 82,86 ---- exit 0 ;; i86pc:SunOS:5.*:*) ! echo i386-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` exit 0 ;; sun4*:SunOS:6*:*) *************** case "${UNAME_MACHINE}:${UNAME_SYSTEM}:$ *** 138,142 **** # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` ! if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88100 ] ; then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then --- 138,142 ---- # DG/UX returns AViiON for all architectures UNAME_PROCESSOR=`/usr/bin/uname -p` ! if [ $UNAME_PROCESSOR = mc88100 -o $UNAME_PROCESSOR = mc88110 ] ; then if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then *************** EOF *** 212,216 **** exit 0 ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and ! echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit 0 ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) --- 212,216 ---- exit 0 ;; ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC NetBSD and ! echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to exit 0 ;; # report: romp-ibm BSD 4.3 *:BOSX:*:*) *************** EOF *** 315,319 **** exit 0 ;; i[34]86:BSD/386:*:* | *:BSD/OS:*:*) ! echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} exit 0 ;; *:FreeBSD:*:*) --- 315,319 ---- exit 0 ;; i[34]86:BSD/386:*:* | *:BSD/OS:*:*) ! echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} exit 0 ;; *:FreeBSD:*:*) *************** EOF *** 324,328 **** exit 0 ;; i*:CYGWIN*:*) ! echo i386-unknown-cygwin32 exit 0 ;; p*:CYGWIN*:*) --- 324,328 ---- exit 0 ;; i*:CYGWIN*:*) ! echo i386-pc-cygwin32 exit 0 ;; p*:CYGWIN*:*) *************** EOF *** 340,361 **** ld_help_string=`ld --help 2>&1` if echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: elf_i[345]86"; then ! echo "${UNAME_MACHINE}-unknown-lignux" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: i[345]86linux"; then ! echo "${UNAME_MACHINE}-unknown-lignuxaout" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: i[345]86coff"; then ! echo "${UNAME_MACHINE}-unknown-lignuxcoff" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: m68kelf"; then ! echo "${UNAME_MACHINE}-unknown-lignux" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: m68klinux"; then ! echo "${UNAME_MACHINE}-unknown-lignuxaout" ; exit 0 elif test "${UNAME_MACHINE}" = "alpha" ; then ! echo alpha-unknown-lignux ; exit 0 elif test "${UNAME_MACHINE}" = "sparc" ; then ! echo sparc-unknown-lignux ; exit 0 else ! # Either a pre-BFD a.out linker (lignuxoldld) or one that does not give us ! # useful --help. Gcc wants to distinguish between lignuxoldld and lignuxaout. test ! -d /usr/lib/ldscripts/. \ ! && echo "${UNAME_MACHINE}-unknown-lignuxoldld" && exit 0 # Determine whether the default compiler is a.out or elf cat >dummy.c <&1` if echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: elf_i[345]86"; then ! echo "${UNAME_MACHINE}-pc-linux-gnu" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: i[345]86linux"; then ! echo "${UNAME_MACHINE}-pc-linux-gnuaout" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: i[345]86coff"; then ! echo "${UNAME_MACHINE}-pc-linux-gnucoff" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: m68kelf"; then ! echo "${UNAME_MACHINE}-unknown-linux-gnu" ; exit 0 elif echo "$ld_help_string" | grep >/dev/null 2>&1 "supported emulations: m68klinux"; then ! echo "${UNAME_MACHINE}-unknown-linux-gnuaout" ; exit 0 elif test "${UNAME_MACHINE}" = "alpha" ; then ! echo alpha-unknown-linux-gnu ; exit 0 elif test "${UNAME_MACHINE}" = "sparc" ; then ! echo sparc-unknown-linux-gnu ; exit 0 else ! # Either a pre-BFD a.out linker (linux-gnuoldld) or one that does not give us ! # useful --help. Gcc wants to distinguish between linux-gnuoldld and linux-gnuaout. test ! -d /usr/lib/ldscripts/. \ ! && echo "${UNAME_MACHINE}-pc-linux-gnuoldld" && exit 0 # Determine whether the default compiler is a.out or elf cat >dummy.c </dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')` --- 390,394 ---- if test -f /usr/options/cb.name; then UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')` *************** EOF *** 396,406 **** (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 ! echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL else ! echo ${UNAME_MACHINE}-unknown-sysv32 fi exit 0 ;; Intel:Mach:3*:*) ! echo i386-unknown-mach3 exit 0 ;; paragon:*:*:*) --- 396,406 ---- (/bin/uname -X|egrep '^Machine.*Pentium' >/dev/null) \ && UNAME_MACHINE=i586 ! echo ${UNAME_MACHINE}-pc-sco$UNAME_REL else ! echo ${UNAME_MACHINE}-pc-sysv32 fi exit 0 ;; Intel:Mach:3*:*) ! echo i386-pc-mach3 exit 0 ;; paragon:*:*:*) *************** main () *** 522,526 **** #if defined (__386BSD__) ! printf ("i386-unknown-bsd\n"); exit (0); #endif --- 522,526 ---- #if defined (__386BSD__) ! printf ("i386-pc-bsd\n"); exit (0); #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/config.sub emacs-19.32/config.sub *** emacs-19.31/config.sub Sat May 25 20:17:33 1996 --- emacs-19.32/config.sub Thu Aug 1 22:02:45 1996 *************** *** 42,45 **** --- 42,47 ---- # machine specification into a single specification in the form: # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM + # or in some cases, the newer four-part form: + # CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM # It is wrong to echo any other type of specification. *************** case $1 in *** 63,71 **** esac ! # Separate what the user gave into CPU-COMPANY and OS (if any). ! basic_machine=`echo $1 | sed 's/-[^-]*$//'` ! if [ $basic_machine != $1 ] ! then os=`echo $1 | sed 's/.*-/-/'` ! else os=; fi ### Let's recognize common machines as not being operating systems so --- 65,83 ---- esac ! # Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). ! # Here we must recognize all the valid KERNEL-OS combinations. ! maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` ! case $maybe_os in ! linux-gnu*) ! os=-$maybe_os ! basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` ! ;; ! *) ! basic_machine=`echo $1 | sed 's/-[^-]*$//'` ! if [ $basic_machine != $1 ] ! then os=`echo $1 | sed 's/.*-/-/'` ! else os=; fi ! ;; ! esac ### Let's recognize common machines as not being operating systems so *************** case $os in *** 92,116 **** -sco5) os=sco3.2v5 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco4) os=-sco3.2v4 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -sco*) os=-sco3.2v2 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -isc) os=-isc2.2 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -clix*) --- 104,128 ---- -sco5) os=sco3.2v5 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco4) os=-sco3.2v4 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2.[4-9]*) os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco3.2v[4-9]*) # Don't forget version if it is 3.2v4 or newer. ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -sco*) os=-sco3.2v2 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -isc) os=-isc2.2 ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -clix*) *************** case $os in *** 118,122 **** ;; -isc*) ! basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; -lynx*) --- 130,134 ---- ;; -isc*) ! basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` ;; -lynx*) *************** case $basic_machine in *** 138,142 **** # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. ! tahoe | i[3456]86 | i860 | m68k | m68000 | m88k | ns32k | arm \ | arme[lb] | pyramid \ | tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \ --- 150,154 ---- # Recognize the basic CPU types without company name. # Some are omitted here because they have special meanings below. ! tahoe | i860 | m68k | m68000 | m88k | ns32k | arm \ | arme[lb] | pyramid \ | tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \ *************** case $basic_machine in *** 145,154 **** | pdp11 | mips64el | mips64orion | mips64orionel \ | sparc | sparclet | sparclite | sparc64) ! basic_machine=$basic_machine-unknown ! ;; # Object if more than one company name word. *-*-*) ! echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 ! exit 1 ;; # Recognize the basic CPU types with company name. --- 157,172 ---- | pdp11 | mips64el | mips64orion | mips64orionel \ | sparc | sparclet | sparclite | sparc64) ! basic_machine=$basic_machine-unknown ! ;; ! # We use `pc' rather than `unknown' ! # because (1) that's what they normally are, and ! # (2) the word "unknown" tends to confuse beginning users. ! i[3456]86) ! basic_machine=$basic_machine-pc ! ;; # Object if more than one company name word. *-*-*) ! echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 ! exit 1 ;; # Recognize the basic CPU types with company name. *************** case $basic_machine in *** 203,210 **** os=-aux ;; - aux) - basic_machine=m68k-apple - os=-aux - ;; balance) basic_machine=ns32k-sequent --- 221,224 ---- *************** case $basic_machine in *** 330,346 **** # I'm not sure what "Sysv32" means. Should this be sysv3.2? i[3456]86v32) ! basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv32 ;; i[3456]86v4*) ! basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv4 ;; i[3456]86v) ! basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-sysv ;; i[3456]86sol2) ! basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'` os=-solaris2 ;; --- 344,360 ---- # I'm not sure what "Sysv32" means. Should this be sysv3.2? i[3456]86v32) ! basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv32 ;; i[3456]86v4*) ! basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv4 ;; i[3456]86v) ! basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-sysv ;; i[3456]86sol2) ! basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` os=-solaris2 ;; *************** if [ x"$os" != x"" ] *** 640,643 **** --- 654,659 ---- then case $os in + # First match some system type aliases + # that might get confused with valid system types. # -solaris* is a basic system type, with this one exception. -solaris1 | -solaris1.*) *************** case $os in *** 651,658 **** ;; -gnu/linux*) ! os=`echo $os | sed -e 's|gnu/linux|lignux|'` ! ;; ! -linux*) ! os=`echo $os | sed -e 's|linux|lignux|'` ;; # First accept the basic system types. --- 667,671 ---- ;; -gnu/linux*) ! os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` ;; # First accept the basic system types. *************** case $os in *** 661,676 **** # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ ! | -vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]* \ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigados* | -msdos* | -newsos* | -unicos* | -aof* | -aos* \ | -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \ ! | -riscos* | -lignux* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ ! | -cygwin32* | -pe* | -psos* | -moss* ) # Remember, each alternative MUST END IN *, to match a version number. ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` --- 674,693 ---- # -sysv* is not here because it comes later, after sysvr4. -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ ! | -*vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[34]*\ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \ | -amigados* | -msdos* | -newsos* | -unicos* | -aof* | -aos* \ | -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \ ! | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ | -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \ | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ ! | -cygwin32* | -pe* | -psos* | -moss* | -proelf* \ ! | -linux-gnu*) # Remember, each alternative MUST END IN *, to match a version number. ;; + -linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; -sunos5*) os=`echo $os | sed -e 's|sunos5|solaris2|'` *************** case $basic_machine in *** 897,902 **** vendor=apple ;; - -aux*) - vendor=apple esac basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` --- 914,917 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/configure emacs-19.32/configure *** emacs-19.31/configure Sat May 25 11:59:44 1996 --- emacs-19.32/configure Wed Jul 31 15:37:32 1996 *************** ac_help="$ac_help *** 21,25 **** --with-hesiod support Hesiod to get the POP server host" ac_help="$ac_help ! --with-x-toolkit=KIT use an X toolkit (KIT = yes/lucid/athena/motif)" ac_help="$ac_help --with-x use the X Window System" --- 21,25 ---- --with-hesiod support Hesiod to get the POP server host" ac_help="$ac_help ! --with-x-toolkit=KIT use an X toolkit (KIT = yes/lucid/athena/motif/no)" ac_help="$ac_help --with-x use the X Window System" *************** vpath %.y $(srcdir)\ *** 626,630 **** vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ ! vpath %.in $(srcdir)' fi --- 626,631 ---- vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ ! vpath %.in $(srcdir)\ ! vpath %.texi $(srcdir)' fi *************** case "${canonical}" in *** 713,717 **** opsys=netbsd case "${canonical}" in ! i[345]86-*-netbsd*) machine=intel386 ;; m68k-*-netbsd*) # This is somewhat bogus. --- 714,718 ---- opsys=netbsd case "${canonical}" in ! i[3456]86-*-netbsd*) machine=intel386 ;; m68k-*-netbsd*) # This is somewhat bogus. *************** case "${canonical}" in *** 749,754 **** ;; ! alpha-*-linux* | alpha-*-lignux* ) ! machine=alpha opsys=lignux ;; --- 750,755 ---- ;; ! alpha-*-linux-gnu* ) ! machine=alpha opsys=gnu-linux ;; *************** case "${canonical}" in *** 820,824 **** ## Cubix QBx/386 ! i[345]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; --- 821,825 ---- ## Cubix QBx/386 ! i[3456]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; *************** case "${canonical}" in *** 999,1006 **** ## IBM machines ! i[345]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; ! i[345]86-ibm-aix1.[23]* | i[345]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; --- 1000,1007 ---- ## IBM machines ! i[3456]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; ! i[3456]86-ibm-aix1.[23]* | i[3456]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; *************** case "${canonical}" in *** 1054,1068 **** ## Intel 386 machines where we do care about the manufacturer ! i[345]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL ! i[345]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry running Dynix ! i[345]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; --- 1055,1069 ---- ## Intel 386 machines where we do care about the manufacturer ! i[3456]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL ! i[3456]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry running Dynix ! i[3456]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; *************** case "${canonical}" in *** 1070,1081 **** ## Sequent Symmetry running DYNIX/ptx ## Use the old cpp rather than the newer ANSI one. ! i[345]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; ## Unspecified sysv on an ncr machine defaults to svr4.2. ## (Plain usg5-4 doesn't turn on POSIX signals, which we need.) ! i[345]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; --- 1071,1087 ---- ## Sequent Symmetry running DYNIX/ptx ## Use the old cpp rather than the newer ANSI one. ! i[3456]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; + ## ncr machine running svr4.3. + i[3456]86-ncr-sysv4.3 ) + machine=ncr386 opsys=usg5-4-3 + ;; + ## Unspecified sysv on an ncr machine defaults to svr4.2. ## (Plain usg5-4 doesn't turn on POSIX signals, which we need.) ! i[3456]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; *************** case "${canonical}" in *** 1206,1210 **** ;; mips-sgi-irix6* ) ! machine=iris4d opsys=irix6-0 NON_GNU_CPP=/lib/cpp ;; mips-sgi-irix5.[01]* ) --- 1212,1218 ---- ;; mips-sgi-irix6* ) ! machine=iris4d opsys=irix6-0 ! NON_GNU_CPP=/lib/cpp ! NON_GCC_TEST_OPTIONS=-32 ;; mips-sgi-irix5.[01]* ) *************** case "${canonical}" in *** 1238,1247 **** ## Suns ! sparc-*-linux* | sparc-*-lignux* ) ! machine=sparc opsys=lignux ;; *-sun-sunos* | *-sun-bsd* | *-sun-solaris* \ ! | i[345]86-*-solaris2* | i[345]86-*-sunos5* | powerpc*-*-solaris2* \ | rs6000-*-solaris2*) case "${canonical}" in --- 1246,1255 ---- ## Suns ! sparc-*-linux-gnu* ) ! machine=sparc opsys=gnu-linux ;; *-sun-sunos* | *-sun-bsd* | *-sun-solaris* \ ! | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* | powerpc*-*-solaris2* \ | rs6000-*-solaris2*) case "${canonical}" in *************** case "${canonical}" in *** 1249,1255 **** m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; ! i[345]86-sun-sunos[34]* ) machine=sun386 ;; ! i[345]86-*-* ) machine=intel386 ;; ! powerpc* | rs6000* ) machine=rs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; --- 1257,1263 ---- m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; ! i[3456]86-sun-sunos[34]* ) machine=sun386 ;; ! i[3456]86-*-* ) machine=intel386 ;; ! powerpc* | rs6000* ) machine=ibmrs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; *************** case "${canonical}" in *** 1257,1261 **** case "${canonical}" in ## The Sun386 didn't get past 4.0. ! i[345]86-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.[3-9]* | *-sunos4shr*) --- 1265,1269 ---- case "${canonical}" in ## The Sun386 didn't get past 4.0. ! i[3456]86-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.[3-9]* | *-sunos4shr*) *************** case "${canonical}" in *** 1263,1267 **** NON_GNU_CPP=/usr/lib/cpp ;; ! *-sunos4.1.[3-9]*-noshare ) opsys=sunos4-1-3 NON_GNU_CPP=/usr/lib/cpp --- 1271,1275 ---- NON_GNU_CPP=/usr/lib/cpp ;; ! *-sunos4.1.[3-9]*noshare ) opsys=sunos4-1-3 NON_GNU_CPP=/usr/lib/cpp *************** case "${canonical}" in *** 1381,1385 **** ## Intel 386 machines where we don't care about the manufacturer ! i[345]86-*-* ) machine=intel386 case "${canonical}" in --- 1389,1393 ---- ## Intel 386 machines where we don't care about the manufacturer ! i[3456]86-*-* ) machine=intel386 case "${canonical}" in *************** case "${canonical}" in *** 1395,1402 **** *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; ! *-linux* | *-lignux* ) opsys=lignux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; ! *-bsdi2* ) opsys=bsdos2 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; --- 1403,1417 ---- *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; ! *-linux-gnu* ) opsys=gnu-linux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; + *-sco3.2v5* ) opsys=sco5 + NON_GNU_CPP=/lib/cpp + # Prevent -belf from being passed to $CPP. + # /lib/cpp does not accept it. + OVERRIDE_CPPFLAGS=" " + ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; ! *-bsdi2.0* ) opsys=bsdos2 ;; ! *-bsdi2* ) opsys=bsdos2-1 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; *************** case "${canonical}" in *** 1406,1412 **** ;; ! ## Lignux/68k ! m68k-*-linux* | m68k-*-lignux* ) ! machine=m68k opsys=lignux ;; --- 1421,1427 ---- ;; ! ## Linux/68k-based GNU system ! m68k-*-linux-gnu* ) ! machine=m68k opsys=gnu-linux ;; *************** else *** 1560,1564 **** #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1563: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else --- 1575,1579 ---- #endif EOF ! if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1578: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else *************** else *** 1670,1674 **** # not just through cpp. cat > conftest.$ac_ext < --- 1685,1689 ---- # not just through cpp. cat > conftest.$ac_ext < *************** Syntax Error *** 1676,1680 **** EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1679: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 1691,1695 ---- EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1694: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** else *** 1685,1689 **** CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < --- 1700,1704 ---- CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < *************** Syntax Error *** 1691,1695 **** EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1694: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 1706,1710 ---- EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1709: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** test -n "$YACC" || YACC="yacc" *** 1806,1810 **** echo $ac_n "checking for AIX""... $ac_c" 1>&6 cat > conftest.$ac_ext <&6 cat > conftest.$ac_ext < conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1844: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 1851,1860 ---- else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1859: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** else *** 1874,1882 **** else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then ac_cv_c_cross=no --- 1889,1897 ---- else cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then ac_cv_c_cross=no *************** if eval "test \"`echo '$''{'ac_cv_header *** 1896,1900 **** else cat > conftest.$ac_ext < --- 1911,1915 ---- else cat > conftest.$ac_ext < *************** else *** 1904,1908 **** EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1907: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 1919,1923 ---- EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:1922: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** if test $ac_cv_header_stdc = yes; then *** 1919,1923 **** # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < --- 1934,1938 ---- # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < *************** if test $ac_cv_header_stdc = yes; then *** 1937,1941 **** # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < --- 1952,1956 ---- # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < *************** if test "$cross_compiling" = yes; then *** 1958,1962 **** else cat > conftest.$ac_ext < --- 1973,1977 ---- else cat > conftest.$ac_ext < *************** exit (0); } *** 1969,1973 **** EOF ! { (eval echo configure:1972: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then : --- 1984,1988 ---- EOF ! { (eval echo configure:1987: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then : *************** if eval "test \"`echo '$''{'ac_cv_header *** 1993,1997 **** else cat > conftest.$ac_ext < --- 2008,2012 ---- else cat > conftest.$ac_ext < *************** struct tm *tp; *** 2003,2007 **** ; return 0; } EOF ! if { (eval echo configure:2006: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes --- 2018,2022 ---- ; return 0; } EOF ! if { (eval echo configure:2021: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes *************** if eval "test \"`echo '$''{'ac_cv_decl_s *** 2027,2031 **** else cat > conftest.$ac_ext < --- 2042,2046 ---- else cat > conftest.$ac_ext < *************** char *msg = *(sys_siglist + 1); *** 2040,2044 **** ; return 0; } EOF ! if { (eval echo configure:2043: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes --- 2055,2059 ---- ; return 0; } EOF ! if { (eval echo configure:2058: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes *************** fi *** 2062,2066 **** echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 cat > conftest.$ac_ext <&6 cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 --- 2097,2101 ---- ; return 0; } EOF ! if { (eval echo configure:2100: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 *************** if eval "test \"`echo '$''{'ac_cv_type_s *** 2101,2105 **** else cat > conftest.$ac_ext < --- 2116,2120 ---- else cat > conftest.$ac_ext < *************** int i; *** 2119,2123 **** ; return 0; } EOF ! if { (eval echo configure:2122: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void --- 2134,2138 ---- ; return 0; } EOF ! if { (eval echo configure:2137: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void *************** EOF *** 2139,2143 **** echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 cat > conftest.$ac_ext <&6 cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 --- 2171,2175 ---- ; return 0; } EOF ! if { (eval echo configure:2174: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 *************** if eval "test \"`echo '$''{'ac_cv_struct *** 2177,2181 **** else cat > conftest.$ac_ext < --- 2192,2196 ---- else cat > conftest.$ac_ext < *************** struct tm *tp; tp->tm_sec; *** 2186,2190 **** ; return 0; } EOF ! if { (eval echo configure:2189: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h --- 2201,2205 ---- ; return 0; } EOF ! if { (eval echo configure:2204: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h *************** if eval "test \"`echo '$''{'ac_cv_struct *** 2210,2214 **** else cat > conftest.$ac_ext < --- 2225,2229 ---- else cat > conftest.$ac_ext < *************** struct tm tm; tm.tm_zone; *** 2219,2223 **** ; return 0; } EOF ! if { (eval echo configure:2222: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes --- 2234,2238 ---- ; return 0; } EOF ! if { (eval echo configure:2237: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes *************** if eval "test \"`echo '$''{'ac_cv_var_tz *** 2242,2246 **** else cat > conftest.$ac_ext < --- 2257,2261 ---- else cat > conftest.$ac_ext < *************** atoi(*tzname); *** 2253,2257 **** ; return 0; } EOF ! if { (eval echo configure:2256: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ac_cv_var_tzname=yes --- 2268,2272 ---- ; return 0; } EOF ! if { (eval echo configure:2271: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ac_cv_var_tzname=yes *************** if eval "test \"`echo '$''{'ac_cv_c_cons *** 2279,2283 **** else cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes --- 2344,2348 ---- ; return 0; } EOF ! if { (eval echo configure:2347: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes *************** if test "$ac_x_includes" = NO; then *** 2479,2488 **** # First, try using that file with no special directory specified. cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:2487: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 2494,2503 ---- # First, try using that file with no special directory specified. cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:2502: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** if test "$ac_x_libraries" = NO; then *** 2551,2555 **** LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* LIBS="$ac_save_LIBS" --- 2574,2578 ---- ; return 0; } EOF ! if { (eval echo configure:2577: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* LIBS="$ac_save_LIBS" *************** echo "checking the machine- and system-d *** 2724,2728 **** ### The two are the same except on a few systems, where they are made ### different to work around various lossages. For example, ! ### GCC 2.5 on Lignux needs them to be different because it treats -g ### as implying static linking. --- 2739,2743 ---- ### The two are the same except on a few systems, where they are made ### different to work around various lossages. For example, ! ### GCC 2.5 on GNU/Linux needs them to be different because it treats -g ### as implying static linking. *************** LISP_FLOAT_TYPE=yes *** 2842,2846 **** #### Add the libraries to LIBS and check for some functions. ! CPPFLAGS="$c_switch_system $c_switch_machine $CPPFLAGS" LIBS="$libsrc_libs $LIBS" --- 2857,2866 ---- #### Add the libraries to LIBS and check for some functions. ! if test x"${OVERRIDE_CPPFLAGS}" != x; then ! CPPFLAGS="${OVERRIDE_CPPFLAGS}" ! else ! CPPFLAGS="$c_switch_system $c_switch_machine $CPPFLAGS" ! fi ! LIBS="$libsrc_libs $LIBS" *************** else *** 2853,2857 **** LIBS="-ldnet $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 2885,2889 ---- ; return 0; } EOF ! if { (eval echo configure:2888: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** else *** 2898,2902 **** LIBS="-lXbsd $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 2926,2930 ---- ; return 0; } EOF ! if { (eval echo configure:2929: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** else *** 2933,2937 **** LIBS="-lpthreads $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 2965,2969 ---- ; return 0; } EOF ! if { (eval echo configure:2968: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** if test "${HAVE_X11}" = "yes"; then *** 2997,3004 **** fi ! if test "${opsys}" = "lignux"; then echo $ac_n "checking whether X on GNU/Linux needs -b to link""... $ac_c" 1>&6 cat > conftest.$ac_ext <&6 cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* xlinux_first_failure=no --- 3028,3032 ---- ; return 0; } EOF ! if { (eval echo configure:3031: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* xlinux_first_failure=no *************** rm -f conftest* *** 3027,3031 **** LIBS="$LIBS -b i486-linuxaout" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* xlinux_second_failure=no --- 3055,3059 ---- ; return 0; } EOF ! if { (eval echo configure:3058: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* xlinux_second_failure=no *************** if eval "test \"`echo '$''{'ac_cv_func_$ *** 3068,3072 **** else cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" --- 3112,3116 ---- ; return 0; } EOF ! if { (eval echo configure:3115: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" *************** if test "${window_system}" = "x11"; then *** 3119,3123 **** echo $ac_n "checking X11 version 6""... $ac_c" 1>&6 cat > conftest.$ac_ext < --- 3139,3143 ---- echo $ac_n "checking X11 version 6""... $ac_c" 1>&6 cat > conftest.$ac_ext < *************** fail; *** 3130,3134 **** ; return 0; } EOF ! if { (eval echo configure:3133: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""6 or newer" 1>&6 --- 3150,3154 ---- ; return 0; } EOF ! if { (eval echo configure:3153: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""6 or newer" 1>&6 *************** rm -f conftest* *** 3145,3152 **** fi ! if test x"${USE_X_TOOLKIT}" = xmaybe; then echo $ac_n "checking X11 version 5""... $ac_c" 1>&6 cat > conftest.$ac_ext < --- 3165,3172 ---- fi ! if test "${window_system}" = "x11"; then echo $ac_n "checking X11 version 5""... $ac_c" 1>&6 cat > conftest.$ac_ext < *************** fail; *** 3159,3166 **** ; return 0; } EOF ! if { (eval echo configure:3162: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ! echo "$ac_t""5 or newer; use toolkit by default" 1>&6 ! USE_X_TOOLKIT=LUCID cat >> confdefs.h <<\EOF #define HAVE_X11R5 1 --- 3179,3186 ---- ; return 0; } EOF ! if { (eval echo configure:3182: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ! echo "$ac_t""5 or newer" 1>&6 ! HAVE_X11R5=yes cat >> confdefs.h <<\EOF #define HAVE_X11R5 1 *************** EOF *** 3169,3174 **** else rm -rf conftest* ! echo "$ac_t""before 5; do not use toolkit by default" 1>&6 ! USE_X_TOOLKIT=none fi rm -f conftest* --- 3189,3195 ---- else rm -rf conftest* ! ! HAVE_X11R5=no ! echo "$ac_t""before 5" 1>&6 fi rm -f conftest* *************** rm -f conftest* *** 3176,3179 **** --- 3197,3230 ---- fi + if test x"${USE_X_TOOLKIT}" = xmaybe; then + if test x"${HAVE_X11R5}" = xyes; then + echo $ac_n "checking X11 version 5 with Xaw""... $ac_c" 1>&6 + cat > conftest.$ac_ext < + #include + int main() { return 0; } + int t() { + + ; return 0; } + EOF + if { (eval echo configure:3214: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then + rm -rf conftest* + echo "$ac_t""5 or newer" 1>&6 + USE_X_TOOLKIT=LUCID + else + rm -rf conftest* + echo "$ac_t""before 5 or no Xaw; do not use toolkit by default" 1>&6 + USE_X_TOOLKIT=none + fi + rm -f conftest* + + else + USE_X_TOOLKIT=none + fi + fi + X_TOOLKIT_TYPE=$USE_X_TOOLKIT *************** if test "${USE_X_TOOLKIT}" != "none"; th *** 3181,3185 **** echo $ac_n "checking X11 toolkit version""... $ac_c" 1>&6 cat > conftest.$ac_ext < --- 3232,3236 ---- echo $ac_n "checking X11 toolkit version""... $ac_c" 1>&6 cat > conftest.$ac_ext < *************** fail; *** 3192,3196 **** ; return 0; } EOF ! if { (eval echo configure:3195: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""6 or newer" 1>&6 --- 3243,3247 ---- ; return 0; } EOF ! if { (eval echo configure:3246: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""6 or newer" 1>&6 *************** else *** 3222,3226 **** LIBS="-lXmu $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 3285,3289 ---- ; return 0; } EOF ! if { (eval echo configure:3288: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** fi *** 3264,3268 **** echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 cat > conftest.$ac_ext < --- 3315,3319 ---- echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 cat > conftest.$ac_ext < *************** return h_errno; *** 3272,3276 **** ; return 0; } EOF ! if { (eval echo configure:3275: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 --- 3323,3327 ---- ; return 0; } EOF ! if { (eval echo configure:3326: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 *************** if eval "test \"`echo '$''{'ac_cv_header *** 3293,3297 **** else cat > conftest.$ac_ext < --- 3344,3348 ---- else cat > conftest.$ac_ext < *************** char *p = alloca(2 * sizeof(int)); *** 3301,3305 **** ; return 0; } EOF ! if { (eval echo configure:3304: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ac_cv_header_alloca_h=yes --- 3352,3356 ---- ; return 0; } EOF ! if { (eval echo configure:3355: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ac_cv_header_alloca_h=yes *************** if eval "test \"`echo '$''{'ac_cv_func_a *** 3325,3329 **** else cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ac_cv_func_alloca=yes --- 3400,3404 ---- ; return 0; } EOF ! if { (eval echo configure:3403: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* ac_cv_func_alloca=yes *************** if eval "test \"`echo '$''{'ac_cv_os_cra *** 3384,3388 **** else cat > conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" --- 3488,3492 ---- ; return 0; } EOF ! if { (eval echo configure:3491: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" *************** else *** 3469,3473 **** else cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then ac_cv_c_stack_direction=1 --- 3539,3543 ---- } EOF ! { (eval echo configure:3542: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then ac_cv_c_stack_direction=1 *************** else *** 3516,3520 **** LIBS="-lm $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 3579,3583 ---- ; return 0; } EOF ! if { (eval echo configure:3582: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** fi *** 3555,3559 **** for ac_func in gettimeofday gethostname dup2 rename closedir mkdir rmdir \ random lrand48 bcopy bcmp logb frexp fmod ftime res_init setsid \ ! strerror fpathconf select mktime eaccess getpagesize tzset setlocale do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 --- 3606,3610 ---- for ac_func in gettimeofday gethostname dup2 rename closedir mkdir rmdir \ random lrand48 bcopy bcmp logb frexp fmod ftime res_init setsid \ ! strerror fpathconf select mktime euidaccess getpagesize tzset setlocale do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 *************** if eval "test \"`echo '$''{'ac_cv_func_$ *** 3562,3566 **** else cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" --- 3637,3641 ---- ; return 0; } EOF ! if { (eval echo configure:3640: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" *************** else *** 3621,3625 **** LIBS="-lncurses $LIBS" cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" --- 3684,3688 ---- ; return 0; } EOF ! if { (eval echo configure:3687: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" *************** emacs_cv_localtime_cache=yes *** 3668,3672 **** else cat > conftest.$ac_ext < --- 3719,3723 ---- else cat > conftest.$ac_ext < *************** main() *** 3701,3705 **** } EOF ! { (eval echo configure:3704: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then emacs_cv_localtime_cache=no --- 3752,3756 ---- } EOF ! { (eval echo configure:3755: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } if test -s conftest && (./conftest; exit) 2>/dev/null; then emacs_cv_localtime_cache=no *************** if test "x$HAVE_TIMEVAL" = xyes; then *** 3726,3730 **** echo $ac_n "checking whether gettimeofday can't accept two arguments""... $ac_c" 1>&6 cat > conftest.$ac_ext <&6 cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""no" 1>&6 --- 3800,3804 ---- ; return 0; } EOF ! if { (eval echo configure:3803: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* echo "$ac_t""no" 1>&6 *************** if eval "test \"`echo '$''{'ac_cv_func_s *** 3770,3774 **** else cat > conftest.$ac_ext < conftest.$ac_ext <&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_socket=yes" --- 3845,3849 ---- ; return 0; } EOF ! if { (eval echo configure:3848: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then rm -rf conftest* eval "ac_cv_func_socket=yes" *************** if eval "test \"`echo '$''{'ac_cv_header *** 3819,3828 **** else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:3827: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 3870,3879 ---- else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:3878: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then *************** if eval "test \"`echo '$''{'ac_cv_header *** 3852,3861 **** else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:3860: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then --- 3903,3912 ---- else cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" ! { (eval echo configure:3911: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/configure.in emacs-19.32/configure.in *** emacs-19.31/configure.in Sat May 25 10:23:12 1996 --- emacs-19.32/configure.in Wed Jul 31 13:52:38 1996 *************** dnl GNU General Public License for more *** 19,24 **** dnl dnl You should have received a copy of the GNU General Public License ! dnl along with GNU Emacs; see the file COPYING. If not, write to ! dnl the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. AC_PREREQ(2.8)dnl --- 19,25 ---- dnl dnl You should have received a copy of the GNU General Public License ! dnl along with GNU Emacs; see the file COPYING. If not, write to the ! dnl Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! dnl Boston, MA 02111-1307, USA. AC_PREREQ(2.8)dnl *************** dnl added later on when we find the path *** 50,54 **** dnl keep them together visually. AC_ARG_WITH(x-toolkit, ! [ --with-x-toolkit=KIT use an X toolkit (KIT = yes/lucid/athena/motif)], [ case "${withval}" in y | ye | yes ) val=athena ;; --- 51,55 ---- dnl keep them together visually. AC_ARG_WITH(x-toolkit, ! [ --with-x-toolkit=KIT use an X toolkit (KIT = yes/lucid/athena/motif/no)], [ case "${withval}" in y | ye | yes ) val=athena ;; *************** vpath %.y $(srcdir)\ *** 110,114 **** vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ ! vpath %.in $(srcdir)' fi --- 111,116 ---- vpath %.l $(srcdir)\ vpath %.s $(srcdir)\ ! vpath %.in $(srcdir)\ ! vpath %.texi $(srcdir)' fi *************** case "${canonical}" in *** 154,158 **** opsys=netbsd case "${canonical}" in ! i[345]86-*-netbsd*) machine=intel386 ;; m68k-*-netbsd*) # This is somewhat bogus. --- 156,160 ---- opsys=netbsd case "${canonical}" in ! i[3456]86-*-netbsd*) machine=intel386 ;; m68k-*-netbsd*) # This is somewhat bogus. *************** case "${canonical}" in *** 190,195 **** ;; ! alpha-*-linux* | alpha-*-lignux* ) ! machine=alpha opsys=lignux ;; --- 192,197 ---- ;; ! alpha-*-linux-gnu* ) ! machine=alpha opsys=gnu-linux ;; *************** case "${canonical}" in *** 261,265 **** ## Cubix QBx/386 ! i[345]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; --- 263,267 ---- ## Cubix QBx/386 ! i[3456]86-cubix-sysv* ) machine=intel386 opsys=usg5-3 ;; *************** case "${canonical}" in *** 440,447 **** ## IBM machines ! i[345]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; ! i[345]86-ibm-aix1.[23]* | i[345]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; --- 442,449 ---- ## IBM machines ! i[3456]86-ibm-aix1.1* ) machine=ibmps2-aix opsys=usg5-2-2 ;; ! i[3456]86-ibm-aix1.[23]* | i[3456]86-ibm-aix* ) machine=ibmps2-aix opsys=usg5-3 ;; *************** case "${canonical}" in *** 495,509 **** ## Intel 386 machines where we do care about the manufacturer ! i[345]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL ! i[345]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry running Dynix ! i[345]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; --- 497,511 ---- ## Intel 386 machines where we do care about the manufacturer ! i[3456]86-intsys-sysv* ) machine=is386 opsys=usg5-2-2 ;; ## Prime EXL ! i[3456]86-prime-sysv* ) machine=i386 opsys=usg5-3 ;; ## Sequent Symmetry running Dynix ! i[3456]86-sequent-bsd* ) machine=symmetry opsys=bsd4-3 ;; *************** case "${canonical}" in *** 511,522 **** ## Sequent Symmetry running DYNIX/ptx ## Use the old cpp rather than the newer ANSI one. ! i[345]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; ## Unspecified sysv on an ncr machine defaults to svr4.2. ## (Plain usg5-4 doesn't turn on POSIX signals, which we need.) ! i[345]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; --- 513,529 ---- ## Sequent Symmetry running DYNIX/ptx ## Use the old cpp rather than the newer ANSI one. ! i[3456]86-sequent-ptx* ) machine=sequent-ptx opsys=ptx NON_GNU_CPP="/lib/cpp" ;; + ## ncr machine running svr4.3. + i[3456]86-ncr-sysv4.3 ) + machine=ncr386 opsys=usg5-4-3 + ;; + ## Unspecified sysv on an ncr machine defaults to svr4.2. ## (Plain usg5-4 doesn't turn on POSIX signals, which we need.) ! i[3456]86-ncr-sysv* ) machine=ncr386 opsys=usg5-4-2 ;; *************** case "${canonical}" in *** 647,651 **** ;; mips-sgi-irix6* ) ! machine=iris4d opsys=irix6-0 NON_GNU_CPP=/lib/cpp ;; mips-sgi-irix5.[01]* ) --- 654,660 ---- ;; mips-sgi-irix6* ) ! machine=iris4d opsys=irix6-0 ! NON_GNU_CPP=/lib/cpp ! NON_GCC_TEST_OPTIONS=-32 ;; mips-sgi-irix5.[01]* ) *************** case "${canonical}" in *** 679,688 **** ## Suns ! sparc-*-linux* | sparc-*-lignux* ) ! machine=sparc opsys=lignux ;; *-sun-sunos* | *-sun-bsd* | *-sun-solaris* \ ! | i[345]86-*-solaris2* | i[345]86-*-sunos5* | powerpc*-*-solaris2* \ | rs6000-*-solaris2*) case "${canonical}" in --- 688,697 ---- ## Suns ! sparc-*-linux-gnu* ) ! machine=sparc opsys=gnu-linux ;; *-sun-sunos* | *-sun-bsd* | *-sun-solaris* \ ! | i[3456]86-*-solaris2* | i[3456]86-*-sunos5* | powerpc*-*-solaris2* \ | rs6000-*-solaris2*) case "${canonical}" in *************** case "${canonical}" in *** 690,696 **** m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; ! i[345]86-sun-sunos[34]* ) machine=sun386 ;; ! i[345]86-*-* ) machine=intel386 ;; ! powerpc* | rs6000* ) machine=rs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; --- 699,705 ---- m68*-sunos2* ) machine=sun2 ;; m68* ) machine=sun3 ;; ! i[3456]86-sun-sunos[34]* ) machine=sun386 ;; ! i[3456]86-*-* ) machine=intel386 ;; ! powerpc* | rs6000* ) machine=ibmrs6000 ;; sparc* ) machine=sparc ;; * ) unported=yes ;; *************** case "${canonical}" in *** 698,702 **** case "${canonical}" in ## The Sun386 didn't get past 4.0. ! i[345]86-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.[3-9]* | *-sunos4shr*) --- 707,711 ---- case "${canonical}" in ## The Sun386 didn't get past 4.0. ! i[3456]86-*-sunos4 ) opsys=sunos4-0 ;; *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.[3-9]* | *-sunos4shr*) *************** case "${canonical}" in *** 704,708 **** NON_GNU_CPP=/usr/lib/cpp ;; ! *-sunos4.1.[3-9]*-noshare ) opsys=sunos4-1-3 NON_GNU_CPP=/usr/lib/cpp --- 713,717 ---- NON_GNU_CPP=/usr/lib/cpp ;; ! *-sunos4.1.[3-9]*noshare ) opsys=sunos4-1-3 NON_GNU_CPP=/usr/lib/cpp *************** case "${canonical}" in *** 822,826 **** ## Intel 386 machines where we don't care about the manufacturer ! i[345]86-*-* ) machine=intel386 case "${canonical}" in --- 831,835 ---- ## Intel 386 machines where we don't care about the manufacturer ! i[3456]86-*-* ) machine=intel386 case "${canonical}" in *************** case "${canonical}" in *** 836,843 **** *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; ! *-linux* | *-lignux* ) opsys=lignux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; ! *-bsdi2* ) opsys=bsdos2 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; --- 845,859 ---- *-esix* ) opsys=esix ;; *-xenix* ) opsys=xenix ;; ! *-linux-gnu* ) opsys=gnu-linux ;; *-sco3.2v4* ) opsys=sco4 ; NON_GNU_CPP=/lib/cpp ;; + *-sco3.2v5* ) opsys=sco5 + NON_GNU_CPP=/lib/cpp + # Prevent -belf from being passed to $CPP. + # /lib/cpp does not accept it. + OVERRIDE_CPPFLAGS=" " + ;; *-bsd386* | *-bsdi1* ) opsys=bsd386 ;; ! *-bsdi2.0* ) opsys=bsdos2 ;; ! *-bsdi2* ) opsys=bsdos2-1 ;; *-386bsd* ) opsys=386bsd ;; *-freebsd* ) opsys=freebsd ;; *************** case "${canonical}" in *** 847,853 **** ;; ! ## Lignux/68k ! m68k-*-linux* | m68k-*-lignux* ) ! machine=m68k opsys=lignux ;; --- 863,869 ---- ;; ! ## Linux/68k-based GNU system ! m68k-*-linux-gnu* ) ! machine=m68k opsys=gnu-linux ;; *************** AC_CHECKING([the machine- and system-dep *** 1109,1113 **** ### The two are the same except on a few systems, where they are made ### different to work around various lossages. For example, ! ### GCC 2.5 on Lignux needs them to be different because it treats -g ### as implying static linking. --- 1125,1129 ---- ### The two are the same except on a few systems, where they are made ### different to work around various lossages. For example, ! ### GCC 2.5 on GNU/Linux needs them to be different because it treats -g ### as implying static linking. *************** LISP_FLOAT_TYPE=yes *** 1229,1233 **** #### Add the libraries to LIBS and check for some functions. ! CPPFLAGS="$c_switch_system $c_switch_machine $CPPFLAGS" LIBS="$libsrc_libs $LIBS" --- 1245,1254 ---- #### Add the libraries to LIBS and check for some functions. ! if test x"${OVERRIDE_CPPFLAGS}" != x; then ! CPPFLAGS="${OVERRIDE_CPPFLAGS}" ! else ! CPPFLAGS="$c_switch_system $c_switch_machine $CPPFLAGS" ! fi ! LIBS="$libsrc_libs $LIBS" *************** if test "${HAVE_X11}" = "yes"; then *** 1271,1275 **** fi ! if test "${opsys}" = "lignux"; then AC_MSG_CHECKING(whether X on GNU/Linux needs -b to link) AC_TRY_LINK([], --- 1292,1296 ---- fi ! if test "${opsys}" = "gnu-linux"; then AC_MSG_CHECKING(whether X on GNU/Linux needs -b to link) AC_TRY_LINK([], *************** fail; *** 1321,1325 **** fi ! if test x"${USE_X_TOOLKIT}" = xmaybe; then AC_MSG_CHECKING(X11 version 5) AC_TRY_LINK([#include ], --- 1342,1346 ---- fi ! if test "${window_system}" = "x11"; then AC_MSG_CHECKING(X11 version 5) AC_TRY_LINK([#include ], *************** if test x"${USE_X_TOOLKIT}" = xmaybe; th *** 1327,1335 **** fail; #endif ! ], [AC_MSG_RESULT(5 or newer; use toolkit by default) ! USE_X_TOOLKIT=LUCID AC_DEFINE(HAVE_X11R5)], ! [AC_MSG_RESULT(before 5; do not use toolkit by default) ! USE_X_TOOLKIT=none]) fi --- 1348,1375 ---- fail; #endif ! ], [AC_MSG_RESULT(5 or newer) ! HAVE_X11R5=yes AC_DEFINE(HAVE_X11R5)], ! [ ! HAVE_X11R5=no ! AC_MSG_RESULT(before 5)]) ! fi ! ! dnl Do not put whitespace before the #include statements below. ! dnl Older compilers (eg sunos4 cc) choke on it. ! if test x"${USE_X_TOOLKIT}" = xmaybe; then ! if test x"${HAVE_X11R5}" = xyes; then ! AC_MSG_CHECKING(X11 version 5 with Xaw) ! AC_TRY_LINK([ ! #include ! #include ], ! [], ! [AC_MSG_RESULT(5 or newer, with Xaw; use toolkit by default) ! USE_X_TOOLKIT=LUCID], ! [AC_MSG_RESULT(before 5 or no Xaw; do not use toolkit by default) ! USE_X_TOOLKIT=none]) ! else ! USE_X_TOOLKIT=none ! fi fi *************** AC_CHECK_LIB(m, sqrt) *** 1376,1380 **** AC_CHECK_FUNCS(gettimeofday gethostname dup2 rename closedir mkdir rmdir \ random lrand48 bcopy bcmp logb frexp fmod ftime res_init setsid \ ! strerror fpathconf select mktime eaccess getpagesize tzset setlocale) # Check this now, so that we will NOT find the above functions in ncurses. --- 1416,1420 ---- AC_CHECK_FUNCS(gettimeofday gethostname dup2 rename closedir mkdir rmdir \ random lrand48 bcopy bcmp logb frexp fmod ftime res_init setsid \ ! strerror fpathconf select mktime euidaccess getpagesize tzset setlocale) # Check this now, so that we will NOT find the above functions in ncurses. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/ChangeLog emacs-19.32/etc/ChangeLog *** emacs-19.31/etc/ChangeLog Sat May 25 15:30:35 1996 --- emacs-19.32/etc/ChangeLog Wed Jul 31 15:11:06 1996 *************** *** 1,2 **** --- 1,11 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + Sun Jun 23 17:12:11 1996 Richard Stallman + + * refcard.ps: File obtained from someone else; + it was generated badly here. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/FAQ emacs-19.32/etc/FAQ *** emacs-19.31/etc/FAQ Thu Apr 11 18:55:24 1996 --- emacs-19.32/etc/FAQ Sat Jul 20 14:25:47 1996 *************** General Questions *** 491,499 **** E-mail address: gnu@prep.ai.mit.edu ! Phone number: (617) 876-3296 Postal address: Free Software Foundation, Inc. ! 675 Massachusetts Avenue ! Cambridge, MA 02139, USA For details on how to order, see the file etc/ORDERS. --- 491,499 ---- E-mail address: gnu@prep.ai.mit.edu ! Phone number: (617) 542-5942 Postal address: Free Software Foundation, Inc. ! 59 Temple Place - Suite 330 ! Boston, MA 02111-1307, USA. For details on how to order, see the file etc/ORDERS. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/FTP emacs-19.32/etc/FTP *** emacs-19.31/etc/FTP Mon Apr 22 19:38:00 1996 --- emacs-19.32/etc/FTP Fri Jul 19 01:59:09 1996 *************** The files are available via anonymous ft *** 146,190 **** Emacs and other GNU programs may be available via anonymous ftp from ! these US sites: ftp.kpc.com:/pub/mirror/gnu (Silicon Valley, CA) ! ftp.hawaii.edu:/mirrors/gnu, f.ms.uky.edu:/pub3/gnu, ! ftp.digex.net:/pub/gnu (Internet address 164.109.10.23, nightly full ! mirror, ran by mcguire@digex.net), wuarchive.wustl.edu:/systems/gnu, ! uiarchive.cso.uiuc.edu:/pub/gnu (Internet address 128.174.5.14, ! nightly full mirror, ran by ftpadmin@uiuc.edu), ! ftp.cs.columbia.edu:/archives/gnu/prep, jaguar.utah.edu:/gnustuff, ! gatekeeper.dec.com:/pub/GNU, labrea.stanford.edu, ! archive.cis.ohio-state.edu, and ftp.uu.net:/archive/systems/gnu. ! And these foreign sites: ftp.cs.ubc.ca:/mirror2/gnu (Western Canada, daily full mirror, ran by ftp-admin@cs.ubc.ca), ! ftp.inf.utfsm.cl:/pub/gnu (Chile 146.83.198.3 nightly full mirror, ran ! by ftp@inf.utfsm.cl), ftp.unicamp.br:/pub/gnu (Brazil manual mirror, ! ran by oliva@dcc.unicamp.br), archie.au:/gnu (Australia (archie.oz or ! archie.oz.au for ACSnet)), ftp.technion.ac.il:/pub/unsupported/gnu ! (Israel, daily full mirror, ran by ftp-admin), ftp.sun.ac.za:/pub/gnu ! (South Africa), ftp.etsimo.uniovi.es:/pub/gnu (Spain), ! ftp.mcc.ac.uk:/pub/gnu (130.88.203.12 daily full mirror, ran by ! root@ftp.mcc.ac.uk), unix.hensa.ac.uk:/mirrors/uunet/systems/gnu, ! ftp.warwick.ac.uk (137.205.192.14 daily full mirror, ran by ! unixhelp@warwick.ac.uk), ftp.informatik.tu-muenchen.de, ! ftp.informatik.rwth-aachen.de, or germany.eu.net (mirror ran by ! archive-admin@germany.eu.net) (Germany), isy.liu.se (Sweden), ! ftp.stacken.kth.se or ftp.luth.se:/pub/unix/gnu (Sweden), ! ftp.sunet.se:/pub/gnu (Sweden 130.238.127.3 daily mirror, ran by ! archive@ftp.sunet.se (also mirrors the Mailing List Archives) ! ftp.nl.net (Netherlands), ftp.win.tue.nl:/pub/gnu (Netherlands ! 131.155.70.100 daily mirror, ran by ftp@win.tue.nl), ! ftp.funet.fi:/pub/gnu (Finland 128.214.6.100, ran by gnu-adm), ! ftp.denet.dk (Denmark), ugle.unit.no (Norway 129.241.1.97), ! ftp.eunet.ch or nic.switch.ch:/mirror/gnu (Switzerland), ! irisa.irisa.fr:/pub/gnu or ftp.univ-lyon1.fr:pub/gnu (ran by ftpmaint@ftp.univ-lyon1.fr) (France), ftp.ieunet.ie:pub/gnu (Ireland 192.111.39.1 weekly mirror, ran by archive@ieunet.ie), archive.eu.net ! (Europe 192.16.202.1), cair-archive.kaist.ac.kr:/pub/gnu (Korea 143.248.11.171, ran by ftpkeeper@cair-archive.kaist.ac.kr), ! ftp.nectec.or.th:/pub/mirrors/gnu (Thailand 192.150.251.32 daily mirror, ran by ftp@nwg.nectec.or.th), ! utsun.s.u-tokyo.ac.jp:/ftpsync/prep or ftp.cs.titech.ac.jp (Japan, ! nemacs, the japanese port of GNU Emacs, is under ~ftp/JAPAN). * Getting GNU software in Great Britain --- 146,193 ---- Emacs and other GNU programs may be available via anonymous ftp from ! these US sites: ftp.kpc.com/pub/mirror/gnu (Silicon Valley, CA) ! ftp.hawaii.edu/mirrors/gnu, f.ms.uky.edu/pub3/gnu, ! ftp.digex.net/pub/gnu (Internet address 164.109.10.23, nightly full ! mirror, ran by mcguire@digex.net), wuarchive.wustl.edu/systems/gnu, ! uiarchive.cso.uiuc.edu/pub/gnu (Internet address 128.174.5.14, nightly ! full mirror, ran by ftpadmin@uiuc.edu), ! ftp.cs.columbia.edu/archives/gnu/prep, jaguar.utah.edu/gnustuff, ! gatekeeper.dec.com/pub/GNU, labrea.stanford.edu, ! archive.cis.ohio-state.edu, and ftp.uu.net/archive/systems/gnu. ! And these foreign sites: ftp.cs.ubc.ca/mirror2/gnu (Western Canada, daily full mirror, ran by ftp-admin@cs.ubc.ca), ! ftp.inf.utfsm.cl/pub/gnu (Chile 146.83.198.3 nightly full mirror, ran ! by ftp@inf.utfsm.cl), ftp.unicamp.br/pub/gnu (Brazil manual mirror, ! ran by oliva@dcc.unicamp.br), archie.au/gnu (Australia ran by ! gnu@archie.au (archie.oz or archie.oz.au for ACSnet)), ! ftp.technion.ac.il/pub/unsupported/gnu (Israel, daily full mirror, ran ! by ftp-admin), ftp.sun.ac.za/pub/gnu (South Africa), ! ftp.etsimo.uniovi.es/pub/gnu (Spain), ftp.mcc.ac.uk/pub/gnu ! (130.88.203.12 daily full mirror, ran by root@ftp.mcc.ac.uk), ! unix.hensa.ac.uk/mirrors/uunet/systems/gnu, ftp.warwick.ac.uk ! (137.205.192.14 daily full mirror, ran by unixhelp@warwick.ac.uk), ! ftp.informatik.tu-muenchen.de, ftp.informatik.rwth-aachen.de (Germany, ! ran by sunsite@sunsite.informatik.rwth-aachen.de), germany.eu.net ! (Germany, ran by archive-admin@germany.eu.net), isy.liu.se (Sweden, ! ran by ftpadm@isy.liu.se), ftp.stacken.kth.se or ! ftp.luth.se/pub/unix/gnu (Sweden), ftp.sunet.se/pub/gnu (Sweden ! 130.238.127.3 daily mirror, ran by archive@ftp.sunet.se (also mirrors ! the Mailing List Archives) ftp.nl.net (Netherlands), ! ftp.win.tue.nl/pub/gnu (Netherlands 131.155.70.100 daily mirror, ran ! by ftp@win.tue.nl), ftp.funet.fi/pub/gnu (Finland 128.214.6.100, ran ! by gnu-adm), ftp.denet.dk (Denmark), ugle.unit.no (Norway ! 129.241.1.97), ftp.eunet.ch or nic.switch.ch/mirror/gnu (Switzerland), ! irisa.irisa.fr/pub/gnu or ftp.univ-lyon1.fr:pub/gnu (ran by ftpmaint@ftp.univ-lyon1.fr) (France), ftp.ieunet.ie:pub/gnu (Ireland 192.111.39.1 weekly mirror, ran by archive@ieunet.ie), archive.eu.net ! (Europe 192.16.202.1), cair-archive.kaist.ac.kr/pub/gnu (Korea 143.248.11.171, ran by ftpkeeper@cair-archive.kaist.ac.kr), ! ftp.nectec.or.th/pub/mirrors/gnu (Thailand 192.150.251.32 daily mirror, ran by ftp@nwg.nectec.or.th), ! tron.um.u-tokyo.ac.jp/pub/GNU/prep (Japan - ran by ! ftp-admin@tron.um.u-tokyo.ac.jp) or ftp.cs.titech.ac.jp (Japan, ran by ! ftp-admin@cs.titech.ac.jp - nemacs, the japanese port of GNU Emacs, is ! under ~ftp/JAPAN). * Getting GNU software in Great Britain diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/LINUX-GNU emacs-19.32/etc/LINUX-GNU *** emacs-19.31/etc/LINUX-GNU Sun May 19 18:50:49 1996 --- emacs-19.32/etc/LINUX-GNU Sat Jun 29 02:43:23 1996 *************** Ghostscript. The components in this las *** 15,24 **** The GNU system consists of all three categories together. ! The GNU project is not just about developing and distributing free ! software. The heart of the GNU project is an idea: that software ! should be free, and that the users' freedom is worth defending. For ! if people have freedom but do not value it, they will not keep it for ! long. In order to make freedom last, we have to teach people to value ! it. The GNU project's method is that free software and the idea of users' --- 15,25 ---- The GNU system consists of all three categories together. ! The GNU project is not just about developing and distributing some ! useful free software. The heart of the GNU project is an idea: that ! software should be free, and that the users' freedom is worth ! defending. For if people have freedom but do not consciously ! appreciate it, they will not keep it for long. If we want to make ! freedom last, we need to call people's attention to the freedoms they ! have in free software. The GNU project's method is that free software and the idea of users' *************** freedom support each other. We develop *** 26,60 **** encounter GNU programs or the GNU system and start to use them, they also think about the GNU idea. The software shows that the idea can ! work in practice. People who come to agree with the idea are likely ! to write additional free software. Thus, the software embodies the ! idea, spreads the idea, and grows from the idea. ! ! This method was working well--until someone combined the Linux kernel ! with the GNU system (which still lacked a kernel), and called the ! combination a "Linux system." ! ! The Linux kernel is a free Unix-compatible kernel written by Linus ! Torvalds. It was not written specifically for the GNU project, but ! the Linux kernel and the GNU system work together well. In fact, ! adding Linux to the GNU system brought the system to completion: it ! made a free Unix-compatible operating system available for use. ! ! But ironically, the practice of calling it a "Linux system" undermines ! our method of communicating the GNU idea. At first impression, a ! "Linux system" sounds like something completely distinct from the "GNU ! system." And that is what most users think it is. Most introductions to the "Linux system" acknowledge the role played by the GNU software components. But they don't say that the system as ! a whole is more or less the same GNU system that the GNU project has ! been compiling for a decade. They don't say that the idea of a free ! Unix-like system originates from the GNU project. So most users don't ! know these things. ! ! This leads many of those users to identify themselves as a separate ! community of "Linux users", distinct from the GNU user community. ! They use all of the GNU software; in fact, they use almost all of the ! GNU system; but they don't think of themselves as GNU users, and they ! may not think about the GNU idea. It leads to other problems as well--even hampering cooperation on --- 27,74 ---- encounter GNU programs or the GNU system and start to use them, they also think about the GNU idea. The software shows that the idea can ! work in practice. Some of these people come to agree with the idea, ! and then they are more likely to write additional free software. ! Thus, the software embodies the idea, spreads the idea, and grows from ! the idea. ! ! By 1992, we had found or written all of the essential major components ! of the system except the kernel, which we were writing. (This kernel ! consists of the Mach microkernel plus the GNU HURD. Currently it is ! running but not ready for users. We are hoping for an alpha release ! soon.) ! ! Then the Linux kernel became available. Linux is a free ! Unix-compatible kernel initially written by Linus Torvalds. It was ! not written for the GNU project, but Linux and the almost-complete GNU ! system made a useful combination. This combination provided all the ! major essential components of a Unix-compatible operating system, and ! with some work, people made it into a usable system. It was a variant ! GNU system, based on the Linux kernel. ! ! Ironically, the popularity of these systems undermines our method of ! communicating the GNU idea to people who use GNU. These systems are ! mostly the same as the GNU system--the main difference being the ! choice of kernel. But people usually call them "Linux systems". At ! first impression, a "Linux system" sounds like something completely ! distinct from the "GNU system," and that is what most users think it ! is. Most introductions to the "Linux system" acknowledge the role played by the GNU software components. But they don't say that the system as ! a whole is a variant of the GNU system that the GNU project has been ! compiling for a decade. They don't say that the goal of a free ! Unix-like system like this one came from the GNU project. So most ! users don't know these things. ! ! Since human beings tend to correct their first impressions less than ! subsequent information calls for, those users who later learn about ! the relationship between these systems and the GNU project still often ! underestimate it. ! ! This leads many users to identify themselves as a separate community ! of "Linux users", distinct from the GNU user community. They use all ! of the GNU software; in fact, they use almost all of the GNU system; ! but they don't think of themselves as GNU users, and often they don't ! think that the GNU idea relates to them. It leads to other problems as well--even hampering cooperation on *************** software maintenance. Normally when use *** 62,67 **** make it work better on a particular system, they send the change to the maintainer of that program; then they work with the maintainer, ! explaining the change, arguing for it and sometimes rewriting it, to ! get it installed. But people who think of themselves as "Linux users" are more likely to --- 76,82 ---- make it work better on a particular system, they send the change to the maintainer of that program; then they work with the maintainer, ! explaining the change, arguing for it, and sometimes rewriting it for ! the sake of the overall coherence and maintainability of the package, ! to get the patch installed. But people who think of themselves as "Linux users" are more likely to *************** box" on Linux-based systems; but if the *** 71,76 **** becomes much harder to achieve. ! So how should the GNU project respond? What should we do now to ! spread the idea that freedom for computer users is important? We should continue to talk about the freedom to share and change --- 86,91 ---- becomes much harder to achieve. ! How should the GNU project deal with this problem? What should we do ! now to spread the idea that freedom for computer users is important? We should continue to talk about the freedom to share and change *************** encouraging others to write additional f *** 82,95 **** additional proprietary software. ! We should not accept the splitting of the community in two. Instead ! we should spread the word that "Linux systems" are variant GNU ! systems--that users of these systems are GNU users, and that they ! ought to consider the GNU philosophy which brought these systems into ! existence. ! ! This article is one way of doing that. Another way is to use the ! terms "Linux-based GNU system" (or "GNU/Linux system" or "Lignux" for ! short) to refer to the combination of the Linux kernel and the GNU ! system. Copyright 1996 Richard Stallman --- 97,111 ---- additional proprietary software. ! We should not accept the idea of two separate communities for GNU and ! Linux. Instead we should spread understanding that "Linux systems" ! are variants of the GNU system, and that the users of these systems ! are as GNU users as well as Linux users (users of the Linux kernel). ! Users who know this will naturally tend to take a look at the GNU ! philosophy which brought these systems into existence. ! ! I've written this article as one way of doing that. Another way is to ! use the terms "Linux-based GNU system" or "GNU/Linux system", instead ! of "Linux system," when you write about or mention such a system. ! Copyright 1996 Richard Stallman diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/MACHINES emacs-19.32/etc/MACHINES *** emacs-19.31/etc/MACHINES Sun Apr 28 01:51:21 1996 --- emacs-19.32/etc/MACHINES Thu Jul 11 20:34:25 1996 *************** Hewlett-Packard 9000 series 200 or 300 ( *** 352,356 **** Version 19 works under BSD. The 19.26 pretest was reported ! to work on HPUX 9. These machines are 68000-series CPUs running HP/UX --- 352,357 ---- Version 19 works under BSD. The 19.26 pretest was reported ! to work on HPUX 9. 19.31 works on HPUX 10.01, but there are ! some problems on 10.10 which have not been resolved. These machines are 68000-series CPUs running HP/UX *************** HP 9000 series 700 or 800 (Spectrum) (hp *** 430,436 **** this patch by using telnet to access the machine support.mayfield.hp.com and logging in as "hpslreg" and following ! the instructions there. Do not ask FSF for further support on ! this. If you have any trouble obtaining the patch, contact HP ! Software Support. If your buffer fills up with nulls (^@) at some point, it could well --- 431,442 ---- this patch by using telnet to access the machine support.mayfield.hp.com and logging in as "hpslreg" and following ! the instructions there. Or you may be able to use this ! web site: ! ! HP Patch Server: http://support.mayfield.hp.com/patches/html/patches.html ! HP Support Line: http://support.mayfield.hp.com ! ! Please do not ask FSF for further support on this. If you have any ! trouble obtaining the patch, contact HP Software Support. If your buffer fills up with nulls (^@) at some point, it could well *************** IBM RS/6000 (rs6000-ibm-aix*) *** 485,489 **** There are reports that IBM compiler versions earlier than 1.03.00.02 ! fail even without -O. As of 19.11, if you strip the Emacs executable, it ceases to work. --- 491,496 ---- There are reports that IBM compiler versions earlier than 1.03.00.02 ! fail even without -O. However, another report said that compiler ! version 1.02.01.00 did work, on AIX 3.2.4, with Emacs 19.31. As of 19.11, if you strip the Emacs executable, it ceases to work. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/MAILINGLISTS emacs-19.32/etc/MAILINGLISTS *** emacs-19.31/etc/MAILINGLISTS Thu May 23 20:05:27 1996 --- emacs-19.32/etc/MAILINGLISTS Wed Jun 19 23:27:01 1996 *************** *** 1,3 **** ! GNU Project Electronic Mailing Lists. Last Updated 4 Mar 96 Please report improvements to: gnu@prep.ai.mit.edu --- 1,4 ---- ! GNU Project Electronic Mailing Lists and gnUSENET Newsgroups ! Last Updated 19 Jun 96 Please report improvements to: gnu@prep.ai.mit.edu Only in emacs-19.31/etc: MSDOS diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/NEWS emacs-19.32/etc/NEWS *** emacs-19.31/etc/NEWS Wed May 15 10:51:58 1996 --- emacs-19.32/etc/NEWS Thu Aug 1 00:58:41 1996 *************** *** 1,3 **** ! GNU Emacs NEWS -- history of user-visible changes. 15 May 1996 Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. See the end for copying conditions. --- 1,3 ---- ! GNU Emacs NEWS -- history of user-visible changes. 1 Aug 1996 Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. See the end for copying conditions. *************** Please send Emacs bug reports to bug-gnu *** 6,9 **** --- 6,274 ---- For older news, see the file ONEWS. + * Editing Changes in Emacs 19.32 + + ** C-x f with no argument now signals an error. + To set the fill column at the current column, use C-u C-x f. + + ** Expanding dynamic abbrevs with M-/ is now smarter about case + conversion. If you type the abbreviation with mixed case, and it + matches the beginning of the expansion including case, then the + expansion is copied verbatim. Using SPC M-/ to copy an additional + word always copies it verbatim except when the previous copied word is + all caps. + + ** On a non-windowing terminal, which can display only one Emacs frame + at a time, creating a new frame with C-x 5 2 also selects that frame. + + When using a display that can show multiple frames at once, C-x 5 2 + does make the frame visible, but does not select it. This is the same + as in previous Emacs versions. + + ** You can use C-x 5 2 to create multiple frames on MSDOS, just as on a + non-X terminal on Unix. Of course, only one frame is visible at any + time, since your terminal doesn't have the ability to display multiple + frames. + + ** On Windows, set win32-pass-alt-to-system to a non-nil value + if you would like tapping the Alt key to invoke the Windows menu. + This feature is not enabled by default; since the Alt key is also the + Meta key, it is too easy and painful to activate this feature by + accident. + + ** The command apply-macro-to-region-lines repeats the last defined + keyboard macro once for each complete line within the current region. + It does this line by line, by moving point to the beginning of that + line and then executing the macro. + + This command is not new, but was never documented before. + + ** You can now use Mouse-1 to place the region around a string constant + (something surrounded by doublequote characters or other delimiter + characters of like syntax) by double-clicking on one of delimiting + characters. + + ** Font Lock mode + + *** Font Lock support modes + + Font Lock can be configured to use Fast Lock mode and Lazy Lock mode (see + below) in a flexible way. Rather than adding the appropriate function to the + hook font-lock-mode-hook, you can use the new variable font-lock-support-mode + to control which modes have Fast Lock mode or Lazy Lock mode turned on when + Font Lock mode is enabled. + + For example, to use Fast Lock mode when Font Lock mode is turned on, put: + + (setq font-lock-support-mode 'fast-lock-mode) + + in your ~/.emacs. + + *** lazy-lock + + The lazy-lock package speeds up Font Lock mode by making fontification occur + only when necessary, such as when a previously unfontified part of the buffer + becomes visible in a window. When you create a buffer with Font Lock mode and + Lazy Lock mode turned on, the buffer is not fontified. When certain events + occur (such as scrolling), Lazy Lock makes sure that the visible parts of the + buffer are fontified. Lazy Lock also defers on-the-fly fontification until + Emacs has been idle for a given amount of time. + + To use this package, put in your ~/.emacs: + + (setq font-lock-support-mode 'lazy-lock-mode) + + To control the package behaviour, see the documentation for `lazy-lock-mode'. + + ** Changes in BibTeX mode. + + *** For all entries allow spaces and tabs between opening brace or + paren and key. + + *** Non-escaped double-quoted characters (as in `Sch"of') are now + supported. + + ** Gnus changes. + + Gnus, the Emacs newsreader, has undergone further rewriting. Many new + commands and variables have been added. There should be no + significant incompatibilities between this Gnus version and the + previously released version, except in the message composition area. + + Below is a list of the more user-visible changes. Coding changes + between Gnus 5.1 and 5.2 are more extensive. + + *** A new message composition mode is used. All old customization + variables for mail-mode, rnews-reply-mode and gnus-msg are now + obsolete. + + *** Gnus is now able to generate "sparse" threads -- threads where + missing articles are represented by empty nodes. + + (setq gnus-build-sparse-threads 'some) + + *** Outgoing articles are stored on a special archive server. + + To disable this: (setq gnus-message-archive-group nil) + + *** Partial thread regeneration now happens when articles are + referred. + + *** Gnus can make use of GroupLens predictions: + + (setq gnus-use-grouplens t) + + *** A trn-line tree buffer can be displayed. + + (setq gnus-use-trees t) + + *** An nn-like pick-and-read minor mode is available for the summary + buffers. + + (add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) + + *** In binary groups you can use a special binary minor mode: + + `M-x gnus-binary-mode' + + *** Groups can be grouped in a folding topic hierarchy. + + (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) + + *** Gnus can re-send and bounce mail. + + Use the `S D r' and `S D b'. + + *** Groups can now have a score, and bubbling based on entry frequency + is possible. + + (add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group) + + *** Groups can be process-marked, and commands can be performed on + groups of groups. + + *** Caching is possible in virtual groups. + + *** nndoc now understands all kinds of digests, mail boxes, rnews news + batches, ClariNet briefs collections, and just about everything else. + + *** Gnus has a new backend (nnsoup) to create/read SOUP packets. + + *** The Gnus cache is much faster. + + *** Groups can be sorted according to many criteria. + + For instance: (setq gnus-group-sort-function 'gnus-group-sort-by-rank) + + *** New group parameters have been introduced to set list-address and + expiry times. + + *** All formatting specs allow specifying faces to be used. + + *** There are several more commands for setting/removing/acting on + process marked articles on the `M P' submap. + + *** The summary buffer can be limited to show parts of the available + articles based on a wide range of criteria. These commands have been + bound to keys on the `/' submap. + + *** Articles can be made persistent -- as an alternative to saving + articles with the `*' command. + + *** All functions for hiding article elements are now toggles. + + *** Article headers can be buttonized. + + (add-hook 'gnus-article-display-hook 'gnus-article-add-buttons-to-head) + + *** All mail backends support fetching articles by Message-ID. + + *** Duplicate mail can now be treated properly. See the + `nnmail-treat-duplicates' variable. + + *** All summary mode commands are available directly from the article + buffer. + + *** Frames can be part of `gnus-buffer-configuration'. + + *** Mail can be re-scanned by a daemonic process. + + *** Gnus can make use of NoCeM files to filter spam. + + (setq gnus-use-nocem t) + + *** Groups can be made permanently visible. + + (setq gnus-permanently-visible-groups "^nnml:") + + *** Many new hooks have been introduced to make customizing easier. + + *** Gnus respects the Mail-Copies-To header. + + *** Threads can be gathered by looking at the References header. + + (setq gnus-summary-thread-gathering-function + 'gnus-gather-threads-by-references) + + *** Read articles can be stored in a special backlog buffer to avoid + refetching. + + (setq gnus-keep-backlog 50) + + *** A clean copy of the current article is always stored in a separate + buffer to allow easier treatment. + + *** Gnus can suggest where to save articles. See `gnus-split-methods'. + + *** Gnus doesn't have to do as much prompting when saving. + + (setq gnus-prompt-before-saving t) + + *** gnus-uu can view decoded files asynchronously while fetching + articles. + + (setq gnus-uu-grabbed-file-functions 'gnus-uu-grab-view) + + *** Filling in the article buffer now works properly on cited text. + + *** Hiding cited text adds buttons to toggle hiding, and how much + cited text to hide is now customizable. + + (setq gnus-cited-lines-visible 2) + + *** Boring headers can be hidden. + + (add-hook 'gnus-article-display-hook 'gnus-article-hide-boring-headers) + + *** Default scoring values can now be set from the menu bar. + + *** Further syntax checking of outgoing articles have been added. + + The Gnus manual has been expanded. It explains all these new features + in greater detail. + + * Lisp Changes in Emacs 19.32 + + ** The function set-visited-file-name now accepts an optional + second argument NO-QUERY. If it is non-nil, then the user is not + asked for confirmation in the case where the specified file already + exists. + + ** The variable print-length applies to printing vectors and bitvectors, + as well as lists. + + ** The new function keymap-parent returns the parent keymap + of a given keymap. + + ** The new function set-keymap-parent specifies a new parent for a + given keymap. The arguments are KEYMAP and PARENT. PARENT must be a + keymap or nil. + + ** Sometimes menu keymaps use a command name, a symbol, which is really + an automatically generated alias for some other command, the "real" + name. In such a case, you should give that alias symbol a non-nil + menu-alias property. That property tells the menu system to look for + equivalent keys for the real name instead of equivalent keys for the + alias. + * Editing Changes in Emacs 19.31 *************** documentation of variables `mail-directo *** 170,174 **** skeletons with completing read for tags and attributes, typing named characters including optionally all 8bit characters, making tags invisible ! with optional alternate display text, skipping and deleting tag(pair)s Note: since Emacs' syntax feature cannot limit the special meaning of ', " and --- 435,439 ---- skeletons with completing read for tags and attributes, typing named characters including optionally all 8bit characters, making tags invisible ! with optional alternate display text, skipping and deleting tag(pair)s. Note: since Emacs' syntax feature cannot limit the special meaning of ', " and *************** headline or C-c u for unordered list (se *** 181,185 **** Text Properties / Face or M-g combinations create tags as applicable. Outline minor mode is supported and level 1 font-locking tries to ! fontify tag contents (which only works when they fit on one line due to a limitation in font-lock). --- 446,450 ---- Text Properties / Face or M-g combinations create tags as applicable. Outline minor mode is supported and level 1 font-locking tries to ! fontify tag contents (which only works when they fit on one line, due to a limitation in font-lock). *************** command M-x follow-delete-other-windows- *** 265,269 **** The hooks hs-hide-hooks and hs-show-hooks have been renamed ! to hs-hide-hook and hs-show-hook. to follow the convention for normal hooks. --- 530,534 ---- The hooks hs-hide-hooks and hs-show-hooks have been renamed ! to hs-hide-hook and hs-show-hook, to follow the convention for normal hooks. *************** call looks like this: *** 371,381 **** SECS says how many seconds of idleness should elapse before the timer ! happens. It may be an integer or a floating point number. When the timer becomes ripe, the action is to call FUNCTION with arguments ARGS. REPEAT, if non-nil, means this timer should be activated again each ! time Emacs becomes idle. If REPEAT is nil, the timer runs just once, ! the first time Emacs is idle for SECS seconds. *** post-command-idle-hook is now obsolete; you shouldn't use it at --- 636,654 ---- SECS says how many seconds of idleness should elapse before the timer ! runs. It may be an integer or a floating point number. When the timer becomes ripe, the action is to call FUNCTION with arguments ARGS. + Emacs becomes idle whenever it finishes executing a keyboard or mouse + command. It remains idle until it receives another keyboard or mouse + command. + REPEAT, if non-nil, means this timer should be activated again each ! time Emacs becomes idle and remains idle for SECS seconds The timer ! does not repeat if Emacs *remains* idle; it runs at most once after ! each time Emacs becomes idle. ! ! If REPEAT is nil, the timer runs just once, the first time Emacs is ! idle for SECS seconds. *** post-command-idle-hook is now obsolete; you shouldn't use it at *************** the tar file. *** 6182,6186 **** Copyright information: ! Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies --- 6455,6459 ---- Copyright information: ! Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc. Permission is granted to anyone to make or distribute verbatim copies *************** Copyright (C) 1993, 1994, 1995 Free Soft *** 6195,6199 **** Local variables: ! mode: text end: --- 6468,6473 ---- Local variables: ! mode: outline ! paragraph-separate: "[ ]*$" end: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/ORDERS.JAPAN emacs-19.32/etc/ORDERS.JAPAN *** emacs-19.31/etc/ORDERS.JAPAN Sat Mar 16 15:24:18 1996 --- emacs-19.32/etc/ORDERS.JAPAN Mon Jul 8 20:07:13 1996 *************** Prices and contents may change without n *** 35,41 **** yet to the Compiler Tools Binaries CD-ROM.) - * Source Code on Tape Y30,000 ________ __________ - (per tape; see the next page for more details.) - Emacs manual, with reference card Y3,700 ________ __________ (Eleventh Edition for Version 19.29) --- 35,38 ---- *************** number, and your signature. Bank transf *** 159,172 **** following account: ! Bank: Sanwa Bank ! Branch: Azabu Branch (#620) ! Account name: Free Software Foundation ! Account number: 3683216 Prices and contents may change without notice after June 30, 1996. All software and publications are distributed with permission to copy and to ! redistribute. Texinfo source for each manual is on the Source Code CD-ROM ! and/or on the appropriate tape. We will ship the latest version of each ! manual, unless you instruct us otherwise. The minimum order amount (before postage) is Y5,000. The FSF regrets that it --- 156,169 ---- following account: ! Bank: Sanwa Bank ! Branch: Azabu Branch (#620) ! Account name: Free Software Foundation ! Account number: 3683216 Prices and contents may change without notice after June 30, 1996. All software and publications are distributed with permission to copy and to ! redistribute. Texinfo source for each manual is on the Source Code CD-ROM. ! We will ship the latest version of each manual, unless you instruct us ! otherwise. The minimum order amount (before postage) is Y5,000. The FSF regrets that it *************** Stallman in Japan. The price for the co *** 183,222 **** For more information, contact the FSF directly. ! Software may also be ordered on magnetic tape. The following tape titles are ! available: ! * Lisps/Emacs ! * Languages ! * Utilities ! * Scheme ! * 4.4BSD-Lite ! * X11R6-Required ! X11R6-Optional ! X11R5-Required ! X11R5-Optional ! ! The following tape formats are available: ! ! Generic Unix tar 9-track 1600bpi 1/2" reel tape ! ! Generic Unix tar DAT 4mm cartridge tape ! ! Generic Unix tar Exabyte 8mm cartridge tape ! ! Sun Unix tar QIC-24 DC300XLP 1/4" cartridge tape ! (may also be read on other systems) ! ! HP Unix tar 16-track DC600HC 1/4" cartridge tape ! ! IBM RS/6000 Unix tar QIC-150 DC600A 1/4" cartridge tape ! (may also be read on other systems) ! ! VMS backup 9-track 1600bpi 1/2" reel tape ! (only two titles: GNU Emacs and GCC/GAS/Bison) ! ! Please indicate your desired tape titles and formats on a separate sheet of ! paper and fax that along with your order. If you need information regarding ! which programs are on which tapes, please consult the Japanese edition of the ! January 1996 GNU Bulletin. If you do not have a copy of the Japanese edition ! of the GNU Bulletin, please contact the FSF. For T-shirt orders, please circle desired color. --- 180,186 ---- For more information, contact the FSF directly. ! If you need further information about the FSF and it offerings, please consult ! the Japanese edition of the January 1996 GNU's Bulletin. If you do not have a ! copy of the Japanese edition of the GNU's Bulletin, please contact the FSF. For T-shirt orders, please circle desired color. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/SERVICE emacs-19.32/etc/SERVICE *** emacs-19.31/etc/SERVICE Sun Mar 10 07:42:09 1996 --- emacs-19.32/etc/SERVICE Fri Jul 26 10:22:05 1996 *************** *** 1,3 **** ! -*- text -*- GNU Service Directory --------------------- --- 1,3 ---- ! -*- text -*- GNU Service Directory --------------------- *************** For a current copy of this directory, or *** 39,43 **** --- 39,65 ---- ** Please keep the entries in this file alphabetical ** +  + Magnus Alvestad + + GNU Emacs, GCC, the Unix tools. + + Rates: Free, or from $50/hour. + + Entered: 1996-07-09 +  + AO UrbanSoft + St. Petersburg State University Science Campus + St. Petersburg, Russia + www.usoft.spb.ru + AO UrbanSoft packages, markets and supports + industry standard free software products, + including the Linux operating system and + TeX document compiler. + The company also provides programming + services based on TeX, HTML, WWW and Perl. + Rates approximately 20 USD per hour. + + Updated: 1996-06-26  Joseph Arceneaux *************** particular job. I am also very interest *** 66,72 **** selected non-profit organizations with worthy goals, I work for free. ! Updated: 17Oct95  ! Gerd Aschemann Osannstr. 49 D-64285 Darmstadt --- 88,94 ---- selected non-profit organizations with worthy goals, I work for free. ! Updated: 1995-10-17  ! Gerd Aschemann Osannstr. 49 D-64285 Darmstadt *************** http://www.informatik.th-darmstadt.de/~a *** 75,83 **** - System Administrator (UNIX) at CS Department, TU Darmstadt, Germany ! - 15 years expirience with CS, Systemadministration on different platforms ! - 8 years with UNIX/Networking/FreeWare/GNU/X11 ! - 6 years organizer of Operating Systems and Distributed Systems courses - Lectures on System and Network Administration ! - Platforms: Solaris, SunOS, Ultrix, OSF1, HP-UX, Linux, FreeBSD, AIX - Experience with parallel environments (Connection Machine, Meiko, Parsytec) - Consultant for other UNIX users at TU Darmstadt --- 97,106 ---- - System Administrator (UNIX) at CS Department, TU Darmstadt, Germany ! - 16 years expirience with CS, Systemadministration on different platforms ! - 9 years with UNIX/Networking/FreeWare/GNU/X11 ! - 7 years organizer of Operating Systems and Distributed Systems courses - Lectures on System and Network Administration ! - Platforms: Solaris, SunOS, Ultrix, OSF1, HP-UX, Linux, FreeBSD, AIX, SCO ! - Distributed Platforms and Information Systems (CORBA, WWW, Java, FTP) - Experience with parallel environments (Connection Machine, Meiko, Parsytec) - Consultant for other UNIX users at TU Darmstadt *************** Rates are at 100,-- DM (~60 US$) per hou *** 86,90 **** I am willing to travel for sufficiently large jobs. ! Updated: 17Oct95  Giuseppe Attardi --- 109,113 ---- I am willing to travel for sufficiently large jobs. ! Updated: 1996-06-24  Giuseppe Attardi *************** I-56125 Pisa, Italy *** 94,101 **** +39 50 887-244 ! GNU: help on obtaininig GNU, for italian sites. ! Updated: 5Apr94  James Craig Burley 97 Arrowhead Circle --- 117,232 ---- +39 50 887-244 ! GNU: help on obtaining GNU, for italian sites. ! Updated: 1994-04-05  + Basis Technology Corp. + One Kendall Square, Bldg 200 + Cambridge, MA 02139 + U.S.A. + + Tel: +1-617-252-5636 + Fax: +1-617-252-9150 + E-mail: + Web: http://www.basistech.com + + Technical Expertise: + Multilingual software development + Internationalization and localization of software products + International character encodings, including Unicode, ISO-10646, + ISO-2022, ISO-8859-n, JIS, KSC5601, BIG5, GB2312 + Translation of technical materials into Japanese, Korean, and Chinese + including HTML, SGML, RTF, MIF, etc. + + GNU-related Services: + Custom internationalization and localization of GNU software, or + applications developed using GNU tools (GCC, G++, Emacs Lisp, etc.) + Custom multilingual application development based on MULE. + + GNU Contributions: + Organized 1992, 1993, and 1994 fund-raising seminars and lecture + tours for FSF in Japan. + Negotiated book royalty agreements with Japanese publishers on + behalf of the FSF. + Negotiated hardware contributions from Japanese PC vendors to + the FSF. + + Contacts: + Carl Hoffman, Steve Cohen, or Karen Watts + + Entered: 1996-07-15 + ^_ + Laurent Bernardin + 16, rue Dicks + L-6944 Niederanven + Luxemburg + + +41 1 632 7469 + + Support and installation of all GNU software. + + Expertise: C, C++, Java, Motif, X, Unix administration, network security + + Rates: ~60 US$ / hour (Flux 2000.-) + + Entered: 1996-07-16 + ^_ + Paul Black + Sydney, Australia + + I am available for general consulting on GNU software. My specific + areas of interest are: + - general C, C++, ADA and APL programming + - Gnu/unix utilities + - Troff + - Real Time Software + - Linux + - IP Comms, SMTP, NNTP, HTTP and WWW + - Simulation + + I am happy to provide free consulting/services if the work is of the order of + a couple of hours. If more time is required, I am happy to negotiate depending + on the nature of the work, my indicative rate is $40 per hour. + + Entered: 1996-07-10 + ^_ + Keith Bostic + + I'm interested in supporting/extending the ex/vi editors, + which I wrote. On-site or by email, rates are based on the + project. + + Entered: 1996-07-15 + ^_ + Philip Brown + + (703) 893-8967 (prefer email) + Northern-VA, D.C. Area + Rates: $40/Hr; less for educational or charitable organizations + + Systems Supported: + HP9000/7xx running HP/UX 8.07 - 10.X + IBM RS6000 running AIX 3.2.X + Also SGI/Indy and Sun/Sparcs + + Software Supported: + Most all FSF (Gnu) software + esp. GCC, Emacs, Binutils, GS, etc... + + Statement: + + I'd be more than happy to assist anyone in my area with acquiring, + installing, and configuring any FSF tools/utilities on any of the + above systems. I can help with other systems but I won't make any + guarantees about them... I'm also willing to share my many years + of experience with anyone having difficulty with these tools. I've + been installing and using them for about 5 years now and I'll + swear by their quality and the people/principles that made them + available. + + Phil Brown + + Entered: 1996-07-15 + ^_ James Craig Burley 97 Arrowhead Circle *************** Expertise: *** 120,131 **** languages, and so on ! Rate: $70/hour -- willing to consider flat-fee arrangements ! Updated: 14Aug95  ! Michael I. Bushnell ! 545 Technology Square, NE43-426 ! Cambridge, MA 02139 ! (617) 253-8568 All GNU software: Installation, customization, answering simple or --- 251,264 ---- languages, and so on ! Rate: $90/hour -- willing to consider flat-fee arrangements ! Updated: 1996-06-26  ! Michael I. Bushnell, p/BSG ! Becket House ! 66 Highland Ave. No. 8 ! Somerville, MA 02143 ! (617) 623-0654 ! All GNU software: Installation, customization, answering simple or *************** I am willing to travel for sufficiently *** 141,152 **** Rates: $100/hr, negotiable, less for non-profit organizaions. ! Updated: 5Apr94  ! C2V Renaud Dumeur ! 82 bd Haussmann Michel Delval ! 75009 Paris Jean-Alain Le Borgne France ! Tel (1) 40.08.07.07 ! Fax (1) 43.87.35.99 We offer source or source+binary distribution, installation, training, --- 274,286 ---- Rates: $100/hr, negotiable, less for non-profit organizaions. ! Updated: 1996-07-09  ! C2V Michel Delval ! 82 bd Haussmann Jean-Alain Le Borgne ! 75008 Paris France ! Tel (33 1) 40.08.07.07 ! Fax (33 1) 43.87.35.99 ! Compuserve 100413,1012 We offer source or source+binary distribution, installation, training, *************** Rates: from 2000 FF/day to 150 000 FF/ye *** 165,169 **** educational institutions, add taxes and expenses. Ask for list. ! Entered: 5May94  Contributed Software --- 299,303 ---- educational institutions, add taxes and expenses. Ask for list. ! Updated: 1996-06-26  Contributed Software *************** sites and configuration management. Tra *** 186,191 **** Free Archive login for downloading on above modem numbers. ! Updated: 5Apr94  Stuart Cracraft 25682 Cresta Loma --- 320,352 ---- Free Archive login for downloading on above modem numbers. ! Updated: 1994-04-05 ! ^_ ! Kevin Cosgrove ! ! ! I can help folks with porting & installation of many GNU ! and X packages on a variety of Unix platforms. ! ! ! My rates depend on the scope of each project but range ! from $35 to $90 per hour. ! ! Entered: 1996-07-15  + Couvares Consulting + 146 Mill Lane + Amherst, MA 01002, USA + Phone: (413) 253-2589 + EMail: + Contact: Peter F. Couvares + + Type of support: We offer phone/email support, installation, ongoing + administration, training, programming, and specialized consulting for + free software and other UNIX systems. + + Sample prices: USD50/hour commercial, USA25/hour nonprofit, sliding scale for individuals. + + Entered: 1996-07-15 + ^- Stuart Cracraft 25682 Cresta Loma *************** to Solaris (System V Release 4). Experti *** 205,210 **** Customized programming also available. ! Entered: 5Apr94 !  Cygnus Support 1937 Landings Drive ...uunet!cygint!info --- 366,371 ---- Customized programming also available. ! Updated: 1996-06-26 ! ^_ Cygnus Support 1937 Landings Drive ...uunet!cygint!info *************** configurations. *** 229,243 **** Updated: 2Feb95  Edgar Der-Danieliantz ! P.O. Box 10 ! Yerevan 375009 AM ARMENIA ! ! Support for GCC (C & Objective C), X Window System, World Wide Web, x86-based embedded systems, logic programming, etc. ! Via Internet (mail, talk, irc, etc.) ! Experience: OS's: 4.3 & 4.4 BSD, SVR3.2 & 4.2, FreeBSD, Linux, --- 390,423 ---- Updated: 2Feb95 + ^_ + Marcus G. Daniels + 31060 S. Kaufman Rd. + Canby, OR 97013-9520 + (503) 651-2694 + + I can customize, extend, port, and repair many types of free software. + I maintain the CLISP Common Lisp implementation and contribute to + several GNU packages, such as Emacs. Ten years of C and Unix + experience. + + Consulting rates are negotiable, but starting at around $40 US/hr. + I like fixed price contracts. Commuting about the Pacific Northwest US + is practical for me and travel is fine for larger projects. + + Feel free to email me if you have a problem in mind or would like an + estimate. I may also be able to assist in redirecting you. + + Entered: 1996-07-15  Edgar Der-Danieliantz ! P.O. Box 10 ! Yerevan 375009 AM ARMENIA ! ! Support for GCC (C & Objective C), X Window System, World Wide Web, x86-based embedded systems, logic programming, etc. ! Via Internet (mail, talk, irc, etc.) ! Experience: OS's: 4.3 & 4.4 BSD, SVR3.2 & 4.2, FreeBSD, Linux, *************** Experience: *** 246,250 **** Bourne Shell, PostScript, HTML, Prolog. Platforms: Intel, SPARC, Mac, VAX, NeXT. ! Rates: Depending on type of work, appx $20/hour. Contact for more information. Negotiable for individuals and non-profit organizations. --- 426,430 ---- Bourne Shell, PostScript, HTML, Prolog. Platforms: Intel, SPARC, Mac, VAX, NeXT. ! Rates: Depending on type of work, appx $20/hour. Contact for more information. Negotiable for individuals and non-profit organizations. *************** Rates: Depending on type of work, appx $ *** 252,256 **** Payment by international wire transfer. ! Entered: 6Mar96  Free Software Association of Germany --- 432,436 ---- Payment by international wire transfer. ! Entered: 1996-03-06  Free Software Association of Germany *************** ert (24h Emergency *** 274,278 **** response team) : 300 US$ / hour ! Entered: 14Apr94  Noah Friedman --- 454,458 ---- response team) : 300 US$ / hour ! Entered: 1994-04-14  Noah Friedman *************** or anywhere accessible on the Internet. *** 297,304 **** to travel. ! Updated: 16Aug95  Ronald F. Guilmette ! Infinite Monkeys & Co. 1751 East Roseville Pkwy. #1828 Roseville, CA 95661 --- 477,484 ---- to travel. ! Updated: 1996-06-26  Ronald F. Guilmette ! RG Consulting 1751 East Roseville Pkwy. #1828 Roseville, CA 95661 *************** Other qualifications: *** 340,363 **** Rates: Variable depending upon contract duration. Call for quote. ! Updated: 23Sep95 !  ! Hundred Acre Consulting ! 1155 W Fourth St Ste 225 ! PO Box 6209 ! Reno NV 89513-6209 ! (702)-348-7299 ! Hundred Acre is a consulting group providing support and development ! services to organizations of all sizes. We support GNU C++ and C in ! particular, but also provide support for all other GNU software and ! certain non-GNU public domain software as well. We work on a "service ! contract" basis for support -- for a yearly fee, we provide multiple ! levels of email and toll free telephone support, and free updates and ! bug fixes. The highersupport levels have on-site support. Development ! is charged on either an hourly or fixed bid basis. ! ! Consulting rates: $70 to $90 per hour, or fixed bid. ! Support contracts: Several levels, from $495 to $90000 per year. ! ! Updated: 27Dec94  Interactive Information Limited --- 520,524 ---- Rates: Variable depending upon contract duration. Call for quote. ! Updated: 1996-06-26  Interactive Information Limited *************** You can contact us *** 384,415 **** Scotland ! Entered: 13Nov95  ! Scott D. Kalter 2032 Corral Canyon Malibu, CA 90265-9503 Home: (310) 456-0254 ! Very familiar with all levels of Elisp programming. Taught Emacs use ! and customization in universities and industry. Extensive ! troubleshooting and user support experience. Co-developed an ! object-oriented extension to Elisp (Eoops) that can be used for ! projects. Extensive Elisp level modification for rapid prototyping of ! designs used in groupware research. This includes the development of ! an infrastructure to support multiple, communicating Emacs processes. ! Prefer e-mail communication to telephone calls. ! Updated: 1996-07-15  KAMAN SCIENCES CORPORATION *************** hourly or as a fixed price contract. *** 433,438 **** Consulting rates: $70 to $200 per hour. ! Entered: 13Jan95 !  Scott J. Kramer P.O. Box 620207 --- 584,633 ---- Consulting rates: $70 to $200 per hour. ! Entered: 1995-01-13 ! ^_ ! Ehud Karni ! ! I am an UNIX system programmer. My skills include writing in C and scripts. ! ! In the GNU domain, I consider myself an expert on Emacs. I have written several ! packages in emacs-lisp (.el) including: better Hebrew support, another marking ! system, emulation for CDC full screen editor (FSE), COBOL mode, mathematical ! expression computing, and enhancements to vc.el (customization) and to ange-ftp ! (added Novell and NT operating systems). ! I have installed and tested Emacs and my el's on several machines: DG, ! HP, Alpha (OSF) and PC (DOS). ! I installed and worked with several other GNU packages - RCS, Gmake, GCC ! and more, but I'm not an expert in these packages. ! ! I work in Israel and my normal rate is $40 per hour. ! ! Entered: 1996-07-15 !  ! Joseph R. Kiniry ! Caltech Mailstop 256-80 http://www.cs.caltech.edu/~kiniry/ ! Pasadena, CA 91125 ! Phone: 818-395-6846 ! Fax: 818-792-4257 ! ! Long-term high-level consultant in a variety of domains. See ! http://www.cs.caltech.edu/~kiniry/resume.html for more information on ! professional and academic background. ! ! I provide installation, porting, debugging, customization, design, and ! development of GNU and other UNIX and non-UNIX software. I am or have ! been a certified developer with Microsoft, SunSoft, NeXT, and Amiga. ! I have a great deal of development and management experience and an ! extremely broad background which contributes to my excellent system ! integration capabilities. I have a special expertise and conduct ! research in distributed technologies. ! ! Time and material rates for local work vary regionally, but are ! currently $200 per hour on the west coast. Other rates apply for ! long-term jobs (day rates, travel, etc.) and remote work (usually 1/2 ! fee). I am interested in fixed-bid jobs and will work for lower rates ! for non-profit organizations and educational institutions. ! ! Entered: 1996-07-24 ! ^_ Scott J. Kramer P.O. Box 620207 *************** Systems Administration: Sun (SunOS & So *** 450,469 **** Rate: Task- and time-dependent; non-monetary offers accepted. ! Updated: 12Apr94 !  ! Fen Labalme ! http://www.smart.net/~bkuhn ! ! I am available for primarily Unix system administration consulting, including ! but not limited to installation, configuration and integration of GNU tools ! and other copy-lefted software such as GNU/Linux. ! ! I am particularly skilled at user hand-holding and assisting in the ! integration of GNU and other copy-lefted software into new environments that ! have not used such tools in the past. ! ! Please visit my homepage for more information on my background and skills. ! ! I am available for both 1099 (preferred) and W2 contracting in the Baltimore, ! MD metropolitan area. My rate is in the $40/hour range, depending on the ! circumstances. Rates for non-profit organizations are substantially lower, ! and possibly free. ! ! Entered: 1996-07-15 !  ! Fen Labalme ! CoMedia Consulting //www.comedia.com ! 40 Carl Street #4 ! San Francisco CA 94117 WE ARE EVERYWHERE ! (415) 731-1174 JUST SAY "KNOW" Consulting, installation, customization and training for GNU Emacs, ! and selected other GNU & network software. Design & implementation ! of free software projects, as well as software engineering & system ! design. I have been hacking Emacs since '76 when it was TECO and ^R ! macros (don't ask), and am inter/intra-network, UNIX & Web friendly. ! ! Rates: $75 hour & up, depending; flat rate jobs considered. ! Lower rates, barter or free for selected non-profits. ! Updated: 1996-07-15  Greg Lehey *************** products. *** 481,485 **** Experience: 20 years OS and compiler experience, portations of most ! GNU products. Author of ported software CD-ROM for Unix 4.2. Rates: Choice of DM 150 per hour or hotline rates 3 DM per minute + 10 --- 699,705 ---- Experience: 20 years OS and compiler experience, portations of most ! GNU products. Author of ported software CD-ROM for Unix 4.2, "Porting ! UNIX Software" (O'Reilly), "Installing and Running FreeBSD" and "The ! Complete FreeBSD" (both Walnut Creek). Rates: Choice of DM 150 per hour or hotline rates 3 DM per minute + 10 *************** DM per phone call. Quick questions may b *** 487,491 **** available for purchasers of LEMIS CD-ROMs. ! Updated: 21Feb95  Marty Leisner --- 707,711 ---- available for purchasers of LEMIS CD-ROMs. ! Updated: 1996-07-06  Marty Leisner *************** Degree : BS CS, Cornell University *** 500,538 **** Rates: $75/hr - - marty ! Updated: 15Apr94  Richard Levitte (in TeX: Richard Levitte ! Södra Långgatan 39, II S\"odra L{\aa}nggatan 39, II ! S-171 49 Solna S-171 49 Solna Sweden Sweden) ! Tel.nr.: +46 (8) 18 30 99 (there is an answering machine) ! e-mail: (preferred) ! What I do: ! Primarly I work on GNU software for VMS, both VAX and AXP. I ! also work on GNU stuff for Unix on occasion. I'm familiar with ! SunOS (version 4.x.x), BSD (version 4.2 and up), ! Ultrix (version 4.2 and up). ! I've been porting GNU Emacs to VMS since spring 1991. This ! includes versions 18.57 to 18.59 and version 19.22. ! I maintain GNU vmslib. Programs supported: ! GNU vmslib: extending, installation, upgrading aid, ! simple and complex questions, you name it. ! GNU Emacs: porting, extending, installation, upgrading aid, ! customization, simple or complex questions, ! training, you name it. ! GNU autoconf: porting, extending, installation, upgrading aid. ! GNU zip, diffutils, m4, patch, texinfo: ! porting, installation, upgrading aid. ! GNU C/C++: installation, upgrading aid. I might start to ! hack at it some day. The list of programs I currently support represents both my interests and --- 720,801 ---- Rates: $75/hr marty ! Updated: 1994-04-15 ! ^_ ! Rohan Lenard ! 32 Holtermann St, ! Crows Nest, NSW 2065 ! AUSTRALIA ! +61 411250024 ! ! * The person behind much of bug-g++@prep.ai.mit.edu interaction - also known ! as . ! ! * Interested in providing first line support down-under. ! ! Experience: 10+ years C/Unix, 6+ years C++ ! Extensive experience with GNU tools, cross-compilers, ! embedded/hosted systems, realtime, simulations, ! and military software. ! ! Degrees: BSc (CS), BE (Comms), University of Melbourne ! ! Rates: AUS $75+/hr neg. ! ! Entered: 1996-07-17 ! ^_ ! Reuven M. Lerner ! 17 Disraeli Street ! Haifa 34333 ! Israel ! Telephone: 04-824-2265 (within Israel) ! +972-4-824-2265 (outside of Israel) ! http://www.netvision.net.il/php/reuven ! ! - System and network administration, especially Linux systems and ! networks ! - Administration, training, and programming for Internet nodes and ! World-Wide Web sites ! - Installation, support and training in the use of Linux, Emacs, Perl, ! and other free software ! - Expertise in C, Emacs Lisp, and Perl ! ! Consulting rates: $50-75/hour, less for non-profit organizations. ! ! Entered: 1996-07-10  Richard Levitte (in TeX: Richard Levitte ! Levitte Programming Levitte Programming ! Spannvdgen 38, I Spannv\"agen 28, I ! S-161 43 Bromma S-161 43 Bromma Sweden Sweden) ! Tel.nr.: +46 (8) 26 52 47 (there is an answering machine) ! e-mail: What I do: ! Primarly I work on GNU software for VMS, both VAX and AXP. I ! also work on GNU stuff for Unix on occasion. I'm familiar with ! SunOS (version 4.x.x), BSD (version 4.2 and up), ! Ultrix (version 4.2 and up) and Linux/Slackware. ! I've been porting GNU Emacs to VMS since spring 1991. This ! includes versions 18.57 to 18.59 and versions 19.22 and 19.28. ! I've also ported a few other programs, most notably autoconf ! version 1.x. Version 2.x is underway at the time of updating ! this entry. ! I maintain GNU vmslib. Programs supported: ! GNU vmslib: extending, installation, upgrading aid, ! simple and complex questions, you name it. ! GNU Emacs: porting, extending, installation, upgrading aid, ! customization, simple or complex questions, ! training, you name it. ! GNU autoconf: porting, extending, installation, upgrading aid. ! GNU zip, diffutils, m4, patch, texinfo: ! porting, installation, upgrading aid. ! GNU C/C++: installation, upgrading aid. I might start to ! hack at it some day. The list of programs I currently support represents both my interests and *************** current priorities. Your interest and f *** 540,560 **** Experience: ! Fluent in C, C++, Emacs Lisp, Pascal as well as assembler ! on VAX, Motorola 680x0, Intel 8086 and 80x86. Modified key ! elements in Emacs (e.g., memory and process management) to work ! transparently on VMS. I have very good knowledge in the VMS ! operating system, as well as MS-DOS and IBM PC compatibles. ! I have worked for four and a half years as a VMS system manager. ! I've also provided consulting services on IBM PC compatibles, ! as well as held classes for IBM PC users. ! A reference list is available on request. Your Rate: ! $50-$80/hour (400-700 SEK in sweden), plus expenses. My rates ! are negotiable, depending on how interesting the project is to me. ! Entered: 18Aug94 !  Roland McGrath 545 Tech Sq, Rm 426 --- 803,885 ---- Experience: ! Fluent in TeX/LaTeX, C, C++, Perl, Emacs Lisp, Pascal as well as ! assembler on VAX, Motorola 680x0, Intel 8086 and 80x86. Modified ! key elements in Emacs (e.g., memory and process management) to ! work transparently on VMS. I have very good knowledge in the VMS ! operating system, as well as MS-DOS and IBM PC compatibles. ! I'm also knowledged in the a few Unix flavors. ! I have worked for four and a half years as a VMS system manager. ! I've also provided consulting services on IBM PC compatibles, ! as well as held classes for IBM PC users. ! A reference list is available on request. Your Rate: ! $70-$100/hour (500-800 SEK in sweden), plus expenses. My rates ! are negotiable, depending on how interesting the project is to me. ! $70-$100/hour (500-800 SEK in sweden), plus expenses. My rates ! are negotiable, depending on how interesting the project is to me. ! ! Updated: 1996-06-26 !  ! Gord Matzigkeit ! 2220 Capitol Hill Crescent http://www.enci.ucalgary.ca/~gord/ ! Calgary, Alberta T2M 4B9 Voice: (403) 282-1387 ! CANADA BBS: (403) 282-3919 ! ! I care more about people than I do computers. I enjoy helping novices ! learn more about free software, and I want to make free software fit ! *your needs* rather than vice versa. ! ! I am eager to help install badly-behaved source code packages, and have ! experience fixing them to conform to GNU standards. ! ! I am the maintainer of GNU dld and GNU libtool. I am very interested in ! dynamic technology, especially adaptive and highly flexible systems. ! ! I have administered free and proprietary systems in the departments of ! Civil, Electrical, and Undergraduate Engineering at the University of ! Calgary. I know how to diagnose a complex existing computer system and ! incrementally replace it with a superior free system without disrupting ! service. ! ! I have over 2 years of experience with all the major free operating ! systems: FreeBSD, GNU/Hurd, GNU/Linux, and NetBSD. I also have ! experience with some of the Project Athena distributed system tools: ! Hesiod, Kerberos 5, Moira, and Zephyr. ! ! I don't believe in making more money than I need. My rates start at ! $10/hr (dirt cheap). When I am not starving, I do not charge worthy ! non-profit organizations. ! ! Entered: 1996-07-15 ! ^_ ! Andrew McCallum ! 6623 Dalzell Place ! Pittsburgh, PA 15217 ! Home: (412) 422-0688 ! ! http://www.cs.rochester.edu/u/mccallum ! ! Services: Support, enhancements, new development in: ! GNU Objective C ! GNUstep, both graphical and non-graphical. ! GNUstep Base Library: libgnustep-base ! (especially Distributed Objects) ! Interface between Objective-C and Guile or TCL: libguileobjc. ! ! Experience: 10+ years of UNIX experience. ! Programming for NeXTSTEP since version 0.8, 1988. ! MA and PhD in Computer Science. ! Extensive work on GNU Objective C Runtime. ! Author of GNUstep Base Library, including Distributed Objects ! FSF Chief Maintainer of the GNUstep Project. ! Contributor to GCC, Emacs, Guile. ! C, Objective-C, Postscript, Scheme, Lisp, ELisp, Linux. ! English and Francais. + Rates: $90-$150 / hour, negotiable, depending on many variables. ! Entered: 1996-07-15 ! ^_ Roland McGrath 545 Tech Sq, Rm 426 *************** only jobs that either can be done entire *** 576,580 **** short-term, or that are very interesting. ! Updated: 21Jan95  Erik Naggum --- 901,905 ---- short-term, or that are very interesting. ! Updated: 1995-01-21  Erik Naggum *************** Please call only about actual work, I pr *** 602,605 **** --- 927,1034 ---- I accept VISA and Mastercard, preferred for remote jobs and small amounts. + + Updated: 1996-06-28 + ^_ + NET-Community + 38403 Pelton Road http://www.net-community.com + Willoughby, OH 44094 USA finger info@net-community.com + 1-800-919-0060 voice + 1-216-946-7884 voice + 1-216-953-5829 fax + + NET-Community provides support for the complete GNUstep toolset including + the Objective-C runtime within GCC, the GNUstep Base Library, the GNUstep + GUI Library, the GNUstep X/DPS GUI Backend, and the GNUstep Database + Library. NET-Community also provides support for its own MediaBook software + including the MediaBook Random Library and the MediaBook Speech Synthesis + Library. NET-Community actively supports and develops free software on all + GNUstep platforms; a portion of the proceeds, usually 20%, generated from + CD-ROM sales go towards additional development and enhancement of GNUstep. + + Entered: 1996-07-25 + ^_ + Open Systems Consultants a.s + St. Olavsgt. 24 + N-0166 OSLO + NORWAY + + Phone: Fax: + +47 22 20 40 50 +47 22 20 02 85 + + Web: E-mail: + http://www.osc.no + + Open Systems Consultants a.s can provide programming support for all + GNU software -- extending or adopting it to meet customer needs. + Prices vary with software and project. Hourly fees are in the $80-120 + range. Fixed-priced projects are also available. No phone support. + + Entered: 1996-07-17 + ^_ + Francesco Potorti` + Via S.Stefano, 8 + 56123 Pisa, Italy + Tel. (050)560671 + + Emacs: installation and maintenance, training and tutorials, + customisation, extensions, troubleshooting. Author of some of + the packages in the emacs distribution, has made the porting + of emacs to the Motorola Delta architecture. + + Other: installation and maintenance of GNU software. Experience with + RCS, gperf, etags, smail, indent, diff, gawk, gcc, screen. Is + the current maintainer of etags. + + Rates: 30-80 KL/hr, depending on experience on the particular task. + Average is 50 KL/hr $50/hr. + Prefer e-mail communication to telephone. + + Qualifications: Electronic Engineering degree, Pisa. Full time + researcher in CNUCE-CNR. + Familiar with elisp programming and porting of C programs. + + Entered: 1996-07-10 + ^_ + Dipl.-Inform. Klaus Kdmpf + proGIS Software + Jakobstr. 117 + D-52064 Aachen + Germany + http://www.progis.de + Tel +49 241 470670 + Fax +49 241 4706729 + + - 15 years C/Unix experience + - 6 years VMS experience + - Ported BFD library, Binutils, GNU Assembler, and GNU C + to openVMS/Alpha. + + We do a lot of cross-platform (Unix-VMS-WindowsNT) development + mostly with the GNU compiler environment. We are actively + supporting GNU software on openVMS/Alpha. + + Rates start at 160.- DM / hour for support and + installation. Larger projects are negotiable. + + Entered: 1996-07-25 + ^_ + Quiotix Corporation + Menlo Park, CA + + Contact: Jeffrey Siegal + jbs@quiotix.com + 415 324-0535 + + Area of focus: Embedded systems--using GNU software to develop for + embedded systems, porting GNU software to embedded systems, extending GNU + software to better support embedded environments, developing new tools and + utilities for embedded development using GNU software. + + Services: porting, development, support, project management, advisory + consulting. + + Rates: $125-$250/hour or fixed fees depending on services provided. + + Entered: 1996-07-10  Wolfgang S. Rupprecht *************** author of the floating point additions i *** 614,624 **** Rates: $95/hr. ! Updated: 14Apr94  Signum Support AB ! Box 2044 _ ...!seunet!signum!info ! S-580 02 Linkoping, Sweden +46 13 21 46 00 voice +46 13 21 47 00 fax Signum Support AB is a company dedicated to supporting, developing --- 1043,1054 ---- Rates: $95/hr. ! Updated: 1996-07-03  Signum Support AB ! Teknikringen 8 ! S-583 30 Linkoping, Sweden +46 13 21 46 00 voice +46 13 21 47 00 fax + http://www.signum.se Signum Support AB is a company dedicated to supporting, developing *************** programs, both administrating it and fin *** 631,634 **** --- 1061,1067 ---- Services offered: + - Support on Internet service software, especially the free + Readynet Internet server we have developed for Linux and Solaris. + - Support on Linux. - Installation and customizing GNU and other free software. We will make free software as easy to install and use as shrink wrapped *************** Services offered: *** 643,649 **** Rates: For software items, request our price list. ! For consulting, 400-800 SEK/hour. ! Updated: 14Apr94  Small Business Systems, Inc. --- 1076,1082 ---- Rates: For software items, request our price list. ! For consulting, 700-900 SEK/hour. ! Updated: 1996-06-26  Small Business Systems, Inc. *************** Rate: Varies depending on complexity of *** 656,697 **** Programs Supported: All ! Updated: 14Apr94 !  ! Julian H. Stacey. ! Vector Systems Ltd, Holz Strasse 27d, D 80469 Munich (Muenchen), GERMANY. ! Tel. +49 89 268616 (089 268616 in Germany) 09:00-21:00 Timezone=GMT+01:00 ! ! Sources: All FSF/GNU, FreeBSD-current, X-Windows, XFree86, NetBSD, Mach, etc. ! (Plus various other things, such as, but not limited to: ! blas blt cflow CAD cnews crypt dvi2lj eispack elm encryption expect ! ezd f2c flexfax gic gopher info-zip ingres inn jpeg kermit ksh ! less lha linpack md5 mh mprof mtools mush nntp octave pbmplus ! popper sather sc schemetoc slurp sml spreadsheet sup tcl tcl-dp ! tcsh tcx term tex tiff tk top trn unarj ups urt wine xlock xv ! xview xxgdb zmodem zip zircon zoo zsh.) ! Media: QIC 1/4" Cartridge 525M, 150M, & 60M, TEAC CAS-60 60M Cassette, ! CD-ROM, Floppies 1.4M & 1.2 & 720K & 360K. DAT arrangeable. ! Postal Service C.O.D.(=`Nachnahme') or pre payment available. Commercial Consultancy: ! Custom Designs, Provision & support of FreeBSD or Unix, C, FSF tools, ! X Windows, own tools, systems engineering, hardware interfacing, ! multi lingual European, Cyrillic & Chinese tools & systems, ! Unix, MSDOS, real time etc, communications & scientific & industrial. ! DEUTSCH + FRANCAIS: Man kann mir in Deutsch schreiben, (oder mich anrufen). Je comprend Francais, mais je n'ecris pas des responses en Francais. ! (Contact me in English, German, or French). ! FREE for Symmetric Computer Systems Model 375 owners: ! Free Binaries & sources on SCS/375's TEAC 50/60M Cassette, for: ! GCC-1.40, UUCP-1.4, Ghostscript 2.3, Tar-1.08, Gzip-1.2.2 etc. ! (Native SCS compiler can't compile GCC on this NSC32016 based BSD4.2) ! On Request: Resume, Company Profile, Index of public & proprietary tools, ! Rate: ~120 DM/hour. ~100DM/Cartridge. (1.5DM = $1 USA = 0.6 UK Pounds @4/'94) ! Short enquiries free. (Kurze Anfragen Ohne Gebuhr). ! Updated: 14Jun94  ! Richard M. Stallman ! UUCP: {mit-eddie,ucbvax,uunet,harvard,uw-beaver}!ai.mit.edu!rms 545 Tech Sq, Rm 430 Cambridge, MA 02139 --- 1089,1156 ---- Programs Supported: All ! Updated: 1994-04-14 ! ^_ ! Jon Solomon ! 235 Main St., Apt 3C-1 ! East Hartford, Conn. 06118 ! +1 860 939-5573 ! ! Maintains all GNU software... Available for General Consulting ! (contact me if you are interested)... ! Sendmail a specialty... Can answer questions pertaining to the ! installation, maintainence, bug reporting and fixing for ! most GNU products... Adhering to the FSF/GNU copyleft for all ! work... (I only charge for the time it takes to do the above, ! the software (and most GNU copyleft'd software) is free. ! I can make tapes for you if you need that... ! ! Entered: 1996-04-09 ! ^_ ! Julian H. Stacey. http://www.freebsd.org/~jhs/ ! Tel. +49 89 268616 (089 268616) Time zone: +01:00 ! Vector Systems Ltd, Holz Strasse 27d, D 80469 Munich (Muenchen), Germany. ! ! NO FREE HELPDESK ! ! Do Not Phone Me Unless You Either ! - Send me a DM 100 Eurocheque, 7 days before phoning, Or... ! - Start by negotiating the contract for my consultancy fees ! ! I earn my living from consultancy fees. ! I contribute code to public domain software projects. ! I don't mind giving a little free help occasionally, ! But be reasonable, define the human parameters First, ! Before you explain your technical wishes. ! Those I Hate Hearing From: ! Those who phone late evening, with complex weird problems, ! who want my time for free, who make no effort to speak my language ! (English), who are too lazy or mean to phone me a week or so later ! to hear any follow-up, who are too lazy to find a friend's ! email for me to forward Internet news/mail group follow-up to, ! who want me make expensive long distance calls phoning them back, ! after I've spent my free time on their problems. ! To those people: ... Don't phone me ! & I won't phone you ! Commercial Consultancy: ! Unix C X-Windows, Internet, with FSF FreeBSD etc. ! Systems engineering, hardware interfacing, real time, comms & ! scientific industrial, even Cyrillic & Chinese etc. ! Commercial Rate: ! DM/hr ~130-170. No Emacs. DM 1.5 = $1USA, DM 2.3 = 1 British Pound ! Work Place: ! Munich Germany, anywhere on the Internet. ! Resume, Company Profile: ! See my web page. ! Free Sources: ! FSF, FreeBSD current & releases, X-Windows, XFree86, NetBSD etc ! will be available for ISDN public access ftp around 8/96. ! Dial in, & write your own tapes for postal delivery. ! Access details available later via http://www.freebsd.org/~jhs/ ! QIC 1/4" 525M, 150M, & 60M, CAS-60M Cassette, Floppies. DM 100. ! Deutsch & Francais: I'm British, Man kann mir in Deutsch schreiben, (oder mich anrufen). Je comprend Francais, mais je n'ecris pas des responses en Francais. ! Free GCC-1.40 for Symmetric Computer Systems Model 375 (native cc fails): ! Updated: 1996-06-28  ! Richard M. Stallman 545 Tech Sq, Rm 430 Cambridge, MA 02139 *************** Original inventor of Emacs and main auth *** 704,708 **** Rates: $6/min or $250/hr. ! Updated: 14Apr94  JoS-Ware Comp Tech Johan Svensson --- 1163,1167 ---- Rates: $6/min or $250/hr. ! Updated: 1996-06-26  JoS-Ware Comp Tech Johan Svensson *************** Rates: 550SEK (+ tax) per hour within Sw *** 730,740 **** Note: fees may vary and special arrangements may be considered ! Entered: 7Apr94  ! Kayvan Sylvan Sylvan Associates 879 Lewiston Drive ! San Jose, CA 95136 ! Phone: 408-978-1407 I will help you port, install and customize GNU Emacs, GCC, G++, --- 1189,1200 ---- Note: fees may vary and special arrangements may be considered ! Entered: 1994-04-07  ! Kayvan Sylvan Sylvan Associates 879 Lewiston Drive ! San Jose, CA 95136-1517 ! Phone: (408) 978-1407 ! Fax: (408) 978-1417 I will help you port, install and customize GNU Emacs, GCC, G++, *************** also do ongoing support and periodic upg *** 744,758 **** software subscription list. ! Rates: $60-$100/hour, depending on type of work. Substantial discounts for long-term contracts and also for educational or non-profit institutions. ! Experience: Many different Unix systems (2.9BSD to 4.4BSD, SVR3 and ! SVR4, Linux, Xenix). Systems programming and system administration on all brands of Unix. Kernel hacking experience. Lots of porting experience. - I can port anything to anything (within reason). ! Updated: 14Apr94  Leonard H. Tower Jr. 36 Porter Street --- 1204,1253 ---- software subscription list. ! Rates: $70-$100/hour, depending on type of work. Substantial discounts for long-term contracts and also for educational or non-profit institutions. ! Experience: Many different Unix systems (2.9BSD to 4.4BSD, Xenix, SVR3 and ! SVR4, Linux, FreeBSD). Systems programming and system administration on all brands of Unix. Kernel hacking experience. Lots of porting experience. ! Updated: 1996-06-26  + TerraTel AB + Tankeg=E5ngen 4 + S-417 56 G=F6teborg, Sweden + +46 31 50 79 40 voice + +46 31 50 79 39 fax + http://www.netg.se + + TerraTel AB is a company that does consultant jobs and holds courses + in the fields of Unix software, TCP/IP networking and Internet + applications. The people behind TerraTel AB have many years + of general UNIX experience, both as system administrators and as + programmers, and also extensive experience in maintaining the GNU + programs; in administration as well as finding and fixing bugs. + + Services offered: + + - Installation and customizing GNU and other free software. We will + make free software as easy to install and use as shrink wrapped + programs. + - Service and support subscriptions. + - Warranty protection. + - Customization and porting. + - Subscriptions to new versions which we will send monthly or with + any other interval. + - Finding, recommending and investigating free software in any + area of the customers choice. + - Regular consulting. + - Support on Internet service software, especially the free + - Support on Linux. + - Freeware based courses in Unix usage, C, C++, or any GNU tools + + Rates: For courses, contact us for a quote, + For consulting, $60-120/hour, depending on contract length. + + Entered: 1996-07-15 + ^_ Leonard H. Tower Jr. 36 Porter Street *************** Rates: 100.00/hour + travel expenses. N *** 767,798 **** Experience: Have hacked on over a dozen architectures in many languages. Have system mothered several varieties of Unixes. Assisted rms with the front end ! of gcc and it's back-end support. Resume available on request. ! ! Entered: 14Apr94 !  ! UrbanSoft AO ! 68 Malooktinskii Prospect ! St. Petersburg, Russia 195272 ! ! Custom GhostScript and TeX programming by e-mail. ! Database documents, directories, standard forms. ! ! UrbanSoft uses a portion of its revenues to contribute ! diskette distributions of GNU software to Russian ! universities (most of which lack FTP access). ! Rates: 30,000 rubles (currently USD 16.80) per hour. ! Fixed rate contracts also possible. ! Payable by bank transfer. ! ! Updated: 20Apr94  ! noris network Matthias Urlichs Schleiermacherstrasse 12 90491 Nuernberg Germany ! Phone: +49 911 9959621 ! Fax: +49 911 5980150 http://info.noris.de/ (German) --- 1262,1276 ---- Experience: Have hacked on over a dozen architectures in many languages. Have system mothered several varieties of Unixes. Assisted rms with the front end ! of gcc and its back-end support. Resume available on request. ! Updated: 1996-06-29  ! noris network GmbH Matthias Urlichs Schleiermacherstrasse 12 90491 Nuernberg Germany ! Phone: +49 911 59818-0 ! Fax: +49 911 59818-11 http://info.noris.de/ (German) *************** Rates: *** 821,826 **** Rates don't include taxes. ! Entered: 16Aug94  Joe Wells Postal Address: --- 1299,1324 ---- Rates don't include taxes. ! Updated: 1996-07-05  + Paul C.A. van Gool + + + Address: Faculty of Aerospace Engineering + Delft University of Technology + Kluyverweg 1, 2629 HS Delft + The Netherlands + + Phone: +31-15-2785312 + Fax : +31-15-2786480 + + I would like to provide unpaid support for the following things: + + - C + - C++ + - f2c + - compilation and installation of most GNU packages + + Entered: 1996-07-15 + ^_ Joe Wells Postal Address: *************** Rates: $65/hour as an independent contra *** 866,871 **** higher rates if extensive travel is required. ! Updated: 27Sep94.  Herb Wood phone: 1-415-789-7173 --- 1364,1402 ---- higher rates if extensive travel is required. ! Updated: 1994-09-27 ! ^_ ! ! Arne Wichmann ! ! EMail: ! Telephone on request. ! ! I support GNU software on the following platforms: ! ! Linux ! SunOS 4.X 5.X ! HPUX 9.X ! other platforms on request. ! ! Usual rates: 20DM per hour. Free support for private people as time ! permits. ! ! Entered: 1996-07-22  + Jody Winston + xprt Computer Consulting, Inc. + 731 Voyager + Houston, TX, 77058 + (713) 480-UNIX, + + We have supported, installed, and used the entire GNU software suite + for over 8 years on many different Unix platforms. We have written + character device drivers and proc file systems for custom hardware + running on Linux. In addition, we have developed a custom X11 server + and X input extensions. Our consulting rate is $150.00 US dollars per + hour, negotiable, plus a per diem for out of town work. + + Entered: 1996-07-15 + ^_ Herb Wood phone: 1-415-789-7173 *************** Rather, I excel in domains that require *** 878,882 **** theoretical parts of computer science --for example, logic, formal methods of program development, and functional programming. I can write, and I have ! "tutoring" (teaching one-on-one) experience, an, unlike some programmers, I enjoy doing these things. --- 1409,1413 ---- theoretical parts of computer science --for example, logic, formal methods of program development, and functional programming. I can write, and I have ! "tutoring" (teaching one-on-one) experience, and, unlike some programmers, I enjoy doing these things. *************** Emacs and VM. I think I can customize E *** 885,889 **** effectively. ! Entered: 30Jul95  Yggdrasil Computing, Inc./ Freesoft, Inc. --- 1416,1420 ---- effectively. ! Entered: 1995-07-30  Yggdrasil Computing, Inc./ Freesoft, Inc. *************** San Jose, CA 95129 *** 893,898 **** (800) 261 6630 ! Updated: 14Apr94  For a current copy of this directory, or to have yourself listed, ask: --- 1424,1445 ---- (800) 261 6630 ! Updated: 1994-04-14  + Lige Zhou + Consultant + Open Technologies Corporation + Sun Lotus Bldg.2nd Floor + 2-9-1 Chuou, Nakano-ku, Tokyo 164 Japan + Tel: +81-3-3365-2911 Fax: +81-3-3365-2920 + E-mail: + + I have two years of experience porting and supporting GNU C Compiler and + GNU Assember at the Wingnut project of SRA, Inc., Tokyo. + + I can provide free consultation on these products if the problem is not + time-consuming. + + Entered: 1996-07-15 + ^_ For a current copy of this directory, or to have yourself listed, ask: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/TODO emacs-19.32/etc/TODO *** emacs-19.31/etc/TODO Wed Dec 31 19:00:00 1969 --- emacs-19.32/etc/TODO Sat Jul 27 20:34:33 1996 *************** *** 0 **** --- 1,38 ---- + * Change vc-directory so that in the CVS case + it does `cvs status .' to get the whole directory status at once + and then parse the output to find out about each file. + + * Change the Windows NT menu code + so that it handles the deep_p argument and avoids + regenerating the whole menu bar menu tree except + when the user tries to use the menubar. + + This requires the RIT to forward the WM_INITMENU message to + the main thread, and not return from that message until the main + thread has processed the menu_bar_activate_event and regenerated + the whole menu bar. In the mean time, it should process other messages. + + * Put the scroll bars on the left of the windows. + + * Enable use of X toolkit scroll bars. + + * Put cross-references into the documentation strings. + + * Implement radio buttons in menus. + + * Save undo information in files, and reload it when needed + for undoing. + + * Support multiple terminal-input descriptors, + and thus allow having both terminal and X frames at once. + + * Implement other text formatting properties. + ** Spaces of fractional width. + ** Footnotes that can appear either in place + or at the end of the page. + ** text property that says "don't break line in middle of this". + Don't break the line between two characters that have the + same value of this property. + ** Discretionary hyphens that disappear at end of line. + ** Text property for raising or lowering text. + ** Text property for making text smaller or bigger by one level of size. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/TUTORIAL emacs-19.32/etc/TUTORIAL *** emacs-19.31/etc/TUTORIAL Sat May 25 19:10:31 1996 --- emacs-19.32/etc/TUTORIAL Fri Jun 14 09:41:03 1996 *************** surrounding the parentheses around the m *** 791,808 **** example, you might see [(Fundamental)] instead of (Fundamental). ! To get out of the recursive editing level, type ! M-x top-level. ! >> Try that now; it should display "Back to top level" ! at the bottom of the screen. ! ! In fact, you were ALREADY at top level (not inside a recursive editing ! level) if you have obeyed instructions. M-x top-level does not care; ! it gets out of any number of recursive editing levels, perhaps zero, ! to get back to top level. You can't use C-g to get out of a recursive editing level because C-g ! is used for discarding numeric arguments and partially typed commands ! WITHIN the recursive editing level. --- 791,803 ---- example, you might see [(Fundamental)] instead of (Fundamental). ! To get out of the recursive editing level, type ESC ESC ESC. That is ! an all-purpose "get out" command. You can also use it for eliminating ! extra windows, and getting out of the minibuffer. ! >> Type M-x to get into a minibuffer; then type ESC ESC ESC to get out. You can't use C-g to get out of a recursive editing level because C-g ! is used for canceling commands and arguments WITHIN the recursive ! editing level. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/WHY-FREE emacs-19.32/etc/WHY-FREE *** emacs-19.31/etc/WHY-FREE Fri Feb 23 00:47:31 1996 --- emacs-19.32/etc/WHY-FREE Fri Jun 7 12:37:31 1996 *************** *** 3,7 **** by Richard Stallman ! Digital information technology's contributes to the world by making it easier to copy and modify information. Computers promise to make this easier for all of us. --- 3,7 ---- by Richard Stallman ! Digital information technology contributes to the world by making it easier to copy and modify information. Computers promise to make this easier for all of us. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/edt-user.doc emacs-19.32/etc/edt-user.doc *** emacs-19.31/etc/edt-user.doc Thu Jan 4 14:54:45 1996 --- emacs-19.32/etc/edt-user.doc Sat Jul 20 14:12:10 1996 *************** GNU General Public License for more deta *** 22,27 **** 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, 675 Mass Ave, Cambridge, MA 02139, USA. ============================================================================ --- 22,28 ---- 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. ============================================================================ *************** G-C-\: Split Window *** 618,623 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 619,625 ---- ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/gnus-tut.txt emacs-19.32/etc/gnus-tut.txt *** emacs-19.31/etc/gnus-tut.txt Thu Jan 4 14:54:56 1996 --- emacs-19.32/etc/gnus-tut.txt Thu Jun 27 18:32:29 1996 *************** Message-ID: *** 6,30 **** Actually, since you are reading this, chances are you are already ! using the new Gnus. Congratulations. This entire newsgroup you are reading is, in fact, no real newsgroup ! at all, in the traditional sense. It is an example of one of the "foreign" select methods that Gnus may use. The text you are now reading is stored in the "etc" directory with the ! rest of the Emacs sources. You are using the "nndir" backend for ! accessing it. Scary, isn't it? ! This isn't the real documentation. `M-x info', `m gnus ' to read ! that. This "newsgroup" is intended as a kinder, gentler way of getting people started. ! Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite was done by moi, yours truly, your humble servant, Lars Magne ! Ingebrigtsen. If you have a WWW browser, you can investigate to your heart's delight at . - Much code (especially the score code) was written by Per Abrahamsen. - ;; Copyright (C) 1995 Free Software Foundation, Inc. --- 6,28 ---- Actually, since you are reading this, chances are you are already ! using the new Gnus. Congratulations. This entire newsgroup you are reading is, in fact, no real newsgroup ! at all, in the traditional sense. It is an example of one of the "foreign" select methods that Gnus may use. The text you are now reading is stored in the "etc" directory with the ! rest of the Emacs sources. You are using the "nndoc" backend for ! accessing it. Scary, isn't it? ! This isn't the real documentation. `M-x info', `m gnus ' to read ! that. This "newsgroup" is intended as a kinder, gentler way of getting people started. ! Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite was done by moi, yours truly, your humble servant, Lars Magne ! Ingebrigtsen. If you have a WWW browser, you can investigate to your heart's delight at . ;; Copyright (C) 1995 Free Software Foundation, Inc. *************** Much code (especially the score code) wa *** 45,50 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. From lars Thu Feb 23 23:20:38 1995 --- 43,49 ---- ;; 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. From lars Thu Feb 23 23:20:38 1995 *************** Message-ID: *** 55,59 **** If you are having problems with Gnus not finding your server, you have ! to set `gnus-select-method'. A "method" is a way of specifying *how* the news is to be found, and from *where*. --- 54,58 ---- If you are having problems with Gnus not finding your server, you have ! to set `gnus-select-method'. A "method" is a way of specifying *how* the news is to be found, and from *where*. *************** Message-ID: *** 84,88 **** If this is the first time you have used a newsreader, you won't have a ! .newsrc file. This means that Gnus will think that all the newsgroups on the server are "new", and kill them all. --- 83,87 ---- If this is the first time you have used a newsreader, you won't have a ! .newsrc file. This means that Gnus will think that all the newsgroups on the server are "new", and kill them all. *************** This means that all the groups have been *** 94,110 **** quite dead, but not exactly alive, either. ! Jump back to the *Group* buffer, and type `C-c C-z' to list all the ! zombie groups. Look though the list, and subscribe to the groups you ! want to read by pressing `u' on the one you think look interesting. ! If all the groups have been killed, type `C-c C-k' to list all the ! killed groups. Subscribe to them the same way. ! When you are satisfied, press `M-z' to kill all the zombie groups. Now you should have a nice list of all groups you are interested in. ! (If you later want to subscribe to more groups, press `C-c C-k' to ! list all the kill groups, and repeat. You can also type `U' and be prompted for groups to subscribe to.) --- 93,109 ---- quite dead, but not exactly alive, either. ! Jump back to the *Group* buffer, and type `A z' to list all the zombie ! groups. Look though the list, and subscribe to the groups you want to ! read by pressing `u' on the one you think look interesting. ! If all the groups have been killed, type `A k' to list all the killed ! groups. Subscribe to them the same way. ! When you are satisfied, press `S z' to kill all the zombie groups. Now you should have a nice list of all groups you are interested in. ! (If you later want to subscribe to more groups, press `A k' to ! list all the kill groups, and repeat. You can also type `U' and be prompted for groups to subscribe to.) *************** Message-ID: *** 118,130 **** Yes, Virginia, you can read mail with Gnus. ! First you have to decide which mail backend you want to use. You have nnml, which is a one-file-one-mail backend, which is quite nice, but apt to make your systems administrator go crazy and come after you with a shotgun. ! nnmbox uses a Unix mail box to store mail. Nice, but slow. ! nnmh uses mh-e folders, which is also a one-file-one-mail thingy, but ! slower than nnml. (It doesn't support NOV files.) So if you want to go with nnmbox, you can simply say: --- 117,129 ---- Yes, Virginia, you can read mail with Gnus. ! First you have to decide which mail backend you want to use. You have nnml, which is a one-file-one-mail backend, which is quite nice, but apt to make your systems administrator go crazy and come after you with a shotgun. ! nnmbox uses a Unix mail box to store mail. Nice, but slow. ! nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but ! slower than nnml. (It doesn't support NOV files.) So if you want to go with nnmbox, you can simply say: *************** Message-ID: *** 156,169 **** These are groups that do not come from `gnus-select-method'. ! Say you want to read "alt.furniture.couches" from "news.funet.fi". You can then either type `B news.funet.fi ' to browse that server and subscribe to that group, or you can type ! `M-a alt.furniture.couchesnntpnews.funet.fi', if you like to type a lot. If you want to read a directory as a newsgroup, you can create an ! nndir group, much the same way. There's a shorthand for that, ! though. If, for instance, you want to read the (ding) list archives, ! you could type `D /ftp '. There's lots more to know about foreign groups, but you have to read --- 155,168 ---- These are groups that do not come from `gnus-select-method'. ! Say you want to read "alt.furniture.couches" from "news.funet.fi". You can then either type `B news.funet.fi ' to browse that server and subscribe to that group, or you can type ! `G m alt.furniture.couchesnntpnews.funet.fi', if you like to type a lot. If you want to read a directory as a newsgroup, you can create an ! nndir group, much the same way. There's a shorthand for that, ! though. If, for instance, you want to read the (ding) list archives, ! you could type `G d /ftp '. There's lots more to know about foreign groups, but you have to read *************** Subject: Low level changes in GNUS, or, *** 177,188 **** Message-ID: ! Gnus really isn't GNUS, even though it looks like it. If you scrape the surface, you'll find that most things have changed. ! This means that old code that relies on GNUS internals will fail. In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc', `gnus-killed-list', the `nntp-header-' macros and the display formats ! have all changed. If you have some code lying around that depend on these, or change these, you'll have to re-write your code. --- 176,187 ---- Message-ID: ! Gnus really isn't GNUS, even though it looks like it. If you scrape the surface, you'll find that most things have changed. ! This means that old code that relies on GNUS internals will fail. In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc', `gnus-killed-list', the `nntp-header-' macros and the display formats ! have all changed. If you have some code lying around that depend on these, or change these, you'll have to re-write your code. *************** remove all hihit code from all the Gnus *** 192,199 **** `gnus-summary-article-hook'). (Well, at the very least the first two.) Gnus provides various integrated functions for highlighting, ! which are both faster and more accurate. There is absolutely no chance, whatsoever, of getting Gnus to work ! with Emacs 18. --- 191,199 ---- `gnus-summary-article-hook'). (Well, at the very least the first two.) Gnus provides various integrated functions for highlighting, ! which are both faster and more accurated. There is absolutely no chance, whatsoever, of getting Gnus to work ! with Emacs 18. It won't even work on Emacsen older than Emacs ! 19.30/XEmacs 19.13. Upgrade your Emacs or die. *************** From lars Thu Feb 23 23:20:38 1995 *** 201,231 **** From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 - Subject: Bugs & stuff - Message-ID: - - If you want to report a bug, please type `M-x gnus-bug'. This will - give me a precise overview of your Gnus and Emacs version numbers, - along with a look at all Gnus variables you have changed. - - Du not expect a reply back, but your bug should be fixed in the next - version. If the bug persists, please re-submit your bug report. - - When a bug occurs, I need a recipe for how to trigger the bug. You - have to tell me exactly what you do to uncover the bug, and you should - (setq debug-on-error t) and send me the backtrace along with the bug - report. - - If I am not able to reproduce the bug, I won't be able to fix it. - - I would, of course, prefer that you locate the bug, fix it, and mail - me the patches, but one can't have everything. - - If you have any questions on usage, the "ding@ifi.uio.no" mailing list - is where to post the questions. - - - From lars Thu Feb 23 23:20:38 1995 - From: larsi@ifi.uio.no (ding) - Date: Fri Feb 24 13:40:45 1995 Subject: How do I re-scan my mail groups? Message-ID: --- 201,204 ---- *************** Just press `M-g' on the mail groups, and *** 236,240 **** You can also re-scan all the mail groups by putting them on level 1 ! (`1 S'), and saying `1 g' to re-scan all level 1 groups. --- 209,213 ---- You can also re-scan all the mail groups by putting them on level 1 ! (`S l 1'), and saying `1 g' to re-scan all level 1 groups. *************** Subject: How do I set up virtual newsgro *** 245,249 **** Message-ID: ! Virtual newsgroups are collections of other newsgroups. Why people want this is beyond me, but here goes: --- 218,222 ---- Message-ID: ! Virtual newsgroups are collections of other newsgroups. Why people want this is beyond me, but here goes: *************** Create the group by saying *** 254,258 **** This will create the group "nnvirtual:my.virtual.newsgroup", which will collect all articles from all the groups in the "rec.aquaria" ! hierarchy. If you want to edit the regular expression, just type `M-e' on the --- 227,231 ---- This will create the group "nnvirtual:my.virtual.newsgroup", which will collect all articles from all the groups in the "rec.aquaria" ! hierarchy. If you want to edit the regular expression, just type `M-e' on the *************** group line. *** 260,270 **** Note that all the groups that are part of the virtual group have to be ! alive. This means that the cannot, absolutely not, be zombie or ! killed. They can be unsubscribed; that's no problem. You can combine groups from different servers in the same virtual ! newsgroup, something that may actually be useful. Say you have the group "comp.headers" on the server "news.server.no" and the same group ! on "news.server.edu". If people have posted articles with Distribution headers that stop propagation of their articles, combining these two newsgroups into one virtual newsgroup should give you a better view of --- 233,243 ---- Note that all the groups that are part of the virtual group have to be ! alive. This means that the cannot, absolutely not, be zombie or ! killed. They can be unsubscribed; that's no problem. You can combine groups from different servers in the same virtual ! newsgroup, something that may actually be useful. Say you have the group "comp.headers" on the server "news.server.no" and the same group ! on "news.server.edu". If people have posted articles with Distribution headers that stop propagation of their articles, combining these two newsgroups into one virtual newsgroup should give you a better view of *************** what's going on. *** 273,278 **** One caveat, though: The virtual group article numbers from the first source group (group A) will always be lower than the article numbers ! from the second (group B). This means that Gnus will believe that ! articles from group A are older than articles from group B. Threading will lessen these problems, but it might be a good idea to sort the threads over the date of the articles to get a correct feel for the --- 246,251 ---- One caveat, though: The virtual group article numbers from the first source group (group A) will always be lower than the article numbers ! from the second (group B). This means that Gnus will believe that ! articles from group A are older than articles from group B. Threading will lessen these problems, but it might be a good idea to sort the threads over the date of the articles to get a correct feel for the *************** From lars Thu Feb 23 23:20:38 1995 *** 296,356 **** From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 ! Subject: I want to kiboze everything in sight! ! Message-ID: ! ! The nnkiboze backend collects articles that you are interested in from ! groups you are interested in. Below is a description for how you can ! gather all posts from me, and all posts about Gnus in the gnu.emacs ! hierarchy in one handy, easy to read group. ! ! Gnus will let you eat up all available machine resources, grinding ! everything to a halt. Including your nntp server. Who says Gnus isn't ! friendly? ! ! You want to do this, of course. ! ! Create an nnkiboze group the normal way: ! ! `M-a my.groupnnkiboze^gnu.emacs.*' ! ! You now have a shiny new group that you can't enter. How... ! practical. ! ! But just wait, it gets worse. ! ! You now have to create a score file. ! ! `C-x C-f ~/News/nnkiboze:my.group.SCORE' ! ! Put something like the following in this file: ! ! (setq gnus-score-alist ! '(("from" ! ("Ingebrigtsen" nil 1000) ! ("lmi" nil 5000)) ! ("subject" ! ("Gnus" nil 10000)) ! (touched))) ! ! Save the file, and go to a shell window. ! ! Type: ! $ emacs -batch -l ~/.emacs -l nnkiboze -f nnkiboze-generate-groups ! Wait a few hours, and all articles from me, or articles about Gnus, ! will appear, as if by magic, in the nnkiboze group. You really want ! that, of course. ! Gnus actually grabs the headers of all the groups that supply the ! nnkiboze group with articles, so this isn't very kind. Pleasy only do ! it at night (`at' is a fine command), and please, *please*, limit the ! number of groups that supply articles to the group. If you specify "" ! as the address of this group, nnkiboze will ask for headers from *all* ! groups, and this is megs and megs and megs of data. ! Use it, don't abuse it. Be nice. --- 269,294 ---- From: larsi@ifi.uio.no (ding) Date: Fri Feb 24 13:40:45 1995 ! Subject: Bugs & stuff ! Message-ID: ! If you want to report a bug, please type `M-x gnus-bug'. This will ! give me a precice overview of your Gnus and Emacs version numbers, ! along with a look at all Gnus variables you have changed. ! Du not expect a reply back, but your bug should be fixed in the next ! version. If the bug persists, please re-submit your bug report. ! When a bug occurs, I need a recipe for how to trigger the bug. You ! have to tell me exactly what you do to uncover the bug, and you should ! (setq debug-on-error t) and send me the backtrace along with the bug ! report. ! If I am not able to reproduce the bug, I won't be able to fix it. + I would, of course, prefer that you locate the bug, fix it, and mail + me the patches, but one can't have everything. + If you have any questions on usage, the "ding@ifi.uio.no" mailing list + is where to post the questions. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/refcard.bit emacs-19.32/etc/refcard.bit *** emacs-19.31/etc/refcard.bit Wed Dec 31 19:00:00 1969 --- emacs-19.32/etc/refcard.bit Sun Jun 23 17:06:00 1996 *************** *** 0 **** --- 1 ---- + @end diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/refcard.ps emacs-19.32/etc/refcard.ps *** emacs-19.31/etc/refcard.ps Thu Mar 21 22:35:11 1996 --- emacs-19.32/etc/refcard.ps Sun Jun 23 20:51:08 1996 *************** *** 1,592 **** %!PS-Adobe-2.0 ! %%Creator: dvipsk 5.58f Copyright 1986, 1994 Radical Eye Software %%Title: refcard.dvi ! %%Pages: 6 ! %%PageOrder: Ascend ! %%BoundingBox: 0 0 596 842 %%EndComments ! %DVIPSCommandLine: dvips refcard.dvi ! %DVIPSParameters: dpi=300, compressed, comments removed ! %DVIPSSource: TeX output 1996.03.21:2231 ! %%BeginProcSet: texc.pro ! /TeXDict 250 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N ! /X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72 ! mul N /landplus90{false}def /@rigin{isls{[0 landplus90{1 -1}{-1 1} ! ifelse 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale ! isls{landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div ! hsize mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul ! TR[matrix currentmatrix{dup dup round sub abs 0.00001 lt{round}if} ! forall round exch round exch]setmatrix}N /@landscape{/isls true N}B ! /@manualfeed{statusdict /manualfeed true put}B /@copies{/#copies X}B ! /FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{ ! /nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N ! string /base X array /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N ! end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{ ! /sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0] ! N df-tail}B /E{pop nn dup definefont setfont}B /ch-width{ch-data dup ! length 5 sub get}B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{ ! 128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub ! get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data ! dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N ! /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup ! /base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx ! 0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff ! setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff ! .1 sub]/id ch-image N /rw ch-width 7 add 8 idiv string N /rc 0 N /gp 0 N ! /cp 0 N{rc 0 ne{rc 1 sub /rc X rw}{G}ifelse}imagemask restore}B /G{{id ! gp get /gp gp 1 add N dup 18 mod S 18 idiv pl S get exec}loop}B /adv{cp ! add /cp X}B /chg{rw cp id gp 4 index getinterval putinterval dup gp add ! /gp X adv}B /nd{/cp 0 N rw exit}B /lsh{rw cp 2 copy get dup 0 eq{pop 1}{ ! dup 255 eq{pop 254}{dup dup add 255 and S 1 and or}ifelse}ifelse put 1 ! adv}B /rsh{rw cp 2 copy get dup 0 eq{pop 128}{dup 255 eq{pop 127}{dup 2 ! idiv S 128 and or}ifelse}ifelse put 1 adv}B /clr{rw cp 2 index string ! putinterval adv}B /set{rw cp fillstr 0 4 index getinterval putinterval ! adv}B /fillstr 18 string 0 1 17{2 copy 255 put pop}for N /pl[{adv 1 chg} ! {adv 1 chg nd}{1 add chg}{1 add chg nd}{adv lsh}{adv lsh nd}{adv rsh}{ ! adv rsh nd}{1 add adv}{/rc X nd}{1 add set}{1 add clr}{adv 2 chg}{adv 2 ! chg nd}{pop nd}]dup{bind pop}forall N /D{/cc X dup type /stringtype ne{] ! }if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup ! length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{ ! cc 1 add D}B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin ! 0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul ! add .99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore userdict ! /eop-hook known{eop-hook}if showpage}N /@start{userdict /start-hook ! known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X ! /IE 256 array N 0 1 255{IE S 1 string dup 0 3 index put cvn put}for ! 65781.76 div /vsize X 65781.76 div /hsize X}N /p{show}N /RMat[1 0 0 -1 0 ! 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley X /rulex X V}B /V ! {}B /RV statusdict begin /product where{pop product dup length 7 ge{0 7 ! getinterval dup(Display)eq exch 0 4 getinterval(NeXT)eq or}{pop false} ! ifelse}{false}ifelse end{{gsave TR -.1 .1 TR 1 1 scale rulex ruley false ! RMat{BDot}imagemask grestore}}{{gsave TR -.1 .1 TR rulex ruley scale 1 1 ! false RMat{BDot}imagemask grestore}}ifelse B /QV{gsave newpath transform ! round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg ! rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail ! {dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail}B /c{-4 M} ! B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B /j{3 M}B /k{ ! 4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{ ! p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto}B /y{3 2 roll p ! a}B /bos{/SS save N}B /eos{SS restore}B end %%EndProcSet ! TeXDict begin 39158280 55380996 1000 300 300 (refcard.dvi) ! @start /Fa 1 59 df<126012F0A2126004047C830C>58 D E /Fb ! 19 122 df45 D97 D<123F1207A2120EA45AA4EA39 ! E0EA3A18EA3C0C12381270130EA3EAE01CA31318133813301360EA60C0EA3180EA1E000F ! 1D7C9C13>I<13F8EA0304120EEA1C0EEA181CEA30001270A25AA51304EA60081310EA30 ! 60EA0F800F127C9113>II<13F8EA0704 ! 120CEA1802EA38041230EA7008EA7FF0EAE000A5EA60041308EA30101360EA0F800F127C ! 9113>I103 ! DII108 ! D<391C1E078039266318C0394683A0E0384703C0008E1380A2120EA2391C0701C0A3EC03 ! 80D8380E1388A2EC0708151039701C032039300C01C01D127C9122>II<13F8EA030CEA0E06487E1218123000701380A238E00700A3130EA25BEA60 ! 185BEA30E0EA0F8011127C9115>I<380387803804C860EBD03013E0EA09C014381201A2 ! 38038070A31460380700E014C0EB0180EB8300EA0E86137890C7FCA25AA45AB4FC151A80 ! 9115>I ! 114 DI<12035AA3120EA4EAFFE0EA1C00A35AA4 ! 5AA4EAE080A2EAE100A2126612380B1A7C990E>I<381C0180EA2E03124EA2388E0700A2 ! 121CA2EA380EA438301C80A3EA383C38184D00EA0F8611127C9116>I<381C0180EA2E03 ! 124EA2388E0700A2121CA2EA380EA4EA301CA3EA383CEA1878EA0FB8EA003813301370EA ! E0605BEA81800043C7FC123C111A7C9114>121 D E /Fc 1 14 df13 D E /Fd 47 122 df<124012E012601220A31240A2128003097D8209>44 ! D<12FFA2080280860B>I<124012E0124003037D8209>I<120FEA30C0EA6060A2EA4020EA ! C030A9EA4020EA6060A2EA30C0EA0F000C137E9211>48 D<120C121C12EC120CAFEAFFC0 ! 0A137D9211>I<121FEA60C01360EAF07013301260EA0070A2136013C012011380EA0200 ! 5AEA08101210EA2020EA7FE012FF0C137E9211>II53 DI<1240EA7FFC13F8EA ! 4010EA80301320EA00401380EA0100A25A12021206A2120EA512040E147E9311>I<120F ! EA3080EA6040EA4060EAC0201330A31240EA6070EA30B0EA0F30120013201360EAE04013 ! 80EA4100123E0C137E9211>57 D<1330A21378A3139CA2EA019E130EA2EA0207A2000613 ! 80EA07FFEA0403380801C0A2001813E0EA380038FE07FC16147F9319>65 ! DII69 DII73 D<00FEEB0FE0001E140000171317A338138027A238 ! 11C047A23810E087A3EB7107A2133AA2131CA2123839FE083FE01B147F931E>77 ! D<38FC01FC381E00700017132013801213EA11C0EA10E01370A21338131C130E130F1307 ! EB03A0EB01E01300A20038136000FE132016147F9319>I80 D83 D<387FFFF03860703000401310A200801308A300001300ACEA07FF15147F ! 9318>I<38FF81FC381C00701420AD120C000E13400006138038038300EA00FC16147F93 ! 19>I<127FEAE1C0EAE040EA40601200EA07E0EA3860126012C01364A2EA61E4EA3E380E ! 0D7E8C11>97 D<12F01230A6EA33E0EA3430EA3808EA300C1306A5130CEA3808EA3430EA ! 23E00F147F9312>II<13781318A6EA0F98EA1878EA2038EA601812C0A51260EA2038EA1858EA0F ! 9E0F147F9312>IIII<12F01230A6EA33E0EA3430EA38181230 ! A9EAFC7E0F147F9312>I<1220127012201200A512F01230AB12FC06157F9409>I<12F012 ! 30A6137C133013601380EA31001233EA3F801231EA30C0136013701330EAFC7C0E147F93 ! 11>107 D<12F01230B212FC06147F9309>I<38F3E1F03834321838381C0CEA3018A938FC ! 7E3F180D7F8C1B>IIII114 DI<1210A312301270EAFF80EA3000A71380 ! A3EA1100120E09127F910D>III<38F87CF8 ! 3870703038305820A238188840138CA2380D04801306A238060300A3150D7F8C18>III E /Fe 25 122 df<90383FE3F83901F03F1C3903C03E3E ! 0007137CEA0F80151C1500A5B612C0A2390F807C00AE397FE1FF80A21F1D809C1C>11 ! D97 DIIII<137F3801E3803803C7C0EA ! 0787120FEB8380EB8000A5EAFFF8A2EA0F80AEEA7FF0A2121D809C0F>I<3803F0F0380E ! 1F38EA3C0F3838073000781380A400381300EA3C0FEA1E1CEA33F00030C7FCA3EA3FFF14 ! C06C13E014F0387801F838F00078A300701370007813F0381E03C03807FF00151B7F9118 ! >II<12 ! 1E123FA4121EC7FCA6127FA2121FAEEAFFC0A20A1E7F9D0E>I107 DI<39FF0FC07E903831E18F3A1F ! 40F20780D980FC13C0A2EB00F8AB3AFFE7FF3FF8A225127F9128>I<38FF0FC0EB31E038 ! 1F40F0EB80F8A21300AB38FFE7FFA218127F911B>II<38FF3F80EBE1E0381F80F0EB0078147C143C143EA6143C147C1478EB80F0EBC1E0 ! EB3F0090C7FCA6EAFFE0A2171A7F911B>I<3803F060380F0CE0EA1E07EA3C03127C1278 ! 12F8A61278127C123CEA1C07EA0E0FEA03F3EA0003A6EB1FFCA2161A7E9119>III<1203A45AA25AA2EA3FFC12FFEA1F00A9130CA4EA0F08EA0798EA03F00E ! 1A7F9913>I<38FF07F8A2EA1F00AC1301120F380786FFEA01F818127F911B>I<38FFC1FC ! A2381F00601380000F13C0A23807C180A23803E300A213F7EA01F613FE6C5AA21378A213 ! 3016127F9119>I<39FF8FF8FEA2391F03E030A3390F87F06013869038C6F8E03907CC78 ! C0A23903FC7D80EBF83D143F3901F01F00A20000131EEBE00EA21F127F9122>I<38FFC7 ! FCA2381F81C0380F83803807C700EA03EEEA01FC5B1200137C13FEEA01DF38039F80EA07 ! 0F380607C0380C03E038FF07FCA216127F9119>I<38FFC1FCA2381F00601380000F13C0 ! A23807C180A23803E300A213F7EA01F613FE6C5AA21378A21330A25B1270EAF8E05BEAF9 ! 800073C7FC123E161A7F9119>I E /Ff 75 126 df<126012F0AF12601200A4126012F0 ! A212600419779816>33 DII< ! 13C01201A3EA07F0EA1FFC48B4FCEA7DCF38F1C78012E1A338F1C300EA79C0127FEA1FF0 ! EA07FCEA01FE13CFEBC780EAF1C3A3EAE1C712F13879DF00EA3FFE6C5AEA07E0EA01C0A2 ! 120011207E9C16>I<38380180EA7C03EAFE07140012EE5B130E131EEAFE1C133CEA7C38 ! 1238EA0078137013F05BA212015B12035BEB8380380787C0EB0FE0EA0F0E120E121E121C ! A2EA3C0F383807C03818038013207F9C16>I<12301278127C123C121CA3123C12381278 ! 12F012E012C0060D789816>39 D<13E01201EA07C013005A121E5A123812781270A312F0 ! 5AA77E1270A312781238123C7E7E7E13C0EA01E012000B217A9C16>I<12E07E127C121C ! 121E7EEA0780120313C01201A313E01200A7120113C0A3120313801207EA0F00121E121C ! 127C12F05A0B217C9C16>II<13E0A8B512E0A33800E000A813137F9516> ! I<1238127C127EA2123E120E121E123C127C12F81260070B798416>II<127012F8A312700505788416>III<12035A5AA2 ! 5AB4FCA212F71207AEEAFFF8A30D197B9816>III<137C13 ! FC13DC1201EA039CA2EA071C120F120E121E123C1238127812F0B512E0A338001C00A538 ! 01FFC0A313197F9816>II<127012F8 ! A312701200A8127012F8A312700512789116>58 D60 D<12E07E12FC123E6C7EEA07E06C7EEA00FC133EEB1F801307131FEB3E ! 0013FCEA03F0485AEA1F80003EC7FC12FC12F05A11157E9616>62 ! DI<13F8EA03FEEA0FFF381F0F80EA3E3FEA3CFF007913C0 ! EA73C7EAF38312E71301A5138300F31380EA73C73879FF006C5AEA3E38381F03C0EA0FFF ! 00031300EA00FC12197E9816>I<13E0487EA213B0A2EA03B8A31318EA071CA5EA0E0EA2 ! EA0FFEA2487EEA1C07A3387E0FC038FF1FE0387E0FC013197F9816>II<3801F180EA07FF5AEA1F0FEA3C0712781303127000F0C7 ! FC5AA77E387003801278A2EA3C07381F0F00EA0FFE6C5AEA01F011197E9816>II<387FFFC0B5FC7EEA1C01A490C7FCA2131CA2EA1FFCA3EA ! 1C1CA290C7FC14E0A5EA7FFFB5FC7E13197F9816>I<387FFFE0B5FC7EEA1C00A41400A2 ! 131CA2EA1FFCA3EA1C1CA290C7FCA6EA7F80487E6C5A13197F9816>I<3801F180EA07FF ! 5AEA1F0FEA3C0712781303127000F0C7FC5AA4EB1FC014E014C038F003801270EA7807A2 ! EA3C0FEA1E1FEA0FFFEA07FBEA01F313197F9816>I76 D<38FC07E0EAFE0FA2383A0B80EA3B1BA513BBEA39B3A413F3EA ! 38E3A21303A538FE0FE0A313197F9816>I<387E07F038FF0FF8387F07F0381D81C0A313 ! C1121C13E1A213611371A313311339A21319131D130DA3EA7F07EAFF87EA7F0315198098 ! 16>I80 D82 DI<387F ! FFE0B5FCA2EAE0E0A400001300AFEA07FC487E6C5A13197F9816>I<387E03F038FF07F8 ! 387E03F0383800E0A4381C01C0A3137113F9A213D9A2000C1380A3EA0DDD138DA338078F ! 00A213071519809816>87 D91 ! D<12E0A27E127012781238123C121C121E120E120F7E7F12037F1201A27F12007F137013 ! 781338133C131C131E130E130F7F14801303130111207E9C16>II<1207EA1FC0EA7FF0EAFDF8EAF078EA40100D067C9816>II<120C121C123C1278127012F012E0A312F012F812781230060D789B ! 16>II<12FCA3121CA4137CEA1DFF001F1380EB ! 07C0EA1E03381C01E0A21300A41301001E13C01303381F078013FF381DFE00EA0C781319 ! 7F9816>II<133FA31307A4EA03C7EA0FF7EA3FFFEA3C1F487EEA ! 700712F012E0A412F05BEA781FEA7C3F383FFFE0EA1FF7EA07C713197F9816>II<131FEBFF805AEA03C7EB83001380A2EA7FFFB5FCA2 ! EA0380ACEA7FFC487E6C5A11197F9816>I<3803E3C0380FFFE05A381E3CC0383C1E00EA ! 380EA3EA3C1E6C5AEA1FFC5BEA3BE00038C7FCA2EA1FFC13FF4813C0EA780338F001E0EA ! E000A3EAF001387C07C0383FFF80380FFE00EA03F8131C7F9116>I<12FCA3121CA41378 ! EA1DFEEA1FFF130FEA1E07A2121CA938FF8FE0139F138F13197F9816>I<1203EA0780A2 ! EA0300C7FCA4EAFF80A31203ACEAFFFC13FE13FC0F1A7C9916>I<13301378A213301300 ! A4EA0FF8121F120FEA0038B3EA6078EAF0F0EAFFE0EA7FC0EA3F800D237E9916>I<127E ! 12FE127E120EA4EB7FE0A3EB0F00131E5B5B5BEA0FF8A213BC131EEA0E0E130FEB078038 ! 7F87F0EAFFCFEA7F871419809816>II<38F9C38038FFEFC0EBFFE0EA3E7CEA3C78EA3870AA38FE7CF8A315128091 ! 16>IIII<38 ! 03E380EA0FFBEA1FFFEA3E1FEA780FEA7007EAF00312E0A412F0EA7007EA780FEA3C1FEA ! 3FFFEA0FFBEA03E3EA0003A6EB1FF0EB3FF8EB1FF0151B7F9116>I<387F0FC038FF3FE0 ! EA7F7F3807F040EBE0005B5BA290C7FCA7EA7FFC12FF127F13127F9116>II<12035AA4EA7FFFB5FCA20007C7FCA75BEB0380A2130713 ! 873803FF005BEA00F811177F9616>II<387F1FC038FF9FE0387F1FC0381C0700A2EA0E0EA36C5AA4EA03B8A3EA ! 01F0A26C5A13127F9116>I<38FF1FE0A338380380A4EA39F3A20019130013B3A3EA1DB7 ! 1317EA1F1FEA0F1EEA0E0E13127F9116>I<387F1FC0133F131F380F1E006C5AEA03B813 ! F012016C5A12017FEA03B8EA073C131CEA0E0E387F1FC038FF3FE0387F1FC013127F9116 ! >I<387F1FC038FF9FE0387F1FC0381C0700120E130EA212075BA2EA039CA21398EA01B8 ! A2EA00F0A35BA3485A1279127BEA7F8090C7FC123C131B7F9116>I<383FFFC05AA23870 ! 0780EB0F00131EC65A13F8485A485A485A48C7FC381E01C0123C1278B5FCA312127F9116 ! >II<12E0B3AE0320779C16>I<12FCB4FC13C012031201A97F6CB4 ! FCEB7F80A2EBFF00EA01E05BA9120312FF90C7FC12FC11207E9C16>I ! E /Fg 42 123 df<903901FF81FE011F9038EFFF80903A7F80FF87C0D9FE00EB0FE03903 ! FC01FE13F8D807F013FCEE07C093C7FCA7B712F8A32707F001FCC7FCB3A33A7FFF1FFFE0 ! A32B2A7FA928>11 D65 DI<91393FF00180903903FFFE07010FEBFF ! 8F90393FF007FF9038FF80014848C7127FD807FC143F49141F4848140F485A003F15075B ! 007F1503A3484891C7FCAB6C7EEE0380A2123F7F001F15076C6C15006C6C5C6D141ED801 ! FE5C6C6C6C13F890393FF007F0010FB512C0010391C7FC9038003FF829297CA832>IIII<91393FF00180903903FFFE07010FEBFF8F90393FF007FF9038FF80014848C712 ! 7FD807FC143F49141F4848140F485A003F15075B007F1503A3484891C7FCA992387FFFFC ! A26C7E9238007F80A26C7EA26C7E120F6C7E7FD801FE14FF6C6C7E90383FF003010FB512 ! DF010314079039003FF8012E297CA836>III ! 75 DII81 DI<90387F80603903FFF0E0000F13FF38 ! 1F807F383F001F007E13071403127C00FC1301A214007EA26C140013C0EA7FFEEBFFE06C ! 13FC14FF6C1480000714C06C14E0C66C13F01307EB007FEC0FF81407140312E01401A37E ! 15F06C13036C14E0B413079038E01FC090B5120000E15B38C01FF01D297CA826>I<007F ! B712C0A39039803FC03FD87E00140700781503A20070150100F016E0A2481500A5C71500 ! B3A4017FB512E0A32B287EA730>I87 D<3803FF80000F13F0381F01FC383F80FE14 ! 7FA2EC3F80EA1F00C7FCA3EB0FFF90B5FC3807FC3FEA1FE0EA3F80127F130012FEA3147F ! 7E6CEBFFC0393F83DFFC380FFF8F3801FC031E1B7E9A21>97 DIIIII<9038FF81F00003EBE7FC390FC1FE7C381F80FC003F13FE9038007E1048EB7F00A66C ! 137EEB80FE001F5B380FC1F8381FFFE0001813800038C8FC123CA2123E383FFFF814FF6C ! 14C06C14E06C14F0121F397E0007F8007C13015A1400A36C1301007EEB03F06CEB07E039 ! 0FC01F803903FFFE0038007FF01E287E9A22>II<12 ! 07EA1FC0EA3FE0A5EA1FC0EA0700C7FCA7EAFFE0A3120FB3A3EAFFFEA30F2B7DAA14>I< ! EAFFE0A3120FACEC1FFCA3EC07C0EC0F80EC1E00147C5CEBE1F0EBE3E0EBE7C0EBEFE0EB ! FFF0A280EBF3FCEBE1FE13C080EC7F80143F15C0EC1FE0EC0FF039FFFC3FFEA31F2A7EA9 ! 24>107 DI<3BFFC07F800FF0903AC1FFE03F ! FC903AC783F0F07E3B0FCE03F9C07F903ADC01FB803F01F8D9FF00138001F05BA301E05B ! AF3CFFFE1FFFC3FFF8A3351B7D9A3A>I<38FFC07F9038C1FFC09038C787E0390FCE07F0 ! 9038DC03F813F813F0A313E0AF3AFFFE3FFF80A3211B7D9A26>II<38FFE1FE9038 ! E7FF809038FE07E0390FF803F8496C7E01E07F140081A2ED7F80A9EDFF00A25DEBF0014A ! 5A01F85B9038FE0FE09038EFFF80D9E1FCC7FC01E0C8FCA9EAFFFEA321277E9A26>I<38 ! FFC1F0EBC7FCEBCE3E380FDC7F13D813F813F0143E14005BAFB5FCA3181B7E9A1C>114 ! D<3803FE30380FFFF0EA3E03EA7800127000F01370A27E00FE1300EAFFE013FE387FFFC0 ! 6C13E06C13F0000713F8C613FC1307EAE000147C6C133CA27E14787E38FF01F038F7FFC0 ! 00C11300161B7E9A1B>I<1370A413F0A312011203A21207381FFFF0B5FCA23807F000AD ! 1438A73803F870000113F03800FFE0EB1F8015267FA51B>I<39FFE03FF8A3000F1303B1 ! 1407A2140F0007131F3A03F03BFF803801FFF338003FC3211B7D9A26>I<3AFFFE03FF80 ! A33A0FF0007800000714706D13F000035CEBFC0100015CA26C6C485AA2EBFF07017F90C7 ! FC148FEB3F8E14CEEB1FDCA2EB0FF8A36D5AA26D5AA26D5A211B7F9A24>I<3BFFFC3FFC ! 0FFEA33B0FE007E000E03B07F003F001C0A29039F807F80300031680A23B01FC0EFC0700 ! A291381EFE0F3A00FE1C7E0EA29039FF383F1E017F141C147890393FF01FB8A29138E00F ! F8011F5CA26D486C5AA36D486C5AA22F1B7F9A32>I<39FFFC0FFFA33907F003C0D803F8 ! 5B3801FC076C6C48C7FCEBFF1E6D5AEB3FF86D5AA2130F130780497E497E131EEB3C7F49 ! 6C7E496C7ED801E07F3803C00F6E7E3AFFF01FFF80A3211B7F9A24>I<3AFFFE03FF80A3 ! 3A0FF0007800000714706D13F000035CEBFC0100015CA26C6C485AA2EBFF07017F90C7FC ! 148FEB3F8E14CEEB1FDCA2EB0FF8A36D5AA26D5AA26D5AA2495AA2EA3807007C90C8FCEA ! FE0F130E5B133CEA7C78EA3FE0EA0F8021277F9A24>I<003FB51280A21300003C140038 ! 3801FE387803FC130700705B495A495A1200495A495A13FF91C7FC3901FE0380EA03FCA2 ! EA07F8380FF007121F01E0130048485A48485A00FF137F90B5FCA2191B7E9A1F>I ! E /Fh 62 124 df11 D<137E3801C180EA0301380703C0120EEB ! 018090C7FCA5B512C0EA0E01B0387F87F8151D809C17>I34 D<126012F012F812681208A3 ! 1210A2122012401280050C7C9C0C>39 D<1380EA0100120212065AA25AA25AA35AA412E0 ! AC1260A47EA37EA27EA27E12027EEA0080092A7C9E10>I<7E12407E12307EA27EA27EA3 ! 7EA41380AC1300A41206A35AA25AA25A12205A5A092A7E9E10>I<126012F0A212701210 ! A41220A212401280040C7C830C>44 DI<126012F0A212600404 ! 7C830C>I<1303A213071306A2130E130C131C1318A213381330A213701360A213E013C0 ! A21201138012031300A25A1206A2120E120CA2121C1218A21238123012701260A212E05A ! A210297E9E15>I<5A1207123F12C71207B3A5EAFFF80D1C7C9B15>49 ! DI< ! EA07E0EA1830EA201CA2EA781E130E131E1238EA001CA2131813301360EA07C0EA003013 ! 1CA2130E130FA2127012F8A3EAF00EEA401C1220EA1830EA07C0101D7E9B15>I<130CA2 ! 131C133CA2135C13DC139CEA011C120312021204120C1208121012301220124012C0B512 ! C038001C00A73801FFC0121C7F9B15>II<13F0EA030CEA0404EA0C0EEA181E1230130CEA7000A21260EAE3E0EAE4 ! 30EAE818EAF00C130EEAE0061307A51260A2EA7006EA300E130CEA1818EA0C30EA03E010 ! 1D7E9B15>I57 D<126012F0A212601200AA126012F0A2126004127C910C>I<1306A3130FA3 ! EB1780A2EB37C01323A2EB43E01341A2EB80F0A338010078A2EBFFF83802003CA3487FA2 ! 000C131F80001E5BB4EBFFF01C1D7F9C1F>65 D68 ! DII<90381F8080EBE061380180 ! 1938070007000E13035A14015A00781300A2127000F01400A6ECFFF0EC0F800070130712 ! 78A212387EA27E6C130B380180113800E06090381F80001C1E7E9C21>I<39FFF0FFF039 ! 0F000F00AC90B5FCEB000FAD39FFF0FFF01C1C7F9B1F>II76 DIII<007FB512C038700F010060130000401440A200C014201280A3000014 ! 00B1497E3803FFFC1B1C7F9B1E>84 D<39FFF01FF0390F000380EC0100B3A26C13021380 ! 00035BEA01C03800E018EB7060EB0F801C1D7F9B1F>I<39FFE00FF0391F0003C0EC0180 ! 6C1400A238078002A213C000035BA2EBE00C00011308A26C6C5AA213F8EB7820A26D5AA3 ! 6D5AA2131F6DC7FCA21306A31C1D7F9B1F>I<3AFFE1FFC0FF3A1F003E003C001E013C13 ! 186C6D1310A32607801F1320A33A03C0278040A33A01E043C080A33A00F081E100A39038 ! F900F3017913F2A2017E137E013E137CA2013C133C011C1338A20118131801081310281D ! 7F9B2B>I<39FFF07FC0390FC01E003807800CEBC00800035B6C6C5A13F000005BEB7880 ! 137C013DC7FC133E7F7F80A2EB13C0EB23E01321EB40F0497E14783801007C00027F141E ! 0006131F001F148039FF807FF01C1C7F9B1F>I92 D97 ! D<12FC121CAA137CEA1D87381E0180381C00C014E014601470A6146014E014C0381E0180 ! 38190700EA10FC141D7F9C17>IIII<13F8EA018CEA071E1206EA0E0C1300A6EAFFE0EA0E00B0EA7F ! E00F1D809C0D>II<12FC121CAA137C1387EA1D03001E1380121CAD38 ! FF9FF0141D7F9C17>I<1218123CA21218C7FCA712FC121CB0EAFF80091D7F9C0C>I<13C0 ! EA01E0A2EA00C01300A7EA07E01200B3A21260EAF0C012F1EA6180EA3E000B25839C0D> ! I<12FC121CAAEB0FE0EB0780EB06005B13105B5B13E0121DEA1E70EA1C781338133C131C ! 7F130F148038FF9FE0131D7F9C16>I<12FC121CB3A9EAFF80091D7F9C0C>I<39FC7E07E0 ! 391C838838391D019018001EEBE01C001C13C0AD3AFF8FF8FF8021127F9124>IIII<3803E080EA0E19EA1805EA3807EA7003A212E0 ! A61270A2EA38071218EA0E1BEA03E3EA0003A7EB1FF0141A7F9116>II ! I<1204A4120CA2121C123CEAFFE0EA1C00A91310A5120CEA0E20EA03C00C1A7F9910>I< ! 38FC1F80EA1C03AD1307120CEA0E1B3803E3F014127F9117>I<38FF07E0383C0380381C ! 0100A2EA0E02A2EA0F06EA0704A2EA0388A213C8EA01D0A2EA00E0A3134013127F9116> ! I<39FF3FC7E0393C0703C0001CEB01801500130B000E1382A21311000713C4A213203803 ! A0E8A2EBC06800011370A2EB8030000013201B127F911E>I<38FF0FE0381E0700EA1C06 ! EA0E046C5AEA039013B0EA01E012007F12011338EA021C1204EA0C0E487E003C138038FE ! 1FF014127F9116>I<38FF07E0383C0380381C0100A2EA0E02A2EA0F06EA0704A2EA0388 ! A213C8EA01D0A2EA00E0A31340A25BA212F000F1C7FC12F312661238131A7F9116>III E /Fi ! 15 116 df<913A03FF800380023FEBF00749B5EAFC0F01079038007F1FD91FF8EB0FFFD9 ! 7FE0130349487F4890C8FC4848157F0007163F4848151F485A170F123F5B1707127FA249 ! 92C7FC12FFAB127F7FEF0380123FA27F001F160718006C6C5D6C6C150E6C6C151E6C5E6C ! 01C05C6D6C495AD91FF8495AD907FFEB3F800101D9FFFEC7FCD9003F13F8020313803131 ! 7BB03C>67 D69 D<913A03FF800380023FEBF00749 ! B5EAFC0F01079038007F1FD91FF8EB0FFFD97FE0130349487F4890C8FC4848157F000716 ! 3F4848151F485A170F123F5B1707127FA24992C7FC12FFA90307B512FEA2127F6DD90001 ! 1380A2123FA27F121F7F120F6C7E6C7E6C7F6C6D5B6D7ED91FF85B903907FF803F010190 ! 38FFFE1FD9003FEBF8070203EBC00137317BB041>71 D ! 78 D82 D85 D97 D99 ! DII<14FF010713C0011F13F0EB7FC79038FF0FF85A13FE ! 120313FCEC07F0EC01C091C7FCA7B512FCA3D803FCC7FCB3A8387FFFF0A31D327EB119> ! I<2703F007F8EB0FF000FFD93FFFEB7FFE4A6DB5FC903CF1F03FC3E07F803D0FF3C01FE7 ! 803FC02607F780EBEF009126000FFEEB1FE001FE5C495CA2495CB3B500C1B50083B5FCA3 ! 40207D9F45>109 D<3903F007F800FFEB3FFF4A7F9039F1F03FC03A0FF3C01FE03807F7 ! 804A6C7E13FE5BA25BB3B500C1B51280A329207D9F2E>I<3803F03F00FFEBFFC001F113 ! F0EBF3C7390FF78FF80007130F13FEA29038FC07F0EC03E0EC008015005BB1B512E0A31D ! 207E9F22>114 DI ! E end %%EndProlog %%BeginSetup ! %%Feature: *Resolution 300dpi ! TeXDict begin ! %%PaperSize: a4 ! %%EndSetup %%Page: 1 1 ! 1 0 bop 79 -160 a Fi(GNU)27 b(Emacs)g(Reference)f(Card)461 ! -92 y Fh(\(for)14 b(v)o(ersion)g(19\))0 28 y Fg(Starting)23 ! b(Emacs)0 125 y Fh(T)m(o)13 b(en)o(ter)i(GNU)f(Emacs)f(19,)g(just)h(t)o ! (yp)q(e)g(its)g(name:)j Ff(emacs)0 192 y Fh(T)m(o)c(read)h(in)g(a)f ! (\014le)h(to)g(edit,)g(see)h(Files,)e(b)q(elo)o(w.)0 ! 306 y Fg(Lea)n(ving)23 b(Emacs)0 403 y Fh(susp)q(end)15 ! b(Emacs)f(\(or)g(iconify)e(it)i(under)h(X\))202 b Ff(C-z)0 ! 453 y Fh(exit)14 b(Emacs)f(p)q(ermanen)o(tly)458 b Ff(C-x)21 ! b(C-c)0 567 y Fg(Files)0 665 y Fe(read)13 b Fh(a)h(\014le)g(in)o(to)f ! (Emacs)490 b Ff(C-x)21 b(C-f)0 715 y Fe(sa)o(v)o(e)13 ! b Fh(a)h(\014le)g(bac)o(k)g(to)f(disk)478 b Ff(C-x)21 ! b(C-s)0 764 y Fh(sa)o(v)o(e)14 b Fe(all)f Fh(\014les)678 ! b Ff(C-x)21 b(s)0 814 y Fe(insert)12 b Fh(con)o(ten)o(ts)j(of)e ! (another)h(\014le)g(in)o(to)f(this)h(bu\013er)68 b Ff(C-x)21 ! b(i)0 864 y Fh(replace)15 b(this)f(\014le)g(with)f(the)i(\014le)f(y)o ! (ou)f(really)g(w)o(an)o(t)98 b Ff(C-x)21 b(C-v)0 914 ! y Fh(write)14 b(bu\013er)h(to)f(a)f(sp)q(eci\014ed)j(\014le)369 ! b Ff(C-x)21 b(C-w)0 964 y Fh(v)o(ersion)14 b(con)o(trol)g(c)o(hec)o ! (kin/c)o(hec)o(k)o(out)310 b Ff(C-x)21 b(C-q)0 1084 y ! Fg(Getting)h(Help)0 1182 y Fh(The)14 b(Help)f(system)g(is)g(simple.)j ! (T)o(yp)q(e)d Ff(C-h)g Fh(\(or)g Ff(F1)p Fh(\))g(and)g(follo)o(w)e(the) ! i(direc-)0 1231 y(tions.)18 b(If)13 b(y)o(ou)h(are)g(a)g(\014rst-time)f ! (user,)h(t)o(yp)q(e)h Ff(C-h)21 b(t)14 b Fh(for)f(a)h ! Fe(tutorial)p Fh(.)0 1298 y(remo)o(v)o(e)f(Help)h(windo)o(w)522 ! b Ff(C-x)21 b(1)0 1347 y Fh(scroll)14 b(Help)g(windo)o(w)555 ! b Ff(C-M-v)0 1414 y Fh(aprop)q(os:)18 b(sho)o(w)c(commands)d(matc)o ! (hing)i(a)g(string)100 b Ff(C-h)21 b(a)0 1463 y Fh(sho)o(w)14 ! b(the)g(function)g(a)g(k)o(ey)f(runs)376 b Ff(C-h)21 ! b(c)0 1513 y Fh(describ)q(e)16 b(a)d(function)556 b Ff(C-h)21 ! b(f)0 1563 y Fh(get)14 b(mo)q(de-sp)q(eci\014c)g(information)361 ! b Ff(C-h)21 b(m)0 1677 y Fg(Error)j(Reco)n(v)n(ery)0 ! 1775 y Fe(ab)q(ort)13 b Fh(partially)f(t)o(yp)q(ed)j(or)f(executing)g ! (command)75 b Ff(C-g)0 1825 y Fe(reco)o(v)o(er)13 b Fh(a)g(\014le)h ! (lost)g(b)o(y)f(a)h(system)g(crash)144 b Ff(M-x)21 b(recover-file)0 ! 1874 y Fe(undo)12 b Fh(an)i(un)o(w)o(an)o(ted)g(c)o(hange)414 ! b Ff(C-x)21 b(u)h Fh(or)g Ff(C-_)0 1924 y Fh(restore)16 ! b(a)d(bu\013er)i(to)f(its)g(original)e(con)o(ten)o(ts)115 ! b Ff(M-x)21 b(revert-buffer)0 1974 y Fh(redra)o(w)14 b(garbaged)g(screen)476 b Ff(C-l)0 2088 y Fg(Incremen)n(tal)21 ! b(Searc)n(h)0 2186 y Fh(searc)o(h)15 b(forw)o(ard)635 ! b Ff(C-s)0 2236 y Fh(searc)o(h)15 b(bac)o(kw)o(ard)602 ! b Ff(C-r)0 2285 y Fh(regular)14 b(expression)h(searc)o(h)448 ! b Ff(C-M-s)0 2335 y Fh(rev)o(erse)16 b(regular)e(expression)h(searc)o ! (h)309 b Ff(C-M-r)0 2401 y Fh(select)15 b(previous)f(searc)o(h)i ! (string)391 b Ff(M-p)0 2451 y Fh(select)15 b(next)g(later)f(searc)o(h)h ! (string)366 b Ff(M-n)0 2501 y Fh(exit)14 b(incremen)o(tal)f(searc)o(h) ! 482 b Ff(RET)0 2551 y Fh(undo)14 b(e\013ect)h(of)f(last)f(c)o(haracter) ! 395 b Ff(DEL)0 2601 y Fh(ab)q(ort)14 b(curren)o(t)h(searc)o(h)533 ! b Ff(C-g)0 2667 y Fh(Use)18 b Ff(C-s)e Fh(or)h Ff(C-r)f ! Fh(again)f(to)i(rep)q(eat)h(the)f(searc)o(h)h(in)f(either)g(direction.) ! 27 b(If)0 2717 y(Emacs)13 b(is)h(still)f(searc)o(hing,)h ! Ff(C-g)f Fh(cancels)i(only)e(the)i(part)f(not)f(done.)129 ! 2783 y Fd(c)120 2784 y Fc(\015)e Fd(1996)e(F)m(ree)j(Soft)o(w)o(are)e ! (F)m(oundation,)j(Inc.)i(P)o(ermissions)e(on)e(bac)o(k.)k(v2.1)1929 ! 2832 y Fh(1)p eop %%Page: 2 2 ! 2 1 bop 0 -168 a Fg(Motion)0 -65 y Fe(en)o(tit)o(y)13 ! b(to)j(mo)o(v)o(e)f(o)o(v)o(er)350 b(bac)o(kw)o(ard)41 ! b(forw)o(ard)0 -15 y Fh(c)o(haracter)593 b Ff(C-b)173 ! b(C-f)0 35 y Fh(w)o(ord)670 b Ff(M-b)173 b(M-f)0 84 y ! Fh(line)694 b Ff(C-p)173 b(C-n)0 134 y Fh(go)13 b(to)h(line)f(b)q ! (eginning)h(\(or)g(end\))237 b Ff(C-a)173 b(C-e)0 184 ! y Fh(sen)o(tence)610 b Ff(M-a)173 b(M-e)0 234 y Fh(paragraph)574 ! b Ff(M-{)173 b(M-})0 284 y Fh(page)676 b Ff(C-x)21 b([)130 ! b(C-x)21 b(])0 333 y Fh(sexp)680 b Ff(C-M-b)129 b(C-M-f)0 ! 383 y Fh(function)610 b Ff(C-M-a)129 b(C-M-e)0 433 y ! Fh(go)13 b(to)h(bu\013er)h(b)q(eginning)e(\(or)h(end\))197 ! b Ff(M-<)173 b(M->)0 501 y Fh(scroll)14 b(to)f(next)i(screen)538 ! b Ff(C-v)0 551 y Fh(scroll)14 b(to)f(previous)i(screen)466 ! b Ff(M-v)0 600 y Fh(scroll)14 b(left)732 b Ff(C-x)21 ! b(<)0 650 y Fh(scroll)14 b(righ)o(t)704 b Ff(C-x)21 b(>)0 ! 700 y Fh(scroll)14 b(curren)o(t)h(line)f(to)f(cen)o(ter)j(of)d(screen) ! 238 b Ff(C-u)21 b(C-l)0 821 y Fg(Killi)o(ng)g(and)i(Deleting)0 ! 925 y Fe(en)o(tit)o(y)13 b(to)j(kill)496 b(bac)o(kw)o(ard)41 ! b(forw)o(ard)0 975 y Fh(c)o(haracter)15 b(\(delete,)g(not)f(kill\))282 ! b Ff(DEL)173 b(C-d)0 1024 y Fh(w)o(ord)670 b Ff(M-DEL)129 ! b(M-d)0 1074 y Fh(line)13 b(\(to)h(end)h(of)s(\))482 ! b Ff(M-0)21 b(C-k)86 b(C-k)0 1124 y Fh(sen)o(tence)610 b Ff(C-x)21 b(DEL)86 b(M-k)0 1174 y Fh(sexp)680 b Ff(M--)21 ! b(C-M-k)42 b(C-M-k)0 1242 y Fh(kill)12 b Fe(region)699 ! b Ff(C-w)0 1291 y Fh(cop)o(y)14 b(region)g(to)f(kill)g(ring)485 ! b Ff(M-w)0 1341 y Fh(kill)12 b(through)i(next)h(o)q(ccurrence)h(of)e ! Fb(char)246 b Ff(M-z)21 b Fb(char)0 1409 y Fh(y)o(ank)13 ! b(bac)o(k)h(last)g(thing)f(killed)417 b Ff(C-y)0 1459 ! y Fh(replace)15 b(last)e(y)o(ank)h(with)f(previous)i(kill)262 ! b Ff(M-y)0 1585 y Fg(Marking)0 1688 y Fh(set)15 b(mark)d(here)653 ! b Ff(C-@)21 b Fh(or)h Ff(C-SPC)0 1738 y Fh(exc)o(hange)15 ! b(p)q(oin)o(t)e(and)h(mark)438 b Ff(C-x)21 b(C-x)0 1806 ! y Fh(set)15 b(mark)d Fb(ar)n(g)17 b Fe(w)o(ords)c Fh(a)o(w)o(a)o(y)428 ! b Ff(M-@)0 1856 y Fh(mark)12 b Fe(paragraph)579 b Ff(M-h)0 ! 1906 y Fh(mark)12 b Fe(page)697 b Ff(C-x)21 b(C-p)0 1955 ! y Fh(mark)12 b Fe(sexp)700 b Ff(C-M-@)0 2005 y Fh(mark)12 b Fe(function)619 b Ff(C-M-h)0 2055 y Fh(mark)12 b(en)o(tire)j Fe(bu\013er)552 b Ff(C-x)21 b(h)0 2176 y Fg(Query)i(Replace)0 --- 1,910 ---- %!PS-Adobe-2.0 ! %%Creator: dvips 5.47 Copyright 1986-91 Radical Eye Software %%Title: refcard.dvi ! %%Pages: 6 1 ! %%BoundingBox: 0 0 612 792 %%EndComments ! %%BeginProcSet: tex.pro ! /TeXDict 200 dict def TeXDict begin /N /def load def /B{bind def}N /S /exch ! load def /X{S N}B /TR /translate load N /isls false N /vsize 10 N /@rigin{ ! isls{[0 1 -1 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale ! Resolution VResolution vsize neg mul TR matrix currentmatrix dup dup 4 get ! round 4 exch put dup dup 5 get round 5 exch put setmatrix}N /@letter{/vsize 10 ! N}B /@landscape{/isls true N /vsize -1 N}B /@a4{/vsize 10.6929133858 N}B /@a3{ ! /vsize 15.5531 N}B /@ledger{/vsize 16 N}B /@legal{/vsize 13 N}B /@manualfeed{ ! statusdict /manualfeed true put}B /@copies{/#copies X}B /FMat[1 0 0 -1 0 0]N ! /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{/nn 8 dict N nn begin ! /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N string /base X array ! /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N end dup{/foo setfont}2 ! array copy cvx N load 0 nn put /ctr 0 N[}B /df{/sf 1 N /fntrx FMat N df-tail} ! B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0]N df-tail}B /E{pop nn dup definefont ! setfont}B /ch-width{ch-data dup length 5 sub get}B /ch-height{ch-data dup ! length 4 sub get}B /ch-xoff{128 ch-data dup length 3 sub get sub}B /ch-yoff{ ! ch-data dup length 2 sub get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B ! /ch-image{ch-data dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 ! N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S ! dup /base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx 0 ! ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff setcachedevice ! ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff .1 add]{ch-image} ! imagemask restore}B /D{/cc X dup type /stringtype ne{]}if nn /base get cc ctr ! put nn /BitMaps get S ctr S sf 1 ne{dup dup length 1 sub dup 2 index S get sf ! div put}if put /ctr ctr 1 add N}B /I{cc 1 add D}B /bop{userdict /bop-hook ! known{bop-hook}if /SI save N @rigin 0 0 moveto}N /eop{clear SI restore ! showpage userdict /eop-hook known{eop-hook}if}N /@start{userdict /start-hook ! known{start-hook}if /VResolution X /Resolution X 1000 div /DVImag X /IE 256 ! array N 0 1 255{IE S 1 string dup 0 3 index put cvn put}for}N /p /show load N ! /RMat[1 0 0 -1 0 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley X ! /rulex X V}B /V statusdict begin /product where{pop product dup length 7 ge{0 ! 7 getinterval(Display)eq}{pop false}ifelse}{false}ifelse end{{gsave TR -.1 -.1 ! TR 1 1 scale rulex ruley false RMat{BDot}imagemask grestore}}{{gsave TR -.1 ! -.1 TR rulex ruley scale 1 1 false RMat{BDot}imagemask grestore}}ifelse B /a{ ! moveto}B /delta 0 N /tail{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{ ! S p tail}B /c{-4 M}B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B ! /j{3 M}B /k{4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w ! }B /q{p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{p 4 w}B /x{0 S rmoveto}B /y{3 2 roll p ! a}B /bos{/SS save N}B /eos{clear SS restore}B end ! /TeXscale { 65536 div } def ! ! /DocumentInitState [ matrix currentmatrix currentlinewidth currentlinecap ! currentlinejoin currentdash currentgray currentmiterlimit ] cvx def ! ! /startTexFig { ! /SavedState save def ! userdict maxlength dict begin ! currentpoint transform ! ! DocumentInitState setmiterlimit setgray setdash setlinejoin setlinecap ! setlinewidth setmatrix ! ! itransform moveto ! ! /ury exch TeXscale def ! /urx exch TeXscale def ! /lly exch TeXscale def ! /llx exch TeXscale def ! /y exch TeXscale def ! /x exch TeXscale def ! ! currentpoint /cy exch def /cx exch def ! ! /sx x urx llx sub div def % scaling for x ! /sy y ury lly sub div def % scaling for y ! ! sx sy scale % scale by (sx,sy) ! ! cx sx div llx sub ! cy sy div ury sub translate ! ! /DefFigCTM matrix currentmatrix def ! ! /initmatrix { ! DefFigCTM setmatrix ! } def ! /defaultmatrix { ! DefFigCTM exch copy ! } def ! ! /initgraphics { ! DocumentInitState setmiterlimit setgray setdash ! setlinejoin setlinecap setlinewidth setmatrix ! DefFigCTM setmatrix ! } def ! ! /showpage { ! initgraphics ! } def ! /erasepage { ! initgraphics ! } def ! /copypage {} def ! ! } def ! /clipFig { ! currentpoint 6 2 roll ! newpath 4 copy ! 4 2 roll moveto ! 6 -1 roll exch lineto ! exch lineto ! exch lineto ! closepath clip ! newpath ! moveto ! } def ! /doclip { llx lly urx ury clipFig } def ! /endTexFig { ! end SavedState restore ! } def %%EndProcSet ! TeXDict begin 1000 300 300 @start /Fa 1 59 df<60F0F06004047C830C>58 ! D E /Fb 19 122 df45 D<03CC063C0C3C181C3838303870387038 ! E070E070E070E070E0E2C0E2C0E261E462643C380F127B9115>97 D<3F00070007000E000E000E ! 000E001C001C001C001C0039C03E60383038307038703870387038E070E070E070E060E0E0C0C0 ! C1C0618063003C000D1D7B9C13>I<01F007080C08181C3838300070007000E000E000E000E000 ! E000E008E010602030C01F000E127B9113>I<001F800003800003800007000007000007000007 ! 00000E00000E00000E00000E0003DC00063C000C3C00181C00383800303800703800703800E070 ! 00E07000E07000E07000E0E200C0E200C0E20061E4006264003C3800111D7B9C15>I<01E00710 ! 0C1018083810701070607F80E000E000E000E000E000E0086010602030C01F000D127B9113>I< ! 00F3018F030F06070E0E0C0E1C0E1C0E381C381C381C381C383830383038187818F00F70007000 ! 7000E000E0C0C0E1C0C3007E00101A7D9113>103 D<0FC00001C00001C0000380000380000380 ! 000380000700000700000700000700000E78000E8C000F0E000E0E001C0E001C0E001C0E001C0E ! 00381C00381C00381C00383800703880703880707080707100E03200601C00111D7D9C15>I<01 ! 800380010000000000000000000000000000001C002600470047008E008E000E001C001C001C00 ! 38003800710071007100720072003C00091C7C9B0D>I<1F800380038007000700070007000E00 ! 0E000E000E001C001C001C001C0038003800380038007000700070007000E400E400E400E40068 ! 003800091D7C9C0B>108 D<3C1E0780266318C04683A0E04703C0E08E0380E08E0380E00E0380 ! E00E0380E01C0701C01C0701C01C0701C01C070380380E0388380E0388380E0708380E0710701C ! 0320300C01C01D127C9122>I<3C3C002646004687004707008E07008E07000E07000E07001C0E ! 001C0E001C0E001C1C00381C40381C40383840383880701900300E0012127C9117>I<01E00718 ! 0C0C180C380C300E700E700EE01CE01CE01CE018E038E030E06060C031801E000F127B9115>I< ! 07870004D98008E0C008E0C011C0E011C0E001C0E001C0E00381C00381C00381C0038180070380 ! 0703000707000706000E8C000E70000E00000E00001C00001C00001C00001C00003C0000FF8000 ! 131A7F9115>I<3C3C26C2468747078E068E000E000E001C001C001C001C003800380038003800 ! 7000300010127C9112>114 D<01F006080C080C1C18181C001F001FC00FF007F0007800386030 ! E030C030806060C01F000E127D9111>I<00C001C001C001C00380038003800380FFE007000700 ! 07000E000E000E000E001C001C001C001C00384038403840388019000E000B1A7D990E>I<1E03 ! 00270700470700470700870E00870E000E0E000E0E001C1C001C1C001C1C001C1C003838803838 ! 801838801839001C5900078E0011127C9116>I<1E03270747074707870E870E0E0E0E0E1C1C1C ! 1C1C1C1C1C38383838183818381C7007F00070007000E0E0C0E1C0818047003C00101A7C9114> ! 121 D E /Fc 1 14 df<003F800000FFE00003C0780007001C000C000600180003003000018030 ! 000180600000C0600000C0C0000060C0000060C0000060C0000060C0000060C0000060600000C0 ! 600000C03000018030000180180003000C00060007001C0003C0780000FFE000003F80001B1A7E ! 9321>13 D E /Fd 47 122 df<40E06020202040408003097D8209>44 DI< ! 40E04003037D8209>I<0F0030C0606060604020C030C030C030C030C030C030C030C030C03040 ! 206060606030C00F000C137E9211>48 D<0C001C00EC000C000C000C000C000C000C000C000C00 ! 0C000C000C000C000C000C000C00FFC00A137D9211>I<1F0060C06060F070F030603000700070 ! 006000C001C00180020004000810101020207FE0FFE00C137E9211>I<0FC03070703870387038 ! 0038003000E00FC0007000380018001C601CF01CF018E03860701FC00E137F9211>I<60607FC0 ! 7F8044004000400040004F0070C040E0006000700070E070E070E06040E021C01F000C137E9211 ! >53 D<07C00C201070207060006000C000CF00D0C0E060C020C030C030C03040306020206010C0 ! 0F000C137E9211>I<40007FFC7FF8401080108020004000800100010003000200060006000E00 ! 0E000E000E000E0004000E147E9311>I<0F00308060404060C020C030C030C0304030607030B0 ! 0F30003000200060E040E08041003E000C137E9211>57 D<003000003000007800007800007800 ! 009C00009C00011E00010E00010E0002070002070004038007FF800403800801C00801C01000E0 ! 3800E0FE07FC16147F9319>65 DI<00FC200703600C00E0180060300060700020600020E00000E00000E00000E00000E00000 ! E000006000207000203000201800400C008007030000FC0013147E9318>I69 DI<00FC200703600C00E0180060300060700020600020E00000E00000E000 ! 00E00000E00FF8E000E06000E07000E03000E01800E00C00E007036000FC2015147E931A>I73 D77 DI80 ! D<1F1030F06030C030C010C010E00070007F003FC00FF000F000380018801880188018C030F060 ! 8FC00D147E9312>83 D<7FFFF06070304070104070108070088070088070080070000070000070 ! 0000700000700000700000700000700000700000700000700000700007FF0015147F9318>II<7F00E1C0E0404060006007E0 ! 38606060C060C064C06461E43E380E0D7E8C11>97 DI<0FE0187020706020C0 ! 00C000C000C000C0006000201018200FC00C0D7F8C0F>I<00780018001800180018001800180F ! 98187820386018C018C018C018C018C0186018203810580F9E0F147F9312>I<0F801040202060 ! 30C010FFF0C000C000C0006000201018200FC00C0D7F8C0F>I<03C00CE018E018401800180018 ! 00FF00180018001800180018001800180018001800180018007F000B1480930A>I<0F3C30E620 ! 40606060606060204030C02F00600060003FE03FF06018C00CC00CC00C601830300FC00F147F8C ! 11>II<2070200000000000F03030303030303030303030FC06157F9409>I107 DIII<0FC01860 ! 20106018C00CC00CC00CC00CC00C6018601838700FC00E0D7F8C11>II114 ! D<3E806180C080C080E0007E003F8003C080C080C0C0C0E1809F000A0D7F8C0D>I<1000100010 ! 0030007000FF80300030003000300030003000300030803080308011000E0009127F910D>IIIIII ! E /Fe 25 122 df<003FE3F801F03F1C03C03E3E07C07C3E0F807C3E0F807C1C0F807C000F807C ! 000F807C000F807C000F807C00FFFFFFC0FFFFFFC00F807C000F807C000F807C000F807C000F80 ! 7C000F807C000F807C000F807C000F807C000F807C000F807C000F807C000F807C000F807C007F ! E1FFC07FE1FFC01F1D809C1C>11 D<0FF8001C1E003E0F803E07803E07C01C07C00007C0007FC0 ! 07E7C01F07C03C07C07C07C0F807C0F807C0F807C0780BC03E13F80FE1F815127F9117>97 ! DI<03FC000E0E001C1F003C1F00781F00780E00F80000F8 ! 0000F80000F80000F80000F800007800007801803C01801C03000E0E0003F80011127E9115>I< ! 000FF0000FF00001F00001F00001F00001F00001F00001F00001F00001F00001F001F9F00F07F0 ! 1C03F03C01F07801F07801F0F801F0F801F0F801F0F801F0F801F0F801F07801F07801F03C01F0 ! 1C03F00F0FFE03F9FE171D7E9C1B>I<01FC000F07001C03803C01C07801C07801E0F801E0F801 ! E0FFFFE0F80000F80000F800007800007C00603C00601E00C00F038001FC0013127F9116>I<00 ! 7F0001E38003C7C00787C00F87C00F83800F80000F80000F80000F80000F8000FFF800FFF8000F ! 80000F80000F80000F80000F80000F80000F80000F80000F80000F80000F80000F80000F80000F ! 80007FF8007FF800121D809C0F>I<03F8F00E0F381E0F381C07303C07803C07803C07803C0780 ! 1C07001E0F000E0E001BF8001000001800001800001FFF001FFFC00FFFE01FFFF07801F8F00078 ! F00078F000787000707800F01E03C007FF00151B7F9118>II<1E003F003F003F003F001E00000000000000000000000000FF00FF001F001F001F001F001F ! 001F001F001F001F001F001F001F001F001F00FFE0FFE00B1E7F9D0E>I107 DIII<01FC ! 000F07801C01C03C01E07800F07800F0F800F8F800F8F800F8F800F8F800F8F800F87800F07800 ! F03C01E01E03C00F078001FC0015127F9118>II<03F0600F0CE01E07E03C03E0 ! 7C03E07803E0F803E0F803E0F803E0F803E0F803E0F803E07803E07C03E03C03E01C07E00E0FE0 ! 03F3E00003E00003E00003E00003E00003E00003E0001FFC001FFC161A7E9119>II<1FD830786018E018E018F000FF807FE07FF01FF807FC ! 007CC01CC01CE01CE018F830CFC00E127E9113>I<0300030003000300070007000F000F003FFC ! FFFC1F001F001F001F001F001F001F001F001F001F0C1F0C1F0C1F0C0F08079803F00E1A7F9913 ! >IIIIII ! E /Ff 75 126 df<60F0F0F0F0F0F0F0F0F0F0F0F0F0F0F0600000000060F0F0600419779816> ! 33 DI<0387000387000387 ! 000387000387000387007FFFC0FFFFE0FFFFE0070E00070E00070E000E1C000E1C000E1C000E1C ! 00FFFFE0FFFFE07FFFC01C38001C38001C38001C38001C38001C380013197F9816>I<00C00001 ! C00001C00001C00007F0001FFC003FFE007DCF0071C780E1C380E1C780E1C780F1C30079C0003F ! C0001FF00007FC0001FE0001CF0001C70061C380F1C380F1C380E1C38071C70079DF003FFE001F ! F80007E00001C00001C00000C00011207E9C16>I<3801807C03807C0380EE0700EE0700EE0E00 ! EE0E00EE0E00EE1C007C1C007C380038380000700000700000700000E00000E00001C00001C000 ! 01C0000380000383800707C00707C00E0EE00E0EE00E0EE01C0EE01C0EE03807C03807C0180380 ! 13207F9C16>I<30787C3C1C1C1C1C3878F0E040060D789816>39 D<00E001E0038007000E001C ! 001C0038003800700070007000E000E000E000E000E000E000E000E000E0007000700070003800 ! 38001C001C000E000700038001E000E00B217A9C16>II<01C00001C00001C00001C00071C700F9CF807FFF00 ! 1FFC0007F00007F0001FFC007FFF00F9CF8071C70001C00001C00001C00001C00011127E9516> ! I<01C00001C00001C00001C00001C00001C00001C00001C000FFFF80FFFF80FFFF8001C00001C0 ! 0001C00001C00001C00001C00001C00001C00011137E9516>I<387C7E7E3E0E1E1C78F060070B ! 798416>II<70F8F8F8700505788416>I<00018000038000 ! 0380000700000700000E00000E00001C00001C0000380000380000700000700000E00000E00001 ! C00001C0000380000380000700000700000E00000E00001C00001C000038000038000070000070 ! 0000E00000E00000C0000011207E9C16>I<03E0000FF8001FFC001E3C00380E00780F00700700 ! 700700E00380E00380E00380E00380E00380E00380E00380E00380F00780700700700700780F00 ! 3C1E001E3C001FFC000FF80003E00011197E9816>I<01800380038007800F807F80FF80738003 ! 8003800380038003800380038003800380038003800380038003807FF87FFC7FF80E197C9816> ! I<07E0001FF8003FFC00783E00E00700F00780F00380600380000380000380000700000700000E ! 00001C0000380000700000E00001C0000380000F00001E03803803807FFF80FFFF807FFF801119 ! 7E9816>I<07E0001FF8003FFC00781E00780700300700000700000700000E00003E0007FC0007 ! F00007FC00001E00000700000300000380000380600380F00380E00700781E003FFC001FF80007 ! E00011197E9816>I<007C0000FC0000DC0001DC00039C00039C00071C000F1C000E1C001E1C00 ! 3C1C00381C00781C00F01C00FFFFE0FFFFE0FFFFE0001C00001C00001C00001C00001C0001FFC0 ! 01FFC001FFC013197F9816>I<3FFE003FFE003FFE003800003800003800003800003800003800 ! 003800003BF0003FFC003FFE003C0F00300700000380000380600380F00380F00380E00700781E ! 003FFC001FF80007E00011197E9816>I<70F8F8F870000000000000000070F8F8F87005127891 ! 16>58 D<000180000780001F80003E0000F80001F00007C0000F80003E0000FC0000F00000FC00 ! 003E00000F800007C00001F00000F800003E00001F8000078000018011157E9616>60 ! D62 ! D<0FE03FF87FFCF01EF00EF00E601E003C007800F001C003800380038003800380030000000000 ! 0000000003000780078003000F197D9816>I<00F80003FC0007FE000F07001C3F80387F8078FF ! 8071C3C071C3C0E381C0E381C0E381C0E381C0E381C0E381C0E381C071C38071C38078FF00387E ! 001C3C000F03C007FFC003FF0000FC0012197E9816>I<00E00001F00001F00001B00001B00003 ! B80003B80003B800031800071C00071C00071C00071C00071C000E0E000E0E000FFE000FFE001F ! FF001C07001C07001C07007F1FC0FF1FE07F1FC013197F9816>I<7FF800FFFE007FFF001C0F00 ! 1C07801C03801C03801C03801C07801C07001FFF001FFE001FFE001C1F001C03801C03C01C01C0 ! 1C01C01C01C01C01C01C03C01C07807FFF80FFFF007FFC0012197F9816>I<01F18007FB800FFF ! 801F0F803C0780380380700380700380F00000E00000E00000E00000E00000E00000E00000E000 ! 00F000007003807003803803803C07001F0F000FFE0007FC0001F00011197E9816>I<7FF800FF ! FE007FFF001C0F001C07801C03C01C01C01C01C01C01E01C00E01C00E01C00E01C00E01C00E01C ! 00E01C00E01C00E01C01C01C01C01C03C01C07801C0F807FFF00FFFE007FF8001319809816>I< ! 7FFFC0FFFFC07FFFC01C01C01C01C01C01C01C01C01C00001C00001C1C001C1C001FFC001FFC00 ! 1FFC001C1C001C1C001C00001C00E01C00E01C00E01C00E01C00E07FFFE0FFFFE07FFFE013197F ! 9816>II<03E30007FF000FFF001E1F003C0F00380700700700700700F00000E00000E0 ! 0000E00000E00000E03F80E07FC0E03F80F00700700700700700380F003C0F001E1F000FFF0007 ! F70003E70012197E9816>I76 DI<7E1FC0FF3FE07F1FC01D07001D87001D8700 ! 1D87001DC7001DC7001CC7001CC7001CE7001CE7001CE7001C67001C67001C77001C77001C3700 ! 1C37001C37001C17007F1F00FF9F007F0F0013197F9816>I<7FF800FFFE007FFF001C0F801C03 ! 801C03C01C01C01C01C01C01C01C03C01C03801C0F801FFF001FFE001FF8001C00001C00001C00 ! 001C00001C00001C00001C00007F0000FF80007F000012197F9816>80 D<7FE000FFF8007FFC00 ! 1C1E001C0F001C07001C07001C07001C07001C0F001C1E001FFC001FF8001FFC001C1C001C0E00 ! 1C0E001C0E001C0E001C0E201C0E701C0E707F07E0FF87E07F03C014197F9816>82 ! D<07E3001FFF003FFF00781F00F00700E00700E00700E00000F000007800003F80001FF00007FC ! 0000FE00000F00000700000380000380600380E00380E00700F80F00FFFE00FFFC00C7F0001119 ! 7E9816>I<7FFFE0FFFFE0FFFFE0E0E0E0E0E0E0E0E0E0E0E0E000E00000E00000E00000E00000 ! E00000E00000E00000E00000E00000E00000E00000E00000E00000E00000E00007FC000FFE0007 ! FC0013197F9816>I87 D91 DII<03000F803FE0FDF8F07840100D ! 067C9816>II<081C3C7870E0E0E0E0F0F87830060D789B16 ! >I<1FE0003FF0007FF800783C00300E00000E00000E0003FE001FFE003E0E00700E00E00E00E0 ! 0E00E00E00783E007FFFE03FE7E00F83E013127E9116>I<7E0000FE00007E00000E00000E0000 ! 0E00000E00000E3E000EFF000FFF800F83C00F00E00E00E00E00700E00700E00700E00700E0070 ! 0E00700E00E00F01E00F83C00FFF800EFF00063C001419809816>I<03F80FFC1FFE3C1E780C70 ! 00E000E000E000E000E000F000700778073E0E1FFC0FF803F010127D9116>I<003F00007F0000 ! 3F0000070000070000070000070003C7000FF7001FFF003C1F00780F00700700E00700E00700E0 ! 0700E00700E00700E00700700F00700F003C1F001FFFE00FE7F007C7E014197F9816>I<03E00F ! F81FFC3C1E780E7007E007FFFFFFFFFFFFE000E000700778073C0F1FFE0FFC03F010127D9116> ! I<001F00007F8000FF8001E78001C30001C00001C0007FFF00FFFF00FFFF0001C00001C00001C0 ! 0001C00001C00001C00001C00001C00001C00001C00001C00001C0003FFE007FFF003FFE001119 ! 7F9816>I<03E3C007F7E00FFFE01C1CC0380E00380E00380E00380E00380E001C1C000FF8001F ! F0001BE0003800001800001FFC001FFF003FFF807803C0E000E0E000E0E000E0E000E07001C07C ! 07C03FFF800FFE0003F800131C7F9116>I<7E0000FE00007E00000E00000E00000E00000E0000 ! 0E3C000EFE000FFF000F87800F03800E03800E03800E03800E03800E03800E03800E03800E0380 ! 0E03800E03807FC7F0FFE7F87FC7F01519809816>I<018003C003C0018000000000000000007F ! C07FC07FC001C001C001C001C001C001C001C001C001C001C001C001C07FFFFFFF7FFF101A7D99 ! 16>I<003000780078003000000000000000001FF81FF81FF80038003800380038003800380038 ! 0038003800380038003800380038003800380038003800386070F0F0FFE07FC03F800D237E9916 ! >I<7E0000FE00007E00000E00000E00000E00000E00000E7FE00E7FE00E7FE00E0F000E1E000E ! 3C000E78000EF0000FF0000FF8000FBC000F1E000E0E000E07000E07807F87F0FFCFF07F87F014 ! 19809816>III<7E3C00FEFE007F ! FF000F87800F03800E03800E03800E03800E03800E03800E03800E03800E03800E03800E03807F ! C7F0FFE7F87FC7F01512809116>I<03E0000FF8001FFC003C1E00780F00700700E00380E00380 ! E00380E00380E00380F00780700700780F003C1E001FFC000FF80003E00011127E9116>I<7E3E ! 00FEFF007FFF800F83C00F00E00E00E00E00700E00700E00700E00700E00700E00700E00E00F01 ! E00F83C00FFF800EFF000E3C000E00000E00000E00000E00000E00000E00007FC000FFE0007FC0 ! 00141B809116>I<07C7000FE7001FF7003C1F00700F00700F00E00700E00700E00700E00700E0 ! 0700E00700700F00700F003C3F003FF7001FE70007C70000070000070000070000070000070000 ! 0700003FE0007FF0003FE0141B7E9116>I ! I<0FEC3FFC7FFCF03CE01CE01C70007F801FF007F8003C600EE00EF00EF81EFFFCFFF8C7E00F12 ! 7D9116>I<0300000700000700000700000700007FFF00FFFF00FFFF0007000007000007000007 ! 000007000007000007000007010007038007038007038007870003FE0001FC0000F80011177F96 ! 16>I<7E1F80FE3F807E1F800E03800E03800E03800E03800E03800E03800E03800E03800E0380 ! 0E03800E03800E0F800FFFF007FBF803E3F01512809116>I<7F1FC0FF1FE07F1FC01C07001E0F ! 000E0E000E0E000E0E00071C00071C00071C00071C0003B80003B80003B80001F00001F00000E0 ! 0013127F9116>II<7F1FC07F3FC07F1FC0 ! 0F1C00073C0003B80003F00001F00000E00001E00001F00003B800073C00071C000E0E007F1FC0 ! FF3FE07F1FC013127F9116>I<7F1FC0FF9FE07F1FC01C07000E07000E0E000E0E00070E00071C ! 00071C00039C00039C0003980001B80001B80000F00000F00000F00000E00000E00000E00001C0 ! 0079C0007BC0007F80003F00003C0000131B7F9116>I<3FFFC07FFFC07FFFC0700780700F0070 ! 1E00003C0000780001F00003E0000780000F00001E01C03C01C07801C0FFFFC0FFFFC0FFFFC012 ! 127F9116>I<001F80007F8000FF8001E00001C00001C00001C00001C00001C00001C00001C000 ! 01C00001C00003C0007F8000FF0000FF00007F800003C00001C00001C00001C00001C00001C000 ! 01C00001C00001C00001C00001E00000FF80007F80001F8011207E9C16>II<7C0000FF0000FF80 ! 0003C00001C00001C00001C00001C00001C00001C00001C00001C00001C00001E00000FF00007F ! 80007F8000FF0001E00001C00001C00001C00001C00001C00001C00001C00001C00001C00003C0 ! 00FF8000FF00007C000011207E9C16>I E /Fg 42 123 df<0001FF81FE00001FFFEFFF80007F ! 80FF87C000FC00FE0FE001F801FE0FE003F801FC0FE007F001FC0FE007F001FC07C007F001FC00 ! 0007F001FC000007F001FC000007F001FC000007F001FC000007F001FC000007F001FC0000FFFF ! FFFFF800FFFFFFFFF800FFFFFFFFF80007F001FC000007F001FC000007F001FC000007F001FC00 ! 0007F001FC000007F001FC000007F001FC000007F001FC000007F001FC000007F001FC000007F0 ! 01FC000007F001FC000007F001FC000007F001FC000007F001FC000007F001FC000007F001FC00 ! 0007F001FC000007F001FC000007F001FC000007F001FC00007FFF1FFFE0007FFF1FFFE0007FFF ! 1FFFE0002B2A7FA928>11 D<000003800000000007C00000000007C0000000000FE0000000000F ! E0000000000FE0000000001FF0000000001FF0000000003FF8000000003FF8000000003FF80000 ! 000073FC0000000073FC00000000F3FE00000000E1FE00000000E1FE00000001C0FF00000001C0 ! FF00000003C0FF80000003807F80000007807FC0000007003FC0000007003FC000000E003FE000 ! 000E001FE000001E001FF000001C000FF000001FFFFFF000003FFFFFF800003FFFFFF800007800 ! 07FC0000700003FC0000700003FC0000E00001FE0000E00001FE0001E00001FF0001C00000FF00 ! 01C00000FF00FFFE001FFFFEFFFE001FFFFEFFFE001FFFFE2F297EA834>65 ! DI<00003FF001800003FFFE0380000FFFFF878000 ! 3FF007DF8000FF8001FF8001FE00007F8003FC00003F8007F000001F800FF000000F801FE00000 ! 07801FE0000007803FC0000007803FC0000003807FC0000003807F80000003807F8000000000FF ! 8000000000FF8000000000FF8000000000FF8000000000FF8000000000FF8000000000FF800000 ! 0000FF8000000000FF80000000007F80000000007F80000000007FC0000003803FC0000003803F ! C0000003801FE0000003801FE0000007000FF00000070007F000000E0003FC00001E0001FE0000 ! 3C0000FF8000F800003FF007E000000FFFFFC0000003FFFF000000003FF8000029297CA832>I< ! FFFFFFF80000FFFFFFFF8000FFFFFFFFE00003FC001FF80003FC0007FC0003FC0001FE0003FC00 ! 00FF0003FC00007F8003FC00003FC003FC00001FC003FC00001FE003FC00001FE003FC00000FF0 ! 03FC00000FF003FC00000FF003FC00000FF003FC00000FF803FC00000FF803FC00000FF803FC00 ! 000FF803FC00000FF803FC00000FF803FC00000FF803FC00000FF803FC00000FF803FC00000FF8 ! 03FC00000FF003FC00000FF003FC00000FF003FC00001FE003FC00001FE003FC00001FC003FC00 ! 003FC003FC00007F8003FC00007F0003FC0001FE0003FC0003FC0003FC001FF800FFFFFFFFE000 ! FFFFFFFF8000FFFFFFFC00002D297DA835>III<00007FE003000003FFFC0700001FFFFF0F00003FF00FFF0000 ! FF8001FF0001FE0000FF0003F800003F0007F000003F000FF000001F001FE000000F001FE00000 ! 0F003FC000000F003FC0000007007FC0000007007F80000007007F8000000000FF8000000000FF ! 8000000000FF8000000000FF8000000000FF8000000000FF8000000000FF8000000000FF800000 ! 0000FF8001FFFFF87F8001FFFFF87F8001FFFFF87FC00000FF003FC00000FF003FC00000FF001F ! E00000FF001FE00000FF000FF00000FF0007F00000FF0003F80000FF0001FE0000FF0000FF8001 ! FF00003FF007BF00001FFFFF1F000003FFFE0F0000007FF003002D297CA836>III75 DII<0000FFE000000007FFFC0000003FC07F8000007F001FC00001FC0007F00003 ! F80003F80007F00001FC000FF00001FE001FE00000FF001FE00000FF003FC000007F803FC00000 ! 7F807FC000007FC07FC000007FC07F8000003FC07F8000003FC0FF8000003FE0FF8000003FE0FF ! 8000003FE0FF8000003FE0FF8000003FE0FF8000003FE0FF8000003FE0FF8000003FE0FF800000 ! 3FE0FF8000003FE07F8000003FC07F8000003FC07FC000007FC03FC000007F803FC000007F801F ! E00000FF001FE01F00FF000FF03F81FE0007F060C1FC0003F8C063F80001FCC077F00000FFC07F ! E000003FE07F8000000FFFFE00000000FFFE00600000003E00600000003F00600000001F81E000 ! 00001FFFE00000001FFFC00000000FFFC00000000FFFC000000007FF8000000007FF8000000003 ! FF0000000001FE000000000078002B357CA834>81 DI<007F806003FFF0E007FFF9E00F807FE01F001FE03E0007E07C0003E07C0001E0FC0001E0FC ! 0001E0FC0000E0FE0000E0FE0000E0FF000000FFC000007FFE00007FFFE0003FFFFC001FFFFE00 ! 0FFFFF8007FFFFC003FFFFE000FFFFE00007FFF000007FF000000FF8000007F8000003F8600001 ! F8E00001F8E00001F8E00001F8F00001F0F00001F0F80003F0FC0003E0FF0007C0FFE01F80F3FF ! FF00E0FFFE00C01FF0001D297CA826>I<7FFFFFFFFFC07FFFFFFFFFC07FFFFFFFFFC07F803FC0 ! 3FC07E003FC007C078003FC003C078003FC003C070003FC001C0F0003FC001E0F0003FC001E0E0 ! 003FC000E0E0003FC000E0E0003FC000E0E0003FC000E0E0003FC000E000003FC0000000003FC0 ! 000000003FC0000000003FC0000000003FC0000000003FC0000000003FC0000000003FC0000000 ! 003FC0000000003FC0000000003FC0000000003FC0000000003FC0000000003FC0000000003FC0 ! 000000003FC0000000003FC0000000003FC0000000003FC0000000003FC0000000003FC0000000 ! 003FC00000007FFFFFE000007FFFFFE000007FFFFFE0002B287EA730>I87 D<01FF800007FFF0000F81F8001FC07E001FC07E001FC0 ! 3F000F803F8007003F8000003F8000003F8000003F80000FFF8000FFFF8007FC3F800FE03F803F ! 803F803F003F807F003F80FE003F80FE003F80FE003F80FE003F807E007F807F00DF803F839FFC ! 0FFF0FFC01FC03FC1E1B7E9A21>97 DI<00 ! 1FF80000FFFE0003F01F0007E03F800FC03F801F803F803F801F007F800E007F0000007F000000 ! FF000000FF000000FF000000FF000000FF000000FF000000FF0000007F0000007F0000007F8000 ! 003F8001C01F8001C00FC0038007E0070003F01E0000FFFC00001FE0001A1B7E9A1F>I<00003F ! F80000003FF80000003FF800000003F800000003F800000003F800000003F800000003F8000000 ! 03F800000003F800000003F800000003F800000003F800000003F800000003F800001FE3F80000 ! FFFBF80003F03FF80007E00FF8000FC007F8001F8003F8003F8003F8007F0003F8007F0003F800 ! 7F0003F800FF0003F800FF0003F800FF0003F800FF0003F800FF0003F800FF0003F800FF0003F8 ! 007F0003F8007F0003F8007F0003F8003F8003F8001F8003F8000F8007F80007C00FF80003F03B ! FF8000FFF3FF80003FC3FF80212A7EA926>I<003FE00001FFF80003F07E0007C01F000F801F80 ! 1F800F803F800FC07F000FC07F0007C07F0007E0FF0007E0FF0007E0FFFFFFE0FFFFFFE0FF0000 ! 00FF000000FF0000007F0000007F0000007F0000003F8000E01F8000E00FC001C007E0038003F8 ! 1F0000FFFE00001FF0001B1B7E9A20>I<0007F0003FFC00FE3E01F87F03F87F03F07F07F07F07 ! F03E07F00007F00007F00007F00007F00007F00007F000FFFFC0FFFFC0FFFFC007F00007F00007 ! F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007F00007 ! F00007F00007F00007F00007F00007F0007FFF807FFF807FFF80182A7EA915>I<00FF81F003FF ! E7F80FC1FE7C1F80FC7C1F007C383F007E107F007F007F007F007F007F007F007F007F007F007F ! 007F003F007E001F007C001F80FC000FC1F8001FFFE00018FF800038000000380000003C000000 ! 3E0000003FFFF8001FFFFF001FFFFF800FFFFFC007FFFFE01FFFFFF03E0007F07C0001F8F80000 ! F8F80000F8F80000F8F80000F87C0001F03C0001E01F0007C00FC01F8003FFFE00007FF0001E28 ! 7E9A22>II<07000F801FC03FE03FE03FE0 ! 1FC00F8007000000000000000000000000000000FFE0FFE0FFE00FE00FE00FE00FE00FE00FE00F ! E00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE00FE0FFFEFFFEFFFE0F2B7DAA ! 14>I107 DIII<003FE00001FFFC0003F07E000FC01F ! 801F800FC03F800FE03F0007E07F0007F07F0007F07F0007F0FF0007F8FF0007F8FF0007F8FF00 ! 07F8FF0007F8FF0007F8FF0007F8FF0007F87F0007F07F0007F03F800FE03F800FE01F800FC00F ! C01F8007F07F0001FFFC00003FE0001D1B7E9A22>II ! 114 D<03FE300FFFF01E03F03800F0700070F00070F00070F80070FC0000FFE0007FFE007FFF80 ! 3FFFE01FFFF007FFF800FFF80003FC0000FC60007CE0003CF0003CF00038F80038FC0070FF01E0 ! F7FFC0C1FF00161B7E9A1B>I<00700000700000700000700000F00000F00000F00001F00003F0 ! 0003F00007F0001FFFF0FFFFF0FFFFF007F00007F00007F00007F00007F00007F00007F00007F0 ! 0007F00007F00007F00007F00007F00007F03807F03807F03807F03807F03807F03803F03803F8 ! 7001F86000FFC0001F8015267FA51B>IIIIII<3FFFFF803F ! FFFF803F007F003C00FE003801FE007803FC007803F8007007F800700FF000700FE000001FC000 ! 003FC000007F8000007F000000FF000001FE038001FC038003F8038007F803800FF007800FE007 ! 801FE007003FC00F003F801F007F007F00FFFFFF00FFFFFF00191B7E9A1F>I ! E /Fh 62 124 df<007E1F0001C1B1800303E3C00703C3C00E03C1800E01C0000E01C0000E01C0 ! 000E01C0000E01C0000E01C000FFFFFC000E01C0000E01C0000E01C0000E01C0000E01C0000E01 ! C0000E01C0000E01C0000E01C0000E01C0000E01C0000E01C0000E01C0000E01C0000E01C0000E ! 01C0007F87FC001A1D809C18>11 D<007E0001C1800301800703C00E03C00E01800E00000E0000 ! 0E00000E00000E0000FFFFC00E01C00E01C00E01C00E01C00E01C00E01C00E01C00E01C00E01C0 ! 0E01C00E01C00E01C00E01C00E01C00E01C00E01C07F87F8151D809C17>I<6060F0F0F8F86868 ! 080808080808101010102020404080800D0C7F9C15>34 D<60F0F8680808081010204080050C7C ! 9C0C>39 D<004000800100020006000C000C0018001800300030007000600060006000E000E000 ! E000E000E000E000E000E000E000E000E000E000600060006000700030003000180018000C000C ! 00060002000100008000400A2A7D9E10>I<800040002000100018000C000C0006000600030003 ! 00038001800180018001C001C001C001C001C001C001C001C001C001C001C001C0018001800180 ! 038003000300060006000C000C00180010002000400080000A2A7E9E10>I<60F0F07010101010 ! 20204080040C7C830C>44 DI<60F0F06004047C830C>I<000100030006 ! 00060006000C000C000C0018001800180030003000300060006000C000C000C001800180018003 ! 0003000300060006000C000C000C00180018001800300030003000600060006000C000C0001029 ! 7E9E15>I<030007003F00C7000700070007000700070007000700070007000700070007000700 ! 0700070007000700070007000700070007000F80FFF80D1C7C9B15>49 D<07C01830201C400C40 ! 0EF00FF80FF807F8077007000F000E000E001C001C00380070006000C00180030006010C011801 ! 10023FFE7FFEFFFE101C7E9B15>I<07E01830201C201C781E780E781E381E001C001C00180030 ! 006007E00030001C001C000E000F000F700FF80FF80FF80FF00E401C201C183007E0101D7E9B15 ! >I<000C00000C00001C00003C00003C00005C0000DC00009C00011C00031C00021C00041C000C ! 1C00081C00101C00301C00201C00401C00C01C00FFFFC0001C00001C00001C00001C00001C0000 ! 1C00001C0001FFC0121C7F9B15>I<300C3FF83FF03FC020002000200020002000200023E02430 ! 2818301C200E000E000F000F000F600FF00FF00FF00F800E401E401C2038187007C0101D7E9B15 ! >I<00F0030C06040C0E181E301E300C700070006000E3E0E430E818F00CF00EE006E007E007E0 ! 07E007E007600760077006300E300C18180C3003E0101D7E9B15>I<03C00C301818300C700C60 ! 0EE006E006E007E007E007E007E0076007700F300F18170C2707C700060006000E300C780C7818 ! 7010203030C00F80101D7E9B15>57 D<60F0F0600000000000000000000060F0F06004127C910C ! >I<000600000006000000060000000F0000000F0000000F000000178000001780000017800000 ! 23C0000023C0000023C0000041E0000041E0000041E0000080F0000080F0000180F80001007800 ! 01FFF80003007C0002003C0002003C0006003E0004001E0004001E000C001F001E001F00FF80FF ! F01C1D7F9C1F>65 D68 DII<00 ! 1F808000E0618001801980070007800E0003801C0003801C000180380001807800008078000080 ! 70000080F0000000F0000000F0000000F0000000F0000000F0000000F000FFF0F0000F80700007 ! 807800078078000780380007801C0007801C0007800E00078007000B800180118000E06080001F ! 80001C1E7E9C21>III76 D ! II<003F800000E0E0000380380007001C000E000E001C0007003C00078038000380780003C0 ! 780003C0700001C0F00001E0F00001E0F00001E0F00001E0F00001E0F00001E0F00001E0F00001 ! E0700001C0780003C0780003C0380003803C0007801C0007000E000E0007001C000380380000E0 ! E000003F80001B1E7E9C20>I<7FFFFFC0700F01C0600F00C0400F0040400F0040C00F0020800F ! 0020800F0020800F0020000F0000000F0000000F0000000F0000000F0000000F0000000F000000 ! 0F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000000F0000 ! 001F800003FFFC001B1C7F9B1E>84 DIII<7FF0FFC00FC03E000780180003C018 ! 0003E0100001E0200001F0600000F0400000788000007D8000003D0000001E0000001F0000000F ! 0000000F8000000F80000013C0000023E0000021E0000041F00000C0F8000080780001007C0003 ! 003C0002001E0006001F001F003F80FFC0FFF01C1C7F9B1F>I<08081010202040404040808080 ! 808080B0B0F8F8787830300D0C7A9C15>92 D<1FC000307000783800781C00301C00001C00001C ! 0001FC000F1C00381C00701C00601C00E01C40E01C40E01C40603C40304E801F870012127E9115 ! >97 DI<07E00C301878307870306000E000E000E000E000 ! E000E00060007004300418080C3007C00E127E9112>I<003F0000070000070000070000070000 ! 070000070000070000070000070000070003E7000C1700180F00300700700700600700E00700E0 ! 0700E00700E00700E00700E00700600700700700300700180F000C370007C7E0131D7E9C17>I< ! 03E00C301818300C700E6006E006FFFEE000E000E000E00060007002300218040C1803E00F127F ! 9112>I<00F8018C071E061E0E0C0E000E000E000E000E000E00FFE00E000E000E000E000E000E ! 000E000E000E000E000E000E000E000E000E000E007FE00F1D809C0D>I<00038003C4C00C38C0 ! 1C3880181800381C00381C00381C00381C001818001C38000C300013C000100000300000180000 ! 1FF8001FFF001FFF803003806001C0C000C0C000C0C000C06001803003001C0E0007F800121C7F ! 9215>II<18003C003C0018000000000000000000000000 ! 000000FC001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C001C00FF80 ! 091D7F9C0C>I<00C001E001E000C000000000000000000000000000000FE000E000E000E000E0 ! 00E000E000E000E000E000E000E000E000E000E000E000E000E000E000E000E060E0F0C0F1C061 ! 803E000B25839C0D>IIIII<03F0000E1C00180600300300700380600180E001C0E001C0 ! E001C0E001C0E001C0E001C06001807003803003001806000E1C0003F00012127F9115>II<03C1000C3300180B00300F00700700700700E00700E00700E00700E00700E00700E0 ! 0700600700700700300F00180F000C370007C70000070000070000070000070000070000070000 ! 0700003FE0131A7E9116>II<1F9030704030C010C010E010F8007F803FE00FF000F880 ! 388018C018C018E010D0608FC00D127F9110>I<04000400040004000C000C001C003C00FFE01C ! 001C001C001C001C001C001C001C001C001C101C101C101C101C100C100E2003C00C1A7F9910> ! IIII<7F8FF00F03800F030007020003840001C80001D80000F00000700000780000F8 ! 00009C00010E00020E000607000403801E07C0FF0FF81512809116>II<7FFC70 ! 386038407040F040E041C003C0038007000F040E041C043C0C380870087038FFF80E127F9112> ! II E /Fi 15 116 df<000003FF80018000003FFFF003800001FFFFFC0F ! 800007FF007F1F80001FF8000FBF80003FE00003FF8000FF800000FF8001FF0000007F8003FE00 ! 00003F8007FC0000003F8007FC0000001F800FF80000001F801FF80000000F801FF00000000F80 ! 3FF000000007803FF000000007807FF000000007807FE000000007807FE000000000007FE00000 ! 000000FFE00000000000FFE00000000000FFE00000000000FFE00000000000FFE00000000000FF ! E00000000000FFE00000000000FFE00000000000FFE000000000007FE000000000007FE0000000 ! 00007FE000000000007FF000000003803FF000000003803FF000000003801FF000000003801FF8 ! 00000007800FF8000000070007FC000000070007FC0000000E0003FE0000001E0001FF0000003C ! 0000FF8000007800003FE00000F000001FF80003E0000007FF003F80000001FFFFFE000000003F ! FFF80000000003FF80000031317BB03C>67 D69 D<000003FF80018000003FFFF003800001FFFFFC0F ! 800007FF007F1F80001FF8000FBF80003FE00003FF8000FF800000FF8001FF0000007F8003FE00 ! 00003F8007FC0000003F8007FC0000001F800FF80000001F801FF80000000F801FF00000000F80 ! 3FF000000007803FF000000007807FF000000007807FE000000007807FE000000000007FE00000 ! 000000FFE00000000000FFE00000000000FFE00000000000FFE00000000000FFE00000000000FF ! E00000000000FFE00000000000FFE00000000000FFE00007FFFFFE7FE00007FFFFFE7FE00007FF ! FFFE7FE0000001FF807FF0000001FF803FF0000001FF803FF0000001FF801FF0000001FF801FF8 ! 000001FF800FF8000001FF8007FC000001FF8007FC000001FF8003FE000001FF8001FF000001FF ! 8000FF800001FF80003FE00003FF80001FF80007FF800007FF803F3F800001FFFFFE1F8000003F ! FFF80780000003FFC0018037317BB041>71 D78 D82 ! D85 D<007FF8000003FFFF000007FFFFC0000FE01FE0001FF007F0001FF003 ! F8001FF003FC001FF001FE000FE001FE0007C001FE00010001FE00000001FE00000001FE000001 ! FFFE00003FFFFE0001FFF1FE0007FE01FE000FF001FE001FC001FE003F8001FE007F8001FE00FF ! 0001FE00FF0001FE00FF0001FE00FF0001FE00FF0003FE007F8003FE007FC00EFE003FF03CFF00 ! 0FFFF87FF807FFF03FF800FF800FF825207E9F28>97 D<0007FF00007FFFE000FFFFF003FC03F8 ! 07F007FC0FE007FC1FE007FC3FC007FC3FC003F87FC001F07F8000407F800000FF800000FF8000 ! 00FF800000FF800000FF800000FF800000FF800000FF8000007F8000007FC000007FC000003FC0 ! 000E3FE0000E1FE0001C0FF0001C07F8007803FF01F000FFFFE0007FFF800007FC001F207D9F25 ! >99 D<00000007E0000003FFE0000003FFE0000003FFE00000003FE00000001FE00000001FE000 ! 00001FE00000001FE00000001FE00000001FE00000001FE00000001FE00000001FE00000001FE0 ! 0000001FE00000001FE00000001FE0000FF81FE0007FFF1FE001FFFFDFE003FE03FFE007F800FF ! E00FE0003FE01FE0001FE03FC0001FE03FC0001FE07F80001FE07F80001FE07F80001FE0FF8000 ! 1FE0FF80001FE0FF80001FE0FF80001FE0FF80001FE0FF80001FE0FF80001FE0FF80001FE07F80 ! 001FE07F80001FE07F80001FE03FC0001FE03FC0001FE01FC0003FE00FE0007FE007F001FFE003 ! FC07DFF001FFFF9FFF007FFE1FFF000FF01FFF28327DB12E>I<0007FC0000003FFF800000FFFF ! E00003FC07F00007F801F8000FE000FC001FE0007E003FC0007E003FC0003F007FC0003F007F80 ! 003F007F80003F80FF80003F80FF80003F80FFFFFFFF80FFFFFFFF80FFFFFFFF80FF80000000FF ! 80000000FF800000007F800000007F800000003FC00000003FC00003801FC00003801FE0000780 ! 0FF0000F0007F8001E0003FE00FC0000FFFFF800003FFFE0000003FF000021207E9F26>I<0000 ! FF000007FFC0001FFFE0003FC7F0007F0FF800FE0FF801FE0FF801FC0FF803FC07F003FC03E003 ! FC01C003FC000003FC000003FC000003FC000003FC000003FC000003FC0000FFFFF800FFFFF800 ! FFFFF80003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC00 ! 0003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC000003FC ! 000003FC000003FC000003FC000003FC000003FC000003FC000003FC00007FFFF0007FFFF0007F ! FFF0001D327EB119>I<03F007F8000FF000FFF03FFF007FFE00FFF07FFF80FFFF00FFF0F03FC1 ! E07F800FF1C01FE3803FC007F3000FE6001FC007F6000FFC001FE007FE000FFC001FE007FC000F ! F8001FE007FC000FF8001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F800 ! 0FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8 ! 000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007 ! F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE007F8000FF0001FE0 ! 07F8000FF0001FE0FFFFC1FFFF83FFFFFFFFC1FFFF83FFFFFFFFC1FFFF83FFFF40207D9F45> ! 109 D<03F007F80000FFF03FFF0000FFF07FFF8000FFF0F03FC0000FF1C01FE00007F3000FE000 ! 07F6000FF00007FE000FF00007FC000FF00007FC000FF00007F8000FF00007F8000FF00007F800 ! 0FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF000 ! 07F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F8000FF00007F800 ! 0FF00007F8000FF00007F8000FF00007F8000FF000FFFFC1FFFF80FFFFC1FFFF80FFFFC1FFFF80 ! 29207D9F2E>I<03F03F00FFF07FC0FFF1FFE0FFF3C7F00FF38FF807F70FF807F60FF807FE0FF8 ! 07FC07F007FC03E007FC008007F8000007F8000007F8000007F8000007F8000007F8000007F800 ! 0007F8000007F8000007F8000007F8000007F8000007F8000007F8000007F8000007F8000007F8 ! 000007F80000FFFFE000FFFFE000FFFFE0001D207E9F22>114 D<00FF870007FFEF001FFFFF00 ! 3F007F003C001F0078000F00F8000700F8000700F8000700FC000700FF000000FFF800007FFFC0 ! 003FFFF0003FFFFC000FFFFE0007FFFF0001FFFF80001FFF800000FFC000001FC060000FC0E000 ! 07C0E00007C0F00007C0F8000780F8000F80FE000F00FF803E00FFFFFC00F3FFF800C07FC0001A ! 207D9F21>I E end %%EndProlog %%BeginSetup ! %%Feature: *Resolution 300 ! TeXDict begin %%EndSetup %%Page: 1 1 ! bop 79 -160 a Fi(GNU)27 b(Emacs)g(Reference)f(Card)461 -92 ! y Fh(\(for)14 b(v)o(ersion)g(19\))0 28 y Fg(Starting)23 b(Emacs)0 ! 125 y Fh(T)m(o)13 b(en)o(ter)i(GNU)f(Emacs)f(19,)g(just)h(t)o(yp)q(e)g(its)g ! (name:)j Ff(emacs)0 192 y Fh(T)m(o)c(read)h(in)g(a)f(\014le)h(to)g(edit,)g ! (see)h(Files,)e(b)q(elo)o(w.)0 306 y Fg(Lea)n(ving)23 b(Emacs)0 ! 403 y Fh(susp)q(end)15 b(Emacs)f(\(or)g(iconify)e(it)i(under)h(X\))202 ! b Ff(C-z)0 453 y Fh(exit)14 b(Emacs)f(p)q(ermanen)o(tly)458 ! b Ff(C-x)21 b(C-c)0 567 y Fg(Files)0 665 y Fe(read)13 b Fh(a)h(\014le)g(in)o ! (to)f(Emacs)490 b Ff(C-x)21 b(C-f)0 715 y Fe(sa)o(v)o(e)13 ! b Fh(a)h(\014le)g(bac)o(k)g(to)f(disk)478 b Ff(C-x)21 b(C-s)0 ! 764 y Fh(sa)o(v)o(e)14 b Fe(all)f Fh(\014les)678 b Ff(C-x)21 ! b(s)0 814 y Fe(insert)12 b Fh(con)o(ten)o(ts)j(of)e(another)h(\014le)g(in)o ! (to)f(this)h(bu\013er)68 b Ff(C-x)21 b(i)0 864 y Fh(replace)15 ! b(this)f(\014le)g(with)f(the)i(\014le)f(y)o(ou)f(really)g(w)o(an)o(t)98 ! b Ff(C-x)21 b(C-v)0 914 y Fh(write)14 b(bu\013er)h(to)f(a)f(sp)q(eci\014ed)j ! (\014le)369 b Ff(C-x)21 b(C-w)0 964 y Fh(v)o(ersion)14 b(con)o(trol)g(c)o ! (hec)o(kin/c)o(hec)o(k)o(out)310 b Ff(C-x)21 b(C-q)0 1084 y ! Fg(Getting)h(Help)0 1182 y Fh(The)14 b(Help)f(system)g(is)g(simple.)j(T)o(yp) ! q(e)d Ff(C-h)g Fh(\(or)g Ff(F1)p Fh(\))g(and)g(follo)o(w)e(the)i(direc-)0 ! 1231 y(tions.)18 b(If)13 b(y)o(ou)h(are)g(a)g(\014rst-time)f(user,)h(t)o(yp)q ! (e)h Ff(C-h)21 b(t)14 b Fh(for)f(a)h Fe(tutorial)p Fh(.)0 1298 ! y(remo)o(v)o(e)f(Help)h(windo)o(w)522 b Ff(C-x)21 b(1)0 1347 ! y Fh(scroll)14 b(Help)g(windo)o(w)555 b Ff(C-M-v)0 1414 y Fh(aprop)q(os:)18 ! b(sho)o(w)c(commands)d(matc)o(hing)i(a)g(string)100 b Ff(C-h)21 ! b(a)0 1463 y Fh(sho)o(w)14 b(the)g(function)g(a)g(k)o(ey)f(runs)376 ! b Ff(C-h)21 b(c)0 1513 y Fh(describ)q(e)16 b(a)d(function)556 ! b Ff(C-h)21 b(f)0 1563 y Fh(get)14 b(mo)q(de-sp)q(eci\014c)g(information)361 ! b Ff(C-h)21 b(m)0 1677 y Fg(Error)j(Reco)n(v)n(ery)0 1775 y ! Fe(ab)q(ort)13 b Fh(partially)f(t)o(yp)q(ed)j(or)f(executing)g(command)75 ! b Ff(C-g)0 1825 y Fe(reco)o(v)o(er)13 b Fh(a)g(\014le)h(lost)g(b)o(y)f(a)h ! (system)g(crash)144 b Ff(M-x)21 b(recover-file)0 1874 y Fe(undo)12 ! b Fh(an)i(un)o(w)o(an)o(ted)g(c)o(hange)414 b Ff(C-x)21 b(u)h ! Fh(or)g Ff(C-_)0 1924 y Fh(restore)16 b(a)d(bu\013er)i(to)f(its)g(original)e ! (con)o(ten)o(ts)115 b Ff(M-x)21 b(revert-buffer)0 1974 y Fh(redra)o(w)14 b(garbaged)g(screen)476 b Ff(C-l)0 2088 y Fg(Incremen)n(tal)21 ! b(Searc)n(h)0 2186 y Fh(searc)o(h)15 b(forw)o(ard)635 b Ff(C-s)0 ! 2236 y Fh(searc)o(h)15 b(bac)o(kw)o(ard)602 b Ff(C-r)0 2285 ! y Fh(regular)14 b(expression)h(searc)o(h)448 b Ff(C-M-s)0 2335 ! y Fh(rev)o(erse)16 b(regular)e(expression)h(searc)o(h)309 b ! Ff(C-M-r)0 2401 y Fh(select)15 b(previous)f(searc)o(h)i(string)391 ! b Ff(M-p)0 2451 y Fh(select)15 b(next)g(later)f(searc)o(h)h(string)366 ! b Ff(M-n)0 2501 y Fh(exit)14 b(incremen)o(tal)f(searc)o(h)482 ! b Ff(RET)0 2551 y Fh(undo)14 b(e\013ect)h(of)f(last)f(c)o(haracter)395 ! b Ff(DEL)0 2601 y Fh(ab)q(ort)14 b(curren)o(t)h(searc)o(h)533 ! b Ff(C-g)0 2667 y Fh(Use)18 b Ff(C-s)e Fh(or)h Ff(C-r)f Fh(again)f(to)i(rep)q ! (eat)h(the)f(searc)o(h)h(in)f(either)g(direction.)27 b(If)0 ! 2717 y(Emacs)13 b(is)h(still)f(searc)o(hing,)h Ff(C-g)f Fh(cancels)i(only)e ! (the)i(part)f(not)f(done.)129 2783 y Fd(c)120 2784 y Fc(\015)e ! Fd(1996)e(F)m(ree)j(Soft)o(w)o(are)e(F)m(oundation,)j(Inc.)i(P)o(ermissions)e ! (on)e(bac)o(k.)k(v2.1)1929 2832 y Fh(1)p eop %%Page: 2 2 ! bop 0 -168 a Fg(Motion)0 -65 y Fe(en)o(tit)o(y)13 b(to)j(mo)o(v)o(e)f(o)o(v)o ! (er)350 b(bac)o(kw)o(ard)41 b(forw)o(ard)0 -15 y Fh(c)o(haracter)593 ! b Ff(C-b)173 b(C-f)0 35 y Fh(w)o(ord)670 b Ff(M-b)173 b(M-f)0 ! 84 y Fh(line)694 b Ff(C-p)173 b(C-n)0 134 y Fh(go)13 b(to)h(line)f(b)q ! (eginning)h(\(or)g(end\))237 b Ff(C-a)173 b(C-e)0 184 y Fh(sen)o(tence)610 ! b Ff(M-a)173 b(M-e)0 234 y Fh(paragraph)574 b Ff(M-{)173 b(M-})0 ! 284 y Fh(page)676 b Ff(C-x)21 b([)130 b(C-x)21 b(])0 333 y ! Fh(sexp)680 b Ff(C-M-b)129 b(C-M-f)0 383 y Fh(function)610 ! b Ff(C-M-a)129 b(C-M-e)0 433 y Fh(go)13 b(to)h(bu\013er)h(b)q(eginning)e ! (\(or)h(end\))197 b Ff(M-<)173 b(M->)0 501 y Fh(scroll)14 b(to)f(next)i ! (screen)538 b Ff(C-v)0 551 y Fh(scroll)14 b(to)f(previous)i(screen)466 ! b Ff(M-v)0 600 y Fh(scroll)14 b(left)732 b Ff(C-x)21 b(<)0 ! 650 y Fh(scroll)14 b(righ)o(t)704 b Ff(C-x)21 b(>)0 700 y Fh(scroll)14 ! b(curren)o(t)h(line)f(to)f(cen)o(ter)j(of)d(screen)238 b Ff(C-u)21 ! b(C-l)0 821 y Fg(Killi)o(ng)g(and)i(Deleting)0 925 y Fe(en)o(tit)o(y)13 ! b(to)j(kill)496 b(bac)o(kw)o(ard)41 b(forw)o(ard)0 975 y Fh(c)o(haracter)15 ! b(\(delete,)g(not)f(kill\))282 b Ff(DEL)173 b(C-d)0 1024 y ! Fh(w)o(ord)670 b Ff(M-DEL)129 b(M-d)0 1074 y Fh(line)13 b(\(to)h(end)h(of)s ! (\))482 b Ff(M-0)21 b(C-k)86 b(C-k)0 1124 y Fh(sen)o(tence)610 b Ff(C-x)21 b(DEL)86 b(M-k)0 1174 y Fh(sexp)680 b Ff(M--)21 ! b(C-M-k)42 b(C-M-k)0 1242 y Fh(kill)12 b Fe(region)699 b Ff(C-w)0 ! 1291 y Fh(cop)o(y)14 b(region)g(to)f(kill)g(ring)485 b Ff(M-w)0 ! 1341 y Fh(kill)12 b(through)i(next)h(o)q(ccurrence)h(of)e Fb(char)246 ! b Ff(M-z)21 b Fb(char)0 1409 y Fh(y)o(ank)13 b(bac)o(k)h(last)g(thing)f ! (killed)417 b Ff(C-y)0 1459 y Fh(replace)15 b(last)e(y)o(ank)h(with)f ! (previous)i(kill)262 b Ff(M-y)0 1585 y Fg(Marking)0 1688 y ! Fh(set)15 b(mark)d(here)653 b Ff(C-@)21 b Fh(or)h Ff(C-SPC)0 ! 1738 y Fh(exc)o(hange)15 b(p)q(oin)o(t)e(and)h(mark)438 b Ff(C-x)21 ! b(C-x)0 1806 y Fh(set)15 b(mark)d Fb(ar)n(g)17 b Fe(w)o(ords)c ! Fh(a)o(w)o(a)o(y)428 b Ff(M-@)0 1856 y Fh(mark)12 b Fe(paragraph)579 ! b Ff(M-h)0 1906 y Fh(mark)12 b Fe(page)697 b Ff(C-x)21 b(C-p)0 ! 1955 y Fh(mark)12 b Fe(sexp)700 b Ff(C-M-@)0 2005 y Fh(mark)12 b Fe(function)619 b Ff(C-M-h)0 2055 y Fh(mark)12 b(en)o(tire)j Fe(bu\013er)552 b Ff(C-x)21 b(h)0 2176 y Fg(Query)i(Replace)0 *************** Fe(bu\013er)552 b Ff(C-x)21 b(h)0 2176 y *** 594,641 **** b Ff(M-\045)0 2330 y Fh(using)14 b(regular)g(expressions)226 b Ff(M-x)21 b(query-replace-rege)o(xp)0 2397 y Fh(V)m(alid)12 ! b(resp)q(onses)17 b(in)c(query-replace)i(mo)q(de)e(are)0 ! 2465 y Fe(replace)f Fh(this)i(one,)g(go)f(on)h(to)g(next)327 ! b Ff(SPC)0 2515 y Fh(replace)15 b(this)f(one,)f(don't)h(mo)o(v)o(e)387 b Ff(,)0 2565 y Fe(skip)13 b Fh(to)g(next)i(without)e(replacing)340 b Ff(DEL)0 2614 y Fh(replace)15 b(all)d(remaining)g(matc)o(hes)361 ! b Ff(!)0 2664 y Fe(bac)o(k)16 b(up)d Fh(to)g(the)i(previous)f(matc)o(h) ! 322 b Ff(^)0 2714 y Fe(exit)13 b Fh(query-replace)566 ! b Ff(RET)0 2764 y Fh(en)o(ter)15 b(recursiv)o(e)g(edit)f(\()p ! Ff(C-M-c)f Fh(to)h(exit\))265 b Ff(C-r)1929 2832 y Fh(2)p ! eop %%Page: 3 3 ! 3 2 bop 0 -168 a Fg(Multiple)20 b(Windo)n(ws)0 -86 y ! Fh(When)14 b(t)o(w)o(o)f(commands)f(are)i(sho)o(wn,)g(the)g(second)h ! (is)f(for)f(\\other)i(frame.")0 -24 y(delete)g(all)e(other)h(windo)o ! (ws)460 b Ff(C-x)21 b(1)0 38 y Fh(split)13 b(windo)o(w)h(in)f(t)o(w)o ! (o)g(v)o(ertically)230 b Ff(C-x)21 b(2)129 b(C-x)21 b(5)h(2)0 ! 88 y Fh(delete)15 b(this)f(windo)o(w)429 b Ff(C-x)21 ! b(0)129 b(C-x)21 b(5)h(0)0 150 y Fh(split)13 b(windo)o(w)h(in)f(t)o(w)o ! (o)g(horizon)o(tally)314 b Ff(C-x)21 b(3)0 213 y Fh(scroll)14 ! b(other)g(windo)o(w)545 b Ff(C-M-v)0 275 y Fh(switc)o(h)14 ! b(cursor)h(to)f(another)g(windo)o(w)174 b Ff(C-x)21 b(o)129 ! b(C-x)21 b(5)h(o)0 325 y Fh(select)15 b(bu\013er)g(in)f(other)g(windo)o ! (w)241 b Ff(C-x)21 b(4)h(b)85 b(C-x)21 b(5)h(b)0 375 ! y Fh(displa)o(y)13 b(bu\013er)i(in)e(other)i(windo)o(w)213 b Ff(C-x)21 b(4)h(C-o)41 b(C-x)21 b(5)h(C-o)0 424 y Fh(\014nd)14 b(\014le)g(in)f(other)i(windo)o(w)323 b Ff(C-x)21 b(4)h(f)85 ! b(C-x)21 b(5)h(f)0 474 y Fh(\014nd)14 b(\014le)g(read-only)f(in)h ! (other)g(windo)o(w)140 b Ff(C-x)21 b(4)h(r)85 b(C-x)21 ! b(5)h(r)0 524 y Fh(run)14 b(Dired)g(in)f(other)i(windo)o(w)282 ! b Ff(C-x)21 b(4)h(d)85 b(C-x)21 b(5)h(d)0 574 y Fh(\014nd)14 ! b(tag)g(in)f(other)h(windo)o(w)319 b Ff(C-x)21 b(4)h(.)85 ! b(C-x)21 b(5)h(.)0 636 y Fh(gro)o(w)13 b(windo)o(w)g(taller)554 ! b Ff(C-x)21 b(^)0 686 y Fh(shrink)14 b(windo)o(w)f(narro)o(w)o(er)464 ! b Ff(C-x)21 b({)0 736 y Fh(gro)o(w)13 b(windo)o(w)g(wider)550 ! b Ff(C-x)21 b(})0 830 y Fg(F)-6 b(ormatting)0 912 y Fh(inden)o(t)14 ! b(curren)o(t)h Fe(line)d Fh(\(mo)q(de-dep)q(enden)o(t\))209 ! b Ff(TAB)0 962 y Fh(inden)o(t)14 b Fe(region)e Fh(\(mo)q(de-dep)q ! (enden)o(t\))299 b Ff(C-M-\\)0 1012 y Fh(inden)o(t)14 ! b Fe(sexp)f Fh(\(mo)q(de-dep)q(enden)o(t\))336 b Ff(C-M-q)0 ! 1062 y Fh(inden)o(t)14 b(region)g(rigidly)e Fb(ar)n(g)17 ! b Fh(columns)295 b Ff(C-x)21 b(TAB)0 1124 y Fh(insert)15 ! b(newline)f(after)g(p)q(oin)o(t)441 b Ff(C-o)0 1174 y ! Fh(mo)o(v)o(e)12 b(rest)j(of)f(line)f(v)o(ertically)g(do)o(wn)309 ! b Ff(C-M-o)0 1224 y Fh(delete)15 b(blank)e(lines)h(around)g(p)q(oin)o (t)335 b Ff(C-x)21 b(C-o)0 1273 y Fh(join)13 b(line)g(with)h(previous)g (\(with)g(arg,)f(next\))191 b Ff(M-^)0 1323 y Fh(delete)15 --- 912,955 ---- b Ff(M-\045)0 2330 y Fh(using)14 b(regular)g(expressions)226 b Ff(M-x)21 b(query-replace-rege)o(xp)0 2397 y Fh(V)m(alid)12 ! b(resp)q(onses)17 b(in)c(query-replace)i(mo)q(de)e(are)0 2465 ! y Fe(replace)f Fh(this)i(one,)g(go)f(on)h(to)g(next)327 b Ff(SPC)0 ! 2515 y Fh(replace)15 b(this)f(one,)f(don't)h(mo)o(v)o(e)387 b Ff(,)0 2565 y Fe(skip)13 b Fh(to)g(next)i(without)e(replacing)340 b Ff(DEL)0 2614 y Fh(replace)15 b(all)d(remaining)g(matc)o(hes)361 ! b Ff(!)0 2664 y Fe(bac)o(k)16 b(up)d Fh(to)g(the)i(previous)f(matc)o(h)322 ! b Ff(^)0 2714 y Fe(exit)13 b Fh(query-replace)566 b Ff(RET)0 ! 2764 y Fh(en)o(ter)15 b(recursiv)o(e)g(edit)f(\()p Ff(C-M-c)f ! Fh(to)h(exit\))265 b Ff(C-r)1929 2832 y Fh(2)p eop %%Page: 3 3 ! bop 0 -168 a Fg(Multiple)20 b(Windo)n(ws)0 -86 y Fh(When)14 ! b(t)o(w)o(o)f(commands)f(are)i(sho)o(wn,)g(the)g(second)h(is)f(for)f(\\other) ! i(frame.")0 -24 y(delete)g(all)e(other)h(windo)o(ws)460 b Ff(C-x)21 ! b(1)0 38 y Fh(split)13 b(windo)o(w)h(in)f(t)o(w)o(o)g(v)o(ertically)230 ! b Ff(C-x)21 b(2)129 b(C-x)21 b(5)h(2)0 88 y Fh(delete)15 b(this)f(windo)o(w) ! 429 b Ff(C-x)21 b(0)129 b(C-x)21 b(5)h(0)0 150 y Fh(split)13 ! b(windo)o(w)h(in)f(t)o(w)o(o)g(horizon)o(tally)314 b Ff(C-x)21 ! b(3)0 213 y Fh(scroll)14 b(other)g(windo)o(w)545 b Ff(C-M-v)0 ! 275 y Fh(switc)o(h)14 b(cursor)h(to)f(another)g(windo)o(w)174 ! b Ff(C-x)21 b(o)129 b(C-x)21 b(5)h(o)0 325 y Fh(select)15 b(bu\013er)g(in)f ! (other)g(windo)o(w)241 b Ff(C-x)21 b(4)h(b)85 b(C-x)21 b(5)h(b)0 ! 375 y Fh(displa)o(y)13 b(bu\013er)i(in)e(other)i(windo)o(w)213 b Ff(C-x)21 b(4)h(C-o)41 b(C-x)21 b(5)h(C-o)0 424 y Fh(\014nd)14 b(\014le)g(in)f(other)i(windo)o(w)323 b Ff(C-x)21 b(4)h(f)85 ! b(C-x)21 b(5)h(f)0 474 y Fh(\014nd)14 b(\014le)g(read-only)f(in)h(other)g ! (windo)o(w)140 b Ff(C-x)21 b(4)h(r)85 b(C-x)21 b(5)h(r)0 524 ! y Fh(run)14 b(Dired)g(in)f(other)i(windo)o(w)282 b Ff(C-x)21 ! b(4)h(d)85 b(C-x)21 b(5)h(d)0 574 y Fh(\014nd)14 b(tag)g(in)f(other)h(windo)o ! (w)319 b Ff(C-x)21 b(4)h(.)85 b(C-x)21 b(5)h(.)0 636 y Fh(gro)o(w)13 ! b(windo)o(w)g(taller)554 b Ff(C-x)21 b(^)0 686 y Fh(shrink)14 ! b(windo)o(w)f(narro)o(w)o(er)464 b Ff(C-x)21 b({)0 736 y Fh(gro)o(w)13 ! b(windo)o(w)g(wider)550 b Ff(C-x)21 b(})0 830 y Fg(F)-6 b(ormatting)0 ! 912 y Fh(inden)o(t)14 b(curren)o(t)h Fe(line)d Fh(\(mo)q(de-dep)q(enden)o ! (t\))209 b Ff(TAB)0 962 y Fh(inden)o(t)14 b Fe(region)e Fh(\(mo)q(de-dep)q ! (enden)o(t\))299 b Ff(C-M-\\)0 1012 y Fh(inden)o(t)14 b Fe(sexp)f ! Fh(\(mo)q(de-dep)q(enden)o(t\))336 b Ff(C-M-q)0 1062 y Fh(inden)o(t)14 ! b(region)g(rigidly)e Fb(ar)n(g)17 b Fh(columns)295 b Ff(C-x)21 ! b(TAB)0 1124 y Fh(insert)15 b(newline)f(after)g(p)q(oin)o(t)441 ! b Ff(C-o)0 1174 y Fh(mo)o(v)o(e)12 b(rest)j(of)f(line)f(v)o(ertically)g(do)o ! (wn)309 b Ff(C-M-o)0 1224 y Fh(delete)15 b(blank)e(lines)h(around)g(p)q(oin)o (t)335 b Ff(C-x)21 b(C-o)0 1273 y Fh(join)13 b(line)g(with)h(previous)g (\(with)g(arg,)f(next\))191 b Ff(M-^)0 1323 y Fh(delete)15 *************** b(all)e(white)h(space)h(around)e(p)q(oin *** 643,827 **** 1373 y Fh(put)14 b(exactly)g(one)g(space)h(at)f(p)q(oin)o(t)348 b Ff(M-SPC)0 1435 y Fh(\014ll)13 b(paragraph)655 b Ff(M-q)0 ! 1485 y Fh(set)15 b(\014ll)e(column)642 b Ff(C-x)21 b(f)0 ! 1535 y Fh(set)15 b(pre\014x)f(eac)o(h)h(line)e(starts)i(with)350 ! b Ff(C-x)21 b(.)0 1597 y Fh(set)15 b(face)765 b Ff(M-g)0 ! 1697 y Fg(Case)23 b(Change)0 1779 y Fh(upp)q(ercase)16 ! b(w)o(ord)618 b Ff(M-u)0 1829 y Fh(lo)o(w)o(ercase)15 ! b(w)o(ord)628 b Ff(M-l)0 1879 y Fh(capitalize)13 b(w)o(ord)627 ! b Ff(M-c)0 1941 y Fh(upp)q(ercase)16 b(region)596 b Ff(C-x)21 ! b(C-u)0 1991 y Fh(lo)o(w)o(ercase)15 b(region)606 b Ff(C-x)21 ! b(C-l)0 2085 y Fg(The)h(Minibu\013er)0 2167 y Fh(The)14 ! b(follo)o(wing)e(k)o(eys)i(are)g(de\014ned)h(in)f(the)g(minibu\013er.)0 ! 2230 y(complete)f(as)h(m)o(uc)o(h)f(as)h(p)q(ossible)370 b Ff(TAB)0 2279 y Fh(complete)13 b(up)h(to)g(one)g(w)o(ord)449 ! b Ff(SPC)0 2329 y Fh(complete)13 b(and)h(execute)511 ! b Ff(RET)0 2379 y Fh(sho)o(w)14 b(p)q(ossible)g(completions)425 ! b Ff(?)0 2429 y Fh(fetc)o(h)14 b(previous)h(minibu\013er)d(input)337 ! b Ff(M-p)0 2479 y Fh(fetc)o(h)14 b(next)h(later)f(minibu\013er)e(input) ! 312 b Ff(M-n)0 2528 y Fh(regexp)15 b(searc)o(h)g(bac)o(kw)o(ard)f ! (through)f(history)173 b Ff(M-r)0 2578 y Fh(regexp)15 ! b(searc)o(h)g(forw)o(ard)e(through)h(history)206 b Ff(M-s)0 ! 2628 y Fh(ab)q(ort)14 b(command)610 b Ff(C-g)0 2690 y ! Fh(T)o(yp)q(e)13 b Ff(C-x)21 b(ESC)g(ESC)12 b Fh(to)g(edit)h(and)g(rep) ! q(eat)g(the)g(last)g(command)c(that)k(used)0 2740 y(the)g ! (minibu\013er.)k(T)o(yp)q(e)c Ff(F10)f Fh(to)g(activ)n(ate)h(the)g(men) ! o(u)f(bar)h(using)f(the)h(mini-)0 2790 y(bu\013er.)1929 2832 y(3)p eop %%Page: 4 4 ! 4 3 bop 79 -160 a Fi(GNU)27 b(Emacs)g(Reference)f(Card)0 ! -21 y Fg(Bu\013ers)0 82 y Fh(select)15 b(another)g(bu\013er)530 ! b Ff(C-x)21 b(b)0 132 y Fh(list)13 b(all)g(bu\013ers)653 ! b Ff(C-x)21 b(C-b)0 182 y Fh(kill)12 b(a)i(bu\013er)691 ! b Ff(C-x)21 b(k)0 303 y Fg(T)-6 b(ransp)r(osing)0 407 ! y Fh(transp)q(ose)15 b Fe(c)o(haracters)500 b Ff(C-t)0 ! 457 y Fh(transp)q(ose)15 b Fe(w)o(ords)591 b Ff(M-t)0 ! 506 y Fh(transp)q(ose)15 b Fe(lines)618 b Ff(C-x)21 b(C-t)0 ! 556 y Fh(transp)q(ose)15 b Fe(sexps)602 b Ff(C-M-t)0 ! 678 y Fg(Sp)r(elling)21 b(Chec)n(k)0 781 y Fh(c)o(hec)o(k)15 ! b(sp)q(elling)e(of)g(curren)o(t)j(w)o(ord)356 b Ff(M-$)0 ! 831 y Fh(c)o(hec)o(k)15 b(sp)q(elling)e(of)g(all)g(w)o(ords)h(in)g ! (region)166 b Ff(M-x)21 b(ispell-region)0 881 y Fh(c)o(hec)o(k)15 ! b(sp)q(elling)e(of)g(en)o(tire)i(bu\013er)282 b Ff(M-x)21 ! b(ispell-buffer)0 1006 y Fg(T)-6 b(ags)0 1110 y Fh(\014nd)14 ! b(a)g(tag)f(\(a)h(de\014nition\))473 b Ff(M-.)0 1160 ! y Fh(\014nd)14 b(next)g(o)q(ccurrence)j(of)c(tag)412 ! b Ff(C-u)21 b(M-.)0 1210 y Fh(sp)q(ecify)14 b(a)g(new)g(tags)g(\014le) ! 366 b Ff(M-x)21 b(visit-tags-table)0 1277 y Fh(regexp)15 ! b(searc)o(h)g(on)e(all)g(\014les)h(in)g(tags)g(table)129 ! b Ff(M-x)21 b(tags-search)0 1327 y Fh(run)14 b(query-replace)h(on)f ! (all)f(the)h(\014les)133 b Ff(M-x)21 b(tags-query-repla)o(ce)0 ! 1377 y Fh(con)o(tin)o(ue)14 b(last)g(tags)g(searc)o(h)h(or)e ! (query-replace)150 b Ff(M-,)0 1498 y Fg(Shells)0 1602 ! y Fh(execute)16 b(a)d(shell)h(command)444 b Ff(M-!)0 ! 1651 y Fh(run)14 b(a)g(shell)g(command)d(on)i(the)i(region)265 ! b Ff(M-|)0 1701 y Fh(\014lter)14 b(region)g(through)g(a)f(shell)h ! (command)212 b Ff(C-u)21 b(M-|)0 1751 y Fh(start)15 b(a)e(shell)h(in)f ! (windo)o(w)g Ff(*shell*)231 b(M-x)21 b(shell)0 1872 y ! Fg(Rectangles)0 1976 y Fh(cop)o(y)14 b(rectangle)h(to)e(register)442 ! b Ff(C-x)21 b(r)h(r)0 2026 y Fh(kill)12 b(rectangle)667 ! b Ff(C-x)21 b(r)h(k)0 2075 y Fh(y)o(ank)13 b(rectangle)637 ! b Ff(C-x)21 b(r)h(y)0 2125 y Fh(op)q(en)14 b(rectangle,)h(shifting)e ! (text)h(righ)o(t)288 b Ff(C-x)21 b(r)h(o)0 2175 y Fh(blank)13 ! b(out)h(rectangle)549 b Ff(C-x)21 b(r)h(c)0 2225 y Fh(pre\014x)15 ! b(eac)o(h)f(line)f(with)h(a)g(string)378 b Ff(C-x)21 ! b(r)h(t)0 2346 y Fg(Abbrevs)0 2450 y Fh(add)14 b(global)e(abbrev)574 ! b Ff(C-x)21 b(a)h(g)0 2499 y Fh(add)14 b(mo)q(de-lo)q(cal)e(abbrev)486 ! b Ff(C-x)21 b(a)h(l)0 2549 y Fh(add)14 b(global)e(expansion)i(for)f ! (this)h(abbrev)237 b Ff(C-x)21 b(a)h(i)f(g)0 2599 y Fh(add)14 ! b(mo)q(de-lo)q(cal)e(expansion)h(for)h(this)g(abbrev)149 ! b Ff(C-x)21 b(a)h(i)f(l)0 2649 y Fh(explicitly)13 b(expand)h(abbrev)453 ! b Ff(C-x)21 b(a)h(e)0 2716 y Fh(expand)14 b(previous)g(w)o(ord)g ! (dynamically)266 b Ff(M-/)1929 2832 y Fh(4)p eop %%Page: 5 5 ! 5 4 bop 0 -168 a Fg(Regular)22 b(Expressions)0 -65 y ! Fh(an)o(y)13 b(single)h(c)o(haracter)h(except)h(a)d(newline)224 ! b Ff(.)43 b Fh(\(dot\))0 -15 y(zero)15 b(or)f(more)e(rep)q(eats)529 ! b Ff(*)0 35 y Fh(one)14 b(or)g(more)f(rep)q(eats)540 ! b Ff(+)0 84 y Fh(zero)15 b(or)f(one)g(rep)q(eat)572 b ! Ff(?)0 134 y Fh(an)o(y)13 b(c)o(haracter)j(in)d(the)i(set)470 ! b Ff([)22 b Fa(:)7 b(:)g(:)20 b Ff(])0 184 y Fh(an)o(y)13 ! b(c)o(haracter)j(not)d(in)h(the)g(set)397 b Ff([^)21 ! b Fa(:)7 b(:)g(:)21 b Ff(])0 234 y Fh(b)q(eginning)13 ! b(of)h(line)597 b Ff(^)0 284 y Fh(end)14 b(of)g(line)709 ! b Ff($)0 333 y Fh(quote)14 b(a)g(sp)q(ecial)g(c)o(haracter)h ! Fb(c)416 b Ff(\\)p Fb(c)0 383 y Fh(alternativ)o(e)14 ! b(\(\\or"\))581 b Ff(\\|)0 433 y Fh(grouping)740 b Ff(\\\()21 ! b Fa(:)7 b(:)g(:)21 b Ff(\\\))0 483 y Fb(n)s Fh(th)15 ! b(group)716 b Ff(\\)p Fb(n)0 533 y Fh(b)q(eginning)13 ! b(of)h(bu\013er)558 b Ff(\\`)0 583 y Fh(end)14 b(of)g(bu\013er)670 ! b Ff(\\')0 632 y Fh(w)o(ord)14 b(break)697 b Ff(\\b)0 ! 682 y Fh(not)14 b(b)q(eginning)f(or)h(end)g(of)g(w)o(ord)370 ! b Ff(\\B)0 732 y Fh(b)q(eginning)13 b(of)h(w)o(ord)573 ! b Ff(\\<)0 782 y Fh(end)14 b(of)g(w)o(ord)685 b Ff(\\>)0 ! 832 y Fh(an)o(y)13 b(w)o(ord-syn)o(tax)h(c)o(haracter)420 ! b Ff(\\w)0 881 y Fh(an)o(y)13 b(non-w)o(ord-syn)o(tax)h(c)o(haracter) ! 339 b Ff(\\W)0 931 y Fh(c)o(haracter)15 b(with)f(syn)o(tax)g ! Fb(c)472 b Ff(\\s)p Fb(c)0 981 y Fh(c)o(haracter)15 b(with)f(syn)o(tax) ! g(not)f Fb(c)399 b Ff(\\S)p Fb(c)0 1102 y Fg(Registers)0 ! 1206 y Fh(sa)o(v)o(e)14 b(region)g(in)f(register)505 ! b Ff(C-x)21 b(r)h(s)0 1256 y Fh(insert)15 b(register)g(con)o(ten)o(ts)g ! (in)o(to)e(bu\013er)284 b Ff(C-x)21 b(r)h(i)0 1323 y ! Fh(sa)o(v)o(e)14 b(v)n(alue)f(of)h(p)q(oin)o(t)f(in)g(register)367 ! b Ff(C-x)21 b(r)h(SPC)0 1373 y Fh(jump)12 b(to)i(p)q(oin)o(t)f(sa)o(v)o ! (ed)h(in)g(register)340 b Ff(C-x)21 b(r)h(j)0 1499 y ! Fg(Info)0 1603 y Fh(en)o(ter)15 b(the)g(Info)e(do)q(cumen)o(tation)g ! (reader)242 b Ff(C-h)21 b(i)0 1671 y Fh(Mo)o(ving)13 ! b(within)g(a)g(no)q(de:)42 1738 y(scroll)g(forw)o(ard)611 ! b Ff(SPC)42 1788 y Fh(scroll)13 b(rev)o(erse)627 b Ff(DEL)42 ! 1838 y Fh(b)q(eginning)13 b(of)g(no)q(de)535 b Ff(.)43 ! b Fh(\(dot\))0 1906 y(Mo)o(ving)13 b(b)q(et)o(w)o(een)i(no)q(des:)42 ! 1973 y Fe(next)e Fh(no)q(de)666 b Ff(n)42 2023 y Fe(previous)11 ! b Fh(no)q(de)583 b Ff(p)42 2073 y Fh(mo)o(v)o(e)12 b ! Fe(up)697 b Ff(u)42 2123 y Fh(select)15 b(men)o(u)e(item)f(b)o(y)i ! (name)383 b Ff(m)42 2173 y Fh(select)15 b Fb(n)s Fh(th)f(men)o(u)f ! (item)g(b)o(y)g(n)o(um)o(b)q(er)h(\(1{9\))155 b Fb(n)42 ! 2222 y Fh(follo)o(w)11 b(cross)k(reference)i(\(return)e(with)f ! Ff(l)p Fh(\))186 b Ff(f)42 2272 y Fh(return)15 b(to)e(last)h(no)q(de)g ! (y)o(ou)g(sa)o(w)357 b Ff(l)42 2322 y Fh(return)15 b(to)e(directory)i ! (no)q(de)418 b Ff(d)42 2372 y Fh(go)13 b(to)h(an)o(y)f(no)q(de)h(b)o(y) ! g(name)418 b Ff(g)0 2439 y Fh(Other:)42 2507 y(run)14 ! b(Info)f Fe(tutorial)537 b Ff(h)42 2557 y Fh(list)13 ! b(Info)g(commands)510 b Ff(?)42 2607 y Fe(quit)12 b Fh(Info)689 ! b Ff(q)42 2657 y Fh(searc)o(h)15 b(no)q(des)f(for)g(regexp)434 ! b Ff(M-s)1929 2832 y Fh(5)p eop %%Page: 6 6 ! 6 5 bop 0 -168 a Fg(Keyb)r(oard)24 b(Macros)0 -65 y Fe(start)13 b Fh(de\014ning)g(a)h(k)o(eyb)q(oard)g(macro)304 b Ff(C-x)21 b(\()0 -15 y Fe(end)13 b Fh(k)o(eyb)q(oard)h(macro)e(de\014nition)336 ! b Ff(C-x)21 b(\))0 35 y Fe(execute)13 b Fh(last-de\014ned)i(k)o(eyb)q ! (oard)f(macro)215 b Ff(C-x)21 b(e)0 84 y Fh(app)q(end)14 ! b(to)g(last)g(k)o(eyb)q(oard)g(macro)332 b Ff(C-u)21 ! b(C-x)g(\()0 134 y Fh(name)13 b(last)g(k)o(eyb)q(oard)h(macro)218 ! b Ff(M-x)21 b(name-last-kbd-mac)o(ro)0 184 y Fh(insert)15 ! b(Lisp)e(de\014nition)h(in)f(bu\013er)221 b Ff(M-x)21 ! b(insert-kbd-macro)0 305 y Fg(Commands)h(Dealing)g(with)f(Emacs)i(Lisp) ! 0 409 y Fh(ev)n(al)13 b Fe(sexp)g Fh(b)q(efore)i(p)q(oin)o(t)490 ! b Ff(C-x)21 b(C-e)0 459 y Fh(ev)n(al)13 b(curren)o(t)j ! Fe(defun)553 b Ff(C-M-x)0 508 y Fh(ev)n(al)13 b Fe(region)598 ! b Ff(M-x)21 b(eval-region)0 558 y Fh(ev)n(al)13 b(en)o(tire)i ! Fe(bu\013er)374 b Ff(M-x)21 b(eval-current-buff)o(er)0 ! 608 y Fh(read)14 b(and)g(ev)n(al)f(minibu\013er)456 b ! Ff(M-:)0 658 y Fh(re-execute)16 b(last)e(minibu\013er)f(command)246 ! b Ff(C-x)21 b(ESC)g(ESC)0 708 y Fh(read)14 b(and)g(ev)n(al)f(Emacs)h ! (Lisp)f(\014le)280 b Ff(M-x)21 b(load-file)0 757 y Fh(load)13 ! b(from)f(standard)i(system)g(directory)152 b Ff(M-x)21 ! b(load-library)0 884 y Fg(Simple)f(Customization)0 987 ! y Fh(Here)15 b(are)f(some)f(examples)g(of)h(binding)f(global)f(k)o(eys) ! i(in)g(Emacs)f(Lisp.)0 1055 y Ff(\(global-set-key)19 ! b("\\C-cg")h('goto-line\))0 1105 y(\(global-set-key)f("\\C-x\\C-k")g ! ('kill-region\))0 1155 y(\(global-set-key)g("\\M-#")h ! ('query-replace-rege)o(xp\))0 1222 y Fh(An)14 b(example)f(of)g(setting) ! h(a)g(v)n(ariable)f(in)g(Emacs)g(Lisp:)0 1290 y Ff(\(setq)21 ! b(backup-by-copyin)o(g-whe)o(n-lin)o(ked)e(t\))0 1416 ! y Fg(W)-6 b(riting)22 b(Commands)0 1520 y Ff(\(defun)f ! Fb(c)n(ommand-name)26 b Ff(\()p Fb(ar)n(gs)s Ff(\))44 ! 1570 y(")p Fb(do)n(cumentation)s Ff(")44 1619 y(\(interactive)19 ! b(")p Fb(template)s Ff("\))44 1669 y Fb(b)n(o)n(dy)t ! Ff(\))0 1737 y Fh(An)14 b(example:)0 1805 y Ff(\(defun)21 ! b(this-line-to-to)o(p-of-)o(windo)o(w)e(\(line\))44 1854 ! y("Reposition)g(line)i(point)g(is)g(on)h(to)f(top)g(of)h(window.)0 ! 1904 y(With)f(ARG,)g(put)g(point)g(on)g(line)g(ARG.)0 ! 1954 y(Negative)f(counts)h(from)g(bottom.")44 2004 y(\(interactive)e ! ("P"\))44 2054 y(\(recenter)h(\(if)h(\(null)f(line\))349 ! 2103 y(0)305 2153 y(\(prefix-numeric-va)o(lue)f(line\)\)\)\))0 ! 2221 y Fh(The)12 b(argumen)o(t)e(to)i Ff(interactive)d ! Fh(is)i(a)g(string)h(sp)q(ecifying)f(ho)o(w)g(to)h(get)f(the)0 ! 2271 y(argumen)o(ts)16 b(when)h(the)h(function)e(is)h(called)g(in)o ! (teractiv)o(ely)m(.)26 b(T)o(yp)q(e)17 b Ff(C-h)k(f)0 ! 2321 y(interactive)12 b Fh(for)h(more)g(information.)238 2466 y Fd(Cop)o(yrigh)o(t)403 2465 y(c)393 2466 y Fc(\015)f Fd(1996)d(F)m(ree)j(Soft)o(w)o(are)e(F)m(oundation,)j(Inc.)269 ! 2506 y(designed)e(b)o(y)i(Stephen)f(Gildea,)f(Marc)o(h)g(1996)e(v2.1) ! 281 2545 y(for)i(GNU)f(Emacs)h(v)o(ersion)h(19)e(on)h(Unix)h(systems)0 ! 2603 y(P)o(ermission)g(is)f(gran)o(ted)e(to)h(mak)o(e)h(and)f ! (distribute)i(copies)e(of)h(this)g(card)f(pro)o(vided)h(the)g(cop)o(y-) ! 0 2643 y(righ)o(t)h(notice)e(and)i(this)g(p)q(ermission)g(notice)f(are) ! g(preserv)o(ed)g(on)h(all)f(copies.)0 2701 y(F)m(or)g(copies)f(of)g ! (the)h(GNU)e(Emacs)h(man)o(ual,)i(write)e(to)g(the)h(F)m(ree)f(Soft)o ! (w)o(are)g(F)m(oundation,)i(Inc.,)0 2741 y(59)e(T)m(emple)i(Place,)f ! (Suite)h(330,)f(Boston,)g(MA)f(02111-1307)e(USA)1929 ! 2832 y Fh(6)p eop %%Trailer end userdict /end-hook known{end-hook}if %%EOF --- 957,1126 ---- 1373 y Fh(put)14 b(exactly)g(one)g(space)h(at)f(p)q(oin)o(t)348 b Ff(M-SPC)0 1435 y Fh(\014ll)13 b(paragraph)655 b Ff(M-q)0 ! 1485 y Fh(set)15 b(\014ll)e(column)642 b Ff(C-x)21 b(f)0 1535 ! y Fh(set)15 b(pre\014x)f(eac)o(h)h(line)e(starts)i(with)350 ! b Ff(C-x)21 b(.)0 1597 y Fh(set)15 b(face)765 b Ff(M-g)0 1697 ! y Fg(Case)23 b(Change)0 1779 y Fh(upp)q(ercase)16 b(w)o(ord)618 ! b Ff(M-u)0 1829 y Fh(lo)o(w)o(ercase)15 b(w)o(ord)628 b Ff(M-l)0 ! 1879 y Fh(capitalize)13 b(w)o(ord)627 b Ff(M-c)0 1941 y Fh(upp)q(ercase)16 ! b(region)596 b Ff(C-x)21 b(C-u)0 1991 y Fh(lo)o(w)o(ercase)15 ! b(region)606 b Ff(C-x)21 b(C-l)0 2085 y Fg(The)h(Minibu\013er)0 ! 2167 y Fh(The)14 b(follo)o(wing)e(k)o(eys)i(are)g(de\014ned)h(in)f(the)g ! (minibu\013er.)0 2230 y(complete)f(as)h(m)o(uc)o(h)f(as)h(p)q(ossible)370 b Ff(TAB)0 2279 y Fh(complete)13 b(up)h(to)g(one)g(w)o(ord)449 ! b Ff(SPC)0 2329 y Fh(complete)13 b(and)h(execute)511 b Ff(RET)0 ! 2379 y Fh(sho)o(w)14 b(p)q(ossible)g(completions)425 b Ff(?)0 ! 2429 y Fh(fetc)o(h)14 b(previous)h(minibu\013er)d(input)337 ! b Ff(M-p)0 2479 y Fh(fetc)o(h)14 b(next)h(later)f(minibu\013er)e(input)312 ! b Ff(M-n)0 2528 y Fh(regexp)15 b(searc)o(h)g(bac)o(kw)o(ard)f(through)f ! (history)173 b Ff(M-r)0 2578 y Fh(regexp)15 b(searc)o(h)g(forw)o(ard)e ! (through)h(history)206 b Ff(M-s)0 2628 y Fh(ab)q(ort)14 b(command)610 ! b Ff(C-g)0 2690 y Fh(T)o(yp)q(e)13 b Ff(C-x)21 b(ESC)g(ESC)12 ! b Fh(to)g(edit)h(and)g(rep)q(eat)g(the)g(last)g(command)c(that)k(used)0 ! 2740 y(the)g(minibu\013er.)k(T)o(yp)q(e)c Ff(F10)f Fh(to)g(activ)n(ate)h(the) ! g(men)o(u)f(bar)h(using)f(the)h(mini-)0 2790 y(bu\013er.)1929 2832 y(3)p eop %%Page: 4 4 ! bop 79 -160 a Fi(GNU)27 b(Emacs)g(Reference)f(Card)0 -21 y ! Fg(Bu\013ers)0 82 y Fh(select)15 b(another)g(bu\013er)530 b ! Ff(C-x)21 b(b)0 132 y Fh(list)13 b(all)g(bu\013ers)653 b Ff(C-x)21 ! b(C-b)0 182 y Fh(kill)12 b(a)i(bu\013er)691 b Ff(C-x)21 b(k)0 ! 303 y Fg(T)-6 b(ransp)r(osing)0 407 y Fh(transp)q(ose)15 b ! Fe(c)o(haracters)500 b Ff(C-t)0 457 y Fh(transp)q(ose)15 b ! Fe(w)o(ords)591 b Ff(M-t)0 506 y Fh(transp)q(ose)15 b Fe(lines)618 ! b Ff(C-x)21 b(C-t)0 556 y Fh(transp)q(ose)15 b Fe(sexps)602 ! b Ff(C-M-t)0 678 y Fg(Sp)r(elling)21 b(Chec)n(k)0 781 y Fh(c)o(hec)o(k)15 ! b(sp)q(elling)e(of)g(curren)o(t)j(w)o(ord)356 b Ff(M-$)0 831 ! y Fh(c)o(hec)o(k)15 b(sp)q(elling)e(of)g(all)g(w)o(ords)h(in)g(region)166 ! b Ff(M-x)21 b(ispell-region)0 881 y Fh(c)o(hec)o(k)15 b(sp)q(elling)e(of)g ! (en)o(tire)i(bu\013er)282 b Ff(M-x)21 b(ispell-buffer)0 1006 ! y Fg(T)-6 b(ags)0 1110 y Fh(\014nd)14 b(a)g(tag)f(\(a)h(de\014nition\))473 ! b Ff(M-.)0 1160 y Fh(\014nd)14 b(next)g(o)q(ccurrence)j(of)c(tag)412 ! b Ff(C-u)21 b(M-.)0 1210 y Fh(sp)q(ecify)14 b(a)g(new)g(tags)g(\014le)366 ! b Ff(M-x)21 b(visit-tags-table)0 1277 y Fh(regexp)15 b(searc)o(h)g(on)e(all)g ! (\014les)h(in)g(tags)g(table)129 b Ff(M-x)21 b(tags-search)0 ! 1327 y Fh(run)14 b(query-replace)h(on)f(all)f(the)h(\014les)133 ! b Ff(M-x)21 b(tags-query-repla)o(ce)0 1377 y Fh(con)o(tin)o(ue)14 ! b(last)g(tags)g(searc)o(h)h(or)e(query-replace)150 b Ff(M-,)0 ! 1498 y Fg(Shells)0 1602 y Fh(execute)16 b(a)d(shell)h(command)444 ! b Ff(M-!)0 1651 y Fh(run)14 b(a)g(shell)g(command)d(on)i(the)i(region)265 ! b Ff(M-|)0 1701 y Fh(\014lter)14 b(region)g(through)g(a)f(shell)h(command)212 ! b Ff(C-u)21 b(M-|)0 1751 y Fh(start)15 b(a)e(shell)h(in)f(windo)o(w)g ! Ff(*shell*)231 b(M-x)21 b(shell)0 1872 y Fg(Rectangles)0 1976 ! y Fh(cop)o(y)14 b(rectangle)h(to)e(register)442 b Ff(C-x)21 ! b(r)h(r)0 2026 y Fh(kill)12 b(rectangle)667 b Ff(C-x)21 b(r)h(k)0 ! 2075 y Fh(y)o(ank)13 b(rectangle)637 b Ff(C-x)21 b(r)h(y)0 ! 2125 y Fh(op)q(en)14 b(rectangle,)h(shifting)e(text)h(righ)o(t)288 ! b Ff(C-x)21 b(r)h(o)0 2175 y Fh(blank)13 b(out)h(rectangle)549 ! b Ff(C-x)21 b(r)h(c)0 2225 y Fh(pre\014x)15 b(eac)o(h)f(line)f(with)h(a)g ! (string)378 b Ff(C-x)21 b(r)h(t)0 2346 y Fg(Abbrevs)0 2450 ! y Fh(add)14 b(global)e(abbrev)574 b Ff(C-x)21 b(a)h(g)0 2499 ! y Fh(add)14 b(mo)q(de-lo)q(cal)e(abbrev)486 b Ff(C-x)21 b(a)h(l)0 ! 2549 y Fh(add)14 b(global)e(expansion)i(for)f(this)h(abbrev)237 ! b Ff(C-x)21 b(a)h(i)f(g)0 2599 y Fh(add)14 b(mo)q(de-lo)q(cal)e(expansion)h ! (for)h(this)g(abbrev)149 b Ff(C-x)21 b(a)h(i)f(l)0 2649 y Fh(explicitly)13 ! b(expand)h(abbrev)453 b Ff(C-x)21 b(a)h(e)0 2716 y Fh(expand)14 ! b(previous)g(w)o(ord)g(dynamically)266 b Ff(M-/)1929 2832 y ! Fh(4)p eop %%Page: 5 5 ! bop 0 -168 a Fg(Regular)22 b(Expressions)0 -65 y Fh(an)o(y)13 ! b(single)h(c)o(haracter)h(except)h(a)d(newline)224 b Ff(.)43 ! b Fh(\(dot\))0 -15 y(zero)15 b(or)f(more)e(rep)q(eats)529 b ! Ff(*)0 35 y Fh(one)14 b(or)g(more)f(rep)q(eats)540 b Ff(+)0 ! 84 y Fh(zero)15 b(or)f(one)g(rep)q(eat)572 b Ff(?)0 134 y Fh(an)o(y)13 ! b(c)o(haracter)j(in)d(the)i(set)470 b Ff([)22 b Fa(:)7 b(:)g(:)20 ! b Ff(])0 184 y Fh(an)o(y)13 b(c)o(haracter)j(not)d(in)h(the)g(set)397 ! b Ff([^)21 b Fa(:)7 b(:)g(:)21 b Ff(])0 234 y Fh(b)q(eginning)13 ! b(of)h(line)597 b Ff(^)0 284 y Fh(end)14 b(of)g(line)709 b ! Ff($)0 333 y Fh(quote)14 b(a)g(sp)q(ecial)g(c)o(haracter)h ! Fb(c)416 b Ff(\\)p Fb(c)0 383 y Fh(alternativ)o(e)14 b(\(\\or"\))581 ! b Ff(\\|)0 433 y Fh(grouping)740 b Ff(\\\()21 b Fa(:)7 b(:)g(:)21 ! b Ff(\\\))0 483 y Fb(n)s Fh(th)15 b(group)716 b Ff(\\)p Fb(n)0 ! 533 y Fh(b)q(eginning)13 b(of)h(bu\013er)558 b Ff(\\`)0 583 ! y Fh(end)14 b(of)g(bu\013er)670 b Ff(\\')0 632 y Fh(w)o(ord)14 ! b(break)697 b Ff(\\b)0 682 y Fh(not)14 b(b)q(eginning)f(or)h(end)g(of)g(w)o ! (ord)370 b Ff(\\B)0 732 y Fh(b)q(eginning)13 b(of)h(w)o(ord)573 ! b Ff(\\<)0 782 y Fh(end)14 b(of)g(w)o(ord)685 b Ff(\\>)0 832 ! y Fh(an)o(y)13 b(w)o(ord-syn)o(tax)h(c)o(haracter)420 b Ff(\\w)0 ! 881 y Fh(an)o(y)13 b(non-w)o(ord-syn)o(tax)h(c)o(haracter)339 ! b Ff(\\W)0 931 y Fh(c)o(haracter)15 b(with)f(syn)o(tax)g Fb(c)472 ! b Ff(\\s)p Fb(c)0 981 y Fh(c)o(haracter)15 b(with)f(syn)o(tax)g(not)f ! Fb(c)399 b Ff(\\S)p Fb(c)0 1102 y Fg(Registers)0 1206 y Fh(sa)o(v)o(e)14 ! b(region)g(in)f(register)505 b Ff(C-x)21 b(r)h(s)0 1256 y Fh(insert)15 ! b(register)g(con)o(ten)o(ts)g(in)o(to)e(bu\013er)284 b Ff(C-x)21 ! b(r)h(i)0 1323 y Fh(sa)o(v)o(e)14 b(v)n(alue)f(of)h(p)q(oin)o(t)f(in)g ! (register)367 b Ff(C-x)21 b(r)h(SPC)0 1373 y Fh(jump)12 b(to)i(p)q(oin)o(t)f ! (sa)o(v)o(ed)h(in)g(register)340 b Ff(C-x)21 b(r)h(j)0 1499 ! y Fg(Info)0 1603 y Fh(en)o(ter)15 b(the)g(Info)e(do)q(cumen)o(tation)g ! (reader)242 b Ff(C-h)21 b(i)0 1671 y Fh(Mo)o(ving)13 b(within)g(a)g(no)q(de:) ! 42 1738 y(scroll)g(forw)o(ard)611 b Ff(SPC)42 1788 y Fh(scroll)13 ! b(rev)o(erse)627 b Ff(DEL)42 1838 y Fh(b)q(eginning)13 b(of)g(no)q(de)535 ! b Ff(.)43 b Fh(\(dot\))0 1906 y(Mo)o(ving)13 b(b)q(et)o(w)o(een)i(no)q(des:) ! 42 1973 y Fe(next)e Fh(no)q(de)666 b Ff(n)42 2023 y Fe(previous)11 ! b Fh(no)q(de)583 b Ff(p)42 2073 y Fh(mo)o(v)o(e)12 b Fe(up)697 ! b Ff(u)42 2123 y Fh(select)15 b(men)o(u)e(item)f(b)o(y)i(name)383 ! b Ff(m)42 2173 y Fh(select)15 b Fb(n)s Fh(th)f(men)o(u)f(item)g(b)o(y)g(n)o ! (um)o(b)q(er)h(\(1{9\))155 b Fb(n)42 2222 y Fh(follo)o(w)11 ! b(cross)k(reference)i(\(return)e(with)f Ff(l)p Fh(\))186 b ! Ff(f)42 2272 y Fh(return)15 b(to)e(last)h(no)q(de)g(y)o(ou)g(sa)o(w)357 ! b Ff(l)42 2322 y Fh(return)15 b(to)e(directory)i(no)q(de)418 ! b Ff(d)42 2372 y Fh(go)13 b(to)h(an)o(y)f(no)q(de)h(b)o(y)g(name)418 ! b Ff(g)0 2439 y Fh(Other:)42 2507 y(run)14 b(Info)f Fe(tutorial)537 ! b Ff(h)42 2557 y Fh(list)13 b(Info)g(commands)510 b Ff(?)42 ! 2607 y Fe(quit)12 b Fh(Info)689 b Ff(q)42 2657 y Fh(searc)o(h)15 ! b(no)q(des)f(for)g(regexp)434 b Ff(M-s)1929 2832 y Fh(5)p eop %%Page: 6 6 ! bop 0 -168 a Fg(Keyb)r(oard)24 b(Macros)0 -65 y Fe(start)13 b Fh(de\014ning)g(a)h(k)o(eyb)q(oard)g(macro)304 b Ff(C-x)21 b(\()0 -15 y Fe(end)13 b Fh(k)o(eyb)q(oard)h(macro)e(de\014nition)336 ! b Ff(C-x)21 b(\))0 35 y Fe(execute)13 b Fh(last-de\014ned)i(k)o(eyb)q(oard)f ! (macro)215 b Ff(C-x)21 b(e)0 84 y Fh(app)q(end)14 b(to)g(last)g(k)o(eyb)q ! (oard)g(macro)332 b Ff(C-u)21 b(C-x)g(\()0 134 y Fh(name)13 ! b(last)g(k)o(eyb)q(oard)h(macro)218 b Ff(M-x)21 b(name-last-kbd-mac)o(ro)0 ! 184 y Fh(insert)15 b(Lisp)e(de\014nition)h(in)f(bu\013er)221 ! b Ff(M-x)21 b(insert-kbd-macro)0 305 y Fg(Commands)h(Dealing)g(with)f(Emacs)i ! (Lisp)0 409 y Fh(ev)n(al)13 b Fe(sexp)g Fh(b)q(efore)i(p)q(oin)o(t)490 ! b Ff(C-x)21 b(C-e)0 459 y Fh(ev)n(al)13 b(curren)o(t)j Fe(defun)553 ! b Ff(C-M-x)0 508 y Fh(ev)n(al)13 b Fe(region)598 b Ff(M-x)21 ! b(eval-region)0 558 y Fh(ev)n(al)13 b(en)o(tire)i Fe(bu\013er)374 ! b Ff(M-x)21 b(eval-current-buff)o(er)0 608 y Fh(read)14 b(and)g(ev)n(al)f ! (minibu\013er)456 b Ff(M-:)0 658 y Fh(re-execute)16 b(last)e(minibu\013er)f ! (command)246 b Ff(C-x)21 b(ESC)g(ESC)0 708 y Fh(read)14 b(and)g(ev)n(al)f ! (Emacs)h(Lisp)f(\014le)280 b Ff(M-x)21 b(load-file)0 757 y ! Fh(load)13 b(from)f(standard)i(system)g(directory)152 b Ff(M-x)21 ! b(load-library)0 884 y Fg(Simple)f(Customization)0 987 y Fh(Here)15 ! b(are)f(some)f(examples)g(of)h(binding)f(global)f(k)o(eys)i(in)g(Emacs)f ! (Lisp.)0 1055 y Ff(\(global-set-key)19 b("\\C-cg")h('goto-line\))0 ! 1105 y(\(global-set-key)f("\\C-x\\C-k")g('kill-region\))0 1155 ! y(\(global-set-key)g("\\M-#")h('query-replace-rege)o(xp\))0 ! 1222 y Fh(An)14 b(example)f(of)g(setting)h(a)g(v)n(ariable)f(in)g(Emacs)g ! (Lisp:)0 1290 y Ff(\(setq)21 b(backup-by-copyin)o(g-whe)o(n-lin)o(ked)e(t\))0 ! 1416 y Fg(W)-6 b(riting)22 b(Commands)0 1520 y Ff(\(defun)f ! Fb(c)n(ommand-name)26 b Ff(\()p Fb(ar)n(gs)s Ff(\))44 1570 ! y(")p Fb(do)n(cumentation)s Ff(")44 1619 y(\(interactive)19 ! b(")p Fb(template)s Ff("\))44 1669 y Fb(b)n(o)n(dy)t Ff(\))0 ! 1737 y Fh(An)14 b(example:)0 1805 y Ff(\(defun)21 b(this-line-to-to)o(p-of-)o ! (windo)o(w)e(\(line\))44 1854 y("Reposition)g(line)i(point)g(is)g(on)h(to)f ! (top)g(of)h(window.)0 1904 y(With)f(ARG,)g(put)g(point)g(on)g(line)g(ARG.)0 ! 1954 y(Negative)f(counts)h(from)g(bottom.")44 2004 y(\(interactive)e("P"\))44 ! 2054 y(\(recenter)h(\(if)h(\(null)f(line\))349 2103 y(0)305 ! 2153 y(\(prefix-numeric-va)o(lue)f(line\)\)\)\))0 2221 y Fh(The)12 ! b(argumen)o(t)e(to)i Ff(interactive)d Fh(is)i(a)g(string)h(sp)q(ecifying)f ! (ho)o(w)g(to)h(get)f(the)0 2271 y(argumen)o(ts)16 b(when)h(the)h(function)e ! (is)h(called)g(in)o(teractiv)o(ely)m(.)26 b(T)o(yp)q(e)17 b ! Ff(C-h)k(f)0 2321 y(interactive)12 b Fh(for)h(more)g(information.)238 2466 y Fd(Cop)o(yrigh)o(t)403 2465 y(c)393 2466 y Fc(\015)f Fd(1996)d(F)m(ree)j(Soft)o(w)o(are)e(F)m(oundation,)j(Inc.)269 ! 2506 y(designed)e(b)o(y)i(Stephen)f(Gildea,)f(Marc)o(h)g(1996)e(v2.1)281 ! 2545 y(for)i(GNU)f(Emacs)h(v)o(ersion)h(19)e(on)h(Unix)h(systems)0 ! 2603 y(P)o(ermission)g(is)f(gran)o(ted)e(to)h(mak)o(e)h(and)f(distribute)i ! (copies)e(of)h(this)g(card)f(pro)o(vided)h(the)g(cop)o(y-)0 ! 2643 y(righ)o(t)h(notice)e(and)i(this)g(p)q(ermission)g(notice)f(are)g ! (preserv)o(ed)g(on)h(all)f(copies.)0 2701 y(F)m(or)g(copies)f(of)g(the)h(GNU) ! e(Emacs)h(man)o(ual,)i(write)e(to)g(the)h(F)m(ree)f(Soft)o(w)o(are)g(F)m ! (oundation,)i(Inc.,)0 2741 y(59)e(T)m(emple)i(Place,)f(Suite)h(330,)f ! (Boston,)g(MA)f(02111-1307)e(USA)1929 2832 y Fh(6)p eop %%Trailer end userdict /end-hook known{end-hook}if %%EOF + diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/refcard.tex emacs-19.32/etc/refcard.tex *** emacs-19.31/etc/refcard.tex Fri Mar 22 17:02:33 1996 --- emacs-19.32/etc/refcard.tex Thu Jun 6 16:54:15 1996 *************** When two commands are shown, the second *** 391,398 **** {\setbox0=\hbox{\kbd{0}}\advance\hsize by 0\wd0 \paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr ! \threecol{split window in two vertically}{C-x 2\ \ \ \ }{C-x 5 2} \threecol{delete this window}{C-x 0\ \ \ \ }{C-x 5 0} }} ! \key{split window in two horizontally}{C-x 3} \key{scroll other window}{C-M-v} --- 391,398 ---- {\setbox0=\hbox{\kbd{0}}\advance\hsize by 0\wd0 \paralign to \hsize{#\tabskip=10pt plus 1 fil&#\tabskip=0pt&#\cr ! \threecol{split window, above and below}{C-x 2\ \ \ \ }{C-x 5 2} \threecol{delete this window}{C-x 0\ \ \ \ }{C-x 5 0} }} ! \key{split window, side by side}{C-x 3} \key{scroll other window}{C-M-v} diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/vipcard.tex emacs-19.32/etc/vipcard.tex *** emacs-19.31/etc/vipcard.tex Wed Jun 9 06:56:01 1993 --- emacs-19.32/etc/vipcard.tex Sat Jul 20 14:13:43 1996 *************** are preserved on all copies. *** 74,78 **** For copies of the GNU Emacs manual, write to the Free Software ! Foundation, Inc., 1000 Massachusetts Ave, Cambridge MA 02138. \endgroup} --- 74,78 ---- For copies of the GNU Emacs manual, write to the Free Software ! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. \endgroup} diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/etc/viperCard.tex emacs-19.32/etc/viperCard.tex *** emacs-19.31/etc/viperCard.tex Thu Jan 4 14:55:14 1996 --- emacs-19.32/etc/viperCard.tex Sat Jul 20 14:15:11 1996 *************** are preserved on all copies. *** 83,87 **** For copies of the GNU Emacs manual, write to the Free Software ! Foundation, Inc., 1000 Massachusetts Ave, Cambridge MA 02138. \endgroup} --- 83,87 ---- For copies of the GNU Emacs manual, write to the Free Software ! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. \endgroup} diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/info/dir emacs-19.32/info/dir *** emacs-19.31/info/dir Thu Jan 25 02:13:38 1996 --- emacs-19.32/info/dir Fri Jul 12 20:52:51 1996 *************** File: dir Node: Top This is the top of t *** 25,31 **** * CL: (cl). Partial Common Lisp support for Emacs Lisp. * SC: (sc). Supercite lets you cite parts of messages you're ! replying to, in hairy ways. * Dired-X: (dired-x). Dired Extra Features. * Ediff: (ediff). A comprehensive visual interface to diff & patch. ! * CC mode: (ccmode). The GNU Emacs mode for editing C, C++, and ! Objective-C code. --- 25,31 ---- * CL: (cl). Partial Common Lisp support for Emacs Lisp. * SC: (sc). Supercite lets you cite parts of messages you're ! replying to, in flexible ways. * Dired-X: (dired-x). Dired Extra Features. * Ediff: (ediff). A comprehensive visual interface to diff & patch. ! * CC mode: (ccmode). The GNU Emacs mode for editing C, C++, Objective-C ! and Java code. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/install.sh emacs-19.32/install.sh *** emacs-19.31/install.sh Sat May 25 20:17:34 1996 --- emacs-19.32/install.sh Thu Aug 1 22:02:46 1996 *************** *** 2,6 **** # # install - install a program, script, or datafile ! # This comes from X11R5. # # Calling this script install-sh is preferred over install.sh, to prevent --- 2,18 ---- # # install - install a program, script, or datafile ! # This comes from X11R5 (mit/util/scripts/install.sh). ! # ! # Copyright 1991 by the Massachusetts Institute of Technology ! # ! # Permission to use, copy, modify, distribute, and sell this software and its ! # documentation for any purpose is hereby granted without fee, provided that ! # the above copyright notice appear in all copies and that both that ! # copyright notice and this permission notice appear in supporting ! # documentation, and that the name of M.I.T. not be used in advertising or ! # publicity pertaining to distribution of the software without specific, ! # written prior permission. M.I.T. makes no representations about the ! # suitability of this software for any purpose. It is provided "as is" ! # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/ChangeLog emacs-19.32/lib-src/ChangeLog *** emacs-19.31/lib-src/ChangeLog Sat May 25 15:30:54 1996 --- emacs-19.32/lib-src/ChangeLog Wed Jul 31 15:11:28 1996 *************** *** 1,2 **** --- 1,66 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + Tue Jul 23 14:41:32 1996 Andrew Innes + + * etags.c (readline_internal) [DOS_NT]: Don't include CRs when + computing character positions in source files. + + Tue Jul 16 19:20:25 1996 Andrew Innes + + * makefile.nt (clean): Use OBJDIR macro. + + Tue Jul 16 18:08:18 1996 Karl Heuer + + * cvtmail.c, sorted-doc.c, yow.c, emacsserver.c: Undo previous change. + + Mon Jul 15 17:10:20 1996 David Mosberger-Tang + + * cvtmail.c, sorted-doc.c, yow.c: [__GNU_LIBRARY__]: Use . + * emacsserver.c (main) [__GNU_LIBRARY__]: Use size_t for fromlen. + * etags.c, fakemail.c, profile.c: Declare main as int, not void. + + Mon Jul 15 15:56:14 1996 Andrew Innes + + * ntlib.h: Correct return type of getwd. + * ntlib.c (getwd): Correct return type. + + Tue Jul 2 17:56:47 1996 Richard Stallman + + * emacsserver.c (main) [HAVE_SOCKETS]: Call rewind before writing + to infile. + + Mon Jul 01 16:00:07 1996 Andrew Innes + + * makefile.nt: Remove all references to wakeup. + + Fri Jun 28 16:51:32 1996 Francesco Potorti` + + * etags.c (C_stab_entry): New keywords for C++ namespace, bool, + explicit, mutable, typename. + + Sat Jun 29 02:16:46 1996 Richard Stallman + + * emacsclient.c (main) [HAVE_SOCKETS]: Use two separate stdio + streams, one for sending and one for reading the reply. + + Fri Jun 21 01:43:45 1996 Richard Stallman + + * Makefile.in (timer, timer.o, getdate.o, $(srcdir)/getdate.c) + (wakeup): Target deleted. + (UTILITIES): Delete wakeup and timer. + + * wakeup.c, timer.c, getdate.y, getdate.c: Files deleted. + + Tue Jun 11 10:27:00 1996 Geoff Voelker + + * etags.c (etags_getcwd) [DOS_NT]: Change conditional to MSDOS only. + * makefile.nt (ETAGS_CFLAGS): Define HAVE_GETCWD macro. + + Thu Jun 6 10:05:51 1996 Richard Stallman + + * etags.c (main): Copy cwd when appending slash. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/Makefile.in emacs-19.32/lib-src/Makefile.in *** emacs-19.31/lib-src/Makefile.in Fri Feb 16 21:22:31 1996 --- emacs-19.32/lib-src/Makefile.in Fri Jun 21 01:45:18 1996 *************** INSTALLABLE_SCRIPTS = rcs-checkin *** 94,99 **** # Things that Emacs runs internally, or during the build process, # which should not be installed in bindir. ! UTILITIES= wakeup profile digest-doc \ ! sorted-doc movemail cvtmail fakemail yow emacsserver hexl timer DONT_INSTALL= test-distrib make-docfile --- 94,99 ---- # Things that Emacs runs internally, or during the build process, # which should not be installed in bindir. ! UTILITIES= profile digest-doc \ ! sorted-doc movemail cvtmail fakemail yow emacsserver hexl DONT_INSTALL= test-distrib make-docfile *************** ${archlibdir}: all *** 252,257 **** fi - /* We don't need to install `wakeup' explicitly, because it will be - copied when this whole directory is copied. */ install: ${archlibdir} @echo --- 252,255 ---- *************** ctags: etags *** 339,345 **** $(CC) ${ALL_CFLAGS} -DCTAGS -DVERSION="\"${version}\"" -DETAGS_REGEXPS ${srcdir}/etags.c $(GETOPTOBJS) $(REGEXPOBJ) $(LOADLIBES) -o ctags - wakeup: ${srcdir}/wakeup.c - $(CC) ${ALL_CFLAGS} ${srcdir}/wakeup.c $(LOADLIBES) -o wakeup - profile: ${srcdir}/profile.c $(CC) ${ALL_CFLAGS} ${srcdir}/profile.c $(LOADLIBES) -o profile --- 337,340 ---- *************** emacsclient: ${srcdir}/emacsclient.c ../ *** 383,398 **** hexl: ${srcdir}/hexl.c $(CC) ${ALL_CFLAGS} ${srcdir}/hexl.c $(LOADLIBES) -o hexl - - TIMEROBJS=getdate.o timer.o $(ALLOCA) - $(srcdir)/getdate.c: ${srcdir}/getdate.y - cd $(srcdir); ${YACC} ${YFLAGS} getdate.y - cd $(srcdir); mv y.tab.c getdate.c - getdate.o: ${srcdir}/getdate.c ../src/config.h - $(CC) $(CPP_CFLAGS) -Demacs -c ${srcdir}/getdate.c - - timer.o: ${srcdir}/timer.c ../src/config.h - $(CC) -c $(CPP_CFLAGS) ${srcdir}/timer.c - timer: ${TIMEROBJS} - $(CC) $(LINK_CFLAGS) ${TIMEROBJS} $(LOADLIBES) -o timer /* These are NOT included in INSTALLABLES or UTILITIES. --- 378,381 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/alloca.c emacs-19.32/lib-src/alloca.c *** emacs-19.31/lib-src/alloca.c Sat May 25 20:21:30 1996 --- emacs-19.32/lib-src/alloca.c Thu Aug 1 22:06:58 1996 *************** alloca (size) *** 181,185 **** /* Reclaim garbage, defined as all alloca'd storage that ! was allocated from deeper in the stack than currently. */ { --- 181,185 ---- /* Reclaim garbage, defined as all alloca'd storage that ! was allocated from deeper in the stack than currently. */ { *************** struct stk_trailer *** 351,355 **** #ifdef CRAY2 /* Determine a "stack measure" for an arbitrary ADDRESS. ! I doubt that "lint" will like this much. */ static long --- 351,355 ---- #ifdef CRAY2 /* Determine a "stack measure" for an arbitrary ADDRESS. ! I doubt that "lint" will like this much. */ static long diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/emacsclient.c emacs-19.32/lib-src/emacsclient.c *** emacs-19.31/lib-src/emacsclient.c Mon Apr 8 16:52:51 1996 --- emacs-19.32/lib-src/emacsclient.c Tue Jul 23 10:18:33 1996 *************** main (argc, argv) *** 64,68 **** char system_name[32]; int s, i; ! FILE *out; struct sockaddr_un server; char *homedir, *cwd, *str; --- 64,68 ---- char system_name[32]; int s, i; ! FILE *out, *in; struct sockaddr_un server; char *homedir, *cwd, *str; *************** main (argc, argv) *** 133,136 **** --- 133,138 ---- exit (1); } + + /* We use the stream OUT to send our command to the server. */ if ((out = fdopen (s, "r+")) == NULL) { *************** main (argc, argv) *** 140,143 **** --- 142,157 ---- } + /* We use the stream IN to read the response. + We used to use just one stream for both output and input + on the socket, but reversing direction works nonportably: + on some systems, the output appears as the first input; + on other systems it does not. */ + if ((in = fdopen (s, "r+")) == NULL) + { + fprintf (stderr, "%s: ", argv[0]); + perror ("fdopen"); + exit (1); + } + #ifdef BSD cwd = getwd (string); *************** main (argc, argv) *** 171,183 **** fflush (stdout); ! rewind (out); /* re-read the output */ ! str = fgets (string, BUFSIZ, out); ! printf ("\n"); ! ! /* Now, wait for an answer and print any messages. */ ! while (str = fgets (string, BUFSIZ, out)) printf ("%s", str); ! return 0; } --- 185,196 ---- fflush (stdout); ! /* Now, wait for an answer and print any messages. On some systems, ! the first line we read will actually be the output we just sent. ! We can't predict whether that will happen, so if it does, we ! detect it by recognizing `Client: ' at the beginning. */ ! while (str = fgets (string, BUFSIZ, in)) printf ("%s", str); ! return 0; } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/emacsserver.c emacs-19.32/lib-src/emacsserver.c *** emacs-19.31/lib-src/emacsserver.c Tue Apr 9 17:17:41 1996 --- emacs-19.32/lib-src/emacsserver.c Tue Jul 16 18:09:29 1996 *************** extern int errno; *** 82,85 **** --- 82,86 ---- #endif /* no FD_SET */ + int main () { *************** main () *** 229,232 **** --- 230,234 ---- /* Transfer text from Emacs to the client, up to a newline. */ infile = openfiles[infd]; + rewind (infile); while (1) { diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/etags.c emacs-19.32/lib-src/etags.c *** emacs-19.31/lib-src/etags.c Fri May 17 12:46:15 1996 --- emacs-19.32/lib-src/etags.c Tue Jul 23 12:32:10 1996 *************** Inc., 59 Temple Place - Suite 330, Bosto *** 32,36 **** */ ! char pot_etags_version[] = "@(#) pot revision number is 11.63"; #define TRUE 1 --- 32,36 ---- */ ! char pot_etags_version[] = "@(#) pot revision number is 11.66"; #define TRUE 1 *************** char *massage_name (s) *** 694,698 **** ! void main (argc, argv) int argc; --- 694,698 ---- ! int main (argc, argv) int argc; *************** main (argc, argv) *** 857,862 **** tagfile = CTAGS ? "tags" : "TAGS"; cwd = etags_getcwd (); /* the current working directory */ ! if (cwd[strlen(cwd)-1] != '/') ! strcat (cwd, "/"); if (streq (tagfile, "-")) tagfiledir = cwd; --- 857,862 ---- tagfile = CTAGS ? "tags" : "TAGS"; cwd = etags_getcwd (); /* the current working directory */ ! if (cwd[strlen (cwd) - 1] != '/') ! cwd = concat (cwd, "/", ""); if (streq (tagfile, "-")) tagfiledir = cwd; *************** enum sym_type *** 1499,1503 **** /* Feed stuff between (but not including) %[ and %] lines to: ! gperf -c -k1,3 -o -p -r -t %[ struct C_stab_entry { char *name; int c_ext; enum sym_type type; } --- 1499,1503 ---- /* Feed stuff between (but not including) %[ and %] lines to: ! gperf -c -k 1,3 -o -p -r -t %[ struct C_stab_entry { char *name; int c_ext; enum sym_type type; } *************** struct C_stab_entry { char *name; int c_ *** 1508,1511 **** --- 1508,1512 ---- @end, 0, st_C_objend class, C_PLPL, st_C_struct + namespace, C_PLPL, st_C_struct domain, C_STAR, st_C_struct union, 0, st_C_struct *************** enum, 0, st_C_enum *** 1514,1517 **** --- 1515,1519 ---- typedef, 0, st_C_typedef define, 0, st_C_define + bool, C_PLPL, st_C_typespec long, 0, st_C_typespec short, 0, st_C_typespec *************** static, 0, st_C_typespec *** 1528,1531 **** --- 1530,1536 ---- const, 0, st_C_typespec volatile, 0, st_C_typespec + explicit, C_PLPL, st_C_typespec + mutable, C_PLPL, st_C_typespec + typename, C_PLPL, st_C_typespec # DEFUN used in emacs, the next three used in glibc (SYSCALL only for mach). DEFUN, 0, st_C_gnumacro *************** PSEUDO, 0, st_C_gnumacro *** 1540,1545 **** and replace lines between %< and %> with its output. */ /*%<*/ ! /* C code produced by gperf version 1.8.1 (K&R C version) */ ! /* Command-line: gperf -c -k1,3 -o -p -r -t */ --- 1545,1550 ---- and replace lines between %< and %> with its output. */ /*%<*/ ! /* C code produced by gperf version 2.1 (K&R C version) */ ! /* Command-line: gperf -c -k 1,3 -o -p -r -t */ *************** struct C_stab_entry { char *name; int c_ *** 1548,1578 **** #define MIN_WORD_LENGTH 3 #define MAX_WORD_LENGTH 15 ! #define MIN_HASH_VALUE 7 ! #define MAX_HASH_VALUE 63 /* ! 29 keywords ! 57 is the maximum key range */ static int hash (str, len) ! register char *str; ! register int len; { static unsigned char hash_table[] = { ! 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 17, 63, 63, 63, 4, 14, ! 4, 63, 63, 63, 63, 63, 63, 63, 63, 63, ! 8, 63, 63, 0, 23, 63, 63, 63, 63, 63, ! 63, 63, 63, 63, 63, 63, 63, 28, 63, 28, ! 10, 31, 27, 18, 63, 6, 63, 63, 26, 1, ! 11, 2, 29, 63, 29, 16, 26, 13, 15, 63, ! 63, 63, 63, 63, 63, 63, 63, 63, }; return len + hash_table[str[2]] + hash_table[str[0]]; --- 1553,1583 ---- #define MIN_WORD_LENGTH 3 #define MAX_WORD_LENGTH 15 ! #define MIN_HASH_VALUE 34 ! #define MAX_HASH_VALUE 121 /* ! 34 keywords ! 88 is the maximum key range */ static int hash (str, len) ! register char *str; ! register unsigned int len; { static unsigned char hash_table[] = { ! 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 45, 121, 121, 121, 16, 19, ! 61, 121, 121, 121, 121, 121, 121, 121, 121, 121, ! 10, 121, 121, 20, 53, 121, 121, 121, 121, 121, ! 121, 121, 121, 121, 121, 121, 121, 41, 45, 22, ! 60, 47, 37, 28, 121, 55, 121, 121, 20, 14, ! 29, 30, 5, 121, 50, 59, 30, 54, 6, 121, ! 121, 121, 121, 121, 121, 121, 121, 121, }; return len + hash_table[str[2]] + hash_table[str[0]]; *************** hash (str, len) *** 1580,1631 **** struct C_stab_entry * ! in_word_set (str, len) register char *str; ! register int len; { static struct C_stab_entry wordlist[] = { ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"SYSCALL", 0, st_C_gnumacro}, ! {"",}, {"",}, {"",}, {"",}, {"",}, ! {"DEFUN", 0, st_C_gnumacro}, ! {"",}, {"",}, {"",}, ! {"domain", C_STAR, st_C_struct}, ! {"",}, {"",}, {"",}, {"",}, {"",}, ! {"short", 0, st_C_typespec}, ! {"union", 0, st_C_struct}, {"void", 0, st_C_typespec}, ! {"",}, {"",}, ! {"PSEUDO", 0, st_C_gnumacro}, ! {"double", 0, st_C_typespec}, ! {"",}, {"",}, ! {"@end", 0, st_C_objend}, ! {"@implementation", 0, st_C_objimpl}, {"float", 0, st_C_typespec}, ! {"int", 0, st_C_typespec}, ! {"",}, ! {"unsigned", 0, st_C_typespec}, {"@interface", 0, st_C_objprot}, ! {"",}, {"signed", 0, st_C_typespec}, ! {"long", 0, st_C_typespec}, ! {"ENTRY", 0, st_C_gnumacro}, {"define", 0, st_C_define}, ! {"const", 0, st_C_typespec}, ! {"",}, {"",}, {"",}, {"enum", 0, st_C_enum}, - {"volatile", 0, st_C_typespec}, {"static", 0, st_C_typespec}, {"struct", 0, st_C_struct}, ! {"",}, {"",}, {"",}, ! {"@protocol", 0, st_C_objprot}, ! {"",}, {"",}, ! {"auto", 0, st_C_typespec}, ! {"",}, ! {"char", 0, st_C_typespec}, ! {"class", C_PLPL, st_C_struct}, ! {"typedef", 0, st_C_typedef}, ! {"extern", 0, st_C_typespec}, }; --- 1585,1649 ---- struct C_stab_entry * ! in_word_set (str, len) register char *str; ! register unsigned int len; { static struct C_stab_entry wordlist[] = { ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, ! {"volatile", 0, st_C_typespec}, ! {"PSEUDO", 0, st_C_gnumacro}, ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, ! {"typedef", 0, st_C_typedef}, ! {"typename", C_PLPL, st_C_typespec}, ! {"",}, {"",}, {"",}, {"SYSCALL", 0, st_C_gnumacro}, ! {"",}, {"",}, {"",}, ! {"mutable", C_PLPL, st_C_typespec}, ! {"namespace", C_PLPL, st_C_struct}, ! {"long", 0, st_C_typespec}, ! {"",}, {"",}, ! {"const", 0, st_C_typespec}, ! {"",}, {"",}, {"",}, ! {"explicit", C_PLPL, st_C_typespec}, ! {"",}, {"",}, {"",}, {"",}, {"void", 0, st_C_typespec}, ! {"",}, ! {"char", 0, st_C_typespec}, ! {"class", C_PLPL, st_C_struct}, ! {"",}, {"",}, {"",}, {"float", 0, st_C_typespec}, ! {"",}, ! {"@implementation", 0, st_C_objimpl}, ! {"auto", 0, st_C_typespec}, ! {"",}, ! {"ENTRY", 0, st_C_gnumacro}, ! {"@end", 0, st_C_objend}, ! {"bool", C_PLPL, st_C_typespec}, ! {"domain", C_STAR, st_C_struct}, ! {"",}, ! {"DEFUN", 0, st_C_gnumacro}, ! {"extern", 0, st_C_typespec}, {"@interface", 0, st_C_objprot}, ! {"",}, {"",}, {"",}, ! {"int", 0, st_C_typespec}, ! {"",}, {"",}, {"",}, {"",}, {"signed", 0, st_C_typespec}, ! {"short", 0, st_C_typespec}, ! {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"define", 0, st_C_define}, ! {"@protocol", 0, st_C_objprot}, {"enum", 0, st_C_enum}, {"static", 0, st_C_typespec}, + {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, {"",}, + {"union", 0, st_C_struct}, {"struct", 0, st_C_struct}, ! {"",}, {"",}, {"",}, {"",}, ! {"double", 0, st_C_typespec}, ! {"unsigned", 0, st_C_typespec}, }; *************** readline_internal (linebuffer, stream) *** 4088,4092 **** --- 4106,4119 ---- { *--p = '\0'; + #ifdef DOS_NT + /* Assume CRLF->LF translation will be performed by Emacs + when loading this file, so CRs won't appear in the buffer. + It would be cleaner to compensate within Emacs; + however, Emacs does not know how many CRs were deleted + before any given point in the file. */ + chars_deleted = 1; + #else chars_deleted = 2; + #endif } else *************** char * *** 4306,4310 **** etags_getcwd () { ! #ifdef DOS_NT char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ --- 4333,4337 ---- etags_getcwd () { ! #ifdef MSDOS char *p, path[MAXPATHLEN + 1]; /* Fixed size is safe on MSDOS. */ *************** etags_getcwd () *** 4317,4321 **** return strdup (path); ! #else /* not DOS_NT */ #if HAVE_GETCWD int bufsize = 200; --- 4344,4348 ---- return strdup (path); ! #else /* not MSDOS */ #if HAVE_GETCWD int bufsize = 200; *************** etags_getcwd () *** 4331,4335 **** return path; ! #else /* not DOS_NT and not HAVE_GETCWD */ struct linebuffer path; FILE *pipe; --- 4358,4362 ---- return path; ! #else /* not MSDOS and not HAVE_GETCWD */ struct linebuffer path; FILE *pipe; *************** etags_getcwd () *** 4343,4347 **** return path.buffer; #endif /* not HAVE_GETCWD */ ! #endif /* not DOS_NT */ } --- 4370,4374 ---- return path.buffer; #endif /* not HAVE_GETCWD */ ! #endif /* not MSDOS */ } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/fakemail.c emacs-19.32/lib-src/fakemail.c *** emacs-19.31/lib-src/fakemail.c Sun Apr 28 14:25:12 1996 --- emacs-19.32/lib-src/fakemail.c Mon Jul 15 16:52:39 1996 *************** Boston, MA 02111-1307, USA. */ *** 25,37 **** #if defined (BSD) && !defined (BSD4_1) && !defined (USE_FAKEMAIL) /* This program isnot used in BSD, so just avoid loader complaints. */ ! void main () { } #else /* not BSD 4.2 (or newer) */ #ifdef MSDOS ! void main () { } #else /* not MSDOS */ --- 25,39 ---- #if defined (BSD) && !defined (BSD4_1) && !defined (USE_FAKEMAIL) /* This program isnot used in BSD, so just avoid loader complaints. */ ! int main () { + return 0; } #else /* not BSD 4.2 (or newer) */ #ifdef MSDOS ! int main () { + return 0; } #else /* not MSDOS */ *************** write_header (the_header) *** 696,700 **** } ! void main (argc, argv) int argc; --- 698,702 ---- } ! int main (argc, argv) int argc; Only in emacs-19.31/lib-src: getdate.c Only in emacs-19.31/lib-src: getdate.y diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/getopt.c emacs-19.32/lib-src/getopt.c *** emacs-19.31/lib-src/getopt.c Wed May 22 17:44:40 1996 --- emacs-19.32/lib-src/getopt.c Mon Jun 24 17:40:30 1996 *************** *** 69,73 **** #endif ! #ifdef WIN32 /* It's not Unix, really. See? Capital letters. */ #include --- 69,73 ---- #endif ! #if defined (WIN32) && !defined (__CYGWIN32__) /* It's not Unix, really. See? Capital letters. */ #include diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/makefile.nt emacs-19.32/lib-src/makefile.nt *** emacs-19.31/lib-src/makefile.nt Sat May 18 16:14:40 1996 --- emacs-19.32/lib-src/makefile.nt Sat Jul 20 14:08:55 1996 *************** *** 16,21 **** # # 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ # --- 16,22 ---- # # 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. # *************** LINK_FLAGS = $(ARCH_LDFLAGS) -debug:PART *** 31,35 **** ALL = $(BLD)\make-docfile.exe \ $(BLD)\hexl.exe \ - $(BLD)\wakeup.exe \ $(BLD)\ctags.exe \ $(BLD)\etags.exe \ --- 32,35 ---- *************** $(BLD)\make-docfile.exe: $(BLD)\make-do *** 56,61 **** $(LINK) -out:$@ $(LINK_FLAGS) $(BLD)\make-docfile.obj $(BLD)\ntlib.obj $(LIBS) $(BLD)\hexl.exe: $(BLD)\hexl.obj - $(BLD)\wakeup.exe: $(BLD)\wakeup.obj $(BLD)\ntlib.obj - $(LINK) -out:$@ $(LINK_FLAGS) $(BLD)\wakeup.obj $(BLD)\ntlib.obj $(LIBS) $(BLD)\movemail.exe: $(BLD)\movemail.obj $(BLD)\pop.obj $(BLD)\ntlib.obj $(LINK) -out:$@ $(LINK_FLAGS) -debug:FULL $(BLD)\movemail.obj $(BLD)\pop.obj $(BLD)\ntlib.obj $(LIBS) wsock32.lib --- 56,59 ---- *************** $(BLD)\fakemail.exe: $(BLD)\fakemail.o *** 64,68 **** make-docfile: $(BLD) $(BLD)\make-docfile.exe - wakeup: $(BLD) $(BLD)\wakeup.exe etags: $(BLD) $(BLD)\etags.exe hexl: $(BLD) $(BLD)\hexl.exe --- 62,65 ---- *************** $(BLD)\regex.obj: ../src/regex.c ../src/ *** 86,90 **** ../src/regex.c -Fo$@ ! ETAGS_CFLAGS = -DETAGS_REGEXPS $(BLD)\etags.obj: etags.c $(CC) $(CFLAGS) $(ETAGS_CFLAGS) -Fo$@ etags.c --- 83,87 ---- ../src/regex.c -Fo$@ ! ETAGS_CFLAGS = -DETAGS_REGEXPS -DHAVE_GETCWD $(BLD)\etags.obj: etags.c $(CC) $(CFLAGS) $(ETAGS_CFLAGS) -Fo$@ etags.c *************** install: $(INSTALL_FILES) *** 197,201 **** $(CP) $(BLD)\ctags.exe $(INSTALL_DIR)\bin $(CP) $(BLD)\hexl.exe $(INSTALL_DIR)\bin - $(CP) $(BLD)\wakeup.exe $(INSTALL_DIR)\bin $(CP) $(BLD)\movemail.exe $(INSTALL_DIR)\bin $(CP) $(BLD)\fakemail.exe $(INSTALL_DIR)\bin --- 194,197 ---- *************** install: $(INSTALL_FILES) *** 208,212 **** clean:; - $(DEL) *~ *.pdb DOC* - $(DEL_TREE) deleted ! - $(DEL_TREE) obj # --- 204,208 ---- clean:; - $(DEL) *~ *.pdb DOC* - $(DEL_TREE) deleted ! - $(DEL_TREE) $(OBJDIR) # *************** $(BLD)\timer.obj : \ *** 355,364 **** $(EMACS_ROOT)\src\m\intel386.h \ $(EMACS_ROOT)\lib-src\..\src\config.h - - $(BLD)\wakeup.obj : \ - $(SRC)\wakeup.c \ - $(EMACS_ROOT)\src\s\windowsnt.h \ - $(EMACS_ROOT)\src\m\intel386.h \ - $(EMACS_ROOT)\src\config.h $(BLD)\yow.obj : \ --- 351,354 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/ntlib.c emacs-19.32/lib-src/ntlib.c *** emacs-19.31/lib-src/ntlib.c Fri May 3 14:26:50 1996 --- emacs-19.32/lib-src/ntlib.c Mon Jul 15 15:55:55 1996 *************** sleep(int seconds) *** 42,46 **** /* Get the current working directory. */ ! int getwd (char *dir) { --- 42,46 ---- /* Get the current working directory. */ ! char * getwd (char *dir) { diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/ntlib.h emacs-19.32/lib-src/ntlib.h *** emacs-19.31/lib-src/ntlib.h Fri May 3 12:34:26 1996 --- emacs-19.32/lib-src/ntlib.h Sat Jul 20 14:06:53 1996 *************** *** 14,20 **** 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 14,21 ---- 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. */ *************** *** 24,28 **** void sleep(int seconds); ! int getwd (char *dir); int getppid(void); char * getlogin (); --- 25,29 ---- void sleep(int seconds); ! char *getwd (char *dir); int getppid(void); char * getlogin (); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/profile.c emacs-19.32/lib-src/profile.c *** emacs-19.31/lib-src/profile.c Tue Apr 9 19:42:07 1996 --- emacs-19.32/lib-src/profile.c Mon Jul 15 16:52:42 1996 *************** gettimeofday (tp, tzp) *** 80,84 **** #endif ! void main () { --- 80,84 ---- #endif ! int main () { diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lib-src/rcs2log emacs-19.32/lib-src/rcs2log *** emacs-19.31/lib-src/rcs2log Sun Jan 14 20:17:56 1996 --- emacs-19.32/lib-src/rcs2log Sat Jul 20 14:08:05 1996 *************** *** 13,17 **** # Author: Paul Eggert ! # $Id: rcs2log,v 1.27 1996/01/15 01:17:03 eggert Exp $ # Copyright 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. --- 13,17 ---- # Author: Paul Eggert ! # $Id: rcs2log,v 1.28 1996/07/20 18:08:03 kwzh Exp $ # Copyright 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. *************** *** 28,33 **** # # 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, 675 Mass Ave, Cambridge, MA 02139, USA. tab=' ' --- 28,34 ---- # # 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. tab=' ' Only in emacs-19.31/lib-src: timer.c Only in emacs-19.31/lib-src: wakeup.c diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ChangeLog emacs-19.32/lisp/ChangeLog *** emacs-19.31/lisp/ChangeLog Sat May 25 15:31:23 1996 --- emacs-19.32/lisp/ChangeLog Thu Aug 1 18:38:40 1996 *************** *** 1,2 **** --- 1,1059 ---- + Thu Aug 1 18:36:15 1996 Richard Stallman + + * Version 19.32 released. + + * gud.el (gdb): Undo previous change. + + Thu Aug 1 10:16:04 1996 Simon Marshall + + * comint.el (comint-file-name-chars): Was comint-file-name-regexp. + Give it a non-nil default value. + + * shell.el (shell-file-name-chars): Was shell-file-name-regexp. + (shell-mode): Set comint-file-name-chars to this variable. + + Wed Jul 31 12:34:47 1996 Richard Stallman + + * dabbrev.el (dabbrev-expand): When snarfing consecutive words, + if previous one was upcased, upcase this one too. + (dabbrev--substitute-expansion): When snarfing consecutive words, + don't case convert here. + + * help.el (help-font-lock-keywords): Undo July 26 change. + + * term/x-win.el: Delete code to disable f10 if motif. + + * gud.el (gdb): Bind comint-file-name-regexp. + + Tue Jul 30 17:53:46 1996 Richard Stallman + + * emerge.el (emerge-files-with-ancestor, emerge-files): + Use add-hook to add to QUIT-HOOKS. + + Mon Jul 29 19:31:37 1996 Richard Stallman + + * help.el (help-fontify-buffer-function): Function deleted. + (help-mode): Set font-lock-defaults in simple way again. + + Mon Jul 29 00:00:00 1996 Erik Naggum + + * ange-ftp.el (ange-ftp-read-passwd): Let first input override + default, and let RET use the default value. + (ange-ftp-get-passwd): Make prompt clearer. + + Sat Jul 27 00:14:21 1996 Richard Stallman + + * complete.el (PC-complete): When command is repeated, + scroll the completion buffer. + + * gud.el (gud-display-line): Don't crash if BUFFER is nil. + + * font-lock.el (font-lock-mode): Don't add to after-change-functions + if font-lock-fontify-region-function is `ignore'. + + Fri Jul 26 17:22:04 1996 Richard Stallman + + * help.el (help-font-lock-keywords): Use font-lock-function-name-face + for variables, too. + + * dabbrev.el (dabbrev--substitute-expansion): Use just ABBREV, not OLD, + in previous change. + + * vc.el (vc-do-command): Bind win32-quote-process-args. + + Fri Jul 26 14:14:22 1996 Simon Marshall + + * help.el (help-mode): Set font-lock-defaults to provide bindings for + local fontification functions. + (help-fontify-buffer-function): New function. + + Tue Jul 23 23:53:53 1996 Richard Stallman + + * edebug.el (edebug-trace-display): Save and restore current buffer. + + Tue Jul 23 18:30:56 1996 Erik Naggum + + * etags.el (tag-exact-file-name-match-p): Fix previous change. + + Tue Jul 23 15:07:47 1996 Andrew Innes + + * winnt.el (file-name-buffer-file-type-alist): Load TAGS files as + text, not binary. + + Tue Jul 23 15:07:47 1996 Paul Eggert + + * completion.el (cmpl-hours-since-origin): Fix bug: + microseconds count was being used instead of seconds count. + + Tue Jul 23 14:17:40 1996 Richard Stallman + + * loaddefs.el (ctl-x-map): Bind C-x M-:. + + Tue Jul 23 12:17:42 1996 Roland McGrath + + Fixes from Robert Praetorius : + * etags.el (etags-goto-tag-location): New local variable LINE; use it. + Fix typo in direct-file-tag case: position -> startpos. + (tag-word-match-p, tag-exact-file-name-match-p): Fix off-by-one errors. + + Tue Jul 23 09:56:21 1996 Richard Stallman + + * shadow.el (list-load-path-shadows): Doc fix. + + Mon Jul 22 15:06:08 1996 Richard Stallman + + * gud.el (perldb-command-name): New variable. + (perldb): Use it. + + Sun Jul 21 20:31:10 1996 Ralf Fassel + + * files.el (dabbrev-case-fold-search, dabbrev-case-replace): Set + `risky-local-variable' property, since these get eval'ed. + + * dabbrev.el (dabbrev-case-fold-search, dabbrev-case-replace): + Undo previous change. + + Sun Jul 21 15:47:16 1996 Richard Stallman + + * dabbrev.el (dabbrev--search): Don't downcase the result here. + (dabbrev-completion): Bind completion-ignore-case. + (dabbrev--substitute-expansion): Downcase the expansion here, + but not if case pattern matches start of original expansion. + + * executable.el (executable-find): Doc fix. + + * time.el (display-time): Fix prev change: use display-time-update. + + Sun Jul 21 15:19:24 1996 Karl Heuer + + * viper-util.el (vip-ms-style-os-p, vip-vms-os-p): Moved here from + viper.el. + + * rmail.el (rmail-next-same-subject): Don't set search-regexp + until after adjusting subject string. + + Sun Jul 21 14:38:08 1996 Richard Stallman + + * browse-url.el (browse-url-choose-browser): New function. + (browse-url-browser-function): Use browse-url-choose-browser + as the initial value. + + * time.el (display-time): Call display-time-event-handler directly + to make the time appear right away. + + Sun Jul 21 13:52:09 1996 Karl Heuer + + * executable.el (executable-find): Doc fix. + + Sat Jul 20 13:19:50 1996 Karl Heuer + + * viper.el (vip-ms-style-os-p): Doc fix. + + Sat Jul 20 02:14:40 1996 Richard Stallman + + * view.el (view-mode-auto-exit): Doc fix. + + Sat Jul 20 02:11:53 1996 Simon Marshall + + * shadow.el (list-load-path-shadows): Fix ambiguous wording. + + Sat Jul 20 02:07:36 1996 Karl Heuer + + * gnus-cus.el: Don't test X colors unless using X. + + Fri Jul 19 15:23:12 1996 Karl Heuer + + * gnus-cus.el: If no dark magenta, use maroon. + (gnus-face-dark-name-list): If no dark blue, use royal blue. + + Wed Jul 17 15:54:40 1996 Karl Heuer + + * viper-util.el (vip-get-filenames-from-buffer): Add &optional. + + * time.el (display-time): Starting time should be future, not past. + + Tue Jul 16 19:29:03 1996 Lars Magne Ingebrigtsen + + * message.el (message-send): Don't use mail-hist by default. + + Mon Jul 15 16:22:45 1996 Paul Eggert + + * appt.el (appt-check, appt-make-list): Avoid race condition + by getting current time only once. + * texinfmt.el (texinfo-format-today): Likewise. + + Mon Jul 15 16:17:26 1996 Richard Stallman + + * sh-script.el (sh-mode): Call sh-set-shell only for a writable + empty buffer. + + * executable.el (executable-set-magic): Don't put a space at end + if user says no. + + Mon Jul 15 16:00:03 1996 Andrew Innes + + * smtpmail.el (smtpmail-send-data-1): Escape "." at the start of + any line of data, not just lines containing nothing else. + + Sun Jul 14 10:31:02 1996 Lars Magne Ingebrigtsen + + * gnus-cache.el: Make sure byte-compilation doesn't trip on + the undefined `gnus-add-shutdown'. + + * gnus.el: Make sure `gnus-directory' is defined + when byte-compiling. + + Sat Jul 13 14:14:09 1996 Karl Heuer + + * allout.el (outline-auto-activation, outline-layout) + (outline-primary-bullet, outline-plain-bullets-string) + (outline-distinctive-bullets-string, outline-old-style-prefixes) + (outline-stylish-prefixes, outline-file-xref-bullet) + (outline-use-hanging-indents, outline-bullets-string) + (outline-write-file-hook, outline-mode, outline-prefix-data) + (outline-before-change-protect, outline-make-topic-prefix) + (outline-rebullet-current-heading, outline-rebullet-heading) + (outline-listify-exposed, outline-expose-topic) + (outline-old-expose-topic, outline-exposure) + (outline-latex-verbatim-quote-curr-line) + (outline-show-current-subtree, outline-hide-current-subtree) + (outline-hide-current-leaves, outline-new-exposure): Doc fix. + + Sat Jul 13 13:57:13 1996 Francois Pinard + + * allout.el (outline-resolve-xref): Do not mistake a blank line + following an xref (@) bullet as part of the rerefenced file name. + + Sat Jul 13 13:53:31 1996 Christopher J. Madsen + + * time.el (display-time): Fix start time for run-at-time. + + Fri Jul 12 20:51:32 1996 Richard Stallman + + * rmailsum.el (rmail-summary-next-labeled-message) + (rmail-summary-previous-labeled-message): + Call rmail-summary-goto-msg to move point in the summary. + + * mouse.el (mouse-major-mode-menu-1): No need to copy the top + levels of structure. + + * browse-url.el (browse-url-netscape-program): New variable. + (browse-url-mosaic-program): New variable. + (browse-url-mosaic, browse-url-netscape): Use them. + + Fri Jul 12 03:34:21 1996 Simon Marshall + + * font-lock.el (font-lock-comment-start-regexp): New variable. + (font-lock-fontify-syntactically-region): Use it. + When matching comments, use (match-end 1) as the start, if non-nil. + (font-lock-defaults-alist): Provide value for Lisp/C/C++ modes. + Remove obsolete entry for bibtex-mode. Doc fix. + (font-lock-match-c++-style-declaration-item-and-skip-to-next): Don't + treat a ; character as a declaration item separator. + + * comint.el (comint-truncate-buffer): Count lines from process-mark, + not point-max, as the input may span lines. + (comint-postoutput-scroll-to-bottom): Don't subtract from process-mark, + use comint-last-output-start, since the buffer string may have changed. + (comint-dynamic-complete-as-filename): Don't bind + file-name-handler-alist to nil, it interferes with directory tracking. + (comint-dynamic-list-filename-completions): Likewise. + (comint-replace-by-expanded-history): Only match leading ^ in input. + (comint-file-name-regexp): New variable. + (comint-mode): Make it buffer-local. + (comint-match-partial-filename): Use it. + + * shell.el (shell-file-name-quote-list): Default to nil on MSDOS/NT. + (shell-file-name-regexp): New variable. + (shell-mode): Set comint-file-name-regexp to its value. + + Thu Jul 11 20:31:10 1996 Ralf Fassel + + * dabbrev.el (dabbrev-case-fold-search, dabbrev-case-replace): Set + `risky-local-variable' property, since these get eval'ed. + + Thu Jul 11 20:09:27 1996 Ronan Waide + + * smtpmail.el (smtpmail-deduce-address-list): Handle RESENT-* fields. + + Thu Jul 11 19:26:18 1996 Richard Stallman + + * startup.el (normal-top-level-add-to-load-path): + Use directory-file-name since load-path elements don't end in /. + + * rmailsum.el (rmail-make-basic-summary-line): + If user-mail-address is nil, use alternative. + + * tex-mode.el (tex-validate-region): Skip fwd over whitespace + and punctuation, to find point of mismatch. + (validate-tex-buffer): Don't include the blank lines + before a paragraph in the paragraph being checked. + + * mouse.el (mouse-drag-region): Cope if stop-point is nil. + + * mouse.el (mouse-major-mode-menu-compute-equiv-keys): Deleted. + (mouse-major-mode-menu-1): Copy the top levels of structure, + if we use all of MENUBAR. + Set mouse-major-mode-menu-prefix. + (mouse-major-mode-menu): Total rewrite. + + Thu Jul 11 19:07:52 1996 Stefan Schoef + + * bibtex.el (bibtex-reference-head): Allow spaces and tabs between + opening brace or paren and key. Simplify regexp. + (bibtex-type-in-head, bibtex-key-in-head): Decrement. + (bibtex-mode): Use new function run-with-idle-timer instead of + auto-save-hook for periodically parsing keys. + (bibtex-mode-syntax-table, bibtex-autokey-name-change-strings, + bibtex-autokey-titleword-change-strings): Support non-escaped + double-quoted characters (as with german styles). + (bibtex-field-string-quoted): Disallow lines like + author = "Stefan Sch"of" + until BibTeX supports them. + + Sun Jul 7 20:17:11 1996 Richard Stallman + + * mouse.el (mouse-major-mode-menu-1): Always return just a keymap; + never (STRING . KEYMAP). + (mouse-major-mode-menu): Discard the `keymap' from the front of + the keymap we get from mouse-major-mode-menu-1. + Construct the menu name string from major-mode. + + Sun Jul 7 18:28:35 1996 Dave Love + + * gud.el (gud-irix-p): Exclude Irix6.1 up. + (gud-dbx-use-stopformat-p): New variable. + (dbx): Use it to send $stopformat for Irix6. + (gud-irixdbx-marker-filter): Cast $curline to int, not long (see + added comments). + (dbx): Likewise. + + Sun Jul 7 13:29:05 1996 Karl Heuer + + * ps-print.el (ps-article-subject): Don't die if header is missing. + (ps-article-author, ps-info-file, ps-info-node): Likewise. + + Sun Jul 7 00:00:00 1996 Francois Pinard + + * timezone.el (timezone-parse-date): Handle ISO 8601 dates, so + rmailsort does the right thing with them. + + Sat Jul 6 16:03:13 1996 Richard Stallman + + * mouse.el (mouse-show-mark): In transient mark mode, + delete mouse-drag-overlay. + (mouse-undouble-last-event): New function. + (mouse-show-mark): Call mouse-undouble-last-event. + + Sat Jul 6 16:03:13 1996 Richard Stallman + + * tar-mode.el (tar-mode-map): Bind up and down like C-p, C-n. + + Sat Jul 6 21:05:11 1996 Erik Naggum + + * files.el (insert-directory): Fix previous change. + + Fri Jul 5 22:04:17 1996 Lars Magne Ingebrigtsen + + * gnus-cus.el (()): Make sure that calling `gnus-visual-p' during + byte-compilation doesn't bug out. + + Fri Jul 5 09:35:58 1996 Simon Marshall + + * mail-utils.el (mail-strip-quoted-names): Removed debugging code. + + Thu Jul 4 13:22:28 1996 Richard Stallman + + * simple.el (newline): Don't do the optimization if the newline before + point is intangible or read-only or invisible. + + Wed Jul 3 11:13:42 1996 Richard Stallman + + * subr.el (unfocus-frame, focus-frame): Define as no-ops. + + Wed Jul 3 11:13:42 1996 Richard Stallman + + * scheme.el (scheme-mode-variables): Set comment-start-skip + to ignore backslash-quoted semicolons. + + * lisp-mode.el (lisp-mode-variables): Set comment-start-skip + to ignore backslash-quoted semicolons. + + Wed Jul 3 11:13:42 1996 Richard Stallman + + * files.el (insert-directory): When converting SWITCHES + string to a list, put back in original order. + + Thu Jul 4 00:15:19 1996 Lars Magne Ingebrigtsen + + * gnus.el (gnus-summary-prepare-threads): Would infloop under + certain obscure conditions. + + Wed Jul 3 11:13:42 1996 Richard Stallman + + * smtpmail.el (smtpmail-send-it): Ignore `To:' if there is a + `Resent-to':. + + Mon Jul 1 10:58:01 1996 Richard Stallman + + * winnt.el (using-unix-filesystems): Doc fix. + + Tue Jul 2 17:13:04 1996 Richard Stallman + + * reporter.el (mail-user-agent): Add autoload cookie. + + Tue Jul 2 17:12:20 1996 Barry A. Warsaw + + * reporter.el: Major rewrite. + + Tue Jul 2 19:36:28 1996 Lars Magne Ingebrigtsen + + * gnus-cache.el (gnus-cache-possibly-alter-active): Check for + gnus-cache-active-hashtb before using it. + + Mon Jul 1 10:58:01 1996 Richard Stallman + + * tcl-mode.el (tcl-imenu-generic-expression): Add nil as 1st elt. + + * mail-hist.el (mail-hist-current-header-name): + Use buffer-substring-no-properties. + + Mon Jul 1 00:00:00 1996 Francois Pinard + + * rmailsum.el (rmail-make-basic-summary-line): Accept ISO 8601 + dates as well. + + Fri Jun 30 22:38:46 1996 Michael Kifer + + * viper-util.el (vip-read-key): inhibit quit added. + + Sun Jun 30 14:06:36 1996 Lars Magne Ingebrigtsen + + * score-mode.el: Renamed from "gnus-scomo.el". + + Sun Jun 30 04:10:54 1996 Richard Stallman + + * info.el (Info-next-preorder): After we move up, move forward again. + (Info-last-preorder): After we move down or to the prev, + move down again. + + Sat Jun 29 15:50:40 1996 Richard Stallman + + * userlock.el (ask-user-about-supersession-help): Change help text. + (ask-user-about-supersession-threat): Add new `r' alternative. + + * files.el (set-visited-file-name): New optional arg NO-QUERY. + + Sat Jun 29 09:20:29 1996 Lars Magne Ingebrigtsen + + * nnheaderems.el: Deleted. + + Fri Jun 28 16:03:05 1996 Richard Stallman + + * view.el (view-mode): Doc fix. + + Fri Jun 28 15:49:41 1996 Ethan Bradford + + * ispell.el (ispell-message): Support message-mode. + + Fri Jun 28 11:21:42 1996 Per Abrahamsen + + * mouse.el (mouse-start-end): Support selecting strings by double + clicking on a character with quote syntax. + + Fri Jun 28 02:55:21 1996 Richard Stallman + + * cal-french.el (french-calendar-accents): New variable. + (french-calendar-month-name-array): Check that variable. + (french-calendar-special-days-array): Likewise. + (calendar-french-date-string): Likewise. + (calendar-goto-french-date): Likewise. + + * rmail.el (rmail-get-new-mail): Run rmail-before-get-new-mail-hook. + + * files.el (abbreviate-file-name): Ignore automount-dir-prefix if nil. + + * rmail.el (rmail-send-actions-rmail-buffer): Mark as permanent-local. + (rmail-send-actions-rmail-msg-number): Likewise. + + * sendmail.el (mail-reply-buffer, mail-send-actions): + Mark them as permanent-local. + (mail-mode): Don't set mail-reply-buffer to nil. + + * files.el (auto-mode-alist): Treat .pm like .pl. + + * term/x-win.el (x-handle-name-switch): Renamed from + x-handle-name-rn-switch. + + * startup.el (command-line-x-option-alist): Don't handle -rn. + x-handle-name-rn-switch renamed to x-handle-name-switch. + + * tmm.el (tmm-add-prompt): If tmm-completion-prompt is nil, + don't insert it; instead delete the usual completion helptext. + (tmm-completion-prompt): Doc fix. + + * mh-utils.el (mail-user-agent): Replaces mua-paradigm. + (mh-find-path): Set mail-user-agent. + + Thu Jun 27 17:53:34 1996 Francesco Potorti` + + * profile.el (profile-functions): No need to assume that the + current buffer is writable. + (profile-print, profile-results): Changed to display number of + calls and average time per call. + (profile-update-function): Update the number of calls. + (profile-a-function): Init the number of calls. + + Thu Jun 27 18:00:13 1996 Paul Eggert + + * rmail.el (rmail-unix-mail-delimiter): + Accept more user names, since they can be + mangled badly by modern Unix mailers (e.g. Solaris 2.5 mail.local). + Be a little more picky about dates to compensate. + Match all the digits of a year, as per RFC 1123 section 5.2.14. + (rmail-nuke-pinhead-header): Adjust to regexp renumbering in + rmail-unix-mail-delimiter. + + Thu Jun 27 01:54:01 1996 Richard Stallman + + * bibtex.el (bibtex-reference-head): Allow whitespace after the open + paren. + + * make-mode.el (makefile-gnumake-functions-alist): Add `addprefix'. + + * comint.el (comint-send-input): Use insert-before-markers + for all the insertions. + + Wed Jun 26 14:03:20 1996 Richard Stallman + + * mail-extr.el (mail-extract-address-components): Rename ,-pos + to comma-pos. + + * noutline.el (outline-minor-mode): No longer permanent local. + + Tue Jun 25 18:35:27 1996 Richard Stallman + + * tex-mode.el (tex-common-initialization): + Set skeleton-further-elements. + (tex-latex-block): Define as a skeleton. + + Tue Jun 25 18:22:54 1996 Lars Magne Ingebrigtsen + + * nnvirtual.el, nntp.el, nnspool.el, nnml.el, nnmh.el, nnmbox.el, + * nnmail.el, nnkiboze.el, nnheader.el, nnfolder.el, nneething.el, + * nndoc.el, nndir.el, nnbabyl.el, gnus.el, gnus-vm.el, + * gnus-vis.el, gnus-uu.el, gnus-score.el, gnus-msg.el, gnus-mh.el, + * gnus-kill.el, gnus-ems.el, gnus-edit.el, gnus-cite.el, + * gnus-cache.el, custom.el: New versions installed. + + * nnsoup.el, nnoo.el, nnheaderems.el, nndb.el, message.el, + * mailheader.el, gnus-topic.el, gnus-srvr.el, gnus-soup.el, + * gnus-setup.el, gnus-scomo.el, gnus-salt.el, gnus-nocem.el, + * gnus-gl.el, gnus-demon.el: New files. + + Tue Jun 25 14:46:53 1996 Richard Stallman + + * executable.el (executable-set-magic): Add space at end of line + if user says no to adding the shell's usual arguments. + Don't clear the buffer's modified-flag. + + * skeleton.el (skeleton-proxy-new): New function. + (define-skeleton): Define the skeleton as a defun + using skeleton-proxy-new. + + Tue Jun 25 15:01:46 1996 Simon Marshall + + * rmailsum.el (rmail-summary-mode-map): Add rmail-summary-by-senders. + + Tue Jun 25 01:13:11 1996 Richard Stallman + + * noutline.el (outline-minor-mode): Using change-major-mode-hook, + turn this mode off if we change major modes. + + Mon Jun 24 00:47:28 1996 + + * skeleton.el (local-variables-section): Adapted comment to outline + minor mode. + (skeleton-pair-insert-maybe): Rewritten to support autowrapping. + (mirror-mode): Fixed change of pair-* to skeleton-pair-*. Also pairs + 8 bit characters. + + Mon Jun 24 02:43:03 1996 Richard Stallman + + * mail-extr.el (mail-extract-address-components): Quote the comma + in ,-pos. + + * rmail.el (rmail-summary-by-senders): FIx typo in fn name. + + * goto-addr.el (goto-address-url-face, goto-address-mail-face) + (goto-address-url-mouse-face): New variables. + (goto-address-fontify): Use them. + + * files.el (set-auto-mode): Run multiple mode: specs + in left-to-right order. + + Mon Jun 24 01:45:37 1996 Simon Marshall + + * font-lock.el (font-lock-verbose): Default to 0. Doc fix. + (font-lock-default-fontify-buffer): Interpret numeric value. + (font-lock-fontified): Don't make it permanent-local. + (font-lock-mode): Remove before-revert-hook and after-revert-hook code. + Call font-lock-turn-on-thing-lock before font-lock-mode-hook. Doc fix. + (font-lock-revert-setup, font-lock-revert-cleanup): Deleted. + (turn-on-font-lock): Don't test font-lock-defaults et. al here again. + (turn-on-font-lock-if-enabled): Do it here again. + (font-lock-support-mode): New variable. + (font-lock-turn-on-thing-lock): New function. Use it. + (font-lock-turn-off-thing-lock): Renamed font-lock-thing-lock-cleanup. + (font-lock-change-major-mode): Turn off Font Lock mode if it is on. + Add font-lock-change-major-mode to change-major-mode-hook at top level. + + * fast-lock.el: New version. Barf if loaded on 8+3 filename pseudo-OS. + (fast-lock-mode): Wrap font-lock-support-mode not font-lock-mode-hook. + (fast-lock-save-cache): Use font-lock-value-in-major-mode. + (fast-lock-set-face-properties): Wrap with save-buffer-state. + + * lazy-lock.el: New file. + + * rmail.el (rmail-variables): Include font-lock-maximum-size in + font-lock-defaults. + + * mailalias.el (mail-complete): Reread mail aliases if necessary. + + Sun Jun 23 15:00:42 1996 Erik Naggum + + * term.el (term-exec-1): Run process on pty if possible. + + Sun Jun 23 01:56:15 1996 Noah Friedman + + * rlogin.el (rlogin): make comint-output-filter-functions local + before adding hooks. + + Sat Jun 22 00:49:00 1996 Richard Stallman + + * gnus-ems.el (gnus-background-mode): Set threshold for "light color" + at .6 of the total for white. + + * font-lock.el (font-lock-make-faces): Set threshold for "light color" + at .6 of the total for white. + + * faces.el (x-create-frame-with-faces): Set threshold for "light color" + at .6 of the total for white. + + * simple.el (choose-completion-string): Don't exit the minibuffer + when a directory name is chosen. + + Sat Jun 22 00:56:36 1996 + + * skeleton.el (skeleton-autowrap): New variable. + (skeleton-abbrev-cleanup): Added variable documentation. + (skeleton-proxy): Added optional autowrappping feature. + (skeleton-proxy, skeleton-abbrev-cleanup): Use `post-command-hook' + instead of someday to be obsolete defer. + + Fri Jun 21 22:05:06 1996 Michael Kifer + + * ediff-diff.el (ediff-setup-fine-diff-regions): + allow diff options to be passed to the diff program. + (ediff-make-diff2-buffer): Don't run Posix diff on remote files. + (ediff-make-diff2-buffer): Refuses to diff remote files. + (ediff-make-diff2-buffer,ediff-setup-diff-regions): Changed functions. + (ediff-make-diff2-buffer): New function. + Added ^\C-m$ to ok-lines regexps + + * ediff-ptch.el: New file. + + * ediff-util.el (ediff-verify-file-buffer): No longer reverts + buffers that have file name handlers. + + * ediff-mult.el (ediff-meta-insert-file-info): Write `remote file' + in the file size/modtime positions, if a file is remote. + + * ediff-wind.el (ediff-make-base-title): New function. + (ediff-refresh-control-frame): Modified. + + Fri Jun 21 21:05:06 1996 Michael Kifer + + * viper-ex.el: Fixed the :e command for NT + + * viper.el: replaced all checks for (or (numberp ...) + (characterp ...)) with vip-characterp + (vip-change): Now hides replace overlay even for multiline changes. + (vip-paren-match): Goes to closing paren first. + + * viper.el (vip-find-char-forward,vip-find-char-backward, + vip-goto-char-forward,vip-goto-char-backward): + (viper-mode): Don't delete the startup message. + (vip-set-hooks): Added fortran-mode to viper. + + * viper-util.el (vip-ex-nontrivial-find-file-unix) + (vip-ex-nontrivial-find-file-ms,vip-get-filenames-from-buffer) + (vip-wildcard-to-regexp,vip-glob-ms-windows-files): New functions. + + Fri Jun 21 01:16:36 1996 Richard Stallman + + * asm-mode.el (asm-mode-map): Bind C-c ; to comment-region. + + * mouse.el (mouse-drag-region): Be smart about which end + gets point and which end gets the mark. + + * hilit19.el (LaTeX-mode): Change handling of escaped $. + + * mouse.el (mouse-buffer-menu): Use aref rather than string-match. + + Wed Jun 19 18:12:09 1996 Richard Stallman + + * rmailsum.el (rmail-summary-bury): New function. + (rmail-summary-mode-map): Put rmail-summary-bury on b. + + * paths.el (Info-default-directory-list): Doc fix. + + Wed Jun 19 18:55:02 1996 Dave Love + + * gud.el (gud-irixdbx-marker-filter): Use %1ld, not %1d, + when printing $curline. + (dbx, irix case): Likewise in arg of gud-down. + + Tue Jun 18 13:14:11 1996 Brian D. Carlstrom + + * smtpmail.el (smtpmail-send-it): Don't handle FCC fields until after + determining FROM field. + Delete code that converted "S:" to "Subject:". + Insert FROM field unless it already exists (code from sendmail.el). + + Tue Jun 18 13:14:11 1996 Andrew Innes + + * smtpmail.el (smtpmail-smtp-service): Use port 25 as default. + (smtpmail-send-it): Require mail-utils upon entry. + Don't invoke sendmail-synch-aliases. + (smtpmail-deduce-address-list): Only use text matched in regexp group, + not the whole regexp. + + * smtpmail.el (smtpmail-read-response): Goto smtpmail-read-point + on every iteration to deal with multiple line banners. + + * smptmail.el (smtpmail-via-smtp): Bracket names in FROM + and RCPT TO commands. + + Tue Jun 18 12:50:58 1996 Richard Stallman + + * ange-ftp.el (ange-ftp-kill-ftp-process): Really use the BUFFER arg. + Make it optional. + + * vc-hooks.el (vc-mode-line): If user is root, + verify file really has user-writable bit. + + Tue Jun 18 13:23:29 1996 Kim F. Storm + + * hippie.el (he-concat-directory-file-name): Directory part may be nil. + (he-file-name-nondirectory): Referenced external variable. + + Tue Jun 18 11:47:00 1996 Richard Stallman + + * pp.el (pp-to-string): Treat #( like (. + + Tue Jun 18 11:06:32 1996 Francesco Potorti` + + * files.el (auto-mode-alist): Add uppercase version of archive + mode file name extensions ARC, ZIP, LXH, ZOO. + + Mon Jun 17 23:46:40 1996 Richard Stallman + + * noutline.el (outline-up-heading): Fix error message. + (outline-backward-same-level, outline-forward-same-level): Likewise. + + Sun Jun 16 14:22:58 1996 Richard Stallman + + * font-lock.el (global-font-lock-mode): Set up find-file-hooks. + (font-lock-default-fontify-buffer, font-lock-fontify-block) + (font-lock-mode): Fix syntax of msgs such as Fontifying...done. + + * skeleton.el (local-variables-section): Deleted. + + * undigest.el (unforward-rmail-message): In summary buffer, + switch temporarily to Rmail buffer. + + Sat Jun 15 19:54:54 1996 Paul Eggert + + * mail-utils.el (mail-strip-quoted-names): + `"' is not special inside an RFC 822 comment. + + Sat Jun 15 19:05:06 1996 Richard Stallman + + * sgml-mode.el (html-list): Definition deleted. + (html-headline): Definition deleted. + (html-ordered-list, html-unordered-list): New definitions. + (html-headline-1 ... html-headline-6): New definitions. + (html-mode-map): Use new commands. + + Fri Jun 14 17:29:30 1996 Richard Stallman + + * rlogin.el (rlogin): Doc fix. + + Fri Jun 14 14:34:54 1996 Ed Reingold + + * cal-tex.el (cal-tex-mini-calendar): Add optional paramter COLSEP. + (cal-tex-cursor-filofax-year): Use it. Also, adjust other sizes. + + Thu Jun 13 16:33:15 1996 Richard Stallman + + * simple.el (set-fill-column): Error if no argument. + + * easymenu.el (easy-menu-create-keymaps): Add menu-alias property. + + * lmenu.el (make-lucid-menu-keymap): Add menu-alias property. + + Tue Jun 11 13:11:08 1996 Andrew Innes + + * nnmail.el (nnmail-move-inbox): Prompt for POP3 password if + required, and include on the movemail command line. + + Wed Jun 12 00:26:30 1996 Richard Stallman + + * imenu.el (imenu--mouse-menu): Don't check imenu-use-keymap-menu. + + * files.el (find-alternate-file): Don't clear buffer-file-truename + and friends until after calling unlock-buffer. + + Wed Jun 12 05:32:05 1996 enami tsugutomo + + * rmailsum.el (rmail-new-summary): Fix typo; (concat ": " + description) should be eval'ed. + + Tue Jun 11 15:44:21 1996 Richard Stallman + + * tar-mode.el (tar-mode-revert): Cope if user cancels the revert. + + Mon Jun 10 17:35:58 1996 Richard Stallman + + * term.el (term-terminal-menu): Don't make a self-recursive keymap. + + * rmail.el (rmail-retry-failure): Nicer error message + if can't find mail-unsent-separator. + + * hexl.el (hexl-mode): Run hexl-mode-hook. + + Sun Jun 9 13:08:37 1996 Eli Zaretskii + + * term/pc-win.el (msdos-face-setup): Use `terminal-frame' for + initial frame setup. + (make-msdos-frame): New MSDOS-specific frame creation function. + (focus-frame, unfocus-frame): Don't set to 'ignore. + (auto-raise-mode, auto-lower-mode): Likewise. + (set-background-color, set-foreground-color): Definitions deleted. + + * loadup.el: On MSDOS, don't assume that `make-frame' + is only bound under an X emulator; use `x-create-frame' instead. + + * frame.el (frame-initialize): Don't count MSDOS neither as + window-system nor as a terminal frame here. + + * dos-fns.el: No need to require 'faces and set menu-bar-mode. + (window-frame): Remove; it is now on `frame.c'. + (raise-frame, select-frame): Likewise. + + Mon Jun 10 12:59:12 1996 Richard Stallman + + * hexl.el (hexl-mode): Set hexl-max-address early on + and call hexl-goto-address afterward. + And call hexlify-buffer even earlier. + + Sat Jun 8 16:03:24 1996 Geoff Voelker + + * comint.el (comint-substitute-in-file-name): New function. + (comint-match-partial-filename): Use comint-substitute-in-file-name + to handle system-specific syntax. + + * shell.el (shell-directory-tracker): Use + comint-substitute-in-file-name to handle system-specific syntax. + + * comint.el (comint-dynamic-complete-as-filename) + (omint-dynamic-simple-complete) + (comint-dynamic-list-filename-completions) [ms-dos, windows-nt]: + Set completion-ignore-case to t for these systems. + + * shell.el (shell-chdrive-regexp): New variable. + (shell-mode): Update doc string. + (shell-directory-tracker): Update doc string. + Detect drive changes. + + Sun Jun 9 15:10:44 1996 Richard Stallman + + * frame.el (make-frame-command): Treat msdos like no window system. + + Sun Jun 9 08:51:17 1996 Karl Heuer + + * comint.el (comint-file-name-quote-list): Doc fix. + * texnfo-upd.el (texinfo-find-pointer): Doc fix. + (texinfo-sequentially-find-pointer): Doc fix. + (texinfo-copy-menu): Use double backslash to quote regexp. + + Sat Jun 8 14:24:36 1996 Roland McGrath + + * etags.el (etags-list-tags): When there is an explicit tag name, skip + the \177 before it. + + Fri Jun 7 20:55:32 1996 Karl Heuer + + * facemenu.el (facemenu-complete-face-list): Doc fix. + + Fri Jun 7 13:06:53 1996 Roland McGrath + + * etags.el (tag-lines-already-matched): Remove defvar. + (initialize-new-tags-table): Don't make that var local. + (tag-lines-already-matched): Add docless defvar near find-tag-in-order + defun; this is a global state variable for that one function. + (find-tag-in-order): Move clearing of tag-lines-already-matched out of + loop. Make it a list of markers and search it with member; it is now + global, not buffer-local in the tags table, and records all matches in + any tags table during a single find-tag loop. When we run out of + matches, clear it and null out the markers. + + Fri Jun 7 10:21:52 1996 Richard Stallman + + * imenu.el (imenu--mouse-menu): Always use nested keymaps. + (imenu-use-keymap-menu): Variable deleted. + + * cmacexp.el (c-macro-preprocessor): New clause for Solaris. + + * winnt.el (x-set-selection, x-get-selection): Define them + to really use TYPE. + + * smtpmail.el: New file. + (smtpmail-send-it): Fix error messages. + (smtpmail-deduce-address-list): Bind recipient-address-list with let. + (smtpmail-via-smtp): Bind greeting, n, process-buffer. + + Thu Jun 6 10:34:19 1996 Richard Stallman + + * files.el (hack-local-variables-prop-line): Bind enable-local-eval. + + * hexl.el (hexl-mode-map): Bind prior, home, deletechar, deleteline, + insertline, S-delete, and DEL. Don't bind prev. + + Mon Jun 3 20:58:42 1996 Geoff Voelker + + * comint.el (comint-dynamic-complete-filename) [ms-dos, windows-nt]: + Always use backslash as a directory separator when completing + in shell mode on these systems. + + * winnt.el (shell-mode-hook): Set comint-completion-addsuffix + so that the directory suffix is backslash and the file suffix is space. + + Wed Jun 5 13:18:37 1996 Richard Stallman + + * comint.el (comint-unquote-filename): Handle quoted backslashes. + + * vc.el (vc-cancel-version): Fix paren error. + + * imenu.el (imenu): In interactive spec, pass the entire + index item, not just the string. + + Tue Jun 4 17:30:07 1996 Per Abrahamsen + + * xt-mouse.el (xterm-mouse-event): Adjust for minibuffer prompt + width. + + Tue Jun 4 12:37:13 1996 Richard Stallman + + * dired.el (dired-chown-program): Try /usr/sbin/chown. + + * frame.el (make-frame-command): New function. + (ctl-x-5-map): Change C-x 5 2 to make-frame-command. + + * hippie-exp.el (he-file-name-chars): Check windows-nt, not ms-windows. + + Tue Jun 04 14:50:26 1996 Kim F. Storm + + * files.el (buffer-file-numbers-unique): New variable; + initialize to nil for windows-nt. + (find-buffer-visiting): Skip search for buffer based + on buffer-file-number if these are not unique. + + Tue Jun 4 11:27:36 1996 Richard Stallman + + * replace.el (occur): Avoid "1 lines" in echo area. + + * shell.el (shell-match-partial-variable): Doc fix. + + Mon Jun 3 10:38:45 1996 Richard Stallman + + * mouse.el (mouse-show-mark): Use temporary highlighting if possible + instead of a pause. + (mouse-drag-region): Use mouse-show-mark to do temp highlighting. + (mouse-save-then-kill): Call mouse-show-mark for a new selection + if we have a window system. + + * reporter.el (reporter-submit-bug-report): + Bind same-window-regexps, same-window-buffer-names, to nil. + + Sun Jun 2 17:55:45 1996 Richard Stallman + + * rmail.el (rmail-get-new-mail): If conversion to BABYL fails + for the default inboxes, rename them so they won't be tried again. + + Sun Jun 2 11:27:13 1996 Eli Zaretskii + + * term/pc-win.el (msdos-color-aliases): Define more colors. + (msdos-color-translate): Fix `substring' arguments. Recognize + ``medium'' prefix. + + Fri May 31 17:04:19 1996 Karl Heuer + + * loaddefs.el (debug-ignored-errors): Don't use concat inside + quoted list. + + Fri May 31 00:16:17 1996 Richard Stallman + + * ehelp.el (electric-helpify): Allow NAME to be given as arg. + (electric-command-apropos): Specify *Apropos* as buffer name. + + * fill.el (fill-individual-paragraphs): Don't get stuck + if no newline at the end of the region. + + Thu May 30 19:13:40 1996 Richard Stallman + + * ispell.el (ispell-region): Handle ispell-skip-sgml properly + with an re-search. + + * reporter.el (reporter-submit-bug-report): + Use display-buffer to re-show the original buffer. + + Thu May 30 15:44:36 1996 Karl Heuer + + * simple.el (shell-command-on-region): In output buffer, display + first page by setting point, not window-start (which can leave + point in an unexpected place). + + * info.el (Info-insert-dir): Fix default directory. + + Thu May 30 13:11:29 1996 Per Abrahamsen + + * custom.el (event-point): Fix fboundp test surrounding this. + + Wed May 29 13:10:04 1996 Karl Heuer + + * debug.el, edebug.el, icomplete.el, macros.el, simple.el: + Use executing-kbd-macro, not executing-macro. + + Tue May 28 11:46:10 1996 Karl Heuer + + * add-log.el (change-log-font-lock-keywords): Require colon after + parenthesized function name. + + Tue May 28 11:21:40 1996 Paul Eggert + + * gnus.el (gnus-article-date-ut): Avoid race condition. + * gnus-msg.el (gnus-inews-date): Likewise. + + * gnus.el (gnus-gmt-to-local): When rewriting a date to local time, + use the UTC offset in effect then, not the current UTC offset. + + Sun May 26 19:12:21 1996 Roland McGrath + + * mailabbrev.el (mail-abbrev-expand-hook): Disable abbrev mode + temporarily while working, to avoid recursion in indent-relative + expanding part of the abbrev expansion as an abbrev itself. + Sat May 25 15:30:10 1996 Karl Heuer *************** Fri May 17 17:02:04 1996 Richard Stallm *** 58,62 **** Wed May 15 10:47:32 1996 Richard Stallman ! * tex-mode.el (latex-imenu-create-index): Change the regexp to match the * versions of commands. (latex-mode): Make imenu-create-index-function buffer-local. --- 1115,1119 ---- Wed May 15 10:47:32 1996 Richard Stallman ! * tex-mode.el (latex-imenu-create-index): Change the regexp to match the * versions of commands. (latex-mode): Make imenu-create-index-function buffer-local. *************** Sat May 11 14:29:44 1996 Andrew Innes < *** 83,87 **** (scroll-bar-maybe-set-window-start): New function. ! * term/win32-win.el (win32-handle-scroll-bar-event): Use scroll-bar-maybe-set-window-start. --- 1140,1144 ---- (scroll-bar-maybe-set-window-start): New function. ! * term/win32-win.el (win32-handle-scroll-bar-event): Use scroll-bar-maybe-set-window-start. *************** Fri May 10 18:41:10 1996 Richard Stallm *** 103,107 **** * vc.el (vc-rename-file): After renaming, update VC info and modeline. Preserve buffer-read-only. ! Thu May 9 13:35:20 1996 Richard Stallman --- 1160,1164 ---- * vc.el (vc-rename-file): After renaming, update VC info and modeline. Preserve buffer-read-only. ! Thu May 9 13:35:20 1996 Richard Stallman *************** Wed May 8 17:03:41 1996 Richard Stallm *** 119,125 **** (bookmark-insert-current-bookmark, bookmark-send-edited-annotation) (bookmark-read-annotation, bookmark-read-annotation-text-func) ! (bookmark-send-annotation, bookmark-insert-file-format-version-stamp): Doc fix. ! Wed May 8 14:43:02 1996 Karl Fogel --- 1176,1182 ---- (bookmark-insert-current-bookmark, bookmark-send-edited-annotation) (bookmark-read-annotation, bookmark-read-annotation-text-func) ! (bookmark-send-annotation, bookmark-insert-file-format-version-stamp): Doc fix. ! Wed May 8 14:43:02 1996 Karl Fogel *************** Mon May 6 19:17:04 1996 Richard Stallm *** 158,162 **** * gulp.el: New file. ! * info.el (Info-enable-active-nodes): Default to nil. Mark it risky. --- 1215,1219 ---- * gulp.el: New file. ! * info.el (Info-enable-active-nodes): Default to nil. Mark it risky. *************** Fri Apr 26 22:15:40 1996 Andrew Innes < *** 255,259 **** * loadup.el [windows-nt]: Load disp-table. ! * rmail.el (rmail-insert-inbox-text): When required, prompt for pop password and pass on to movemail. (rmail-pop-password, rmail-pop-password-required): New variables. --- 1312,1316 ---- * loadup.el [windows-nt]: Load disp-table. ! * rmail.el (rmail-insert-inbox-text): When required, prompt for pop password and pass on to movemail. (rmail-pop-password, rmail-pop-password-required): New variables. *************** Fri Apr 19 05:30:53 1996 Richard Stallm *** 346,350 **** (metamail-interpret-header, metamail-interpret-body): New functions. (metamail-region, metamail-buffer): New arg VIEWMODE. ! * Optional argument which value is passed to the environment variable EMACS_VIEW_MODE is added to the function metamail-buffer --- 1403,1407 ---- (metamail-interpret-header, metamail-interpret-body): New functions. (metamail-region, metamail-buffer): New arg VIEWMODE. ! * Optional argument which value is passed to the environment variable EMACS_VIEW_MODE is added to the function metamail-buffer *************** Sat Mar 23 00:32:19 1996 Per Abrahamsen *** 641,647 **** * custom.el (custom-type-properties): ! Use custom-asis instead of as-is. (custom-asis): Set it to itself. ! * gnus-cus.el: Use custom-asis instead of as-is. Fri Mar 22 18:25:21 1996 Michelangelo Grigni --- 1698,1704 ---- * custom.el (custom-type-properties): ! Use custom-asis instead of as-is. (custom-asis): Set it to itself. ! * gnus-cus.el: Use custom-asis instead of as-is. Fri Mar 22 18:25:21 1996 Michelangelo Grigni *************** Fri Mar 22 08:20:31 1996 Richard Stallm *** 661,665 **** * faces.el (x-frob-font-slant): Properly handle a match against x-font-regexp-head. ! (x-frob-font-weight): Separate two cond cases by analogy with x-frob-font-slant. --- 1718,1722 ---- * faces.el (x-frob-font-slant): Properly handle a match against x-font-regexp-head. ! (x-frob-font-weight): Separate two cond cases by analogy with x-frob-font-slant. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/MANIFEST emacs-19.32/lisp/MANIFEST *** emacs-19.31/lisp/MANIFEST Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/MANIFEST Thu Aug 1 22:14:25 1996 *************** *** 0 **** --- 1,402 ---- + abbrev.el --- abbrev mode commands for Emacs + abbrevlist.el --- list one abbrev table alphabetically ordered. + ada-mode.el --- An Emacs major-mode for editing Ada source. + add-log.el --- change log maintenance commands for Emacs + advice.el --- an overloading mechanism for Emacs Lisp functions + allout.el --- Extensive outline mode for use alone and with other modes. + ange-ftp.el --- transparent FTP support for GNU Emacs + appt.el --- appointment notification functions. + apropos.el --- apropos commands for users and programmers. + arc-mode.el --- simple editing of archives + array.el --- array editing commands for Gnu Emacs + asm-mode.el --- mode for editing assembler code + assoc.el --- insert/delete/sort functions on association lists + auto-show.el --- perform automatic horizontal scrolling as point moves + autoinsert.el --- automatic mode-dependent insertion of text into new files + autoload.el --- maintain autoloads in loaddefs.el. + avoid.el --- make mouse pointer stay out of the way of editing + awk-mode.el --- AWK code editing commands for Emacs + backquote.el --- implement the ` Lisp construct + bib-mode.el --- bib-mode, major mode for editing bib files. + bibtex.el --- BibTeX mode for GNU Emacs + blackbox.el --- blackbox game in Emacs Lisp + blessmail.el --- Decide whether movemail needs special privileges. + bookmark.el --- set bookmarks, maybe annotate them, jump to them later. + browse-url.el --- ask a WWW browser to load a URL + buff-menu.el --- buffer menu main function and support functions. + byte-opt.el --- the optimization passes of the emacs-lisp byte compiler. + byte-run.el --- byte-compiler support for inlining + bytecomp.el --- compilation of Lisp code into byte code. + c-mode.el --- C code editing commands for Emacs + cal-china.el --- calendar functions for the Chinese calendar. + cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars. + cal-dst.el --- calendar functions for daylight savings rules. + cal-french.el --- calendar functions for the French Revolutionary calendar. + cal-hebrew.el --- calendar functions for the Hebrew calendar. + cal-islam.el --- calendar functions for the Islamic calendar. + cal-iso.el --- calendar functions for the ISO calendar. + cal-julian.el --- calendar functions for the Julian calendar. + cal-mayan.el --- calendar functions for the Mayan calendars. + cal-menu.el --- calendar functions for menu bar and popup menu support + cal-move.el --- calendar functions for movement in the calendar + cal-persia.el --- calendar functions for the Persian calendar. + cal-tex.el --- calendar functions for printing calendars with LaTeX. + cal-x.el --- calendar windows in dedicated frames in X + calendar.el --- Calendar functions. + case-table.el --- code to extend the character set and support case tables. + cc-compat.el --- cc-mode compatibility with c-mode.el confusion + cc-mode.el --- major mode for editing C, C++, and Objective-C code + cdl.el --- Common Data Language (CDL) utility functions for Gnu Emacs + chistory.el --- list command history + cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) + cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two) + cl-indent.el --- enhanced lisp-indent mode + cl-macs.el --- Common Lisp extensions for GNU Emacs Lisp (part four) + cl-seq.el --- Common Lisp extensions for GNU Emacs Lisp (part three) + cl-specs.el --- Edebug specs for cl.el + cl.el --- Common Lisp extensions for GNU Emacs Lisp + cmacexp.el --- expand C macros in a region + cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el. + comint.el --- general command interpreter in a window stuff + compare-w.el --- compare text between windows for Emacs. + compile.el --- run compiler as inferior of Emacs, parse error messages. + complete.el --- partial completion mechanism plus other goodies + completion.el --- dynamic word-completion code + cookie1.el --- retrieve random phrases from fortune cookie files + copyright.el --- update the copyright notice in current buffer + cplus-md.el --- C++ code editing commands for Emacs + cpp.el --- Highlight or hide text according to cpp conditionals. + cust-print.el --- handles print-level and print-circle. + custom.el --- User friendly customization support. + dabbrev.el --- dynamic abbreviation package + debug.el --- debuggers and related commands for Emacs + decipher.el --- Cryptanalyze monoalphabetic substitution ciphers + ;;I turned this off because I don't want it + delsel.el --- delete selection if you insert + derived.el --- allow inheritance of major modes. + desktop.el --- save partial status of Emacs when killed + diary-lib.el --- diary functions. + diff.el --- Run `diff' in compilation-mode. + dired-aux.el --- less commonly used parts of dired -*-byte-compile-dynamic: t;-*- + dired-x.el --- Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19 + dired.el --- directory-browsing commands + disass.el --- disassembler for compiled Emacs Lisp code + disp-table.el --- functions for dealing with char tables. + dissociate.el --- scramble text amusingly for Emacs. + docref.el --- Simple cross references for Elisp documentation strings + doctor.el --- psychological help for frustrated users. + dos-fns.el --- MS-Dos specific functions. + double.el --- Support for keyboard remapping with double clicking + dunnet.el --- Text adventure for Emacs + easymenu.el --- support the easymenu interface for defining a menu. + ebuff-menu.el --- electric-buffer-list mode + echistory.el --- Electric Command History Mode + edebug.el --- a source-level debugger for Emacs Lisp + ediff-diff.el --- diff-related utilities + ediff-hook.el --- setup for Ediff's menus and autoloads + ediff-init.el --- Macros, variables, and defsubsts used by Ediff + ediff-merg.el --- merging utilities + ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff + ediff-ptch.el --- Ediff's patch support + ediff-util.el --- the core commands and utilities of ediff + ediff-vers.el --- version control interface to Ediff + ediff-wind.el --- window manipulation utilities + ediff.el --- a comprehensive visual interface to diff & patch + edmacro.el --- keyboard macro editor + edt-lk201.el --- Enhanced EDT Keypad Mode Emulation for LK-201 Keyboards + edt-mapper.el --- Create an EDT LK-201 Map File for X-Windows Emacs + edt-pc.el --- Enhanced EDT Keypad Mode Emulation for PC 101 Keyboards + edt-vt100.el --- Enhanced EDT Keypad Mode Emulation for VT Series Terminals + edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19 + ehelp.el --- bindings for electric-help mode + electric.el --- window maker and Command loop for `electric' modes. + elp.el --- Emacs Lisp Profiler + emacs-lock.el --- prevents you from exiting emacs if a buffer is locked + emacsbug.el --- command to report Emacs bugs to appropriate mailing list. + emerge.el --- merge diffs under Emacs control + enriched.el --- read and save files in text/enriched format + env.el --- functions to manipulate environment variables. + etags.el --- etags facility for Emacs + eval-reg.el --- Redefine eval-region, and subrs that use it, in Lisp + executable.el --- base functionality for executable interpreter scripts + f90.el --- Fortran-90 mode (free format) + facemenu.el --- create a face menu for interactively adding fonts to text + faces.el --- Lisp interface to the c "face" structure + fast-lock.el --- Automagic text properties caching for fast Font Lock mode. + ffap.el --- find file or url at point + files.el --- file input and output commands for Emacs + fill.el --- fill commands for Emacs + find-dired.el --- run a `find' command and dired the output + find-file.el --- find a file corresponding to this one given a pattern + find-gc.el --- detect functions that call the garbage collector + finder-inf.el --- keyword-to-package mapping + finder.el --- topic & keyword-based code finder + float-sup.el --- detect absence of floating-point support in Emacs runtime + float.el --- floating point arithmetic package. + flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control + foldout.el --- Folding extensions for outline-mode and outline-minor-mode. + follow.el --- Minor mode, Synchronize windows showing the same buffer. + font-lock.el --- Electric font lock mode + format.el --- read and save files in multiple formats + forms-d2.el --- demo forms-mode + forms-pass.el --- passwd file demo for forms-mode + forms.el --- Forms mode: edit a file as a form to fill in + fortran.el --- Fortran mode for GNU Emacs + frame.el --- multi-frame management independent of window systems. + gnus-cache.el --- cache interface for Gnus + gnus-cite.el --- parse citations in articles for Gnus + gnus-cus.el --- User friendly customization of Gnus + gnus-demon.el --- daemonic Gnus behaviour + gnus-edit.el --- Gnus SCORE file editing + gnus-ems.el --- functions for making Gnus work under different Emacsen + gnus-gl.el --- an interface to GroupLens for Gnus + gnus-kill.el --- kill commands for Gnus + gnus-mh.el --- mh-e interface for Gnus + gnus-msg.el --- mail and post interface for Gnus + gnus-nocem.el --- NoCeM pseudo-cancellation treatment + gnus-salt.el --- alternate summary mode interfaces for Gnus + gnus-score.el --- scoring code for Gnus + gnus-setup.el --- Initialization & Setup for Gnus 5 + gnus-soup.el --- SOUP packet writing support for Gnus + gnus-srvr.el --- virtual server support for Gnus + gnus-topic.el --- a folding minor mode for Gnus group buffers + gnus-uu.el --- extract (uu)encoded files in Gnus + gnus-vis.el --- display-oriented parts of Gnus + gnus-vm.el --- vm interface for Gnus + gnus.el --- a newsreader for GNU Emacs + gomoku.el --- Gomoku game between you and Emacs + goto-addr.el --- click to browse URL or to send to e-mail address + gud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb under Emacs + gulp.el --- Ask for updates for Lisp packages + hanoi.el --- towers of hanoi in GNUmacs + help-macro.el --- Makes command line help such as help-for-help + help.el --- help commands for Emacs + helper.el --- utility help package supporting help in electric modes + hexl.el --- edit a file in a hex dump format using the hexl filter. + hide-ifdef-mode.el --- hides selected code within ifdef. + hideshow.el --- minor mode cmds to selectively display blocks of code + hilit19.el --- customizable highlighting for Emacs19 + hippie-exp.el --- expand text trying various ways to find its expansion. + holidays.el --- holiday functions for the calendar package + icomplete.el --- minibuffer completion incremental feedback + icon.el --- mode for editing Icon code + ielm.el --- interaction mode for Emacs Lisp + imenu.el --- Framework for mode-specific buffer indexes. + indent.el --- indentation commands for Emacs + inf-lisp.el --- an inferior-lisp mode + info.el --- info package for Emacs. + informat.el --- info support functions package for Emacs + isearch.el --- incremental search minor mode. + iso-acc.el --- minor mode providing electric accent keys + iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals. + iso-cvt.el --- translate to ISO 8859-1 from/to net/TeX conventions + iso-insert.el --- insert functions for ISO 8859/1. + iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys + iso-syntax.el --- set up case-conversion and syntax tables for ISO 8859/1 + iso-transl.el --- keyboard input definitions for ISO 8859/1. + iso02-syn.el --- set up case-conversion and syntax tables for ISO 8859-2 + ispell.el --- spell checking using Ispell + ispell4.el --- this is the GNU EMACS interface to GNU ISPELL version 4. + jka-compr.el --- reading/writing/loading compressed files + kermit.el --- additions to shell mode for use with kermit, etc. + lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode. + ledit.el --- Emacs side of ledit interface + levents.el --- emulate the Lucid event data type and associated functions. + life.el --- John Horton Conway's `Life' game for GNU Emacs + lisp-mnt.el --- minor mode for Emacs Lisp maintainers + lisp-mode.el --- Lisp mode, and its idiosyncratic commands. + lisp.el --- Lisp editing commands for Emacs + lmenu.el --- emulate Lucid's menubar support + loaddefs.el --- define standard autoloads and keys of other files + loadhist.el --- lisp functions for working with feature groups + loadup.el --- load up standardly loaded Lisp files for Emacs. + lpr.el --- print Emacs buffer on line printer. + ls-lisp.el --- emulate insert-directory completely in Emacs Lisp + lselect.el --- Lucid interface to X Selections + lucid.el --- Emulate some Lucid Emacs functions. + lunar.el --- calendar functions for phases of the moon. + macros.el --- non-primitive commands for keyboard macros. + mail-extr.el --- extract full name and address from RFC 822 mail header. + mail-hist.el --- Headers and message body history for outgoing mail. + mail-utils.el --- utility functions used both by rmail and rnews + mailabbrev.el --- abbrev-expansion of mail aliases. + mailalias.el --- expand and complete mailing address aliases + mailheader.el --- Mail header parsing, merging, formatting + mailpost.el --- RMAIL coupler to /usr/uci/post mailer + make-mode.el --- makefile editing commands for Emacs + makeinfo.el --- run makeinfo conveniently + makesum.el --- generate key binding summary for Emacs + man.el --- browse UNIX manual pages + map-ynp.el --- General-purpose boolean question-asker. + meese.el --- protect the impressionable young minds of America + menu-bar.el --- define a default menu bar. + message.el --- composing mail and news messages + metamail.el --- Metamail interface for GNU Emacs + mh-comp --- mh-e functions for composing messages + mh-e.el --- GNU Emacs interface to the MH mail system + mh-funcs --- mh-e functions not everyone will use right away + mh-mime --- mh-e support for composing MIME messages + mh-pick --- make a search pattern and search for a message in mh-e + mh-seq --- mh-e sequences support + mh-utils.el --- mh-e code needed for both sending and reading + misc.el --- basic editing commands for Emacs + mlconvert.el --- convert buffer of Mocklisp code to real lisp. + mldrag.el --- mode line and vertical line dragging to resize windows + mlsupport.el --- run-time support for mocklisp code. + modula2.el --- Modula-2 editing support package + morse.el --- Convert text to morse code and back. + mouse-sel.el --- Multi-click selection support for Emacs 19 + mouse.el --- window system-independent mouse support + mpuz.el --- multiplication puzzle for GNU Emacs + msb.el --- Customizable buffer-selection with multiple menus. + nnbabyl.el --- rmail mbox access for Gnus + nndb.el --- nndb access for Gnus + nndir.el --- single directory newsgroup access for Gnus + nndoc.el --- single file access for Gnus + nneething.el --- random file access for Gnus + nnfolder.el --- mail folder access for Gnus + nnheader.el --- header access macros for Gnus and its backends + nnkiboze.el --- select virtual news access for Gnus + nnmail.el --- mail support functions for the Gnus mail backends + nnmbox.el --- mail mbox access for Gnus + nnmh.el --- mhspool access for Gnus + nnml.el --- mail spool access for Gnus + nnoo.el --- OO Gnus Backends + nnsoup.el --- SOUP access for Gnus + nnspool.el --- spool access for GNU Emacs + nntp.el --- nntp access for Gnus + nnvirtual.el --- virtual newsgroups access for Gnus + outline.el --- outline mode commands for Emacs + novice.el --- handling of disabled commands ("novice mode") for Emacs. + nroff-mode.el --- GNU Emacs major mode for editing nroff source + options.el --- edit Options command for Emacs. + outline.el --- outline mode commands for Emacs + page-ext.el --- extended page handling commands + page.el --- page motion commands for emacs. + paragraphs.el --- paragraph and sentence parsing. + paren.el --- highlight matching paren. + pascal.el --- major mode for editing pascal source in Emacs + paths.el --- define pathnames for use by various Emacs commands. + pc-mode.el --- emulate certain key bindings used on PCs. + pc-select.el --- emulate mark, cut, copy and paste from motif + perl-mode.el --- Perl code editing commands for GNU Emacs + picture.el --- "Picture mode" -- editing using quarter-plane screen model. + pp.el --- pretty printer for Emacs Lisp + profile.el --- generate run time measurements of Emacs Lisp functions + prolog.el --- major mode for editing and running Prolog under Emacs + ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19. + rcompile.el --- run a compilation on a remote machine + rect.el --- rectangle functions for GNU Emacs. + refbib.el --- convert refer-style references to ones usable by Latex bib + refer.el --- look up references in bibliography files. + regi.el --- REGular expression Interpreting engine + register.el --- register commands for Emacs. + replace.el --- replace commands for Emacs. + reporter.el --- customizable bug reporting of lisp programs + reposition.el --- center a Lisp function or comment on the screen + resume.el --- process command line args from within a suspended Emacs job + rfc822.el --- hairy rfc822 parser for mail and news and suchlike + ring.el --- handle rings of items + rlogin.el --- remote login interface + rmail.el --- main code of "RMAIL" mail reader for Emacs. + rmailedit.el --- "RMAIL edit mode" Edit the current message. + rmailkwd.el --- part of the "RMAIL" mail reader for Emacs. + rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader + rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file. + rmailsort.el --- Rmail: sort messages. + rmailsum.el --- make summary buffers for the mail reader + rnews.el --- USENET news reader for gnu emacs + rnewspost.el --- USENET news poster/mailer for GNU Emacs + rot13.el --- display a buffer in rot13. + rsz-mini.el --- dynamically resize minibuffer to display entire contents + s-region.el --- set region using shift key. + saveplace.el --- automatically save place in files. + scheme.el --- Scheme mode, and its idiosyncratic commands. + score-mode.el --- mode for editing Gnus score files + scribe.el --- scribe mode, and its idiosyncratic commands. + scroll-bar.el --- window system-independent scroll bar support. + select.el --- lisp portion of standard selection support. + sendmail.el --- mail sending commands for Emacs. + server.el --- Lisp code for GNU Emacs running as server process. + sgml-mode.el --- SGML- and HTML-editing modes + sh-script.el --- shell-script editing commands for Emacs + shadow.el --- Locate Emacs Lisp file shadowings. + shadowfile.el --- automatic file copying for Emacs 19 + shell.el --- specialized comint.el for running the shell. + simple.el --- basic editing commands for Emacs + simula.el --- SIMULA 87 code editing commands for Emacs + skeleton.el --- Lisp language extension for writing statement skeletons + ;; Simple SMTP protocol (RFC 821) for sending mail + solar.el --- calendar functions for solar events. + solitaire.el --- game of solitaire in Emacs Lisp + sort.el --- commands to sort text in an Emacs buffer. + soundex.el --- implement Soundex algorithm + spell.el --- spelling correction interface for Emacs. + spook.el --- spook phrase utility for overloading the NSA line eater + startup.el --- process Emacs shell arguments + studly.el --- StudlyCaps (tm)(r)(c)(xxx) + subr.el --- basic lisp subroutines for Emacs + sun-curs.el --- cursor definitions for Sun windows + sun-fns.el --- subroutines of Mouse handling for Sun windows + supercite.el --- minor mode for citing mail and news replies + swedish.el --- miscellaneous functions for dealing with Swedish. + tabify.el --- tab conversion commands for Emacs + talk.el --- Allow several users to talk to each other through Emacs. + tar-mode.el --- simple editing of tar files from GNU emacs + tcl-mode.el --- a major-mode for editing tcl/tk scripts + tcp.el --- TCP/IP stream emulation for GNU Emacs + telnet.el --- run a telnet session from within an Emacs buffer + tempo.el --- Flexible template insertion + term-nasty.el --- Damned Things from terminfo.el + term.el --- general command interpreter in a window stuff + terminal.el --- terminal emulator for GNU Emacs. + tex-mode.el --- TeX, LaTeX, and SliTeX mode commands. + texinfmt.el --- format Texinfo files into Info files. + texinfo.el --- major mode for editing Texinfo files + texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files + text-mode.el --- text mode, and its idiosyncratic commands. + thingatpt.el --- Get the `thing' at point + time-stamp.el --- Maintain last change time stamps in files edited by Emacs + time.el --- display time and load in mode line of Emacs. + timer.el --- run a function with args at some time in future. + timezone.el --- time zone package for GNU Emacs + tmm.el --- text mode access to menu-bar + tpu-edt.el --- Emacs emulating TPU emulating EDT + tpu-extras.el --- Scroll margins and free cursor mode for TPU-edt + tpu-mapper.el --- Create a TPU-edt X-windows keymap file + tq.el --- utility to maintain a transaction queue + trace.el --- tracing facility for Emacs Lisp functions + two-column.el --- minor mode for editing of two-column text + type-break.el --- encourage rests from typing at appropriate intervals + uncompress.el --- auto-decompression hook for visiting .Z files + underline.el --- insert/remove underlining (done by overstriking) in Emacs. + undigest.el --- digest-cracking support for the RMAIL mail reader + uniquify.el --- unique buffer names dependent on file name + unrmail.el --- convert Rmail files to mailbox files. + unused.el --- editing commands in GNU Emacs that turned out not to be used. + userlock.el --- handle file access contention between multiple users + vc-hooks.el --- resident support for version-control + vc.el --- drive a version-control system from within Emacs + version.el --- record version number of Emacs. + vi.el --- major mode for emulating "vi" editor under GNU Emacs. + view.el --- peruse file or buffer without editing. + vip.el --- a VI Package for GNU Emacs + viper-ex.el --- functions implementing the Ex commands for Viper + viper-keym.el --- Viper keymaps + viper-macs.el --- functions implementing keyboard macros for Viper + viper-mous.el --- mouse support for Viper + viper-util.el --- Utilities used by viper.el + viper.el --- A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19, + vms-patch.el --- override parts of files.el for VMS. + vms-pmail.el --- use Emacs as the editor within VMS mail. + vmsproc.el --- run asynchronous VMS subprocesses under Emacs + vt-control.el --- Common VTxxx control functions + vt100-led.el --- functions for LED control on VT-100 terminals & clones. + window.el --- GNU Emacs window commands aside from those written in C. + winnt.el --- Lisp routines for Windows NT. + ws-mode.el --- WordStar emulation mode for GNU Emacs + x-apollo.el --- Apollo support functions + x-menu.el --- menu support for X + xscheme.el --- run Scheme under Emacs + xt-mouse.el --- Support the mouse when emacs run in an xterm. + yow.el --- quote random zippyisms diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/abbrevlist.el emacs-19.32/lisp/abbrevlist.el *** emacs-19.31/lisp/abbrevlist.el Thu Mar 18 16:29:42 1993 --- emacs-19.32/lisp/abbrevlist.el Sat Jul 20 13:48:27 1996 *************** *** 20,25 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Code: --- 20,26 ---- ;; 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: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/add-log.el emacs-19.32/lisp/add-log.el *** emacs-19.31/lisp/add-log.el Fri Mar 22 08:22:18 1996 --- emacs-19.32/lisp/add-log.el Fri Jun 28 03:41:22 1996 *************** This defaults to the value of `user-mail *** 50,54 **** '(("^[SMTWF].+" . font-lock-function-name-face) ; Date line. ("^\t\\* \\([^ :\n]+\\)" 1 font-lock-comment-face) ; File name. ! ("\(\\([^)\n]+\\)\)" 1 font-lock-keyword-face)) ; Function name. "Additional expressions to highlight in Change Log mode.") --- 50,54 ---- '(("^[SMTWF].+" . font-lock-function-name-face) ; Date line. ("^\t\\* \\([^ :\n]+\\)" 1 font-lock-comment-face) ; File name. ! ("(\\([^)\n]+\\)):" 1 font-lock-keyword-face)) ; Function name. "Additional expressions to highlight in Change Log mode.") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/allout.el emacs-19.32/lisp/allout.el *** emacs-19.31/lisp/allout.el Mon Jan 29 17:52:43 1996 --- emacs-19.32/lisp/allout.el Sat Jul 13 14:45:56 1996 *************** *** 34,43 **** ;; sensitive text, eg programming languages. (For an example, see the ;; allout code itself, which is organized in outline structure.) ! ;; ;; It also includes such things as topic-oriented repositioning, cut, and ;; paste; integral outline exposure-layout; incremental search with ;; dynamic exposure/concealment of concealed text; automatic topic-number ;; maintenance; and many other features. ! ;; ;; See the docstring of the variables `outline-layout' and ;; `outline-auto-activation' for details on automatic activation of --- 34,43 ---- ;; sensitive text, eg programming languages. (For an example, see the ;; allout code itself, which is organized in outline structure.) ! ;; ;; It also includes such things as topic-oriented repositioning, cut, and ;; paste; integral outline exposure-layout; incremental search with ;; dynamic exposure/concealment of concealed text; automatic topic-number ;; maintenance; and many other features. ! ;; ;; See the docstring of the variables `outline-layout' and ;; `outline-auto-activation' for details on automatic activation of *************** *** 45,50 **** ;; 3.x, for those of you that depend on the old method.) ;; ! ;; Note - the lines beginning with ';;;_' are outline topic headers. ! ;; Just 'ESC-x eval-current-buffer' to give it a whirl. ;;Ken Manheimer 301 975-3539 --- 45,50 ---- ;; 3.x, for those of you that depend on the old method.) ;; ! ;; Note - the lines beginning with `;;;_' are outline topic headers. ! ;; Just `ESC-x eval-current-buffer' to give it a whirl. ;;Ken Manheimer 301 975-3539 *************** With value `ask', auto-mode-activation i *** 81,86 **** performing auto-layout is asked of the user each time. ! With value `activate', only auto-mode-activation is enabled, auto- ! layout is not. With value `nil', neither auto-mode-activation nor auto-layout are --- 81,86 ---- performing auto-layout is asked of the user each time. ! With value `activate', only auto-mode-activation is enabled, ! auto-layout is not. With value `nil', neither auto-mode-activation nor auto-layout are *************** Buffer-specific. *** 96,102 **** A list value specifies a default layout for the current buffer, to be ! applied upon activation of allout outline-mode. Any non-nil value ! will automatically trigger allout outline-mode, provided `outline- ! init' has been called to enable it. See the docstring for `outline-init' for details on setting up for --- 96,102 ---- A list value specifies a default layout for the current buffer, to be ! applied upon activation of allout outline-mode. Any non-nil value will ! automatically trigger allout outline-mode, provided `outline-init' ! has been called to enable it. See the docstring for `outline-init' for details on setting up for *************** activated when the file is visited, foll *** 117,124 **** the allout.el, itself.) ! Also, allout's mode-specific provisions will make topic prefixes ! default to the comment-start string, if any, of the language of the ! file. This is modulo the setting of `outline-use-mode-specific- ! leader', which see.") (make-variable-buffer-local 'outline-layout) --- 117,123 ---- the allout.el, itself.) ! Also, allout's mode-specific provisions will make topic prefixes default ! to the comment-start string, if any, of the language of the file. This ! is modulo the setting of `outline-use-mode-specific-leader', which see.") (make-variable-buffer-local 'outline-layout) *************** prefix, which is concluded by bullets th *** 141,145 **** var and the respective outline-*-bullets-string vars. ! The value of an asterisk ('*') provides for backwards compatibility with the original emacs outline mode. See outline-plain-bullets-string and outline-distinctive-bullets-string for the range of available --- 140,144 ---- var and the respective outline-*-bullets-string vars. ! The value of an asterisk (`*') provides for backwards compatibility with the original emacs outline mode. See outline-plain-bullets-string and outline-distinctive-bullets-string for the range of available *************** bullets.") *** 151,158 **** "*The bullets normally used in outline topic prefixes. ! See 'outline-distinctive-bullets-string' for the other kind of bullets. ! DO NOT include the close-square-bracket, ']', as a bullet. Outline mode has to be reactivated in order for changes to the value --- 150,157 ---- "*The bullets normally used in outline topic prefixes. ! See `outline-distinctive-bullets-string' for the other kind of bullets. ! DO NOT include the close-square-bracket, `]', as a bullet. Outline mode has to be reactivated in order for changes to the value *************** shifting the level of a topic. See `out *** 168,175 **** the selection of alternating bullets. ! You must run 'set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation. ! DO NOT include the close-square-bracket, ']', on either of the bullet strings.") (make-variable-buffer-local 'outline-distinctive-bullets-string) --- 167,174 ---- the selection of alternating bullets. ! You must run `set-outline-regexp' in order for changes to the value of this var to effect outline-mode operation. ! DO NOT include the close-square-bracket, `]', on either of the bullet strings.") (make-variable-buffer-local 'outline-distinctive-bullets-string) *************** strings.") *** 181,185 **** Allout outline mode will use the mode-specific `outline-mode-leaders' and/or comment-start string, if any, to lead the topic prefix string, ! so topic headers look like comments in the programming language. String values are used as they stand. --- 180,184 ---- Allout outline mode will use the mode-specific `outline-mode-leaders' and/or comment-start string, if any, to lead the topic prefix string, ! so topic headers look like comments in the programming language. String values are used as they stand. *************** Value `nil' means to always use the defa *** 195,204 **** comment-start strings that do not end in spaces are tripled, and an ! '_' underscore is tacked on the end, to distinguish them from regular comment strings. comment-start strings that do end in spaces are not ! tripled, but an underscore is substituted for the space. \[This presumes that the space is for appearance, not comment syntax. You can use `outline-mode-leaders' to override this behavior, when ! incorrect.\]") ;;;_ = outline-mode-leaders (defvar outline-mode-leaders '() --- 194,203 ---- comment-start strings that do not end in spaces are tripled, and an ! `_' underscore is tacked on the end, to distinguish them from regular comment strings. comment-start strings that do end in spaces are not ! tripled, but an underscore is substituted for the space. [This presumes that the space is for appearance, not comment syntax. You can use `outline-mode-leaders' to override this behavior, when ! incorrect.]") ;;;_ = outline-mode-leaders (defvar outline-mode-leaders '() *************** from regular comments that start at bol. *** 215,219 **** ;;;_ = outline-old-style-prefixes (defvar outline-old-style-prefixes nil ! "*When non-nil, use only old-and-crusty outline-mode '*' topic prefixes. Non-nil restricts the topic creation and modification --- 214,218 ---- ;;;_ = outline-old-style-prefixes (defvar outline-old-style-prefixes nil ! "*When non-nil, use only old-and-crusty outline-mode `*' topic prefixes. Non-nil restricts the topic creation and modification *************** Non-nil enables topic creation, modifica *** 231,235 **** functions to vary the topic bullet char (the char that marks the topic depth) just preceding the start of the topic text) according to level. ! Otherwise, only asterisks ('*') and distinctive bullets are used. This is how an outline can look (but sans indentation) with stylish --- 230,234 ---- functions to vary the topic bullet char (the char that marks the topic depth) just preceding the start of the topic text) according to level. ! Otherwise, only asterisks (`*') and distinctive bullets are used. This is how an outline can look (but sans indentation) with stylish *************** disables numbering maintenance.") *** 283,291 **** Set this var to the bullet you want to use for file cross-references. ! Set it 'nil' if you want to inhibit this capability.") ;;;_ + LaTeX formatting ;;;_ - outline-number-pages ! (defvar outline-number-pages nil "*Non-nil turns on page numbering for LaTeX formatting of an outline.") ;;;_ - outline-label-style --- 282,290 ---- Set this var to the bullet you want to use for file cross-references. ! Set it to nil if you want to inhibit this capability.") ;;;_ + LaTeX formatting ;;;_ - outline-number-pages ! (defvar outline-number-pages nil "*Non-nil turns on page numbering for LaTeX formatting of an outline.") ;;;_ - outline-label-style *************** formatted copy.") *** 315,319 **** ;;;_ = outline-keybindings-list ! ;;; You have to reactivate outline-mode - '(outline-mode t)' - to ;;; institute changes to this var. (defvar outline-keybindings-list () --- 314,318 ---- ;;;_ = outline-keybindings-list ! ;;; You have to reactivate outline-mode - `(outline-mode t)' - to ;;; institute changes to this var. (defvar outline-keybindings-list () *************** relevant mostly for use with indented-te *** 380,385 **** where auto-fill occurs. ! [This feature no longer depends in any way on the 'filladapt.el' ! lisp-archive package.]") (make-variable-buffer-local 'outline-use-hanging-indents) --- 379,384 ---- where auto-fill occurs. ! \[This feature no longer depends in any way on the `filladapt.el' ! lisp-archive package.\]") (make-variable-buffer-local 'outline-use-hanging-indents) *************** by set-outline-regexp.") *** 445,451 **** "A string dictating the valid set of outline topic bullets. ! This var should *not* be set by the user - it is set by 'set-outline-regexp', ! and is produced from the elements of 'outline-plain-bullets-string' ! and 'outline-distinctive-bullets-string'.") (make-variable-buffer-local 'outline-bullets-string) ;;;_ = outline-bullets-string-len --- 444,450 ---- "A string dictating the valid set of outline topic bullets. ! This var should *not* be set by the user - it is set by `set-outline-regexp', ! and is produced from the elements of `outline-plain-bullets-string' ! and `outline-distinctive-bullets-string'.") (make-variable-buffer-local 'outline-bullets-string) ;;;_ = outline-bullets-string-len *************** and 'outline-distinctive-bullets-string' *** 458,462 **** \(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly ! set when outline-regexp is produced by 'set-outline-regexp', so that (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-line-boundary-regexp) --- 457,461 ---- \(Ie, C-j, *or* C-m, for prefixes of hidden topics). This is properly ! set when outline-regexp is produced by `set-outline-regexp', so that (match-beginning 2) and (match-end 2) delimit the prefix.") (make-variable-buffer-local 'outline-line-boundary-regexp) *************** invoking it directly." *** 531,535 **** comment-start ;; Use comment-start, maybe tripled, and with ! ;; underscore: (concat (if (string= " " --- 530,534 ---- comment-start ;; Use comment-start, maybe tripled, and with ! ;; underscore: (concat (if (string= " " *************** See doc string for outline-keybindings-l *** 631,640 **** map)) ;;;_ = outline-prior-bindings - being deprecated. ! (defvar outline-prior-bindings nil "Variable for use in V18, with outline-added-bindings, for resurrecting, on mode deactivation, bindings that existed before activation. Being deprecated.") ;;;_ = outline-added-bindings - being deprecated ! (defvar outline-added-bindings nil "Variable for use in V18, with outline-prior-bindings, for resurrecting, on mode deactivation, bindings that existed before --- 630,639 ---- map)) ;;;_ = outline-prior-bindings - being deprecated. ! (defvar outline-prior-bindings nil "Variable for use in V18, with outline-added-bindings, for resurrecting, on mode deactivation, bindings that existed before activation. Being deprecated.") ;;;_ = outline-added-bindings - being deprecated ! (defvar outline-added-bindings nil "Variable for use in V18, with outline-prior-bindings, for resurrecting, on mode deactivation, bindings that existed before *************** from the list." *** 659,663 **** (let ((on-list (assq name outline-mode-prior-settings)) ! prior-capsule ; By 'capsule' i mean a list ; containing a value, so we can ; distinguish nil from no value. --- 658,662 ---- (let ((on-list (assq name outline-mode-prior-settings)) ! prior-capsule ; By `capsule' i mean a list ; containing a value, so we can ; distinguish nil from no value. *************** It's automatically reset to nil after ev *** 722,726 **** ;;;_ > outline-unprotected (expr) (defmacro outline-unprotected (expr) ! "Evaluate EXPRESSION with `outline-override-protect' let-bound 't'." (` (let ((outline-override-protect t)) (, expr)))) --- 721,725 ---- ;;;_ > outline-unprotected (expr) (defmacro outline-unprotected (expr) ! "Evaluate EXPRESSION with `outline-override-protect' let-bound to t." (` (let ((outline-override-protect t)) (, expr)))) *************** to track repeats.") *** 741,746 **** "In outline mode, run as a local-write-file-hooks activity. ! Currently just sets 'outline-during-write-cue', so outline-change- ! protection knows to keep inactive during file write." (setq outline-during-write-cue t) nil) --- 740,745 ---- "In outline mode, run as a local-write-file-hooks activity. ! Currently just sets `outline-during-write-cue', so outline-change-protection ! knows to keep inactive during file write." (setq outline-during-write-cue t) nil) *************** So outline-post-command-business should *** 765,773 **** MODE is one of the following symbols: ! - nil \(or no argument) deactivate auto-activation/layou; ! - 'activate', enable auto-activation only; ! - 'ask', enable auto-activation, and enable auto-layout but with confirmation for layout operation solicited from user each time; ! - 'report', just report and return the current auto-activation state; - anything else \(eg, t) for auto-activation and auto-layout, without any confirmation check. --- 764,772 ---- MODE is one of the following symbols: ! - nil \(or no argument) deactivate auto-activation/layout; ! - `activate', enable auto-activation only; ! - `ask', enable auto-activation, and enable auto-layout but with confirmation for layout operation solicited from user each time; ! - `report', just report and return the current auto-activation state; - anything else \(eg, t) for auto-activation and auto-layout, without any confirmation check. *************** the following two lines in your emacs in *** 806,810 **** ((hook 'outline-find-file-hook) (curr-mode 'outline-auto-activation)) ! (cond ((not mode) (setq find-file-hooks (delq hook find-file-hooks)) --- 805,809 ---- ((hook 'outline-find-file-hook) (curr-mode 'outline-auto-activation)) ! (cond ((not mode) (setq find-file-hooks (delq hook find-file-hooks)) *************** the following two lines in your emacs in *** 817,821 **** (outline-init (symbol-value curr-mode)))) (t (add-hook 'find-file-hooks hook) ! (set curr-mode ; 'set', not 'setq'! (cond ((eq mode 'activate) (message --- 816,820 ---- (outline-init (symbol-value curr-mode)))) (t (add-hook 'find-file-hooks hook) ! (set curr-mode ; `set', not `setq'! (cond ((eq mode 'activate) (message *************** the following two lines in your emacs in *** 833,837 **** "Outline mode auto-activation and -layout enabled.") 'full))))))) ! ;;;_ > outline-mode (&optional toggle) ;;;_ : Defun: --- 832,836 ---- "Outline mode auto-activation and -layout enabled.") 'full))))))) ! ;;;_ > outline-mode (&optional toggle) ;;;_ : Defun: *************** C-c , outline-open-supertopic ... a sibl *** 885,889 **** C-c > outline-shift-in Shift current topic and all offspring deeper. C-c < outline-shift-out ... less deep. ! C-c outline-rebullet-topic Reconcile bullets of topic and its' offspring - distinctive bullets are not changed, others alternated according to nesting depth. --- 884,888 ---- C-c > outline-shift-in Shift current topic and all offspring deeper. C-c < outline-shift-out ... less deep. ! C-c outline-rebullet-topic Reconcile bullets of topic and its offspring - distinctive bullets are not changed, others alternated according to nesting depth. *************** CHILDREN: *** 963,971 **** SIBLINGS: Topics having the same parent and depth. ! Topic text constituents: HEADER: The first line of a topic, include the topic PREFIX and header ! text. PREFIX: The leading text of a topic which which distinguishes it from normal text. It has a strict form, which consists of a --- 962,970 ---- SIBLINGS: Topics having the same parent and depth. ! Topic text constituents: HEADER: The first line of a topic, include the topic PREFIX and header ! text. PREFIX: The leading text of a topic which which distinguishes it from normal text. It has a strict form, which consists of a *************** PREFIX: The leading text of a topic whic *** 977,981 **** of the topic. PREFIX-LEAD: ! The string at the beginning of a topic prefix, normally a '.'. It can be customized by changing the setting of `outline-header-prefix' and then reinitializing outline-mode. --- 976,980 ---- of the topic. PREFIX-LEAD: ! The string at the beginning of a topic prefix, normally a `.'. It can be customized by changing the setting of `outline-header-prefix' and then reinitializing outline-mode. *************** PREFIX-PADDING: *** 990,995 **** bullet, according to the depth of the topic. BULLET: A character at the end of the topic prefix, it must be one of ! the characters listed on 'outline-plain-bullets-string' or ! 'outline-distinctive-bullets-string'. (See the documentation for these variables for more details.) The default choice of bullet when generating varies in a cycle with the depth of the --- 989,994 ---- bullet, according to the depth of the topic. BULLET: A character at the end of the topic prefix, it must be one of ! the characters listed on `outline-plain-bullets-string' or ! `outline-distinctive-bullets-string'. (See the documentation for these variables for more details.) The default choice of bullet when generating varies in a cycle with the depth of the *************** BODY: Same as ENTRY. *** 1001,1013 **** EXPOSURE: The state of a topic which determines the on-screen visibility ! of its' offspring and contained text. CONCEALED: Topics and entry text whose display is inhibited. Contiguous ! units of concealed text is represented by '...' ellipses. ! (Ref the 'selective-display' var.) Concealed topics are effectively collapsed within an ancestor. CLOSED: A topic whose immediate offspring and body-text is concealed. ! OPEN: A topic that is not closed, though its' offspring or body may be." ;;;_ . Code (interactive "P") --- 1000,1012 ---- EXPOSURE: The state of a topic which determines the on-screen visibility ! of its offspring and contained text. CONCEALED: Topics and entry text whose display is inhibited. Contiguous ! units of concealed text is represented by `...' ellipses. ! (Ref the `selective-display' var.) Concealed topics are effectively collapsed within an ancestor. CLOSED: A topic whose immediate offspring and body-text is concealed. ! OPEN: A topic that is not closed, though its offspring or body may be." ;;;_ . Code (interactive "P") *************** OPEN: A topic that is not closed, though *** 1015,1019 **** (let* ((active (and (not (equal major-mode 'outline)) (outline-mode-p))) ! ; Massage universal-arg 'toggle' val: (toggle (and toggle (or (and (listp toggle)(car toggle)) --- 1014,1018 ---- (let* ((active (and (not (equal major-mode 'outline)) (outline-mode-p))) ! ; Massage universal-arg `toggle' val: (toggle (and toggle (or (and (listp toggle)(car toggle)) *************** OPEN: A topic that is not closed, though *** 1049,1053 **** emacs-version)); 19.19. t) ! ;; Deactivation: ((and (not explicit-activation) --- 1048,1052 ---- emacs-version)); 19.19. t) ! ;; Deactivation: ((and (not explicit-activation) *************** OPEN: A topic that is not closed, though *** 1132,1136 **** (current-local-map))) ) ! ; selective-display is the ; emacs conditional exposure --- 1131,1135 ---- (current-local-map))) ) ! ; selective-display is the ; emacs conditional exposure *************** OPEN: A topic that is not closed, though *** 1201,1205 **** (outline-this-or-next-heading) (condition-case err ! (progn (apply 'outline-expose-topic (list outline-layout)) (message "Adjusting '%s' exposure... done." (buffer-name))) --- 1200,1204 ---- (outline-this-or-next-heading) (condition-case err ! (progn (apply 'outline-expose-topic (list outline-layout)) (message "Adjusting '%s' exposure... done." (buffer-name))) *************** OPEN: A topic that is not closed, though *** 1236,1240 **** "Register outline-prefix state data - BEGINNING and END of prefix. ! For reference by 'outline-recent' funcs. Returns BEGINNING." (` (setq outline-recent-prefix-end (, end) outline-recent-prefix-beginning (, beg)))) --- 1235,1239 ---- "Register outline-prefix state data - BEGINNING and END of prefix. ! For reference by `outline-recent' funcs. Returns BEGINNING." (` (setq outline-recent-prefix-end (, end) outline-recent-prefix-beginning (, beg)))) *************** Returns the location of the heading, or *** 1367,1371 **** '(if (re-search-forward outline-line-boundary-regexp nil 0) (progn ; Got valid location state - set vars: ! (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) --- 1366,1370 ---- '(if (re-search-forward outline-line-boundary-regexp nil 0) (progn ; Got valid location state - set vars: ! (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) *************** Return the location of the beginning of *** 1391,1395 **** (looking-at outline-bob-regexp)) (progn ; Got valid location state - set vars: ! (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) --- 1390,1394 ---- (looking-at outline-bob-regexp)) (progn ; Got valid location state - set vars: ! (outline-prefix-data (goto-char (or (match-beginning 2) outline-recent-prefix-beginning)) *************** not be specified by external callers. O *** 1429,1433 **** starting point, and PREV-DEPTH is depth of prior topic." ! (let ((original (not orig-depth)) ; 'orig-depth' set only in recursion. chart curr-depth) --- 1428,1432 ---- starting point, and PREV-DEPTH is depth of prior topic." ! (let ((original (not orig-depth)) ; `orig-depth' set only in recursion. chart curr-depth) *************** starting point, and PREV-DEPTH is depth *** 1488,1492 **** (forward-char -1)) (setq outline-recent-end-of-subtree (point)))) ! chart ; (nreverse chart) not necessary, ; and maybe not preferable. --- 1487,1491 ---- (forward-char -1)) (setq outline-recent-end-of-subtree (point)))) ! chart ; (nreverse chart) not necessary, ; and maybe not preferable. *************** starting point, and PREV-DEPTH is depth *** 1495,1499 **** (defun outline-chart-siblings (&optional start end) "Produce a list of locations of this and succeeding sibling topics. ! Effectively a top-level chart of siblings. See 'outline-chart-subtree' for an explanation of charts." (save-excursion --- 1494,1498 ---- (defun outline-chart-siblings (&optional start end) "Produce a list of locations of this and succeeding sibling topics. ! Effectively a top-level chart of siblings. See `outline-chart-subtree' for an explanation of charts." (save-excursion *************** exposed reside. *** 1550,1557 **** opened. - Lists signify the beginning and end points of regions that should ! be flagged, and the flag to employ. (For concealment: '\(\?r\)', and exposure:" (while spec ! (cond ((listp spec) ) ) --- 1549,1556 ---- opened. - Lists signify the beginning and end points of regions that should ! be flagged, and the flag to employ. (For concealment: `\(\?r\)', and exposure:" (while spec ! (cond ((listp spec) ) ) *************** Changes to concealed regions are ignored *** 1909,1921 **** writes, like crypt and zip modes.) ! Locally bound in outline buffers to 'before-change-function', which in emacs 19 is run before any change to the buffer. (Has no effect ! in Emacs 18, which doesn't support before-change-function.) ! Any functions which set ['this-command' to 'undo', or which set] ! 'outline-override-protect' non-nil (as does, eg, outline-flag-chars) are exempt from this restriction." (if (and (outline-mode-p) ! ; outline-override-protect ; set by functions that know what ; they're doing, eg outline internals: --- 1908,1920 ---- writes, like crypt and zip modes.) ! Locally bound in outline buffers to `before-change-function', which in emacs 19 is run before any change to the buffer. (Has no effect ! in Emacs 18, which doesn't support before-change-function.) ! Any functions which set [`this-command' to `undo', or which set] ! `outline-override-protect' non-nil (as does, eg, outline-flag-chars) are exempt from this restriction." (if (and (outline-mode-p) ! ; outline-override-protect ; set by functions that know what ; they're doing, eg outline internals: *************** are exempt from this restriction." *** 1952,1956 **** (outline-hidden-p))) rehide-place) ! (save-excursion (if (condition-case err --- 1951,1955 ---- (outline-hidden-p))) rehide-place) ! (save-excursion (if (condition-case err *************** are exempt from this restriction." *** 1967,1971 **** ; Then interpret the response: (while ! (progn (message (concat "Change inside concealed" " region - do it? " --- 1966,1970 ---- ; Then interpret the response: (while ! (progn (message (concat "Change inside concealed" " region - do it? " *************** are exempt from this restriction." *** 1982,1986 **** ((eq response ??) (message ! "'r' means 'yes, then reclose") nil) (t (message "Please answer y, n, or r") --- 1981,1985 ---- ((eq response ??) (message ! "`r' means `yes, then reclose'") nil) (t (message "Please answer y, n, or r") *************** motion command to relocate the cursor of *** 2093,2097 **** (eq this-command 'self-insert-command) (eq (point)(outline-current-bullet-pos))) ! (let* ((this-key-num (if (numberp last-command-event) last-command-event)) --- 2092,2096 ---- (eq this-command 'self-insert-command) (eq (point)(outline-current-bullet-pos))) ! (let* ((this-key-num (if (numberp last-command-event) last-command-event)) *************** choice among the valid bullets. (This o *** 2223,2227 **** options, including, eg, a distinctive PRIOR-BULLET.) ! Fifth arg, NUMBER-CONTROL, matters only if 'outline-numbered-bullet' is non-nil *and* soliciting was not explicitly invoked. Then NUMBER-CONTROL non-nil forces prefix to either numbered or --- 2222,2226 ---- options, including, eg, a distinctive PRIOR-BULLET.) ! Fifth arg, NUMBER-CONTROL, matters only if `outline-numbered-bullet' is non-nil *and* soliciting was not explicitly invoked. Then NUMBER-CONTROL non-nil forces prefix to either numbered or *************** Nuances: *** 2389,2393 **** ; padding - only if not ; opening-on-blank: ! (progn (goto-char ref-topic) (setq dbl-space ; Determine double space action: --- 2388,2392 ---- ; padding - only if not ; opening-on-blank: ! (progn (goto-char ref-topic) (setq dbl-space ; Determine double space action: *************** Nuances: *** 2496,2500 **** ;;;_ ; level 1 topics have special provisions also - double space. ;;;_ ; location of new topic ! ;;;_ . ;;;_ > outline-open-subtopic (arg) (defun outline-open-subtopic (arg) --- 2495,2499 ---- ;;;_ ; level 1 topics have special provisions also - double space. ;;;_ ; location of new topic ! ;;;_ . ;;;_ > outline-open-subtopic (arg) (defun outline-open-subtopic (arg) *************** Note that refill of indented paragraphs *** 2564,2568 **** ;; to the new margin and the shift in depth: (old-margin (+ old-depth (- new-margin new-depth)))) ! ;; Process lines up to (but excluding) next topic header: (outline-unprotected --- 2563,2567 ---- ;; to the new margin and the shift in depth: (old-margin (+ old-depth (- new-margin new-depth)))) ! ;; Process lines up to (but excluding) next topic header: (outline-unprotected *************** Note that refill of indented paragraphs *** 2573,2577 **** t) ;; Register the indent data, before we reset the ! ;; match data with a subsequent 'looking-at': (setq old-indent-begin (match-beginning 1) old-indent-end (match-end 1)) --- 2572,2576 ---- t) ;; Register the indent data, before we reset the ! ;; match data with a subsequent `looking-at': (setq old-indent-begin (match-beginning 1) old-indent-end (match-end 1)) *************** Note that refill of indented paragraphs *** 2588,2592 **** ;;;_ > outline-rebullet-current-heading (arg) (defun outline-rebullet-current-heading (arg) ! "Like non-interactive version 'outline-rebullet-heading'. But \(only\) affects visible heading containing point. --- 2587,2591 ---- ;;;_ > outline-rebullet-current-heading (arg) (defun outline-rebullet-current-heading (arg) ! "Like non-interactive version `outline-rebullet-heading'. But \(only\) affects visible heading containing point. *************** of the topics current depth. *** 2622,2626 **** Third arg NUMBER-CONTROL can force the prefix to or away from ! numbered form. It has effect only if 'outline-numbered-bullet' is non-nil and soliciting was not explicitly invoked (via first arg). Its effect, numbering or denumbering, then depends on the setting --- 2621,2625 ---- Third arg NUMBER-CONTROL can force the prefix to or away from ! numbered form. It has effect only if `outline-numbered-bullet' is non-nil and soliciting was not explicitly invoked (via first arg). Its effect, numbering or denumbering, then depends on the setting *************** Fifth arg DO-SUCCESSORS t means re-resol *** 2638,2643 **** siblings. ! Cf vars 'outline-stylish-prefixes', 'outline-old-style-prefixes', ! and 'outline-numbered-bullet', which all affect the behavior of this function." --- 2637,2642 ---- siblings. ! Cf vars `outline-stylish-prefixes', `outline-old-style-prefixes', ! and `outline-numbered-bullet', which all affect the behavior of this function." *************** Leaves primary topic's trailing vertical *** 2923,2927 **** (>= (outline-recent-depth) depth)))) (forward-char 1))) ! (kill-region beg (point)) (sit-for 0) --- 2922,2926 ---- (>= (outline-recent-depth) depth)))) (forward-char 1))) ! (kill-region beg (point)) (sit-for 0) *************** however, are left exactly like normal, n *** 2956,2965 **** (let* ((subj-beg (point)) (subj-end (mark-marker)) ! ;; 'resituate' if yanking an entire topic into topic header: (resituate (and (outline-e-o-prefix-p) (looking-at (concat "\\(" outline-regexp "\\)")) (outline-prefix-data (match-beginning 1) (match-end 1)))) ! ;; 'rectify-numbering' if resituating (where several topics may ;; be resituating) or yanking a topic into a topic slot (bol): (rectify-numbering (or resituate --- 2955,2964 ---- (let* ((subj-beg (point)) (subj-end (mark-marker)) ! ;; `resituate' if yanking an entire topic into topic header: (resituate (and (outline-e-o-prefix-p) (looking-at (concat "\\(" outline-regexp "\\)")) (outline-prefix-data (match-beginning 1) (match-end 1)))) ! ;; `rectify-numbering' if resituating (where several topics may ;; be resituating) or yanking a topic into a topic slot (bol): (rectify-numbering (or resituate *************** however, are left exactly like normal, n *** 3040,3044 **** (exchange-point-and-mark)))) (if rectify-numbering ! (progn (save-excursion ; Give some preliminary feedback: --- 3039,3043 ---- (exchange-point-and-mark)))) (if rectify-numbering ! (progn (save-excursion ; Give some preliminary feedback: *************** by pops to non-distinctive yanks. Bug.. *** 3114,3126 **** (if (not outline-file-xref-bullet) (error ! "outline cross references disabled - no 'outline-file-xref-bullet'") (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) ! (error "current heading lacks cross-reference bullet '%s'" outline-file-xref-bullet) (let (file-name) (save-excursion (let* ((text-start outline-recent-prefix-end) ! (heading-end (progn (outline-pre-next-preface) ! (point)))) (goto-char text-start) (setq file-name --- 3113,3124 ---- (if (not outline-file-xref-bullet) (error ! "outline cross references disabled - no `outline-file-xref-bullet'") (if (not (string= (outline-current-bullet) outline-file-xref-bullet)) ! (error "current heading lacks cross-reference bullet `%s'" outline-file-xref-bullet) (let (file-name) (save-excursion (let* ((text-start outline-recent-prefix-end) ! (heading-end (progn (end-of-line) (point)))) (goto-char text-start) (setq file-name *************** by pops to non-distinctive yanks. Bug.. *** 3130,3134 **** (if (not (= (aref file-name 0) ?:)) (expand-file-name file-name) ! ; A registry-files ref, strip the ':' ; and try to follow it: (let ((reg-ref (reference-registered-file --- 3128,3132 ---- (if (not (= (aref file-name 0) ?:)) (expand-file-name file-name) ! ; A registry-files ref, strip the `:' ; and try to follow it: (let ((reg-ref (reference-registered-file *************** See `outline-flag-region' for more detai *** 3183,3187 **** "Produce a list representing exposed topics in current region. ! This list can then be used by 'outline-process-exposed' to manipulate the subject region. --- 3181,3185 ---- "Produce a list representing exposed topics in current region. ! This list can then be used by `outline-process-exposed' to manipulate the subject region. *************** exposed components in subtopic. *** 3191,3195 **** Each component list contains: - a number representing the depth of the topic, ! - a string representing the header-prefix (ref. 'outline-header-prefix'), - a string representing the bullet character, - and a series of strings, each containing one line of the exposed --- 3189,3193 ---- Each component list contains: - a number representing the depth of the topic, ! - a string representing the header-prefix (ref. `outline-header-prefix'), - a string representing the bullet character, - and a series of strings, each containing one line of the exposed *************** Each component list contains: *** 3200,3204 **** (let* (strings pad result depth bullet beg next done) ; State vars. (goto-char start) ! (beginning-of-line) (if (not (outline-goto-prefix)) ; Get initial position within a topic: (outline-next-visible-heading 1)) --- 3198,3202 ---- (let* (strings pad result depth bullet beg next done) ; State vars. (goto-char start) ! (beginning-of-line) (if (not (outline-goto-prefix)) ; Get initial position within a topic: (outline-next-visible-heading 1)) *************** warn people about the change, and then d *** 3363,3367 **** (interactive "p") ;;(beep) ! ;;(message (format "Use '%s' instead of '%s' (%s)." ;; "outline-show-children" ;; "outline-show-current-children" --- 3361,3365 ---- (interactive "p") ;;(beep) ! ;;(message (format "Use `%s' instead of `%s' (%s)." ;; "outline-show-children" ;; "outline-show-current-children" *************** exposed by outline-show-entry but are wi *** 3454,3458 **** (defun outline-show-current-subtree (&optional arg) "Show everything within the current topic. With a repeat-count, ! expose this topic and its' siblings." (interactive "P") (save-excursion --- 3452,3456 ---- (defun outline-show-current-subtree (&optional arg) "Show everything within the current topic. With a repeat-count, ! expose this topic and its siblings." (interactive "P") (save-excursion *************** expose this topic and its' siblings." *** 3473,3477 **** If this topic is closed and it's a top level topic, close this topic ! and its' siblings. If optional arg JUST-CLOSE is non-nil, do not treat the parent or --- 3471,3475 ---- If this topic is closed and it's a top level topic, close this topic ! and its siblings. If optional arg JUST-CLOSE is non-nil, do not treat the parent or *************** siblings, even if the target topic is al *** 3512,3516 **** ;;;_ > outline-hide-current-leaves () (defun outline-hide-current-leaves () ! "Hide the bodies of the current topic and all its' offspring." (interactive) (outline-back-to-current-heading) --- 3510,3514 ---- ;;;_ > outline-hide-current-leaves () (defun outline-hide-current-leaves () ! "Hide the bodies of the current topic and all its offspring." (interactive) (outline-back-to-current-heading) *************** Non-null lists recursively designate exp *** 3567,3573 **** subtopics of the current topic. ! The ':' repeat spec is used to specify exposure for any number of successive siblings, up to the trailing ones for which there are ! explicit specs following the ':'. Simple (numeric and null-list) specs are interpreted as follows: --- 3565,3571 ---- subtopics of the current topic. ! The `:' repeat spec is used to specify exposure for any number of successive siblings, up to the trailing ones for which there are ! explicit specs following the `:'. Simple (numeric and null-list) specs are interpreted as follows: *************** Simple (numeric and null-list) specs are *** 3580,3586 **** number, but do not force already opened subtopics to be closed. - 0 means to close topic - hide all offspring. ! : - 'repeat' apply prior element to all siblings at current level, *up to* ! those siblings that would be covered by specs following the ':' on the list. Ie, apply to all topics at level but the last ones. \(Only first of multiple colons at same level is --- 3578,3584 ---- number, but do not force already opened subtopics to be closed. - 0 means to close topic - hide all offspring. ! : - `repeat' apply prior element to all siblings at current level, *up to* ! those siblings that would be covered by specs following the `:' on the list. Ie, apply to all topics at level but the last ones. \(Only first of multiple colons at same level is *************** Examples: *** 3629,3633 **** ((eq curr-elem ':) (setq stay t) ! ;; Expand the 'repeat' spec to an explicit version, ;; w.r.t. remaining siblings: (let ((residue ; = # of sibs not covered by remaining spec --- 3627,3631 ---- ((eq curr-elem ':) (setq stay t) ! ;; Expand the `repeat' spec to an explicit version, ;; w.r.t. remaining siblings: (let ((residue ; = # of sibs not covered by remaining spec *************** Simple (numeric and null-list) specs are *** 3687,3693 **** - positive numbers just open to the relative depth indicated by the number. - 0 just closes ! - '*' completely opens the topic, including bodies. ! - '+' shows all the sub headers, but not the bodies ! - '-' exposes the body and immediate offspring of the corresponding topic. If the spec is a list, the first element must be a number, which --- 3685,3691 ---- - positive numbers just open to the relative depth indicated by the number. - 0 just closes ! - `*' completely opens the topic, including bodies. ! - `+' shows all the sub headers, but not the bodies ! - `-' exposes the body and immediate offspring of the corresponding topic. If the spec is a list, the first element must be a number, which *************** need not be quoted in outline-new-exposu *** 3749,3753 **** Cursor is left at start position. ! Use this instead of obsolete 'outline-exposure'. Examples: --- 3747,3751 ---- Cursor is left at start position. ! Use this instead of obsolete `outline-exposure'. Examples: *************** Examples: *** 3759,3763 **** Close all topics at current level to expose only their immediate children, except for the last topic at the current ! level, in which even its' immediate children are hidden. \(outline-exposure -2 : -1 *) Expose children and grandchildren of first topic at current --- 3757,3761 ---- Close all topics at current level to expose only their immediate children, except for the last topic at the current ! level, in which even its immediate children are hidden. \(outline-exposure -2 : -1 *) Expose children and grandchildren of first topic at current *************** Examples: *** 3771,3775 **** ;;;_ > outline-exposure '() (defmacro outline-exposure (&rest spec) ! "Being deprecated - use more recent 'outline-new-exposure' instead. Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments --- 3769,3773 ---- ;;;_ > outline-exposure '() (defmacro outline-exposure (&rest spec) ! "Being deprecated - use more recent `outline-new-exposure' instead. Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments *************** Used by isearch-terminate/outline-provis *** 3796,3800 **** isearch-done/outline-provisions") ! ;;;_ > outline-enwrap-isearch () (defun outline-enwrap-isearch () --- 3794,3798 ---- isearch-done/outline-provisions") ! ;;;_ > outline-enwrap-isearch () (defun outline-enwrap-isearch () *************** The function checks to ensure that the r *** 3819,3823 **** (if (or (and (fboundp 'isearch-mode) (fboundp 'isearch-quote-char)) ! (condition-case error (load-library outline-enwrap-isearch-mode) (file-error (message "Skipping isearch-mode provisions - %s '%s'" --- 3817,3821 ---- (if (or (and (fboundp 'isearch-mode) (fboundp 'isearch-quote-char)) ! (condition-case error (load-library outline-enwrap-isearch-mode) (file-error (message "Skipping isearch-mode provisions - %s '%s'" *************** The function checks to ensure that the r *** 3829,3843 **** ;; Isearch-mode loaded, encapsulate specific entry points for ;; outline dynamic-exposure business: ! (progn ! ;; stash crucial isearch-mode funcs under known, private ;; names, then register wrapper functions under the old ! ;; names, in their stead: 'isearch-quit' is pre isearch v 1.2. (fset 'real-isearch-terminate ! ; 'isearch-quit is pre v 1.2: (or (if (fboundp 'isearch-quit) (symbol-function 'isearch-quit)) (if (fboundp 'isearch-abort) ! ; 'isearch-abort' is v 1.2 and on: (symbol-function 'isearch-abort)))) (fset 'isearch-quit 'isearch-terminate/outline-provisions) --- 3827,3841 ---- ;; Isearch-mode loaded, encapsulate specific entry points for ;; outline dynamic-exposure business: ! (progn ! ;; stash crucial isearch-mode funcs under known, private ;; names, then register wrapper functions under the old ! ;; names, in their stead: `isearch-quit' is pre isearch v 1.2. (fset 'real-isearch-terminate ! ; `isearch-quit' is pre v 1.2: (or (if (fboundp 'isearch-quit) (symbol-function 'isearch-quit)) (if (fboundp 'isearch-abort) ! ; `isearch-abort' is v 1.2 and on: (symbol-function 'isearch-abort)))) (fset 'isearch-quit 'isearch-terminate/outline-provisions) *************** string across latex processing." *** 4010,4014 **** Adjust line contents so it is unaltered \(from the original line) ! across latex processing, within the context of a 'verbatim' environment. Leaves point at the end of the line." (beginning-of-line) --- 4008,4012 ---- Adjust line contents so it is unaltered \(from the original line) ! across latex processing, within the context of a `verbatim' environment. Leaves point at the end of the line." (beginning-of-line) *************** BULLET string, and a list of TEXT string *** 4114,4118 **** body-content bop) ; Do the head line: ! (insert-string (concat "\\OneHeadLine{\\verb\1 " (outline-latex-verb-quote bullet) "\1}{" --- 4112,4116 ---- body-content bop) ; Do the head line: ! (insert-string (concat "\\OneHeadLine{\\verb\1 " (outline-latex-verb-quote bullet) "\1}{" *************** Optional arg DO-DEFAULTING indicates to *** 4242,4246 **** ;; We do our own reading here, so we can circumvent, eg, special ! ;; treatment for '?' character. (Might oughta change minibuffer ;; keymap instead, oh well.) (setq got --- 4240,4244 ---- ;; We do our own reading here, so we can circumvent, eg, special ! ;; treatment for `?' character. (Might oughta change minibuffer ;; keymap instead, oh well.) (setq got *************** Optional arg SUCCESSIVE-BACKSLASHES is u *** 4293,4297 **** (defun add-hook (hook function &optional append) "Add to the value of HOOK the function FUNCTION unless already present. ! \(It becomes the first hook on the list unless optional APPEND is non-nil, in which case it becomes the last). HOOK should be a symbol, and FUNCTION may be any valid function. HOOK's value should be a list of functions, not a single --- 4291,4295 ---- (defun add-hook (hook function &optional append) "Add to the value of HOOK the function FUNCTION unless already present. ! \(It becomes the first hook on the list unless optional APPEND is non-nil, in which case it becomes the last). HOOK should be a symbol, and FUNCTION may be any valid function. HOOK's value should be a list of functions, not a single *************** function. If HOOK is void, it is first *** 4304,4308 **** (equal function tail)) (memq function (symbol-value hook))) ! (set hook (if append (nconc (symbol-value hook) (list function)) --- 4302,4306 ---- (equal function tail)) (memq function (symbol-value hook))) ! (set hook (if append (nconc (symbol-value hook) (list function)) *************** function. If HOOK is void, it is first *** 4318,4322 **** "ISearch for topic with bullet: " (regexp-sans-escapes outline-bullets-string)))) ! (let ((isearch-regexp t) (isearch-string (concat "^" --- 4316,4320 ---- "ISearch for topic with bullet: " (regexp-sans-escapes outline-bullets-string)))) ! (let ((isearch-regexp t) (isearch-string (concat "^" *************** function. If HOOK is void, it is first *** 4327,4331 **** (isearch-mode t))) ;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than ! ;;; wrapping the isearch functions. ;;;_* Local emacs vars. --- 4325,4329 ---- (isearch-mode t))) ;;;_ ? Re hooking up with isearch - use isearch-op-fun rather than ! ;;; wrapping the isearch functions. ;;;_* Local emacs vars. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ange-ftp.el emacs-19.32/lisp/ange-ftp.el *** emacs-19.31/lisp/ange-ftp.el Sun Mar 24 19:14:32 1996 --- emacs-19.32/lisp/ange-ftp.el Mon Jul 29 12:26:55 1996 *************** only return the directory part of FILE." *** 1009,1013 **** End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. Optional DEFAULT is password to start with." ! (let ((pass (if default default "")) (c 0) (echo-keystrokes 0) --- 1009,1013 ---- End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. Optional DEFAULT is password to start with." ! (let ((pass nil) (c 0) (echo-keystrokes 0) *************** Optional DEFAULT is password to start wi *** 1026,1030 **** (message "") (ange-ftp-repaint-minibuffer) ! pass)) (defmacro ange-ftp-generate-passwd-key (host user) --- 1026,1030 ---- (message "") (ange-ftp-repaint-minibuffer) ! (or pass default ""))) (defmacro ange-ftp-generate-passwd-key (host user) *************** Optional DEFAULT is password to start wi *** 1103,1107 **** ;; Try that account. (ange-ftp-read-passwd ! (format "passwd for %s@%s (same as %s@%s): " user host user other) (ange-ftp-lookup-passwd other user)) --- 1103,1107 ---- ;; Try that account. (ange-ftp-read-passwd ! (format "passwd for %s@%s (default same as %s@%s): " user host user other) (ange-ftp-lookup-passwd other user)) *************** Optional DEFAULT is password to start wi *** 1362,1367 **** (auto-save-mode ange-ftp-auto-save))) ! (defun ange-ftp-kill-ftp-process (buffer) ! "Kill the FTP process associated with BUFFER. If the BUFFER's visited filename or default-directory is an ftp filename then kill the related ftp process." --- 1362,1367 ---- (auto-save-mode ange-ftp-auto-save))) ! (defun ange-ftp-kill-ftp-process (&optional buffer) ! "Kill the FTP process associated with BUFFER (the current buffer, if nil). If the BUFFER's visited filename or default-directory is an ftp filename then kill the related ftp process." *************** then kill the related ftp process." *** 1369,1373 **** (if (null buffer) (setq buffer (current-buffer))) ! (let ((file (or (buffer-file-name) default-directory))) (if file (let ((parsed (ange-ftp-ftp-name (expand-file-name file)))) --- 1369,1374 ---- (if (null buffer) (setq buffer (current-buffer))) ! (let ((file (or (buffer-file-name buffer) ! (save-excursion (set-buffer buffer) default-directory)))) (if file (let ((parsed (ange-ftp-ftp-name (expand-file-name file)))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/appt.el emacs-19.32/lisp/appt.el *** emacs-19.31/lisp/appt.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/appt.el Mon Jul 15 16:21:37 1996 *************** Therefore, you need to have `(display-ti *** 247,254 **** ;; from midnight. ie. 12:01am = 1, midnight = 0. ! (let* ((cur-hour(string-to-int ! (substring (current-time-string) 11 13))) ! (cur-min (string-to-int ! (substring (current-time-string) 14 16))) (cur-comp-time (+ (* cur-hour 60) cur-min))) --- 247,253 ---- ;; from midnight. ie. 12:01am = 1, midnight = 0. ! (let* ((now (decode-time)) ! (cur-hour (nth 2 now)) ! (cur-min (nth 1 now)) (cur-comp-time (+ (* cur-hour 60) cur-min))) *************** The time should be in either 24 hour for *** 531,538 **** ;; be removed. ! (let* ((cur-hour(string-to-int ! (substring (current-time-string) 11 13))) ! (cur-min (string-to-int ! (substring (current-time-string) 14 16))) (cur-comp-time (+ (* cur-hour 60) cur-min)) (appt-comp-time (car (car (car appt-time-msg-list))))) --- 530,536 ---- ;; be removed. ! (let* ((now (decode-time)) ! (cur-hour (nth 2 now)) ! (cur-min (nth 1 now)) (cur-comp-time (+ (* cur-hour 60) cur-min)) (appt-comp-time (car (car (car appt-time-msg-list))))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/asm-mode.el emacs-19.32/lisp/asm-mode.el *** emacs-19.31/lisp/asm-mode.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/asm-mode.el Fri Jun 21 22:14:01 1996 *************** *** 68,71 **** --- 68,72 ---- ;; Note that the comment character isn't set up until asm-mode is called. (define-key asm-mode-map ":" 'asm-colon) + (define-key asm-mode-map "\C-c;" 'comment-region) (define-key asm-mode-map "\C-i" 'tab-to-tab-stop) (define-key asm-mode-map "\C-j" 'asm-newline) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/bibtex.el emacs-19.32/lisp/bibtex.el *** emacs-19.31/lisp/bibtex.el Fri Mar 8 12:42:37 1996 --- emacs-19.32/lisp/bibtex.el Thu Jul 11 19:07:04 1996 *************** This variable is buffer local.") *** 96,99 **** --- 96,106 ---- (make-variable-buffer-local 'bibtex-maintain-sorted-entries) + (defvar bibtex-parse-keys-timeout auto-save-timeout + "*Specifies interval for parsing buffer for keys. + The buffer is checked every bibtex-parse-keys-timeout seconds if it is + modified since last parsing and is parsed if necessary. This is needed + only if buffer is maintained sorted (bibtex-maintain-sorted-entries + non-nil).") + (defvar bibtex-entry-field-alist '( *************** See the documentation of function bibtex *** 327,330 **** --- 334,339 ---- ("\\\\\\\"s" "ss") ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue") + ("\\\"a" "ae") ("\\\"o" "oe") ("\\\"u" "ue") ("\\\"s" "ss") + ("\\\"A" "Ae") ("\\\"O" "Oe") ("\\\"U" "Ue") ("{" "") ("}" "")) "Alist of (old-regexp new-string) pairs. *************** See the documentation of function bibtex *** 380,383 **** --- 389,394 ---- ("\\\\\\\"s" "ss") ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue") + ("\\\"a" "ae") ("\\\"o" "oe") ("\\\"u" "ue") ("\\\"s" "ss") + ("\\\"A" "Ae") ("\\\"O" "Oe") ("\\\"U" "Ue") ("{" "") ("}" "")) "Alist of (old-regexp new-string) pairs. *************** See the documentation of function bibtex *** 414,419 **** (defvar bibtex-mode-syntax-table (let ((st (make-syntax-table))) ! ;; [alarson:19920214.1004CST] make double quote a string quote ! (modify-syntax-entry ?\" "\"" st) (modify-syntax-entry ?$ "$$ " st) (modify-syntax-entry ?% "< " st) --- 425,430 ---- (defvar bibtex-mode-syntax-table (let ((st (make-syntax-table))) ! (modify-syntax-entry ?\" "w" st) ! ;; this was formerly "\"". Does this cause any problems? (modify-syntax-entry ?$ "$$ " st) (modify-syntax-entry ?% "< " st) *************** See the documentation of function bibtex *** 650,655 **** "\\(" "[^\"\\]" "\\)" ;; every character except quote or backslash "\\|" ! "\\(" "\"[A-Za-z-]" "\\)" ;; a quote followed by a letter or dash ! "\\|" "\\(" "\\\\.\\|\n" "\\)" ;; a backslash followed by any character "\\)*" --- 661,669 ---- "\\(" "[^\"\\]" "\\)" ;; every character except quote or backslash "\\|" ! ;; "\\(" "\"[A-Za-z-]" "\\)" ;; a quote followed by a letter or dash ! ;; "\\|" ! ;; last two lines commented out until lines like ! ;; author = "Stefan Sch"of" ! ;; are supported by BibTeX "\\(" "\\\\.\\|\n" "\\)" ;; a backslash followed by any character "\\)*" *************** See the documentation of function bibtex *** 694,700 **** (defconst bibtex-reference-head ! (concat "^\\( \\|\t\\)*\\(" bibtex-reference-type ! "\\)[ \t]*[({]\\(" bibtex-reference-key "\\)")) --- 708,714 ---- (defconst bibtex-reference-head ! (concat "^[ \t]*\\(" bibtex-reference-type ! "\\)[ \t]*[({][ \t]*\\(" bibtex-reference-key "\\)")) *************** See the documentation of function bibtex *** 707,715 **** ;; BibTeX reference entry (without reference key). ! (defconst bibtex-type-in-head 2) ;; The regexp subexpression number of the type part in ;; bibtex-reference-head. ! (defconst bibtex-key-in-head 3) ;; The regexp subexpression number of the key part in ;; bibtex-reference-head. --- 721,729 ---- ;; BibTeX reference entry (without reference key). ! (defconst bibtex-type-in-head 1) ;; The regexp subexpression number of the type part in ;; bibtex-reference-head. ! (defconst bibtex-key-in-head 2) ;; The regexp subexpression number of the key part in ;; bibtex-reference-head. *************** non-nil." *** 1458,1463 **** (error "File %s not in $BIBINPUTS paths" filename))))) bibtex-string-files) ! (add-hook ! 'auto-save-hook (function (lambda () --- 1472,1477 ---- (error "File %s not in $BIBINPUTS paths" filename))))) bibtex-string-files) ! (run-with-idle-timer ! bibtex-parse-keys-timeout bibtex-parse-keys-timeout (function (lambda () diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/browse-url.el emacs-19.32/lisp/browse-url.el *** emacs-19.31/lisp/browse-url.el Sat Mar 2 01:35:56 1996 --- emacs-19.32/lisp/browse-url.el Sun Jul 21 15:13:14 1996 *************** *** 262,269 **** (defvar browse-url-browser-function ! 'browse-url-netscape "*Function to display the current buffer in a WWW browser. ! Used by the `browse-url-at-point', `browse-url-at-mouse', and ! `browse-url-of-file' commands.") (defvar browse-url-netscape-arguments nil --- 262,273 ---- (defvar browse-url-browser-function ! 'browse-url-choose-browser "*Function to display the current buffer in a WWW browser. ! This is used by the `browse-url-at-point', `browse-url-at-mouse', and ! `browse-url-of-file' commands. ! The function should take one argument, an URL.") ! ! (defvar browse-url-netscape-program "netscape" ! "*The name for invoking Netscape.") (defvar browse-url-netscape-arguments nil *************** Passing an interactive argument to \\[br *** 276,279 **** --- 280,286 ---- Netscape version 1.1N or later or XMosaic version 2.5 or later.") + (defvar browse-url-mosaic-program "xmosaic" + "*The name for invoking Mosaic.") + (defvar browse-url-mosaic-arguments nil "*A list of strings to pass to Mosaic as arguments.") *************** used instead of browse-url-new-window-p. *** 488,492 **** (null current-prefix-arg)))))) (let ((res ! (apply 'call-process "netscape" nil nil nil (append browse-url-netscape-arguments (if new-window '("-noraise")) --- 495,499 ---- (null current-prefix-arg)))))) (let ((res ! (apply 'call-process browse-url-netscape-program nil nil nil (append browse-url-netscape-arguments (if new-window '("-noraise")) *************** used instead of browse-url-new-window-p. *** 501,505 **** (progn ; Netscape not running - start it (message "Starting Netscape...") ! (apply 'start-process "netscape" nil "netscape" (append browse-url-netscape-arguments (list url)))))))) --- 508,512 ---- (progn ; Netscape not running - start it (message "Starting Netscape...") ! (apply 'start-process "netscape" nil browse-url-netscape-program (append browse-url-netscape-arguments (list url)))))))) *************** Default to the URL around or before poin *** 542,546 **** ;; Mosaic not running - start it (message "Starting Mosaic...") ! (apply 'start-process "xmosaic" nil "xmosaic" (append browse-url-mosaic-arguments (list url))) (message "Starting Mosaic...done")))) --- 549,553 ---- ;; Mosaic not running - start it (message "Starting Mosaic...") ! (apply 'start-process "xmosaic" nil browse-url-mosaic-program (append browse-url-mosaic-arguments (list url))) (message "Starting Mosaic...done")))) *************** Default to the URL around or before poin *** 585,588 **** --- 592,603 ---- (interactive (browse-url-interactive-arg "W3 URL: ")) (w3-fetch url)) + + (defun browse-url-choose-browser (argument) + "Decide which browser to use, then invoke it. + This is the default value of `browse-url-browser-function'." + (if (fboundp 'w3-fetch) + (setq browse-url-browser-function 'browse-url-w3) + (setq browse-url-browser-function 'browse-url-netscape)) + (funcall browse-url-browser-function argument)) (provide 'browse-url) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/cal-french.el emacs-19.32/lisp/cal-french.el *** emacs-19.31/lisp/cal-french.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/cal-french.el Fri Jun 28 04:41:46 1996 *************** *** 30,37 **** ;; Technical details of the French Revolutionary calendar can be found in ! ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' ! ;; by E. M. Reingold, N. Dershowitz, and S. M. Clamen, ! ;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993), ! ;; pages 383-404. ;; Comments, corrections, and improvements should be sent to --- 30,36 ---- ;; Technical details of the French Revolutionary calendar can be found in ! ;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by ! ;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and ! ;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404. ;; Comments, corrections, and improvements should be sent to *************** *** 45,54 **** (require 'calendar) (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) "Absolute date of start of French Revolutionary calendar = September 22, 1792.") (defconst french-calendar-month-name-array ! ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" ! "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]) (defconst french-calendar-day-name-array --- 44,61 ---- (require 'calendar) + (defvar french-calendar-accents + (and (char-table-p standard-display-table) + (equal (aref standard-display-table 161) [161])) + "True if diacritical marks are available.") + (defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792)) "Absolute date of start of French Revolutionary calendar = September 22, 1792.") (defconst french-calendar-month-name-array ! (if french-calendar-accents ! ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse" ! "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"] ! ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se" ! "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"])) (defconst french-calendar-day-name-array *************** *** 57,62 **** (defconst french-calendar-special-days-array ! ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" ! "de la Re'volution"]) (defun french-calendar-leap-year-p (year) --- 64,72 ---- (defconst french-calendar-special-days-array ! (if french-calendar-accents ! ["de la Vertu" "du Genie" "du Labour" "de la Raison" ! "de la Récompense" "de la Révolution"] ! ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense" ! "de la Re'volution"])) (defun french-calendar-leap-year-p (year) *************** Defaults to today's date if DATE is not *** 144,155 **** (cond ((< y 1) "") ! ((= m 13) (format "Jour %s de l'Anne'e %d de la Re'volution" (aref french-calendar-special-days-array (1- d)) y)) ! (t (format "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution" ! (make-string (1+ (/ (1- d) 10)) ?I) ! (aref french-calendar-day-name-array (% (1- d) 10)) ! (aref french-calendar-month-name-array (1- m)) ! y))))) (defun calendar-print-french-date () --- 154,170 ---- (cond ((< y 1) "") ! ((= m 13) (format (if french-calendar-accents ! "Jour %s de l'Année %d de la Révolution" ! "Jour %s de l'Anne'e %d de la Re'volution") (aref french-calendar-special-days-array (1- d)) y)) ! (t (format ! (if french-calendar-accents ! "Décade %s, %s de %s de l'Année %d de la Révolution" ! "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution") ! (make-string (1+ (/ (1- d) 10)) ?I) ! (aref french-calendar-day-name-array (% (1- d) 10)) ! (aref french-calendar-month-name-array (1- m)) ! y))))) (defun calendar-print-french-date () *************** Echo French Revolutionary date unless NO *** 166,170 **** (interactive (let* ((year (calendar-read ! "Anne'e de la Re'volution (>0): " '(lambda (x) (> x 0)) (int-to-string --- 181,187 ---- (interactive (let* ((year (calendar-read ! (if french-calendar-accents ! "Année de la Révolution (>0): " ! "Anne'e de la Re'volution (>0): ") '(lambda (x) (> x 0)) (int-to-string *************** Echo French Revolutionary date unless NO *** 200,204 **** 1 (calendar-read ! "De'cade (1-3): " '(lambda (x) (memq x '(1 2 3)))))) (day (if (> month 12) --- 217,223 ---- 1 (calendar-read ! (if french-calendar-accents ! "Décade (1-3): " ! "De'cade (1-3): ") '(lambda (x) (memq x '(1 2 3)))))) (day (if (> month 12) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/cal-tex.el emacs-19.32/lisp/cal-tex.el *** emacs-19.31/lisp/cal-tex.el Wed Jan 24 10:57:21 1996 --- emacs-19.32/lisp/cal-tex.el Fri Jun 14 15:02:40 1996 *************** Optional parameter specifies number of y *** 301,310 **** (cal-tex-cmd "\\textwidth 3.25in") (cal-tex-cmd "\\textheight 6.5in") ! (cal-tex-cmd "\\oddsidemargin 1.6in") ! (cal-tex-cmd "\\evensidemargin 1.55in") (cal-tex-cmd "\\topmargin 0pt") (cal-tex-cmd "\\headheight -0.875in") (cal-tex-cmd "\\pagestyle{empty}") (cal-tex-b-document) (calendar-for-loop j from 1 to n do (insert (format "\\hfil {\\Large \\bf %s} \\hfil\\\\\n" year)) --- 301,312 ---- (cal-tex-cmd "\\textwidth 3.25in") (cal-tex-cmd "\\textheight 6.5in") ! (cal-tex-cmd "\\oddsidemargin 1.675in") ! (cal-tex-cmd "\\evensidemargin 1.675in") (cal-tex-cmd "\\topmargin 0pt") (cal-tex-cmd "\\headheight -0.875in") + (cal-tex-cmd "\\fboxsep 0.5mm") (cal-tex-cmd "\\pagestyle{empty}") (cal-tex-b-document) + (cal-tex-cmd "\\vspace*{0.25in}") (calendar-for-loop j from 1 to n do (insert (format "\\hfil {\\Large \\bf %s} \\hfil\\\\\n" year)) *************** Optional parameter specifies number of y *** 317,321 **** (insert (cal-tex-mini-calendar i year (calendar-month-name i) ! "1.05in" ".8in" "tiny"))) (insert "\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\ --- 319,323 ---- (insert (cal-tex-mini-calendar i year (calendar-month-name i) ! "1in" ".9in" "tiny" "0.6mm"))) (insert "\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\ *************** Optional parameter specifies number of y *** 327,333 **** (cal-tex-e-center) (setq year (1+ year)) ! (if (/= j n) ! (cal-tex-newpage) ! (cal-tex-end-document)) (run-hooks 'cal-tex-year-hook)) (run-hooks 'cal-tex-hook))) --- 329,336 ---- (cal-tex-e-center) (setq year (1+ year)) ! (if (= j n) ! (cal-tex-end-document) ! (cal-tex-newpage) ! (cal-tex-cmd "\\vspace*{0.25in}")) (run-hooks 'cal-tex-year-hook)) (run-hooks 'cal-tex-hook))) *************** Optional prefix argument specifies numbe *** 1276,1282 **** ;;; ! (defun cal-tex-mini-calendar (month year name width height &optional size) "Produce mini-calendar for MONTH, YEAR in macro NAME with WIDTH and HEIGHT. ! Optional SIZE gives the point size; scriptsize is the default," (let* ((blank-days;; at start of month (mod --- 1279,1286 ---- ;;; ! (defun cal-tex-mini-calendar (month year name width height &optional ptsize colsep) "Produce mini-calendar for MONTH, YEAR in macro NAME with WIDTH and HEIGHT. ! Optional PTSIZE gives the point ptsize; scriptsize is the default. Optional ! COLSEP gives the column separation; 1mm is the default." (let* ((blank-days;; at start of month (mod *************** Optional SIZE gives the point size; scri *** 1284,1301 **** calendar-week-start-day) 7)) ! (last (calendar-last-day-of-month month year)) (str (concat "\\def\\" name "{\\hbox to" width "{%\n" "\\vbox to" height "{%\n" "\\vfil \\hbox to" width "{%\n" "\\hfil\\" ! (if size size "scriptsize") "\\begin{tabular}" ! "{@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}" ! "r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}r@{\\hspace{1mm}}}%\n" "\\multicolumn{7}{c}{" (calendar-month-name month) " " (int-to-string year) ! "}\\\\[0.5mm]\n"))) (calendar-for-loop i from 0 to 6 do (setq str (concat str --- 1288,1308 ---- calendar-week-start-day) 7)) ! (last (calendar-last-day-of-month month year)) ! (colsep (if colsep colsep "1mm")) (str (concat "\\def\\" name "{\\hbox to" width "{%\n" "\\vbox to" height "{%\n" "\\vfil \\hbox to" width "{%\n" "\\hfil\\" ! (if ptsize ptsize "scriptsize") "\\begin{tabular}" ! "{@{\\hspace{0mm}}r@{\\hspace{" colsep ! "}}r@{\\hspace{" colsep "}}r@{\\hspace{" colsep ! "}}r@{\\hspace{" colsep "}}r@{\\hspace{" colsep ! "}}r@{\\hspace{" colsep "}}r@{\\hspace{0mm}}}%\n" "\\multicolumn{7}{c}{" (calendar-month-name month) " " (int-to-string year) ! "}\\\\[1mm]\n"))) (calendar-for-loop i from 0 to 6 do (setq str (concat str *************** Optional SIZE gives the point size; scri *** 1305,1309 **** (if (/= i 6) " & " ! "\\\\[0.5mm]\n")))) (calendar-for-loop i from 1 to blank-days do (setq str (concat str " & "))) --- 1312,1316 ---- (if (/= i 6) " & " ! "\\\\[0.7mm]\n")))) (calendar-for-loop i from 1 to blank-days do (setq str (concat str " & "))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/calendar.el emacs-19.32/lisp/calendar.el *** emacs-19.31/lisp/calendar.el Mon May 20 11:35:45 1996 --- emacs-19.32/lisp/calendar.el Mon Jun 3 01:05:50 1996 *************** *** 65,69 **** ;; cal-tex.el Calendars in LaTeX ;; cal-x.el X-windows dedicated frame functions ! ;; diary.el Diary functions ;; holidays.el Holiday functions ;; lunar.el Phases of the moon --- 65,69 ---- ;; cal-tex.el Calendars in LaTeX ;; cal-x.el X-windows dedicated frame functions ! ;; diary-lib.el Diary functions ;; holidays.el Holiday functions ;; lunar.el Phases of the moon diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/cmacexp.el emacs-19.32/lisp/cmacexp.el *** emacs-19.31/lisp/cmacexp.el Tue May 21 11:42:19 1996 --- emacs-19.32/lisp/cmacexp.el Fri Jun 7 18:59:28 1996 *************** *** 4,8 **** ;; Author: Francesco Potorti` ! ;; Version: $Id: cmacexp.el,v 1.25 1996/05/21 15:42:13 kwzh Exp $ ;; Adapted-By: ESR ;; Keywords: c --- 4,8 ---- ;; Author: Francesco Potorti` ! ;; Version: $Id: cmacexp.el,v 1.26 1996/06/07 22:59:27 rms Exp $ ;; Adapted-By: ESR ;; Keywords: c *************** *** 99,103 **** (defvar c-macro-preprocessor ;; Cannot rely on standard directory on MS-DOS to find CPP. ! (if (eq system-type 'ms-dos) "cpp -C" "/lib/cpp -C") "The preprocessor used by the cmacexp package. --- 99,109 ---- (defvar c-macro-preprocessor ;; Cannot rely on standard directory on MS-DOS to find CPP. ! (cond ((eq system-type 'ms-dos) "cpp -C") ! ;; Solaris has it in an unusual place. ! ((and (string-match "^[^-]*-[^-]*-\\(solaris\\|sunos5\\)" ! system-configuration) ! (file-exists-p "/opt/SUNWspro/SC3.0.1/bin/acomp")) ! "/opt/SUNWspro/SC3.0.1/bin/acomp -C -E") ! (t "/lib/cpp -C")) "The preprocessor used by the cmacexp package. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/comint.el emacs-19.32/lisp/comint.el *** emacs-19.31/lisp/comint.el Sun Mar 17 10:28:55 1996 --- emacs-19.32/lisp/comint.el Thu Aug 1 18:30:38 1996 *************** *** 1,5 **** ;;; comint.el --- general command interpreter in a window stuff ! ;; Copyright (C) 1988, 90, 92, 93, 94, 95 Free Software Foundation, Inc. ;; Author: Olin Shivers --- 1,5 ---- ;;; comint.el --- general command interpreter in a window stuff ! ;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96 Free Software Foundation, Inc. ;; Author: Olin Shivers *************** *** 108,139 **** ;;============================================================================ ;; Comint mode buffer local variables: ! ;; comint-prompt-regexp - string comint-bol uses to match prompt ! ;; comint-delimiter-argument-list - list For delimiters and arguments ! ;; comint-last-input-start - marker Handy if inferior always echoes ! ;; comint-last-input-end - marker For comint-kill-output command ! ;; comint-input-ring-size - integer For the input history ! ;; comint-input-ring - ring mechanism ! ;; comint-input-ring-index - number ... ! ;; comint-input-autoexpand - symbol ... ! ;; comint-input-ignoredups - boolean ... ! ;; comint-last-input-match - string ... ! ;; comint-dynamic-complete-functions - hook For the completion mechanism ! ;; comint-completion-fignore - list ... ! ;; comint-file-name-quote-list - list ... ! ;; comint-get-old-input - function Hooks for specific ! ;; comint-input-filter-functions - hook process-in-a-buffer ! ;; comint-output-filter-functions - hook function modes. ! ;; comint-input-filter - function ... ! ;; comint-input-sender - function ... ! ;; comint-eol-on-send - boolean ... ! ;; comint-process-echoes - boolean ... ! ;; comint-scroll-to-bottom-on-input - symbol For scroll behavior ! ;; comint-scroll-to-bottom-on-output - symbol ... ! ;; comint-scroll-show-maximum-output - boolean... ;; ;; Comint mode non-buffer local variables: ! ;; comint-completion-addsuffix - boolean/cons For file name completion ! ;; comint-completion-autolist - boolean behavior ! ;; comint-completion-recexact - boolean ... (defvar comint-prompt-regexp "^" --- 108,140 ---- ;;============================================================================ ;; Comint mode buffer local variables: ! ;; comint-prompt-regexp string comint-bol uses to match prompt ! ;; comint-delimiter-argument-list list For delimiters and arguments ! ;; comint-last-input-start marker Handy if inferior always echoes ! ;; comint-last-input-end marker For comint-kill-output command ! ;; comint-input-ring-size integer For the input history ! ;; comint-input-ring ring mechanism ! ;; comint-input-ring-index number ... ! ;; comint-input-autoexpand symbol ... ! ;; comint-input-ignoredups boolean ... ! ;; comint-last-input-match string ... ! ;; comint-dynamic-complete-functions hook For the completion mechanism ! ;; comint-completion-fignore list ... ! ;; comint-file-name-chars string ... ! ;; comint-file-name-quote-list list ... ! ;; comint-get-old-input function Hooks for specific ! ;; comint-input-filter-functions hook process-in-a-buffer ! ;; comint-output-filter-functions hook function modes. ! ;; comint-input-filter function ... ! ;; comint-input-sender function ... ! ;; comint-eol-on-send boolean ... ! ;; comint-process-echoes boolean ... ! ;; comint-scroll-to-bottom-on-input symbol For scroll behavior ! ;; comint-scroll-to-bottom-on-output symbol ... ! ;; comint-scroll-show-maximum-output boolean ... ;; ;; Comint mode non-buffer local variables: ! ;; comint-completion-addsuffix boolean/cons For file name ! ;; comint-completion-autolist boolean completion behavior ! ;; comint-completion-recexact boolean ... (defvar comint-prompt-regexp "^" *************** This variable is buffer-local.") *** 263,267 **** "Functions to call after output is inserted into the buffer. One possible function is `comint-postoutput-scroll-to-bottom'. ! These functions get one argument, a string containing the text just inserted. This variable is buffer-local.") --- 264,271 ---- "Functions to call after output is inserted into the buffer. One possible function is `comint-postoutput-scroll-to-bottom'. ! These functions get one argument, a string containing the text as originally ! inserted. Note that this might not be the same as the buffer contents between ! `comint-last-output-start' and the buffer's `process-mark', if other filter ! functions have already modified the buffer. This variable is buffer-local.") *************** Entry to this mode runs the hooks on `co *** 394,397 **** --- 398,402 ---- (make-local-variable 'comint-exec-hook) (make-local-variable 'comint-process-echoes) + (make-local-variable 'comint-file-name-chars) (make-local-variable 'comint-file-name-quote-list) (run-hooks 'comint-mode-hook)) *************** Returns t if successful." *** 896,900 **** (interactive) (if (and comint-input-autoexpand ! (string-match "[!^]" (funcall comint-get-old-input)) (save-excursion (beginning-of-line) (looking-at comint-prompt-regexp))) --- 901,905 ---- (interactive) (if (and comint-input-autoexpand ! (string-match "!\\|^\\^" (funcall comint-get-old-input)) (save-excursion (beginning-of-line) (looking-at comint-prompt-regexp))) *************** Similarly for Soar, Scheme, etc." *** 1167,1175 **** (let ((copy (buffer-substring pmark (point)))) (delete-region pmark (point)) ! (insert input) copy)))) (if comint-process-echoes (delete-region pmark (point)) ! (insert ?\n)) (if (and (funcall comint-input-filter history) (or (null comint-input-ignoredups) --- 1172,1180 ---- (let ((copy (buffer-substring pmark (point)))) (delete-region pmark (point)) ! (insert-before-markers input) copy)))) (if comint-process-echoes (delete-region pmark (point)) ! (insert-before-markers ?\n)) (if (and (funcall comint-input-filter history) (or (null comint-input-ignoredups) *************** This function should be in the list `com *** 1281,1290 **** (if (and (< (point) (process-mark process)) (or (eq scroll t) (eq scroll 'all) ! ;; Maybe user wants point to jump to the end. (and (eq scroll 'this) (eq selected window)) (and (eq scroll 'others) (not (eq selected window))) ! ;; If point was at the end, keep it at the end. ! (>= (point) ! (- (process-mark process) (length string))))) (goto-char (process-mark process))) ;; Optionally scroll so that the text --- 1286,1294 ---- (if (and (< (point) (process-mark process)) (or (eq scroll t) (eq scroll 'all) ! ;; Maybe user wants point to jump to end. (and (eq scroll 'this) (eq selected window)) (and (eq scroll 'others) (not (eq selected window))) ! ;; If point was at the end, keep it at end. ! (>= (point) comint-last-output-start))) (goto-char (process-mark process))) ;; Optionally scroll so that the text *************** This function could be on `comint-output *** 1304,1308 **** (interactive) (save-excursion ! (goto-char (point-max)) (forward-line (- comint-buffer-maximum-size)) (beginning-of-line) --- 1308,1312 ---- (interactive) (save-excursion ! (goto-char (process-mark (get-buffer-process (current-buffer)))) (forward-line (- comint-buffer-maximum-size)) (beginning-of-line) *************** The string is sent using `comint-input-s *** 1440,1444 **** Security bug: your string can still be temporarily recovered with \\[view-lossage]." ! (interactive "P") ; Defeat snooping via C-x esc (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) --- 1444,1448 ---- Security bug: your string can still be temporarily recovered with \\[view-lossage]." ! (interactive "P") ; Defeat snooping via C-x ESC ESC (let ((proc (get-buffer-process (current-buffer)))) (if (not proc) *************** This is used by comint's and shell's com *** 1824,1829 **** directory tracking functions.") (defvar comint-file-name-quote-list nil ! "List of characters to quote with `\' when in a file name. This is a good thing to set in mode hooks.") --- 1828,1841 ---- directory tracking functions.") + (defvar comint-file-name-chars + (if (memq system-type '(ms-dos windows-nt)) + "~/A-Za-z0-9_^$!#%&{}@`'.()-" + "~/A-Za-z0-9+@:_.$#%,={}-") + "String of characters valid in a file name. + + This is a good thing to set in mode hooks.") + (defvar comint-file-name-quote-list nil ! "List of characters to quote with `\\' when in a file name. This is a good thing to set in mode hooks.") *************** inside of a \"[...]\" (see `skip-chars-f *** 1855,1864 **** (match-string 0)))))) (defun comint-match-partial-filename () "Return the filename at point, or nil if non is found. Environment variables are substituted. See `comint-word'." ! (let ((filename (comint-word "~/A-Za-z0-9+@:_.$#%,={}-"))) ! (and filename (substitute-in-file-name (comint-unquote-filename filename))))) --- 1867,1894 ---- (match-string 0)))))) + (defun comint-substitute-in-file-name (filename) + "Return FILENAME with environment variables substituted. + Supports additional environment variable syntax of the command + interpreter (e.g., the percent notation of cmd.exe on NT)." + (let ((name (substitute-in-file-name filename))) + (if (memq system-type '(ms-dos windows-nt)) + (let (env-var-name + env-var-val) + (save-match-data + (while (string-match "%\\([^\\\\/]*\\)%" name) + (setq env-var-name + (substring name (match-beginning 1) (match-end 1))) + (setq env-var-val (if (getenv env-var-name) + (getenv env-var-name) + "")) + (setq name (replace-match env-var-val nil nil name)))))) + name)) (defun comint-match-partial-filename () "Return the filename at point, or nil if non is found. Environment variables are substituted. See `comint-word'." ! (let ((filename (comint-word comint-file-name-chars))) ! (and filename (comint-substitute-in-file-name ! (comint-unquote-filename filename))))) *************** Magic characters are those in `comint-fi *** 1881,1886 **** filename (save-match-data ! (while (string-match "\\\\\\(.\\)" filename) ! (setq filename (replace-match "\\1" nil nil filename))) filename))) --- 1911,1918 ---- filename (save-match-data ! (let ((i 0)) ! (while (string-match "\\\\\\(.\\)" filename i) ! (setq filename (replace-match "\\1" nil nil filename)) ! (setq i (+ 1 (match-beginning 0))))) filename))) *************** Returns t if successful." *** 1911,1925 **** (interactive) (if (comint-match-partial-filename) ! (prog2 (or (window-minibuffer-p (selected-window)) ! (message "Completing file name...")) ! (comint-dynamic-complete-as-filename)))) ! (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." ! (let* ((completion-ignore-case nil) (completion-ignored-extensions comint-completion-fignore) ! (file-name-handler-alist nil) (minibuffer-p (window-minibuffer-p (selected-window))) (success t) --- 1943,1962 ---- (interactive) (if (comint-match-partial-filename) ! (let ((directory-sep-char (if (memq system-type '(ms-dos windows-nt)) ! ?\\ ! ?/))) ! (prog2 (or (window-minibuffer-p (selected-window)) ! (message "Completing file name...")) ! (comint-dynamic-complete-as-filename))))) (defun comint-dynamic-complete-as-filename () "Dynamically complete at point as a filename. See `comint-dynamic-complete-filename'. Returns t if successful." ! (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt))) (completion-ignored-extensions comint-completion-fignore) ! ;; If we bind this, it breaks remote directory tracking in rlogin.el. ! ;; I think it was originally bound to solve file completion problems, ! ;; but subsequent changes may have made this unnecessary. sm. ! ;;(file-name-handler-alist nil) (minibuffer-p (window-minibuffer-p (selected-window))) (success t) *************** Returns `listed' if a completion listing *** 1993,1997 **** See also `comint-dynamic-complete-filename'." ! (let* ((completion-ignore-case nil) (suffix (cond ((not comint-completion-addsuffix) "") ((not (consp comint-completion-addsuffix)) " ") --- 2030,2034 ---- See also `comint-dynamic-complete-filename'." ! (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt))) (suffix (cond ((not comint-completion-addsuffix) "") ((not (consp comint-completion-addsuffix)) " ") *************** See also `comint-dynamic-complete-filena *** 2034,2039 **** "List in help buffer possible completions of the filename at point." (interactive) ! (let* ((completion-ignore-case nil) ! (file-name-handler-alist nil) (filename (or (comint-match-partial-filename) "")) (pathdir (file-name-directory filename)) --- 2071,2079 ---- "List in help buffer possible completions of the filename at point." (interactive) ! (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt))) ! ;; If we bind this, it breaks remote directory tracking in rlogin.el. ! ;; I think it was originally bound to solve file completion problems, ! ;; but subsequent changes may have made this unnecessary. sm. ! ;;(file-name-handler-alist nil) (filename (or (comint-match-partial-filename) "")) (pathdir (file-name-directory filename)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/complete.el emacs-19.32/lisp/complete.el *** emacs-19.31/lisp/complete.el Mon May 20 17:03:04 1996 --- emacs-19.32/lisp/complete.el Sat Jul 27 23:21:15 1996 *************** Word-delimiters for the purposes of Part *** 179,183 **** (if (PC-was-meta-key) (minibuffer-complete) ! (PC-do-completion nil))) --- 179,197 ---- (if (PC-was-meta-key) (minibuffer-complete) ! ;; If the previous command was not this one, ! ;; never scroll, always retry completion. ! (or (eq last-command this-command) ! (setq minibuffer-scroll-window nil)) ! (let ((window minibuffer-scroll-window)) ! ;; If there's a fresh completion window with a live buffer, ! ;; and this command is repeated, scroll that window. ! (if (and window (window-buffer window) ! (buffer-name (window-buffer window))) ! (save-excursion ! (set-buffer (window-buffer window)) ! (if (pos-visible-in-window-p (point-max) window) ! (set-window-start window (point-min) nil) ! (scroll-other-window))) ! (PC-do-completion nil))))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/completion.el emacs-19.32/lisp/completion.el *** emacs-19.31/lisp/completion.el Sat Apr 13 15:44:07 1996 --- emacs-19.32/lisp/completion.el Tue Jul 23 16:00:03 1996 *************** Used to decide whether to save completio *** 471,477 **** (defun cmpl-hours-since-origin () (let ((time (current-time))) ! (truncate ! (+ (* (/ (car time) 3600.0) (lsh 1 16)) ! (/ (nth 2 time) 3600.0))))) ;;--------------------------------------------------------------------------- --- 471,475 ---- (defun cmpl-hours-since-origin () (let ((time (current-time))) ! (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600))) ;;--------------------------------------------------------------------------- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/custom.el emacs-19.32/lisp/custom.el *** emacs-19.31/lisp/custom.el Tue Mar 26 19:00:58 1996 --- emacs-19.32/lisp/custom.el Tue Jun 25 18:26:06 1996 *************** *** 69,81 **** ;;; Code: ;;; Compatibility: ! (or (fboundp 'buffer-substring-no-properties) ! ;; Introduced in Emacs 19.29. ! (defun buffer-substring-no-properties (beg end) ! "Return the text from BEG to END, without text properties, as a string." ! (let ((string (buffer-substring beg end))) ! (set-text-properties 0 (length string) nil string) ! string))) (or (fboundp 'add-to-list) --- 69,116 ---- ;;; Code: + (eval-when-compile + (require 'cl)) + ;;; Compatibility: ! (defun custom-xmas-add-text-properties (start end props &optional object) ! (add-text-properties start end props object) ! (put-text-property start end 'start-open t object) ! (put-text-property start end 'end-open t object)) ! ! (defun custom-xmas-put-text-property (start end prop value &optional object) ! (put-text-property start end prop value object) ! (put-text-property start end 'start-open t object) ! (put-text-property start end 'end-open t object)) ! ! (defun custom-xmas-extent-start-open () ! (map-extents (lambda (extent arg) ! (set-extent-property extent 'start-open t)) ! nil (point) (min (1+ (point)) (point-max)))) ! ! (if (string-match "XEmacs\\|Lucid" emacs-version) ! (progn ! (fset 'custom-add-text-properties 'custom-xmas-add-text-properties) ! (fset 'custom-put-text-property 'custom-xmas-put-text-property) ! (fset 'custom-extent-start-open 'custom-xmas-extent-start-open) ! (fset 'custom-set-text-properties ! (if (fboundp 'set-text-properties) ! 'set-text-properties)) ! (fset 'custom-buffer-substring-no-properties ! (if (fboundp 'buffer-substring-no-properties) ! 'buffer-substring-no-properties ! 'custom-xmas-buffer-substring-no-properties))) ! (fset 'custom-add-text-properties 'add-text-properties) ! (fset 'custom-put-text-property 'put-text-property) ! (fset 'custom-extent-start-open 'ignore) ! (fset 'custom-set-text-properties 'set-text-properties) ! (fset 'custom-buffer-substring-no-properties ! 'buffer-substring-no-properties)) ! ! (defun custom-xmas-buffer-substring-no-properties (beg end) ! "Return the text from BEG to END, without text properties, as a string." ! (let ((string (buffer-substring beg end))) ! (custom-set-text-properties 0 (length string) nil string) ! string)) (or (fboundp 'add-to-list) *************** STRING should be given if the last searc *** 172,187 **** (funcall 'set-face-underline-p 'underline t)))) ! (or (fboundp 'set-text-properties) ! ;; Missing in XEmacs 19.12. ! (defun set-text-properties (start end props &optional buffer) ! (if (or (null buffer) (bufferp buffer)) ! (if props ! (while props ! (put-text-property ! start end (car props) (nth 1 props) buffer) ! (setq props (nthcdr 2 props))) ! (remove-text-properties start end ()))))) ! (or (fboundp 'event-closest-point) ;; Missing in Emacs 19.29. (defun event-point (event) --- 207,220 ---- (funcall 'set-face-underline-p 'underline t)))) ! (defun custom-xmas-set-text-properties (start end props &optional buffer) ! (if (null buffer) ! (if props ! (while props ! (custom-put-text-property ! start end (car props) (nth 1 props) buffer) ! (setq props (nthcdr 2 props))) ! (remove-text-properties start end ())))) ! (or (fboundp 'event-point) ;; Missing in Emacs 19.29. (defun event-point (event) *************** into the buffer visible in the event's w *** 202,259 **** (defvar custom-field-active-face nil)) - (or (and (fboundp 'modify-face) (not (featurep 'face-lock))) - ;; Introduced in Emacs 19.29. Incompatible definition also introduced - ;; by face-lock.el version 3.00 and above for Emacs 19.28 and below. - ;; face-lock does not call modify-face, so we can safely redefine it. - (defun modify-face (face foreground background stipple - bold-p italic-p underline-p) - "Change the display attributes for face FACE. - FOREGROUND and BACKGROUND should be color strings or nil. - STIPPLE should be a stipple pattern name or nil. - BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold, - in italic, and underlined, respectively. (Yes if non-nil.) - If called interactively, prompts for a face and face attributes." - (interactive - (let* ((completion-ignore-case t) - (face (symbol-name (read-face-name "Modify face: "))) - (colors (mapcar 'list x-colors)) - (stipples (mapcar 'list - (apply 'nconc - (mapcar 'directory-files - x-bitmap-file-path)))) - (foreground (modify-face-read-string - face (face-foreground (intern face)) - "foreground" colors)) - (background (modify-face-read-string - face (face-background (intern face)) - "background" colors)) - (stipple (modify-face-read-string - face (face-stipple (intern face)) - "stipple" stipples)) - (bold-p (y-or-n-p (concat "Set face " face " bold "))) - (italic-p (y-or-n-p (concat "Set face " face " italic "))) - (underline-p (y-or-n-p (concat "Set face " face " underline ")))) - (message "Face %s: %s" face - (mapconcat 'identity - (delq nil - (list (and foreground (concat (downcase foreground) " foreground")) - (and background (concat (downcase background) " background")) - (and stipple (concat (downcase stipple) " stipple")) - (and bold-p "bold") (and italic-p "italic") - (and underline-p "underline"))) ", ")) - (list (intern face) foreground background stipple - bold-p italic-p underline-p))) - (condition-case nil (set-face-foreground face foreground) (error nil)) - (condition-case nil (set-face-background face background) (error nil)) - (condition-case nil (set-face-stipple face stipple) (error nil)) - (if (string-match "XEmacs" emacs-version) - (progn - (funcall (if bold-p 'make-face-bold 'make-face-unbold) face) - (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face)) - (funcall (if bold-p 'make-face-bold 'make-face-unbold) face nil t) - (funcall (if italic-p 'make-face-italic 'make-face-unitalic) face nil t)) - (set-face-underline-p face underline-p) - (and (interactive-p) (redraw-display)))) - ;; We can't easily check for a working intangible. (defconst intangible (if (and (boundp 'emacs-minor-version) --- 235,238 ---- *************** If called interactively, prompts for a f *** 282,288 **** ;; Put it in the Help menu, if possible. (if (string-match "XEmacs" emacs-version) ! ;; XEmacs (disabled because it doesn't work) ! (and current-menubar ! (add-menu-item '("Help") "Customize..." 'customize nil)) ;; Emacs 19.28 and earlier (global-set-key [ menu-bar help customize ] --- 261,268 ---- ;; Put it in the Help menu, if possible. (if (string-match "XEmacs" emacs-version) ! (if (featurep 'menubar) ! ;; XEmacs (disabled because it doesn't work) ! (and current-menubar ! (add-menu-item '("Help") "Customize..." 'customize t))) ;; Emacs 19.28 and earlier (global-set-key [ menu-bar help customize ] *************** If called interactively, prompts for a f *** 360,364 **** (defun custom-category-set (from to category) "Make text between FROM and TWO have category CATEGORY." ! (put-text-property from to 'category category))) ;;; External Data: --- 340,344 ---- (defun custom-category-set (from to category) "Make text between FROM and TWO have category CATEGORY." ! (custom-put-text-property from to 'category category))) ;;; External Data: *************** If called interactively, prompts for a f *** 420,424 **** ;; property and `custom-type-properties'. ! (defvar custom-file (convert-standard-filename "~/.custom.el") "Name of file with customization information.") --- 400,404 ---- ;; property and `custom-type-properties'. ! (defvar custom-file "~/.custom.el" "Name of file with customization information.") *************** If optional ORIGINAL is non-nil, conside *** 1081,1084 **** --- 1061,1065 ---- (data (vector repeat nil start end)) field) + (custom-extent-start-open) (insert-before-markers "\n") (backward-char 1) *************** If optional ORIGINAL is non-nil, conside *** 1310,1314 **** current) (if face-tag ! (put-text-property from (+ from (length (custom-tag custom))) 'face (funcall face-tag field value))) (if original --- 1291,1295 ---- current) (if face-tag ! (custom-put-text-property from (+ from (length (custom-tag custom))) 'face (funcall face-tag field value))) (if original *************** If optional ORIGINAL is non-nil, conside *** 1396,1402 **** (setq begin (point) found (custom-insert (custom-property custom 'none) nil)) ! (add-text-properties begin (point) ! (list rear-nonsticky t ! 'face custom-field-uninitialized-face))) (or original (custom-field-original-set found (custom-field-original field))) --- 1377,1384 ---- (setq begin (point) found (custom-insert (custom-property custom 'none) nil)) ! (custom-add-text-properties ! begin (point) ! (list rear-nonsticky t ! 'face custom-field-uninitialized-face))) (or original (custom-field-original-set found (custom-field-original field))) *************** If optional ORIGINAL is non-nil, conside *** 1484,1488 **** (defun custom-face-import (custom value) "Modify CUSTOM's VALUE to match internal expectations." ! (let ((name (symbol-name value))) (list (if (string-match "\ custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)" --- 1466,1471 ---- (defun custom-face-import (custom value) "Modify CUSTOM's VALUE to match internal expectations." ! (let ((name (or (and (facep value) (symbol-name (face-name value))) ! (symbol-name value)))) (list (if (string-match "\ custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)" *************** custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\ *** 1497,1503 **** value)))) ! (defun custom-face-lookup (fg bg stipple bold italic underline) ! "Lookup or create a face with specified attributes. ! FG BG STIPPLE BOLD ITALIC UNDERLINE" (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S" (or fg "default") --- 1480,1485 ---- value)))) ! (defun custom-face-lookup (&optional fg bg stipple bold italic underline) ! "Lookup or create a face with specified attributes." (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S" (or fg "default") *************** FG BG STIPPLE BOLD ITALIC UNDERLINE" *** 1508,1517 **** (fboundp 'make-face)) () ! (make-face name) ! (modify-face name ! (if (string-equal fg "default") nil fg) ! (if (string-equal bg "default") nil bg) ! (if (string-equal stipple "default") nil stipple) ! bold italic underline)) name)) --- 1490,1524 ---- (fboundp 'make-face)) () ! (copy-face 'default name) ! (when (and fg ! (not (string-equal fg "default"))) ! (condition-case () ! (set-face-foreground name fg) ! (error nil))) ! (when (and bg ! (not (string-equal bg "default"))) ! (condition-case () ! (set-face-background name bg) ! (error nil))) ! (when (and stipple ! (not (string-equal stipple "default")) ! (not (eq stipple 'custom:asis)) ! (fboundp 'set-face-stipple)) ! (set-face-stipple name stipple)) ! (when (and bold ! (not (eq bold 'custom:asis))) ! (condition-case () ! (make-face-bold name) ! (error nil))) ! (when (and italic ! (not (eq italic 'custom:asis))) ! (condition-case () ! (make-face-italic name) ! (error nil))) ! (when (and underline ! (not (eq underline 'custom:asis))) ! (condition-case () ! (set-face-underline-p name t) ! (error nil)))) name)) *************** FG BG STIPPLE BOLD ITALIC UNDERLINE" *** 1529,1533 **** (from (point))) (custom-text-insert (custom-tag custom)) ! (add-text-properties from (point) (list 'face face rear-nonsticky t)) --- 1536,1540 ---- (from (point))) (custom-text-insert (custom-tag custom)) ! (custom-add-text-properties from (point) (list 'face face rear-nonsticky t)) *************** FG BG STIPPLE BOLD ITALIC UNDERLINE" *** 1540,1544 **** (let ((from (custom-field-start field)) (custom (custom-field-custom field))) ! (put-text-property from (+ from (length (custom-tag custom))) 'face (custom-field-face field)))) --- 1547,1551 ---- (let ((from (custom-field-start field)) (custom (custom-field-custom field))) ! (custom-put-text-property from (+ from (length (custom-tag custom))) 'face (custom-field-face field)))) *************** If the optional argument SAVE is non-nil *** 1829,1835 **** (insert tag) (custom-category-set from (point) 'custom-button-properties) ! (put-text-property from (point) 'custom-tag field) (if data ! (add-text-properties from (point) (list 'custom-data data))))) (defun custom-documentation-insert (custom &rest ignore) --- 1836,1842 ---- (insert tag) (custom-category-set from (point) 'custom-button-properties) ! (custom-put-text-property from (point) 'custom-tag field) (if data ! (custom-add-text-properties from (point) (list 'custom-data data))))) (defun custom-documentation-insert (custom &rest ignore) *************** If the optional argument SAVE is non-nil *** 1850,1858 **** (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") ! (set-text-properties from (point) ! (list 'face custom-button-face ! mouse-face custom-mouse-face ! 'custom-jump t ;Make TAB jump over it. ! 'custom-tag command)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) --- 1857,1867 ---- (let ((from (point))) (insert "`" (key-description (where-is-internal command nil t)) "'") ! (custom-set-text-properties from (point) ! (list 'face custom-button-face ! mouse-face custom-mouse-face ! 'custom-jump t ;Make TAB jump over it. ! 'custom-tag command ! 'start-open t ! 'end-open t)) (custom-category-set from (point) 'custom-documentation-properties)) (custom-help-insert ": " (custom-first-line (documentation command)) "\n")) *************** If the optional argument is non-nil, sho *** 2176,2190 **** (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) ! (set-text-properties from (point) (list 'custom-field field 'custom-tag field 'face (custom-field-face field) ! front-sticky t)))) (defun custom-field-read (field) ;; Read the screen content of FIELD. (custom-read (custom-field-custom field) ! (buffer-substring-no-properties (custom-field-start field) (custom-field-end field)))) --- 2185,2200 ---- (- (custom-width custom) (- (point) from))) (custom-field-move field from (point)) ! (custom-set-text-properties from (point) (list 'custom-field field 'custom-tag field 'face (custom-field-face field) ! 'start-open t ! 'end-open t)))) (defun custom-field-read (field) ;; Read the screen content of FIELD. (custom-read (custom-field-custom field) ! (custom-buffer-substring-no-properties (custom-field-start field) (custom-field-end field)))) *************** If the optional argument is non-nil, sho *** 2197,2201 **** (let ((before-change-functions nil) (after-change-functions nil)) ! (put-text-property (custom-field-start field) (custom-field-end field) 'face (custom-field-face field)))) --- 2207,2211 ---- (let ((before-change-functions nil) (after-change-functions nil)) ! (custom-put-text-property (custom-field-start field) (custom-field-end field) 'face (custom-field-face field)))) *************** If the optional argument is non-nil, sho *** 2215,2219 **** (if (< pos (point)) (goto-char pos)))) ! (put-text-property start end 'face custom-field-active-face))) (defun custom-field-resize (field) --- 2225,2229 ---- (if (< pos (point)) (goto-char pos)))) ! (custom-put-text-property start end 'face custom-field-active-face))) (defun custom-field-resize (field) *************** If the optional argument is non-nil, sho *** 2297,2301 **** (custom-assert '(prog1 field (setq custom-field-was nil))) ;; Prevent mixing fields properties. ! (put-text-property begin end 'custom-field field) ;; Update the field after modification. (if (eq (custom-field-property begin) field) --- 2307,2311 ---- (custom-assert '(prog1 field (setq custom-field-was nil))) ;; Prevent mixing fields properties. ! (custom-put-text-property begin end 'custom-field field) ;; Update the field after modification. (if (eq (custom-field-property begin) field) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/dabbrev.el emacs-19.32/lisp/dabbrev.el *** emacs-19.31/lisp/dabbrev.el Wed Jan 24 14:01:08 1996 --- emacs-19.32/lisp/dabbrev.el Thu Aug 1 00:52:58 1996 *************** if there is a suitable one already." *** 339,343 **** ;; Find all expansion (let ((completion-list ! (dabbrev--find-all-expansions abbrev ignore-case-p))) ;; Make an obarray with all expansions (setq my-obarray (make-vector (length completion-list) 0)) --- 339,344 ---- ;; Find all expansion (let ((completion-list ! (dabbrev--find-all-expansions abbrev ignore-case-p)) ! (completion-ignore-case ignore-case-p)) ;; Make an obarray with all expansions (setq my-obarray (make-vector (length completion-list) 0)) *************** See also `dabbrev-abbrev-char-regexp' an *** 438,442 **** (marker-position dabbrev--last-abbrev-location) (= (point) (1+ dabbrev--last-abbrev-location))) ! (progn ;; The "abbrev" to expand is just the space. (setq abbrev " ") --- 439,450 ---- (marker-position dabbrev--last-abbrev-location) (= (point) (1+ dabbrev--last-abbrev-location))) ! (let* ((prev-expansion ! (buffer-substring-no-properties ! (- dabbrev--last-abbrev-location (length dabbrev--last-expansion)) ! dabbrev--last-abbrev-location)) ! ;; If the previous expansion was upcased. ! ;; upcase this one too. ! (upcase-it ! (equal prev-expansion (upcase prev-expansion)))) ;; The "abbrev" to expand is just the space. (setq abbrev " ") *************** See also `dabbrev-abbrev-char-regexp' an *** 459,462 **** --- 467,472 ---- (buffer-substring dabbrev--last-expansion-location (point))) + (if upcase-it + (setq expansion (upcase expansion))) ;; Record the end of this expansion, in case we repeat this. *************** See also `dabbrev-abbrev-char-regexp' an *** 748,751 **** --- 758,774 ---- (setq old (concat abbrev (or old ""))) (setq expansion (concat abbrev expansion))) + ;; If the given abbrev is mixed case and its case pattern + ;; matches the start of the expansion, + ;; copy the expansion's case + ;; instead of downcasing all the rest. + (if (and (string= abbrev + (substring expansion 0 (length abbrev))) + (not (string= abbrev (downcase abbrev))) + (not (string= abbrev (upcase abbrev)))) + (setq use-case-replace nil)) + (if (equal abbrev " ") + (setq use-case-replace nil)) + (if use-case-replace + (setq expansion (downcase expansion))) (if old (save-excursion *************** See also `dabbrev-abbrev-char-regexp' an *** 829,833 **** (cons found-string dabbrev--last-table)) (if (and ignore-case (eval dabbrev-case-replace)) ! (downcase result) result))))))) --- 852,856 ---- (cons found-string dabbrev--last-table)) (if (and ignore-case (eval dabbrev-case-replace)) ! result result))))))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/debug.el emacs-19.32/lisp/debug.el *** emacs-19.31/lisp/debug.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/debug.el Wed May 29 13:14:43 1996 *************** first will be printed into the backtrace *** 78,82 **** (debugger-step-after-exit nil) ;; Don't keep reading from an executing kbd macro! ! (executing-macro nil) ;; Save the outer values of these vars for the `e' command ;; before we replace the values. --- 78,82 ---- (debugger-step-after-exit nil) ;; Don't keep reading from an executing kbd macro! ! (executing-kbd-macro nil) ;; Save the outer values of these vars for the `e' command ;; before we replace the values. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/decipher.el emacs-19.32/lisp/decipher.el *** emacs-19.31/lisp/decipher.el Fri Feb 23 18:50:19 1996 --- emacs-19.32/lisp/decipher.el Sat Jul 20 13:27:18 1996 *************** *** 19,24 **** ;; ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Quick Start: --- 19,25 ---- ;; ;; 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. ;;; Quick Start: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/dired.el emacs-19.32/lisp/dired.el *** emacs-19.31/lisp/dired.el Fri Apr 5 14:10:39 1996 --- emacs-19.32/lisp/dired.el Tue Jun 4 13:51:20 1996 *************** may contain even `F', `b', `i' and `s'. *** 50,54 **** (defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v irix linux lignux)) ! "chown" "/etc/chown") "Name of chown command (usually `chown' or `/etc/chown').") --- 50,57 ---- (defvar dired-chown-program (if (memq system-type '(hpux dgux usg-unix-v irix linux lignux)) ! "chown" ! (if (file-exists-p "/usr/sbin/chown") ! "/usr/sbin/chown" ! "/etc/chown")) "Name of chown command (usually `chown' or `/etc/chown').") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/dos-fns.el emacs-19.32/lisp/dos-fns.el *** emacs-19.31/lisp/dos-fns.el Sat May 18 16:07:57 1996 --- emacs-19.32/lisp/dos-fns.el Mon Jun 10 17:17:50 1996 *************** against the file name, and TYPE is nil f *** 193,208 **** (int86 33 regs)) - ;; Extra stub to functions in src/frame.c - ;; Emacs aborts during dump if the following don't have a doc string. - (defun window-frame (window) - "Return the frame that WINDOW resides on." - (selected-frame)) - (defun raise-frame (frame) - "Raise FRAME to the top of the desktop." - nil) - (defun select-frame (frame &optional no-enter) - "Select FRAME for input events." - (selected-frame)) - ;; Support for printing under MS-DOS, see lpr.el and ps-print.el. (defvar dos-printer "PRN" --- 193,196 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/easymenu.el emacs-19.32/lisp/easymenu.el *** emacs-19.31/lisp/easymenu.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/easymenu.el Thu Jun 13 16:45:53 1996 *************** is a list of menu items, as above." *** 175,179 **** (if (symbolp callback) (fset command callback) ! (fset command (list 'lambda () '(interactive) callback))))) (if (null command) ;; Handle inactive strings specially--allow any number --- 175,180 ---- (if (symbolp callback) (fset command callback) ! (fset command (list 'lambda () '(interactive) callback))) ! (put command 'menu-alias t))) (if (null command) ;; Handle inactive strings specially--allow any number diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/edebug.el emacs-19.32/lisp/edebug.el *** emacs-19.31/lisp/edebug.el Wed Mar 20 08:31:01 1996 --- emacs-19.32/lisp/edebug.el Wed Jul 24 12:36:53 1996 *************** *** 9,13 **** ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |A source level debugger for Emacs Lisp. ! ;; |$Date: 1996/03/20 13:30:16 $|$Revision: 3.6 $|~/modes/edebug.el| ;; This file is part of GNU Emacs. --- 9,13 ---- ;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu ;; |A source level debugger for Emacs Lisp. ! ;; |$Date: 1996/07/24 16:36:41 $|$Revision: 3.8 $|~/modes/edebug.el| ;; This file is part of GNU Emacs. *************** *** 86,90 **** (defconst edebug-version ! (let ((raw-version "$Revision: 3.6 $")) (substring raw-version (string-match "[0-9.]*" raw-version) (match-end 0)))) --- 86,90 ---- (defconst edebug-version ! (let ((raw-version "$Revision: 3.8 $")) (substring raw-version (string-match "[0-9.]*" raw-version) (match-end 0)))) *************** error is signaled again." *** 2264,2268 **** ;; Save the outside value of executing macro. (here??) ! (edebug-outside-executing-macro executing-macro) (edebug-outside-pre-command-hook pre-command-hook) (edebug-outside-post-command-hook post-command-hook) --- 2264,2268 ---- ;; Save the outside value of executing macro. (here??) ! (edebug-outside-executing-macro executing-kbd-macro) (edebug-outside-pre-command-hook pre-command-hook) (edebug-outside-post-command-hook post-command-hook) *************** error is signaled again." *** 2272,2277 **** ;; within edebug unless edebug-continue-kbd-macro is ;; non-nil. Again, local binding may not be best. ! (executing-macro ! (if edebug-continue-kbd-macro executing-macro)) ;; Disable command hooks. This is essential when --- 2272,2277 ---- ;; within edebug unless edebug-continue-kbd-macro is ;; non-nil. Again, local binding may not be best. ! (executing-kbd-macro ! (if edebug-continue-kbd-macro executing-kbd-macro)) ;; Disable command hooks. This is essential when *************** error is signaled again." *** 2291,2295 **** (fset 'signal (symbol-function 'edebug-original-signal)))) ;; Reset global variables in case outside value was changed. ! (setq executing-macro edebug-outside-executing-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook --- 2291,2295 ---- (fset 'signal (symbol-function 'edebug-original-signal)))) ;; Reset global variables in case outside value was changed. ! (setq executing-kbd-macro edebug-outside-executing-macro pre-command-hook edebug-outside-pre-command-hook post-command-hook edebug-outside-post-command-hook *************** Return the result of the last expression *** 3566,3570 **** (standard-input edebug-outside-standard-input) ! (executing-macro edebug-outside-executing-macro) (defining-kbd-macro edebug-outside-defining-kbd-macro) (pre-command-hook edebug-outside-pre-command-hook) --- 3566,3570 ---- (standard-input edebug-outside-standard-input) ! (executing-kbd-macro edebug-outside-executing-macro) (defining-kbd-macro edebug-outside-defining-kbd-macro) (pre-command-hook edebug-outside-pre-command-hook) *************** Return the result of the last expression *** 3608,3612 **** edebug-outside-standard-input standard-input ! edebug-outside-executing-macro executing-macro edebug-outside-defining-kbd-macro defining-kbd-macro edebug-outside-pre-command-hook pre-command-hook --- 3608,3612 ---- edebug-outside-standard-input standard-input ! edebug-outside-executing-macro executing-kbd-macro edebug-outside-defining-kbd-macro defining-kbd-macro edebug-outside-pre-command-hook pre-command-hook *************** You must include newlines in FMT to brea *** 4141,4145 **** ;; "saving: point = %s window-start = %s" ;; (point) (window-start)) ! (let* ((selected-window (selected-window)) (buffer (get-buffer-create buf-name)) buf-window) --- 4141,4146 ---- ;; "saving: point = %s window-start = %s" ;; (point) (window-start)) ! (let* ((oldbuf (current-buffer)) ! (selected-window (selected-window)) (buffer (get-buffer-create buf-name)) buf-window) *************** You must include newlines in FMT to brea *** 4157,4161 **** ;; (edebug-sit-for 0) (bury-buffer buffer) ! (select-window selected-window)) buf-name) --- 4158,4163 ---- ;; (edebug-sit-for 0) (bury-buffer buffer) ! (select-window selected-window) ! (set-buffer oldbuf)) buf-name) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-diff.el emacs-19.32/lisp/ediff-diff.el *** emacs-19.31/lisp/ediff-diff.el Mon May 6 19:16:44 1996 --- emacs-19.32/lisp/ediff-diff.el Fri Jun 21 23:20:35 1996 *************** *** 1,5 **** ;;; ediff-diff.el --- diff-related utilities ! ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-diff.el --- diff-related utilities ! ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 29,33 **** (defvar ediff-shell (cond ((eq system-type 'emx) "cmd") ; OS/2 ! ((eq system-type 'ms-dos) shell-file-name) ; no standard name on MS-DOS ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS (t "sh")) ; UNIX --- 29,34 ---- (defvar ediff-shell (cond ((eq system-type 'emx) "cmd") ; OS/2 ! ((memq system-type '(ms-dos windows-nt windows-95)) ! shell-file-name) ; no standard name on MS-DOS ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS (t "sh")) ; UNIX *************** Must produce output compatible with Unix *** 64,68 **** "*Options to pass to `ediff-diff3-program'.") (defvar ediff-diff3-ok-lines-regexp ! "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\)" "*Regexp that matches normal output lines from `ediff-diff3-program'. Lines that do not match are assumed to be error messages.") --- 65,69 ---- "*Options to pass to `ediff-diff3-program'.") (defvar ediff-diff3-ok-lines-regexp ! "^\\([1-3]:\\|====\\| \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)" "*Regexp that matches normal output lines from `ediff-diff3-program'. Lines that do not match are assumed to be error messages.") *************** Lines that do not match are assumed to b *** 72,87 **** (ediff-defvar-local ediff-diff-status "" "") - ;; Support for patch - - (defvar ediff-patch-program "patch" - "*Name of the program that applies patches.") - (defvar ediff-patch-options "" - "*Options to pass to ediff-patch-program.") - - ;; The buffer of the patch file. - (defvar ediff-patch-buf nil) - ;; The buffer where patch would display its diagnostics. - (defvar ediff-patch-diagnostics nil) - ;;; Fine differences --- 73,76 ---- *************** This variable can be set either in .emac *** 100,110 **** Use `setq-default' if setting it in .emacs") ! (ediff-defvar-local ediff-auto-refine-limit 700 ! "Auto-refine only those regions that are smaller than this number of bytes.") ;;; General (defvar ediff-diff-ok-lines-regexp ! "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No newline\\|.*missing newline\\)" "Regexp that matches normal output lines from `ediff-diff-program'. This is mostly lifted from Emerge, except that Ediff also considers --- 89,99 ---- Use `setq-default' if setting it in .emacs") ! (ediff-defvar-local ediff-auto-refine-limit 1400 ! "*Auto-refine only the regions of this size \(in bytes\) or less.") ;;; General (defvar ediff-diff-ok-lines-regexp ! "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No +newline\\|.*missing +newline\\|^\C-m$\\)" "Regexp that matches normal output lines from `ediff-diff-program'. This is mostly lifted from Emerge, except that Ediff also considers *************** one optional arguments, diff-number to r *** 139,155 **** ;;; (if ediff-xemacs-p (setq synchronize-minibuffers t)) (or (ediff-buffer-live-p ediff-diff-buffer) (setq ediff-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) ! ! (message "Computing differences ...") ! (ediff-exec-process ediff-diff-program ediff-diff-buffer 'synchronize ! ediff-diff-options file-A file-B) ! (ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer) - ;;(message "Computing differences ... done") (ediff-convert-diffs-to-overlays (ediff-extract-diffs ediff-diff-buffer ediff-word-mode ediff-narrow-bounds))) ;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers --- 128,171 ---- ;;; (if ediff-xemacs-p (setq synchronize-minibuffers t)) + ;; create, if it doesn't exist (or (ediff-buffer-live-p ediff-diff-buffer) (setq ediff-diff-buffer (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) ! (ediff-make-diff2-buffer ediff-diff-buffer file-A file-B) (ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer) (ediff-convert-diffs-to-overlays (ediff-extract-diffs ediff-diff-buffer ediff-word-mode ediff-narrow-bounds))) + + ;; Run the diff program on FILE1 and FILE2 and put the output in DIFF-BUFFER + ;; Return the size of DIFF-BUFFER + (defun ediff-make-diff2-buffer (diff-buffer file1 file2) + (cond ((< (ediff-file-size file1) 0) + (message "Can't diff remote files: %s" + (ediff-abbreviate-file-name file1)) + (sit-for 2) + ;; 1 is an error exit code + 1) + ((< (ediff-file-size file2) 0) + (message "Can't diff remote file: %s" + (ediff-abbreviate-file-name file2)) + (sit-for 2) + (message "") + ;; 1 is an error exit code + 1) + (t (message "Computing differences between %s and %s ..." + (file-name-nondirectory file1) + (file-name-nondirectory file2)) + ;; this erases the diff buffer automatically + (ediff-exec-process ediff-diff-program + diff-buffer + 'synchronize + ediff-diff-options file1 file2) + ;;(message "Computing differences ... done") + (message "") + (ediff-eval-in-buffer diff-buffer + (buffer-size))))) + + ;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers *************** one optional arguments, diff-number to r *** 501,505 **** (if (< ediff-number-of-differences 1) ! (error "Sorry, it is not my job to munch identical variants...")) (if ediff-word-mode --- 517,521 ---- (if (< ediff-number-of-differences 1) ! (error ediff-NO-DIFFERENCES)) (if ediff-word-mode *************** one optional arguments, diff-number to r *** 525,529 **** ;; don't compute fine diffs if diff vector exists (if (ediff-no-fine-diffs-p n) ! (ediff-message-if-verbose "Only white-space differences in region %d" (1+ n)))) ;; If one of the regions is empty (or 2 in 3way comparison) --- 541,546 ---- ;; don't compute fine diffs if diff vector exists (if (ediff-no-fine-diffs-p n) ! ;;(ediff-message-if-verbose ! (message "Only white-space differences in region %d" (1+ n)))) ;; If one of the regions is empty (or 2 in 3way comparison) *************** one optional arguments, diff-number to r *** 549,555 **** (empty-C 'C))) ) ! ;; if all regions happen to be whitespace, indicate this (if (and whitespace-A whitespace-B whitespace-C) (ediff-mark-diff-as-space-only n t) (ediff-mark-diff-as-space-only n nil))) ;; don't compute fine diffs for this region --- 566,575 ---- (empty-C 'C))) ) ! ;; if all regions happen to be whitespace (if (and whitespace-A whitespace-B whitespace-C) + ;; mark as space only (ediff-mark-diff-as-space-only n t) + ;; if some regions are white and others don't, then mark as + ;; non-white-space-only (ediff-mark-diff-as-space-only n nil))) ;; don't compute fine diffs for this region *************** one optional arguments, diff-number to r *** 558,562 **** (memq ediff-auto-refine '(off nix)) (ediff-message-if-verbose ! "Region %d exceeds auto-refine limit. `%s' force-refines" (1+ n) (substitute-command-keys --- 578,582 ---- (memq ediff-auto-refine '(off nix)) (ediff-message-if-verbose ! "Region %d exceeds auto-refine limit. Type `%s' to refine" (1+ n) (substitute-command-keys *************** one optional arguments, diff-number to r *** 606,612 **** (ediff-setup-fine-diff-regions file-A nil file-C n)) ((and ediff-3way-job ! (or whitespace-C ! (and ediff-merge-job ! (ediff-looks-like-combined-merge n)))) (ediff-setup-fine-diff-regions file-A file-B nil n)) (t --- 626,632 ---- (ediff-setup-fine-diff-regions file-A nil file-C n)) ((and ediff-3way-job ! ;; In merge-jobs, whitespace-C is t, since ! ;; ediff-empty-diff-region-p returns t in this case ! whitespace-C) (ediff-setup-fine-diff-regions file-A file-B nil n)) (t *************** one optional arguments, diff-number to r *** 615,623 **** (setq cumulative-fine-diff-length (+ (length (ediff-get-fine-diff-vector n 'A)) ! (length (ediff-get-fine-diff-vector n 'B)) ! (if file-C ! (length ! (ediff-get-fine-diff-vector n 'C)) ! 0))) (cond ((or --- 635,643 ---- (setq cumulative-fine-diff-length (+ (length (ediff-get-fine-diff-vector n 'A)) ! (length (ediff-get-fine-diff-vector n 'B)) ! ;; in merge jobs, the merge buffer is never refined ! (if (and file-C (not ediff-merge-job)) ! (length (ediff-get-fine-diff-vector n 'C)) ! 0))) (cond ((or *************** one optional arguments, diff-number to r *** 633,637 **** "Only white-space differences in region %d" (1+ n))) ((eq cumulative-fine-diff-length 0) ! (ediff-mark-diff-as-space-only n nil) (ediff-message-if-verbose "Only white-space differences in region %d %s" --- 653,657 ---- "Only white-space differences in region %d" (1+ n))) ((eq cumulative-fine-diff-length 0) ! (ediff-mark-diff-as-space-only n t) (ediff-message-if-verbose "Only white-space differences in region %d %s" *************** one optional arguments, diff-number to r *** 848,852 **** (beginning-of-line 2) (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) ! ;; if the A and B files are the same and not 3way-comparison, ;; ignore the difference (if (or three-way-comp (not (string-equal agreement "3"))) --- 868,872 ---- (beginning-of-line 2) (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) ! ;; if the files A and B are the same and not 3way-comparison, ;; ignore the difference (if (or three-way-comp (not (string-equal agreement "3"))) *************** argument to `skip-chars-forward'." *** 1164,1167 **** --- 1184,1192 ---- (point)))) + + ;;; Local Variables: + ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) + ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) + ;;; End: (provide 'ediff-diff) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-hook.el emacs-19.32/lisp/ediff-hook.el *** emacs-19.31/lisp/ediff-hook.el Fri Feb 16 01:28:45 1996 --- emacs-19.32/lisp/ediff-hook.el Fri Jun 21 21:43:36 1996 *************** *** 1,5 **** ;;; ediff-hook.el --- setup for Ediff's menus and autoloads ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-hook.el --- setup for Ediff's menus and autoloads ! ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 26,33 **** ;;; These must be placed in menu-bar.el in Emacs ;; - ;; (define-key menu-bar-tools-menu [ediff-doc] - ;; '("Ediff Manual..." . ediff-documentation)) - ;; (define-key menu-bar-tools-menu [eregistry] - ;; '("List Ediff Sessions..." . ediff-show-registry)) ;; (define-key menu-bar-tools-menu [epatch] ;; '("Apply Patch" . menu-bar-epatch-menu)) --- 26,29 ---- *************** *** 37,40 **** --- 33,41 ---- ;; '("Compare" . menu-bar-ediff-menu)) + ;; Compiler pacifier + (defvar ediff-menu) + (defvar ediff-merge-menu) + (defvar epatch-menu) + ;; end pacifier (defun ediff-xemacs-init-menus () *************** *** 49,58 **** (add-menu-button '("Tools") - ["List Ediff Sessions..." ediff-show-registry t] "OO-Browser...") - (add-menu-button - '("Tools") - ["Ediff Manual..." ediff-documentation t] "OO-Browser...") - (add-menu-button - '("Tools") ["-------" nil nil] "OO-Browser...") ))) --- 50,53 ---- *************** *** 79,82 **** --- 74,80 ---- ["Regions Word-by-word..." ediff-regions-wordwise t] ["Regions Line-by-line..." ediff-regions-linewise t] + "---" + ["List Ediff Sessions..." ediff-show-registry t] + ["Ediff Manual..." ediff-documentation t] )) (defvar ediff-merge-menu *************** *** 98,101 **** --- 96,102 ---- ["Directory Revisions with Ancestor..." ediff-merge-directory-revisions-with-ancestor t] + "---" + ["List Ediff Sessions..." ediff-show-registry t] + ["Ediff Manual..." ediff-documentation t] )) (defvar epatch-menu *************** *** 103,106 **** --- 104,110 ---- ["To a file..." ediff-patch-file t] ["To a buffer..." ediff-patch-buffer t] + "---" + ["List Ediff Sessions..." ediff-show-registry t] + ["Ediff Manual..." ediff-documentation t] )) *************** *** 123,126 **** --- 127,135 ---- ;; define ediff-menu + (define-key menu-bar-ediff-menu [ediff-doc] + '("Ediff Manual..." . ediff-documentation)) + (define-key menu-bar-ediff-menu [eregistry] + '("List Ediff Sessions..." . ediff-show-registry)) + (define-key menu-bar-ediff-menu [separator-ediff-manual] '("--")) (define-key menu-bar-ediff-menu [window] '("This Window and Next Window" . compare-windows)) *************** *** 155,158 **** --- 164,173 ---- ;; define merge menu + (define-key menu-bar-ediff-merge-menu [ediff-doc2] + '("Ediff Manual..." . ediff-documentation)) + (define-key menu-bar-ediff-merge-menu [eregistry2] + '("List Ediff Sessions..." . ediff-show-registry)) + (define-key + menu-bar-ediff-merge-menu [separator-ediff-merge-manual] '("--")) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] *************** *** 188,191 **** --- 203,211 ---- ;; define epatch menu + (define-key menu-bar-epatch-menu [ediff-doc3] + '("Ediff Manual..." . ediff-documentation)) + (define-key menu-bar-epatch-menu [eregistry3] + '("List Ediff Sessions..." . ediff-show-registry)) + (define-key menu-bar-epatch-menu [separator-epatch] '("--")) (define-key menu-bar-epatch-menu [ediff-patch-buffer] '("To a Buffer..." . ediff-patch-buffer)) *************** *** 203,209 **** --- 223,231 ---- (autoload 'ediff-files "ediff" "Compare two files" t) (autoload 'ediff-buffers "ediff" "Compare two bufers" t) + (autoload 'ebuffers "ediff" "Compare two bufers" t) (autoload 'ediff3 "ediff" "Compare three files" t) (autoload 'ediff-files3 "ediff" "Compare three files" t) (autoload 'ediff-buffers3 "ediff" "Compare three bufers" t) + (autoload 'ebuffers3 "ediff" "Compare three bufers" t) (autoload 'ediff-revision "ediff" "Compare versions of a file" t) *************** *** 211,274 **** ;; compare regions and windows (autoload 'ediff-windows-wordwise ! "ediff" "Compare two windows word-by-word" t) (autoload 'ediff-regions-wordwise ! "ediff" "Compare two regions word-by-word" t) (autoload 'ediff-windows-linewise ! "ediff" "Compare two windows line-by-line" t) (autoload 'ediff-regions-linewise ! "ediff" "Compare two regions line-by-line" t) ;; patch ! (autoload 'ediff-patch-file "ediff" "Patch a file" t) ! (autoload 'epatch "ediff" "Patch a file" t) ! (autoload 'ediff-patch-buffer "ediff" "Patch a buffer") ! (autoload 'epatch-buffer "ediff" "Patch a buffer" t) ;; merge ! (autoload 'ediff-merge "ediff" "Merge two files" t) ! (autoload 'ediff-merge-files "ediff" "Merge two files" t) (autoload 'ediff-merge-files-with-ancestor ! "ediff" "Merge two files using a third file as an ancestor" t) ! (autoload 'ediff-merge-buffers "ediff" "Merge two buffers" t) (autoload 'ediff-merge-buffers-with-ancestor ! "ediff" "Merge two buffers using a third buffer as an ancestor" t) ! (autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file" t) (autoload 'ediff-merge-revisions-with-ancestor ! "ediff" "Merge two versions of a file" t) ;; compare directories ! (autoload 'edirs "ediff" "Compare files in two directories" t) ! (autoload 'ediff-directories "ediff" "Compare files in two directories" t) ! (autoload 'edirs3 "ediff" "Compare files in three directories" t) ! (autoload 'ediff-directories3 "ediff" "Compare files in three directories" t) (autoload 'edir-revisions ! "ediff" "Compare two versions of a file" t) (autoload 'ediff-directory-revisions ! "ediff" "Compare two versions of a file" t) ;; merge directories ! (autoload 'edirs-merge "ediff" "Merge files in two directories" t) (autoload 'ediff-merge-directories ! "ediff" "Merge files in two directories" t) (autoload 'edirs-merge-with-ancestor "ediff" ! "Merge files in two directories using files in a third dir as ancestors" t) (autoload 'ediff-merge-directories-with-ancestor "ediff" ! "Merge files in two directories using files in a third dir as ancestors" t) (autoload 'edir-merge-revisions ! "ediff" "Merge versions of files in a directory" t) (autoload 'ediff-merge-directory-revisions ! "ediff" "Merge versions of files in a directory" t) (autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" ! "Merge versions of files in a directory using other versions as ancestors" t) (autoload 'edir-merge-revisions-with-ancestor "ediff" ! "Merge versions of files in a directory using other versions as ancestors" t) --- 233,299 ---- ;; compare regions and windows (autoload 'ediff-windows-wordwise ! "ediff" "Compare two windows word-by-word." t) (autoload 'ediff-regions-wordwise ! "ediff" "Compare two regions word-by-word." t) (autoload 'ediff-windows-linewise ! "ediff" "Compare two windows line-by-line." t) (autoload 'ediff-regions-linewise ! "ediff" "Compare two regions line-by-line." t) ;; patch ! (autoload 'ediff-patch-file "ediff" "Patch a file." t) ! (autoload 'epatch "ediff" "Patch a file." t) ! (autoload 'ediff-patch-buffer "ediff" "Patch a buffer.") ! (autoload 'epatch-buffer "ediff" "Patch a buffer." t) ;; merge ! (autoload 'ediff-merge "ediff" "Merge two files." t) ! (autoload 'ediff-merge-files "ediff" "Merge two files." t) (autoload 'ediff-merge-files-with-ancestor ! "ediff" "Merge two files using a third file as an ancestor." t) ! (autoload 'ediff-merge-buffers "ediff" "Merge two buffers." t) (autoload 'ediff-merge-buffers-with-ancestor ! "ediff" "Merge two buffers using a third buffer as an ancestor." t) ! (autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file." t) (autoload 'ediff-merge-revisions-with-ancestor ! "ediff" "Merge two versions of a file." t) ;; compare directories ! (autoload 'edirs "ediff" "Compare files in two directories." t) ! (autoload 'ediff-directories "ediff" "Compare files in two directories." t) ! (autoload 'edirs3 "ediff" "Compare files in three directories." t) ! (autoload ! 'ediff-directories3 "ediff" "Compare files in three directories." t) (autoload 'edir-revisions ! "ediff" "Compare two versions of a file." t) (autoload 'ediff-directory-revisions ! "ediff" "Compare two versions of a file." t) ;; merge directories ! (autoload 'edirs-merge "ediff" "Merge files in two directories." t) (autoload 'ediff-merge-directories ! "ediff" "Merge files in two directories." t) (autoload 'edirs-merge-with-ancestor "ediff" ! "Merge files in two directories using files in a third dir as ancestors." ! t) (autoload 'ediff-merge-directories-with-ancestor "ediff" ! "Merge files in two directories using files in a third dir as ancestors." ! t) (autoload 'edir-merge-revisions ! "ediff" "Merge versions of files in a directory." t) (autoload 'ediff-merge-directory-revisions ! "ediff" "Merge versions of files in a directory." t) (autoload 'ediff-merge-directory-revisions-with-ancestor "ediff" ! "Merge versions of files in a directory using other versions as ancestors." t) (autoload 'edir-merge-revisions-with-ancestor "ediff" ! "Merge versions of files in a directory using other versions as ancestors." t) *************** *** 276,284 **** (autoload 'ediff-show-registry "ediff-meta" ! "Display the registry of active Ediff sessions" t) (autoload 'ediff-version "ediff" ! "Show Ediff's version and last modification date" t) ) ; if purify-flag --- 301,313 ---- (autoload 'ediff-show-registry "ediff-meta" ! "Display the registry of active Ediff sessions." ! t) ! (autoload 'ediff-documentation ! "ediff" ! "Display Ediff's manual." t) (autoload 'ediff-version "ediff" ! "Show Ediff's version and last modification date." t) ) ; if purify-flag diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-init.el emacs-19.32/lisp/ediff-init.el *** emacs-19.31/lisp/ediff-init.el Fri Feb 16 01:28:47 1996 --- emacs-19.32/lisp/ediff-init.el Fri Jun 21 21:51:49 1996 *************** *** 1,5 **** ;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff ! ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff ! ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 24,31 **** --- 24,48 ---- ;;; Code: + ;; Start compiler pacifier + (defvar ediff-metajob-name) + (defvar ediff-meta-buffer) + (defvar pm-color-alist) + (defvar ediff-grab-mouse) + (defvar ediff-mouse-pixel-position) + (defvar ediff-mouse-pixel-threshold) + (defvar ediff-whitespace) + (defvar ediff-multiframe) + ;; end pacifier + ;; Is it XEmacs? (defconst ediff-xemacs-p (string-match "XEmacs" emacs-version)) ;; Is it Emacs? (defconst ediff-emacs-p (not ediff-xemacs-p)) + + (defvar ediff-force-faces nil + "If t, Ediff will think that it is running on a display that supports faces. + This is provided as a temporary relief for users of face-capable displays + that Ediff doesn't know about.") + ;; Are we running as a window application or on a TTY? (defsubst ediff-device-type () *************** *** 33,36 **** --- 50,54 ---- window-system (device-type (selected-device)))) + ;; in XEmacs: device-type is tty on tty and stream in batch. (defun ediff-window-display-p () *************** *** 46,49 **** --- 64,96 ---- (ediff-xemacs-p (memq (ediff-device-type) '(tty pc))))) + + ;; Defines SYMBOL as an advertised local variable. + ;; Performs a defvar, then executes `make-variable-buffer-local' on + ;; the variable. Also sets the `permanent-local' property, + ;; so that `kill-all-local-variables' (called by major-mode setting + ;; commands) won't destroy Ediff control variables. + ;; + ;; Plagiarised from `emerge-defvar-local' for XEmacs. + (defmacro ediff-defvar-local (var value doc) + (` (progn + (defvar (, var) (, value) (, doc)) + (make-variable-buffer-local '(, var)) + (put '(, var) 'permanent-local t)))) + + + + ;; Variables that control each Ediff session---local to the control buffer. + + ;; Mode variables + ;; The buffer in which the A variant is stored. + (ediff-defvar-local ediff-buffer-A nil "") + ;; The buffer in which the B variant is stored. + (ediff-defvar-local ediff-buffer-B nil "") + ;; The buffer in which the C variant is stored. + (ediff-defvar-local ediff-buffer-C nil "") + ;; Ancestor buffer + (ediff-defvar-local ediff-ancestor-buffer nil "") + ;; The control buffer of ediff. + (ediff-defvar-local ediff-control-buffer nil "") ;;; Macros *************** *** 131,148 **** (ediff-get-difference (, n) (, buf-type))))) - - ;; Defines SYMBOL as an advertised local variable. - ;; Performs a defvar, then executes `make-variable-buffer-local' on - ;; the variable. Also sets the `permanent-local' property, - ;; so that `kill-all-local-variables' (called by major-mode setting - ;; commands) won't destroy Ediff control variables. - ;; - ;; Plagiarised from `emerge-defvar-local' for XEmacs. - (defmacro ediff-defvar-local (var value doc) - (` (progn - (defvar (, var) (, value) (, doc)) - (make-variable-buffer-local '(, var)) - (put '(, var) 'permanent-local t)))) - ;; Macro to switch to BUFFER, evaluate FORMS, returns to original buffer. ;; Differs from `save-excursion' in that it doesn't save the point and mark. --- 178,181 ---- *************** *** 230,236 **** ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor))) ! ;; metajob involving only one directory ! (defsubst ediff-dir1-metajob (&optional metajob) (or (ediff-revision-metajob metajob) ;; add more here )) --- 263,274 ---- ediff-merge-directory-revisions ediff-merge-directory-revisions-with-ancestor))) ! (defsubst ediff-patch-metajob (&optional metajob) ! (memq (or metajob ediff-metajob-name) ! '(ediff-multifile-patch))) ! ;; metajob involving only one group of files, such as multipatch or directory ! ;; revision ! (defsubst ediff-one-filegroup-metajob (&optional metajob) (or (ediff-revision-metajob metajob) + (ediff-patch-metajob metajob) ;; add more here )) *************** the value of this variable and the varia *** 432,436 **** "You have killed a vital Ediff buffer---you must leave Ediff now!") (defconst ediff-NO-DIFFERENCES ! "Sorry, it is not my job to munch identical variants...") ;; Selective browsing --- 470,477 ---- "You have killed a vital Ediff buffer---you must leave Ediff now!") (defconst ediff-NO-DIFFERENCES ! "Sorry, comparison of identical variants is not what I am made for...") ! (defconst ediff-BAD-DIFF-NUMBER ! ;; %S stands for this-command, %d - diff number, %d - max diff ! "%S: Bad diff region number, %d. Valid numbers are 1 to %d") ;; Selective browsing *************** This variable can be set either in .emac *** 512,521 **** Use `setq-default' if setting it in .emacs") - (defvar ediff-force-faces nil - "If t, Ediff will think that it is running on a display that supports faces. - This is provided as a temporary relief for users of face-capable displays - that Ediff doesn't know about.") - - ;; this indicates that diff regions are word-size, so fine diffs are ;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise --- 553,556 ---- *************** ediff-toggle-hilit. Use `setq-default' t *** 561,580 **** (ediff-defvar-local ediff-highlighting-style nil "") - - ;; Variables that control each Ediff session. They are local to the - ;; control buffer. - - ;; Mode variables - ;; The buffer in which the A variant is stored. - (ediff-defvar-local ediff-buffer-A nil "") - ;; The buffer in which the B variant is stored. - (ediff-defvar-local ediff-buffer-B nil "") - ;; The buffer in which the C variant is stored. - (ediff-defvar-local ediff-buffer-C nil "") - ;; Ancestor buffer - (ediff-defvar-local ediff-ancestor-buffer nil "") - ;; The control buffer of ediff. - (ediff-defvar-local ediff-control-buffer nil "") - ;; The suffix of the control buffer name. --- 596,599 ---- *************** appropriate symbol: `rcs', `pcl-cvs', or *** 798,813 **** (face (ediff-overlay-get extent 'face)) (diff-num (ediff-overlay-get extent 'ediff-diff-num)) ! face-help help-msg) ;; This happens only for refinement overlays (setq face-help (and face (get face 'ediff-help-echo))) ! (setq help-msg ! (cond ((and is-current diff-num) ; current diff region ! (format "Difference region %S -- current" (1+ diff-num))) ! (face-help) ; refinement of current diff region ! (diff-num ; non-current ! (format "Difference region %S -- non-current" (1+ diff-num))) ! (t ""))))) ; none (defun ediff-set-face (ground face color) --- 817,832 ---- (face (ediff-overlay-get extent 'face)) (diff-num (ediff-overlay-get extent 'ediff-diff-num)) ! face-help) ;; This happens only for refinement overlays (setq face-help (and face (get face 'ediff-help-echo))) ! (cond ((and is-current diff-num) ; current diff region ! (format "Difference region %S -- current" (1+ diff-num))) ! (face-help) ; refinement of current diff region ! (diff-num ; non-current ! (format "Difference region %S -- non-current" (1+ diff-num))) ! (t "")) ; none ! )) (defun ediff-set-face (ground face color) *************** More precisely, a regexp to match any on *** 1354,1358 **** (if ediff-emacs-p (overlay-buffer overl) ! (and (extent-live-p overl) (extent-buffer overl)))) ;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is --- 1373,1377 ---- (if ediff-emacs-p (overlay-buffer overl) ! (and (extent-live-p overl) (extent-object overl)))) ;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is *************** More precisely, a regexp to match any on *** 1482,1485 **** --- 1501,1517 ---- (if ediff-verbose-p (apply 'message string args))) + + (defun ediff-file-attributes (filename attr-number) + (let ((handler (find-file-name-handler filename 'find-file-noselect))) + (if (and handler (string-match "ange-ftp" (format "%S" handler))) + -1 + (nth attr-number (file-attributes filename))))) + (defsubst ediff-file-size (filename) + (ediff-file-attributes filename 7)) + (defsubst ediff-file-modtime (filename) + (ediff-file-attributes filename 5)) + + + diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-merg.el emacs-19.32/lisp/ediff-merg.el *** emacs-19.31/lisp/ediff-merg.el Fri Feb 16 01:28:50 1996 --- emacs-19.32/lisp/ediff-merg.el Fri Jun 21 21:52:50 1996 *************** *** 1,5 **** ;;; ediff-merg.el --- merging utilities ! ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-merg.el --- merging utilities ! ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 26,29 **** --- 26,30 ---- (require 'ediff-init) + (defvar ediff-default-variant 'combined "*The variant to be used as a default for buffer C in merging. *************** skiped over. Nil means show all regions. *** 115,121 **** (if (< diff-num 0) (setq diff-num 0)) (let ((n diff-num) ! (default-state-of-merge (format "%S" ediff-default-variant)) do-not-copy state-of-merge) (while (< n ediff-number-of-differences) (if (= (mod n 10) 0) (message "%s buffers A & B into C ... region %d of %d" --- 116,123 ---- (if (< diff-num 0) (setq diff-num 0)) (let ((n diff-num) ! ;;(default-state-of-merge (format "%S" ediff-default-variant)) do-not-copy state-of-merge) (while (< n ediff-number-of-differences) + (setq do-not-copy nil) ; reset after each cycle (if (= (mod n 10) 0) (message "%s buffers A & B into C ... region %d of %d" *************** skiped over. Nil means show all regions. *** 131,137 **** (reg-C (ediff-get-region-contents n 'C ediff-control-buffer))) ! ;;; was edited since first set by default (if (or (and (string= state-of-merge "default-A") ! (not (string= reg-A reg-C))) ;; was edited since first set by default (and (string= state-of-merge "default-B") --- 133,139 ---- (reg-C (ediff-get-region-contents n 'C ediff-control-buffer))) ! ;; if region was edited since it was first set by default (if (or (and (string= state-of-merge "default-A") ! (not (string= reg-A reg-C))) ;; was edited since first set by default (and (string= state-of-merge "default-B") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-mult.el emacs-19.32/lisp/ediff-mult.el *** emacs-19.31/lisp/ediff-mult.el Fri Feb 16 01:28:52 1996 --- emacs-19.32/lisp/ediff-mult.el Fri Jun 21 21:54:21 1996 *************** *** 1,5 **** ;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff ! ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 24,30 **** ;;; Commentary: ! ;; Users are strongly encouraged to add functionality to this file. ! ;; In particular, epatch needs to be enhanced to work with multi-file ! ;; patches. The present file contains all the infrastructure needed for that. ;; ;; Generally, to to implement a new multisession capability within Ediff, --- 24,29 ---- ;;; Commentary: ! ;; Users are encouraged to add functionality to this file. ! ;; The present file contains all the infrastructure needed for that. ;; ;; Generally, to to implement a new multisession capability within Ediff, *************** *** 38,51 **** ;; directly or after a small modification. ;; 2. What action to take when the user clicks button 2 or types v,e, or ! ;; RET. See ediff-dir-action. ;; 3. Provide a list of pairs or triples of file names (or buffers, ;; depending on the particular Ediff operation you want to invoke) ;; in the following format: ! ;; ((obj1 obj2 [optional obj3]) (...) ...) ;; Actually, the format of this list is pretty much up to the ! ;; developer. The only thing is that it must be a list of lists. ;; Also, keep in mind that the function ediff-prepare-meta-buffer ! ;; (which see) prepends nil in front of each list (i.e., the above list ! ;; will become ((nil obj1 obj2 ...) (nil ...) ...). ;; Ediff expects that your function (in 2 above) will arrange to ;; replace this prepended nil (via setcar) with the actual ediff --- 37,57 ---- ;; directly or after a small modification. ;; 2. What action to take when the user clicks button 2 or types v,e, or ! ;; RET. See ediff-filegroup-action. ;; 3. Provide a list of pairs or triples of file names (or buffers, ;; depending on the particular Ediff operation you want to invoke) ;; in the following format: ! ;; (descriptor (obj1 obj2 obj3) (...) ...) ;; Actually, the format of this list is pretty much up to the ! ;; developer. The only thing is that it must be a list of lists, ! ;; and the first list must describe the meta session, and subsequent ! ;; elements must describe individual sessions. ! ;; This descriptor must be a list of two, three, or four elements (nil ! ;; or string). The function ediff-redraw-registry-buffer displays the ! ;; second through last of these in the registry buffer. ;; Also, keep in mind that the function ediff-prepare-meta-buffer ! ;; (which see) prepends the session group buffer to the descriptor and ! ;; nil in front of each subsequent list (i.e., the above list ! ;; will become ! ;; ((meta-buf descriptor) (nil obj1 obj2 obj3) (nil ...) ...) ;; Ediff expects that your function (in 2 above) will arrange to ;; replace this prepended nil (via setcar) with the actual ediff *************** *** 53,57 **** ;; This is arranged through internal startup hooks that can be passed ;; to any of Ediff major entries (such as ediff-files, epatch, etc.). ! ;; See how this is done in ediff-dir-action. ;; 4. Write a function that makes a call to ediff-prepare-meta-buffer ;; passing all this info. --- 59,70 ---- ;; This is arranged through internal startup hooks that can be passed ;; to any of Ediff major entries (such as ediff-files, epatch, etc.). ! ;; See how this is done in ediff-filegroup-action. ! ;; ! ;; Session descriptions are of the form (obj1 obj2 obj3), which ! ;; describe objects relevant to the session. Usually they are names of ! ;; files, but sometimes they may be other things. For instance, obj3 is ! ;; nil for jobs that involve only two files. For patch jobs, obj2 and ! ;; obj3 are markers that specify the patch corresponding to the file ! ;; (whose name is obj1). ;; 4. Write a function that makes a call to ediff-prepare-meta-buffer ;; passing all this info. *************** *** 65,75 **** ;; ediff-directories-internal. ;; ! ;; In case of multifile patching, the easiest thing is to first apply the patch ! ;; and then find out which files were patched (using the algorithm utilized by ! ;; Unix patch and by parsing the patch file). The procedure ediff-patch-file ! ;; works for single-file patches only. However, it can deal with remote and ! ;; compressed files. Check out ediff-patch-file for details. ! ;; ! ;; Another useful addition here could be session groups selected by patterns ;; (which are different in each directory). For instance, one may want to ;; compare files of the form abc{something}.c to files old{something}.d --- 78,82 ---- ;; ediff-directories-internal. ;; ! ;; A useful addition here could be session groups selected by patterns ;; (which are different in each directory). For instance, one may want to ;; compare files of the form abc{something}.c to files old{something}.d *************** *** 80,84 **** ;; up appropriate files. It will also require a generalization of the functions ;; that do the layout of the meta- and differences buffers and of ! ;; ediff-dir-action. ;;; Code: --- 87,91 ---- ;; up appropriate files. It will also require a generalization of the functions ;; that do the layout of the meta- and differences buffers and of ! ;; ediff-filegroup-action. ;;; Code: *************** *** 96,104 **** Useful commands: button2, `v', RET over a session line: start that Ediff session ! `M' in any session invoked from here: bring back this buffer `R':\tdisplay the registry of active Ediff sessions ! `h':\tmark session for hiding; with prefix arg--unmark `x':\thide marked sessions; with prefix arg--unhide hidden sessions ! `m':\tmark session for non-hiding operation; with prefix arg--unmark SPC:\tnext session DEL:\tprevious session --- 103,111 ---- Useful commands: button2, `v', RET over a session line: start that Ediff session ! `M':\tin any session invoked from here, brings back this group panel `R':\tdisplay the registry of active Ediff sessions ! `h':\tmark session for hiding (toggle) `x':\thide marked sessions; with prefix arg--unhide hidden sessions ! `m':\tmark session for a non-hiding operation (toggle) SPC:\tnext session DEL:\tprevious session *************** directories.") *** 114,123 **** ;; Variable specifying the action to take when the use invokes ediff in the ! ;; meta buffer. This is usually ediff-registry-action or ediff-dir-action (ediff-defvar-local ediff-meta-action-function nil "") ;; Tells ediff-update-meta-buffer how to redraw it (ediff-defvar-local ediff-meta-redraw-function nil "") ! ;; Tells ediff-dir-action and similar procedures how to invoke Ediff for the ! ;; sessions in a given session group (ediff-defvar-local ediff-session-action-function nil "") --- 121,130 ---- ;; Variable specifying the action to take when the use invokes ediff in the ! ;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action (ediff-defvar-local ediff-meta-action-function nil "") ;; Tells ediff-update-meta-buffer how to redraw it (ediff-defvar-local ediff-meta-redraw-function nil "") ! ;; Tells ediff-filegroup-action and similar procedures how to invoke Ediff for ! ;; the sessions in a given session group (ediff-defvar-local ediff-session-action-function nil "") *************** directories.") *** 131,135 **** ;; This has the form ((ctl-buf file1 file2) (stl-buf file1 file2) ...) ! ;; If ctl-buf is nil, the file-pare wasn't processed yet. If it is ;; killed-buffer object, the file pair has been processed. If it is a live ;; buffer, this means ediff is still working on the pair --- 138,142 ---- ;; This has the form ((ctl-buf file1 file2) (stl-buf file1 file2) ...) ! ;; If ctl-buf is nil, the file-pair wasn't processed yet. If it is ;; killed-buffer object, the file pair has been processed. If it is a live ;; buffer, this means ediff is still working on the pair *************** ediff-directories, is run.") *** 154,163 **** "*Hooks run just after a session group buffer is shown.") ! ;;; API (defun ediff-get-group-buffer (meta-list) (nth 0 (car meta-list))) (defun ediff-get-group-regexp (meta-list) (nth 1 (car meta-list))) (defun ediff-get-group-objA (meta-list) (nth 2 (car meta-list))) --- 161,175 ---- "*Hooks run just after a session group buffer is shown.") ! ;; buffer holding the multi-file patch. local to the meta buffer ! (ediff-defvar-local ediff-meta-patchbufer nil "") ! ! ;;; API for ediff-meta-list + ;; group buffer/regexp (defun ediff-get-group-buffer (meta-list) (nth 0 (car meta-list))) (defun ediff-get-group-regexp (meta-list) (nth 1 (car meta-list))) + ;; group objects (defun ediff-get-group-objA (meta-list) (nth 2 (car meta-list))) *************** ediff-directories, is run.") *** 166,173 **** --- 178,189 ---- (defun ediff-get-group-objC (meta-list) (nth 4 (car meta-list))) + ;; session buffer (defun ediff-get-session-buffer (elt) (nth 0 elt)) (defun ediff-get-session-status (elt) (nth 1 elt)) + (defun ediff-set-session-status (session-info new-status) + (setcar (cdr session-info) new-status)) + ;; session objects (defun ediff-get-session-objA (elt) (nth 2 elt)) *************** ediff-directories, is run.") *** 176,181 **** (defun ediff-get-session-objC (elt) (nth 4 elt)) ! (defun ediff-set-session-status (session-info new-status) ! (setcar (cdr session-info) new-status)) ;; set up the keymap in the meta buffer --- 192,206 ---- (defun ediff-get-session-objC (elt) (nth 4 elt)) ! (defun ediff-get-session-objA-name (elt) ! (car (nth 2 elt))) ! (defun ediff-get-session-objB-name (elt) ! (car (nth 3 elt))) ! (defun ediff-get-session-objC-name (elt) ! (car (nth 4 elt))) ! ;; equality indicators ! (defsubst ediff-get-file-eqstatus (elt) ! (nth 1 elt)) ! (defsubst ediff-set-file-eqstatus (elt value) ! (setcar (cdr elt) value)) ;; set up the keymap in the meta buffer *************** ediff-directories, is run.") *** 192,195 **** --- 217,222 ---- (define-key ediff-meta-buffer-map [delete] 'ediff-previous-meta-item) (define-key ediff-meta-buffer-map [backspace] 'ediff-previous-meta-item) + (or (ediff-one-filegroup-metajob) + (define-key ediff-meta-buffer-map "=" 'ediff-meta-mark-equal-files)) (if ediff-no-emacs-help-in-control-buffer (define-key ediff-meta-buffer-map "\C-h" 'ediff-previous-meta-item)) *************** Moves in circular fashion. With numeric *** 254,258 **** (if pos (goto-char pos)) (if (eq ediff-metajob-name 'ediff-registry) ! (if (search-forward "*Ediff" nil t) (skip-chars-backward "a-zA-Z*")) (if (> (skip-chars-forward "-+?H* \t0-9") 0) --- 281,286 ---- (if pos (goto-char pos)) (if (eq ediff-metajob-name 'ediff-registry) ! (if (and (ediff-get-meta-info (current-buffer) pos 'noerror) ! (search-forward "*Ediff" nil t)) (skip-chars-backward "a-zA-Z*")) (if (> (skip-chars-forward "-+?H* \t0-9") 0) *************** Moves in circular fashion. With numeric *** 279,286 **** (if pos (goto-char pos)) (if (eq ediff-metajob-name 'ediff-registry) ! (if (search-forward "*Ediff" nil t) (skip-chars-backward "a-zA-Z*")) (if (> (skip-chars-forward "-+?H* \t0-9") 0) ! (backward-char 1))))) --- 307,316 ---- (if pos (goto-char pos)) (if (eq ediff-metajob-name 'ediff-registry) ! (if (and (ediff-get-meta-info (current-buffer) pos 'noerror) ! (search-forward "*Ediff" nil t)) (skip-chars-backward "a-zA-Z*")) (if (> (skip-chars-forward "-+?H* \t0-9") 0) ! (backward-char 1))) ! )) *************** Moves in circular fashion. With numeric *** 471,483 **** ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry)) ;; initialize the meta list -- don't do this for registry we prepend ! ;; '(nil nil) nil to all elts of meta-list, except the first. The ;; first nil will later be replaced by the session buffer. The second ;; is reserved for session status. ;; (car ediff-meta-list) gets cons'ed with the session group buffer. (setq ediff-meta-list (cons (cons meta-buffer (car meta-list)) (mapcar (function (lambda (elt) ! (cons nil (cons nil elt)))) (cdr meta-list))))) --- 501,524 ---- ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry)) ;; initialize the meta list -- don't do this for registry we prepend ! ;; '(nil nil) to all elts of meta-list, except the first. The ;; first nil will later be replaced by the session buffer. The second ;; is reserved for session status. ;; (car ediff-meta-list) gets cons'ed with the session group buffer. + ;; Also, session objA/B/C are turned into lists (obj eq-indicator) + ;; For now, the eq-indicator is used only for 2 and 3-file jobs. (setq ediff-meta-list (cons (cons meta-buffer (car meta-list)) (mapcar (function (lambda (elt) ! (cons nil ! (cons nil ! ;; convert each obj to (obj nil), ! ;; where nil may later be replaced ! ;; by =, if this file equals some ! ;; other file in the same session ! (mapcar (function ! (lambda (obj) ! (list obj nil))) ! elt))))) (cdr meta-list))))) *************** Moves in circular fashion. With numeric *** 497,501 **** ;; must be after run startup-hooks, since ediff-dir-difference-list is ;; set inside these hooks ! (if (eq action-func 'ediff-dir-action) (progn ;; put meta buffer in (car ediff-dir-difference-list) --- 538,542 ---- ;; must be after run startup-hooks, since ediff-dir-difference-list is ;; set inside these hooks ! (if (eq action-func 'ediff-filegroup-action) (progn ;; put meta buffer in (car ediff-dir-difference-list) *************** Moves in circular fashion. With numeric *** 504,508 **** (cdr ediff-dir-difference-list))) ! (or (ediff-dir1-metajob jobname) (ediff-draw-dir-diffs ediff-dir-difference-list)) (define-key ediff-meta-buffer-map "h" 'ediff-mark-for-hiding) --- 545,549 ---- (cdr ediff-dir-difference-list))) ! (or (ediff-one-filegroup-metajob jobname) (ediff-draw-dir-diffs ediff-dir-difference-list)) (define-key ediff-meta-buffer-map "h" 'ediff-mark-for-hiding) *************** Moves in circular fashion. With numeric *** 510,516 **** ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions) (define-key ediff-meta-buffer-map "m" 'ediff-mark-for-operation) ! (if (ediff-collect-diffs-metajob jobname) ! (define-key ! ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs)) (define-key ediff-meta-buffer-map "u" 'ediff-up-meta-hierarchy) (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs))) --- 551,560 ---- ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions) (define-key ediff-meta-buffer-map "m" 'ediff-mark-for-operation) ! (cond ((ediff-collect-diffs-metajob jobname) ! (define-key ! ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs)) ! ((ediff-patch-metajob jobname) ! (define-key ! ediff-meta-buffer-map "P" 'ediff-meta-show-patch))) (define-key ediff-meta-buffer-map "u" 'ediff-up-meta-hierarchy) (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs))) *************** Moves in circular fashion. With numeric *** 540,549 **** (setq regexp (ediff-get-group-regexp meta-list)) ! (if (ediff-collect-diffs-metajob) ! (insert ! " `P':\tcollect custom diffs of all marked sessions\n")) (insert ! " `u':\tshow parent session group ! `D':\tdisplay differences among the contents of directories\n\n") (if (and (stringp regexp) (> (length regexp) 0)) --- 584,599 ---- (setq regexp (ediff-get-group-regexp meta-list)) ! (cond ((ediff-collect-diffs-metajob) ! (insert ! " `P':\tcollect custom diffs of all marked sessions\n")) ! ((ediff-patch-metajob) ! (insert ! " `P':\tshow patch appropriately for the context (session or group)\n"))) (insert ! " `u':\tshow parent session group\n") ! (or (ediff-one-filegroup-metajob) ! (insert ! " `D':\tshow differences among directories\n" ! " `=':\tmark identical files in each session\n\n")) (if (and (stringp regexp) (> (length regexp) 0)) *************** Moves in circular fashion. With numeric *** 551,555 **** (insert "\n ! Size Name ----------------------------------------------------------------------- --- 601,605 ---- (insert "\n ! Size Last modified Name ----------------------------------------------------------------------- *************** Moves in circular fashion. With numeric *** 570,579 **** ;; now organize file names like this: - ;; preferred format: ;; use-mark sizeA dateA sizeB dateB filename - ;; I don't have time to mess up with calculating last modtimes - ;; (XEmacs has no decode-time function), so - ;; the actual format is: - ;; use-mark Size filename ;; make sure directories are displayed with a trailing slash. ;; If one is a directory and another isn't, indicate this with a `?' --- 620,624 ---- *************** Moves in circular fashion. With numeric *** 610,616 **** ;; when the ancestor is a directory rather than a file. (defun ediff-problematic-session-p (session) ! (let ((f1 (ediff-get-session-objA session)) ! (f2 (ediff-get-session-objB session)) ! (f3 (ediff-get-session-objC session))) (cond ((and (stringp f1) (not (file-directory-p f1)) (stringp f2) (not (file-directory-p f2)) --- 655,661 ---- ;; when the ancestor is a directory rather than a file. (defun ediff-problematic-session-p (session) ! (let ((f1 (ediff-get-session-objA-name session)) ! (f2 (ediff-get-session-objB-name session)) ! (f3 (ediff-get-session-objC-name session))) (cond ((and (stringp f1) (not (file-directory-p f1)) (stringp f2) (not (file-directory-p f2)) *************** Moves in circular fashion. With numeric *** 621,637 **** (t nil)))) ! (defun ediff-meta-insert-file-info (file) ! (if (stringp file) ! (insert ! (format ! " %10d %s\n" ! (nth 7 (file-attributes file)) ! ;; dir names in meta lists have no trailing `/' so insert it ! (cond ((file-directory-p file) ! (file-name-as-directory (ediff-abbreviate-file-name file))) ! (t (ediff-abbreviate-file-name file))))) ! )) ! (defun ediff-draw-dir-diffs (diff-list) --- 666,716 ---- (t nil)))) ! (defun ediff-meta-insert-file-info (fileinfo) ! (let ((file-size -1) ! (fname (car fileinfo)) ! (feq (ediff-get-file-eqstatus fileinfo)) ! (file-modtime "*file doesn't exist*")) ! ! (if (and (stringp fname) (file-exists-p fname)) ! (setq file-size (ediff-file-size fname) ! file-modtime (ediff-file-modtime fname))) ! (if (stringp fname) ! (insert ! (format ! "%s %s %-20s %s\n" ! (if feq "=" " ") ; equality indicator ! (format "%10s" (if (< file-size 0) ! "remote" ! file-size)) ! (if (< file-size 0) ! "file" ! (ediff-format-date (decode-time file-modtime))) ! ;; dir names in meta lists have no trailing `/' so insert it ! (cond ((file-directory-p fname) ! (file-name-as-directory (ediff-abbreviate-file-name fname))) ! (t (ediff-abbreviate-file-name fname))))) ! ))) + (defconst ediff-months '((1 . "Jan") (2 . "Feb") (3 . "Mar") (4 . "Apr") + (5 . "May") (6 . "Jun") (7 . "Jul") (8 . "Aug") + (9 . "Sep") (10 . "Oct") (11 . "Nov") (12 . "Dec")) + "Months' associative array.") + + ;; TIME is like the output of decode-time + (defun ediff-format-date (time) + (format "%s %2d %4d %s:%s:%s" + (cdr (assoc (nth 4 time) ediff-months)) ; month + (nth 3 time) ; day + (nth 5 time) ; year + (ediff-fill-leading-zero (nth 2 time)) ; hour + (ediff-fill-leading-zero (nth 1 time)) ; min + (ediff-fill-leading-zero (nth 0 time)) ; sec + )) + + ;; returns 2char string + (defsubst ediff-fill-leading-zero (num) + (if (< num 10) + (format "0%d" num) + (number-to-string num))) (defun ediff-draw-dir-diffs (diff-list) *************** Useful commands: *** 741,745 **** "Display differences among the directories involved in session group." (interactive) ! (if (ediff-dir1-metajob) (error "This command is inapplicable in the present context")) (or (ediff-buffer-live-p ediff-dir-diffs-buffer) --- 820,824 ---- "Display differences among the directories involved in session group." (interactive) ! (if (ediff-one-filegroup-metajob) (error "This command is inapplicable in the present context")) (or (ediff-buffer-live-p ediff-dir-diffs-buffer) *************** Useful commands: *** 811,817 **** (ediff-get-group-objA meta-list)) (ediff-abbreviate-file-name ! (or (ediff-get-group-objB meta-list) "")) (ediff-abbreviate-file-name ! (or (ediff-get-group-objC meta-list) "")))) (ediff-set-meta-overlay pt (point) elt)) (progn --- 890,902 ---- (ediff-get-group-objA meta-list)) (ediff-abbreviate-file-name ! (if (stringp ! (ediff-get-group-objB meta-list)) ! (ediff-get-group-objB meta-list) ! "")) (ediff-abbreviate-file-name ! (if (stringp ! (ediff-get-group-objC meta-list)) ! (ediff-get-group-objC meta-list) ! "")))) (ediff-set-meta-overlay pt (point) elt)) (progn *************** Useful commands: *** 868,871 **** --- 953,958 ---- (session-buf (ediff-get-session-buffer info))) + (if (eq (ediff-get-session-status info) ?H) + (setq unmark t)) (if unmark (ediff-set-session-status info nil) *************** Useful commands: *** 873,876 **** --- 960,965 ---- (error "Can't hide active session, %s" (buffer-name session-buf))) (ediff-set-session-status info ?H)) + (or unmark + (ediff-next-meta-item 1)) (ediff-update-meta-buffer meta-buf) )) *************** Useful commands: *** 884,890 **** --- 973,983 ---- (info (ediff-get-meta-info meta-buf pos))) + (if (eq (ediff-get-session-status info) ?*) + (setq unmark t)) (if unmark (ediff-set-session-status info nil) (ediff-set-session-status info ?*)) + (or unmark + (ediff-next-meta-item 1)) (ediff-update-meta-buffer meta-buf) )) *************** Useful commands: *** 898,909 **** (to (if unhide ?H ?I)) (numMarked 0) ! elt) (while meta-list (setq elt (car meta-list) ! meta-list (cdr meta-list)) (if (eq (ediff-get-session-status elt) from) (progn (setq numMarked (1+ numMarked)) ! (ediff-set-session-status elt to)))) (if (> numMarked 0) (ediff-update-meta-buffer grp-buf) --- 991,1007 ---- (to (if unhide ?H ?I)) (numMarked 0) ! active-sessions-exist session-buf elt) (while meta-list (setq elt (car meta-list) ! meta-list (cdr meta-list) ! session-buf (ediff-get-session-buffer elt)) ! (if (eq (ediff-get-session-status elt) from) (progn (setq numMarked (1+ numMarked)) ! (if (and (eq to ?I) (buffer-live-p session-buf)) ! ;; shouldn't hide active sessions ! (setq active-sessions-exist t) ! (ediff-set-session-status elt to))))) (if (> numMarked 0) (ediff-update-meta-buffer grp-buf) *************** Useful commands: *** 912,915 **** --- 1010,1015 ---- (message "Nothing to reveal...") (message "Nothing to hide..."))) + (if active-sessions-exist + (message "Note: didn't hide active sessions!")) )) *************** Useful commands: *** 969,974 **** (format "%s %s %s %s" ediff-custom-diff-program ediff-custom-diff-options ! (ediff-get-session-objA session) ! (ediff-get-session-objB session)) t)) (save-excursion --- 1069,1074 ---- (format "%s %s %s %s" ediff-custom-diff-program ediff-custom-diff-options ! (ediff-get-session-objA-name session) ! (ediff-get-session-objB-name session)) t)) (save-excursion *************** all marked sessions must be active." *** 1000,1006 **** (message "No marked sessions found"))) ;; This function executes in meta buffer. It knows where event happened. ! (defun ediff-dir-action () "Execute appropriate action for the selected session." (interactive) --- 1100,1128 ---- (message "No marked sessions found"))) + (defun ediff-meta-show-patch () + "Show the multi-file patch associated with this group session." + (interactive) + (let* ((pos (ediff-event-point last-command-event)) + (meta-buf (ediff-event-buffer last-command-event)) + (info (ediff-get-meta-info meta-buf pos 'noerror)) + (patchbuffer ediff-meta-patchbufer)) + (if (ediff-buffer-live-p patchbuffer) + (ediff-eval-in-buffer patchbuffer + (save-restriction + (if (not info) + (widen) + (narrow-to-region + (ediff-get-session-objB-name info) + (ediff-get-session-objC-name info))) + (set-buffer (get-buffer-create ediff-tmp-buffer)) + (erase-buffer) + (insert-buffer patchbuffer) + (display-buffer ediff-tmp-buffer 'not-this-window) + )) + (error "The patch buffer wasn't found")))) + ;; This function executes in meta buffer. It knows where event happened. ! (defun ediff-filegroup-action () "Execute appropriate action for the selected session." (interactive) *************** all marked sessions must be active." *** 1012,1022 **** (setq session-buf (ediff-get-session-buffer info) ! file1 (ediff-get-session-objA info) ! file2 (ediff-get-session-objB info) ! file3 (ediff-get-session-objC info)) ;; make sure we don't start on hidden sessions ;; ?H means marked for hiding. ?I means invalid (hidden). ! (if (memq (ediff-get-session-status info) '(?H ?I)) (progn (beep) --- 1134,1144 ---- (setq session-buf (ediff-get-session-buffer info) ! file1 (ediff-get-session-objA-name info) ! file2 (ediff-get-session-objB-name info) ! file3 (ediff-get-session-objC-name info)) ;; make sure we don't start on hidden sessions ;; ?H means marked for hiding. ?I means invalid (hidden). ! (if (memq (ediff-get-session-status info) '(?I)) (progn (beep) *************** all marked sessions must be active." *** 1053,1057 **** ;; Do ediff-revision on a subdirectory ! ((and (ediff-dir1-metajob) (file-directory-p file1)) (if (ediff-buffer-live-p session-buf) (ediff-show-meta-buffer session-buf) --- 1175,1181 ---- ;; Do ediff-revision on a subdirectory ! ((and (ediff-one-filegroup-metajob) ! (ediff-revision-metajob) ! (file-directory-p file1)) (if (ediff-buffer-live-p session-buf) (ediff-show-meta-buffer session-buf) *************** all marked sessions must be active." *** 1071,1075 **** ;; From here on---only individual session handlers ! ;; handle an individual session with live control buffer ((ediff-buffer-live-p session-buf) (ediff-eval-in-buffer session-buf --- 1195,1199 ---- ;; From here on---only individual session handlers ! ;; handle an individual session with a live control buffer ((ediff-buffer-live-p session-buf) (ediff-eval-in-buffer session-buf *************** all marked sessions must be active." *** 1083,1087 **** (ediff-merge-files file1 file2 ! ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) --- 1207,1211 ---- (ediff-merge-files file1 file2 ! ;; provide startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) *************** all marked sessions must be active." *** 1090,1097 **** (quote (, info)) ediff-control-buffer))))) (error "Aborted"))) ! ((ediff-dir1-metajob) ; needs 1 file arg (funcall ediff-session-action-function file1 ! ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) --- 1214,1221 ---- (quote (, info)) ediff-control-buffer))))) (error "Aborted"))) ! ((ediff-one-filegroup-metajob) ; needs 1 file arg (funcall ediff-session-action-function file1 ! ;; provide startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) *************** all marked sessions must be active." *** 1102,1106 **** (funcall ediff-session-action-function file1 file2 ! ;; arrange startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) --- 1226,1230 ---- (funcall ediff-session-action-function file1 file2 ! ;; provide startup hooks (` (list (lambda () (setq ediff-meta-buffer (, (current-buffer))) *************** If this is a session registry buffer the *** 1322,1333 **** (cond ((and (ediff-safe-to-quit buf) (y-or-n-p "Quit this session group? ")) (ediff-dispose-of-meta-buffer buf)) ((ediff-safe-to-quit buf) (bury-buffer)) (t ! (bury-buffer) ! (beep) ! (message ! "Session group suspended, not deleted (has active sessions)"))) (ediff-cleanup-meta-buffer parent-buf) (ediff-kill-buffer-carefully dir-diffs-buffer) --- 1446,1456 ---- (cond ((and (ediff-safe-to-quit buf) (y-or-n-p "Quit this session group? ")) + (message "") (ediff-dispose-of-meta-buffer buf)) ((ediff-safe-to-quit buf) (bury-buffer)) (t ! (error ! "This session group has active sessions---cannot exit"))) (ediff-cleanup-meta-buffer parent-buf) (ediff-kill-buffer-carefully dir-diffs-buffer) *************** If this is a session registry buffer the *** 1379,1416 **** ;; return location of the next meta overlay after point (defun ediff-next-meta-overlay-start (point) ! (let (overl) ! (if ediff-xemacs-p ! (progn ! (setq overl (extent-at point (current-buffer) 'ediff-meta-info)) ! (if overl ! (setq overl (next-extent overl)) ! (setq overl (next-extent (current-buffer)))) ! (if overl ! (extent-start-position overl) ! (point-max))) ! (if (= point (point-max)) (setq point (point-min))) ! (setq overl (car (overlays-at point))) ! (if (and overl (overlay-get overl 'ediff-meta-info)) ! (overlay-end overl) ! (next-overlay-change point))))) (defun ediff-previous-meta-overlay-start (point) ! (let (overl) ! (if ediff-xemacs-p ! (progn ! (setq overl (extent-at point (current-buffer) 'ediff-meta-info)) ! (if overl ! (setq overl (previous-extent overl)) ! (setq overl (previous-extent (current-buffer)))) ! (if overl ! (extent-start-position overl) ! (point-max))) ! ;;(if (bobp) (setq point (point-max))) ! (setq overl (car (overlays-at point))) ! (setq point (if (and overl (overlay-get overl 'ediff-meta-info)) ! (previous-overlay-change (overlay-start overl)) ! (previous-overlay-change point))) ! (if (= point (point-min)) (point-max) point) ! ))) --- 1502,1616 ---- ;; return location of the next meta overlay after point (defun ediff-next-meta-overlay-start (point) ! (if (eobp) ! (goto-char (point-min)) ! (let (overl) ! (if ediff-xemacs-p ! (progn ! (setq overl (extent-at point (current-buffer) 'ediff-meta-info)) ! (if overl ! (setq overl (next-extent overl)) ! (setq overl (next-extent (current-buffer)))) ! (if overl ! (extent-start-position overl) ! (point-max))) ! (setq overl (car (overlays-at point))) ! (if (and overl (overlay-get overl 'ediff-meta-info)) ! ;; note: end of current overlay is the beginning of the next one ! (overlay-end overl) ! (next-overlay-change point)))) ! )) (defun ediff-previous-meta-overlay-start (point) ! (if (bobp) ! (goto-char (point-max)) ! (let (overl) ! (if ediff-xemacs-p ! (progn ! (setq overl (extent-at point (current-buffer) 'ediff-meta-info)) ! (if overl ! (setq overl (previous-extent overl)) ! (setq overl (previous-extent (current-buffer)))) ! (if overl ! (extent-start-position overl) ! (point-min))) ! (setq overl (car (overlays-at point))) ! (if (and overl (overlay-get overl 'ediff-meta-info)) ! (setq point (overlay-start overl))) ! ;; to get to the beginning of prev overlay ! (if (not (bobp)) ! ;; trickery to overcome an emacs bug--doesn't always find previous ! ;; overlay change correctly ! (setq point (1- point))) ! (setq point (previous-overlay-change point)) ! ;; If we are not over an overlay after subtracting 1, it means we are ! ;; in the description area preceding session records. In this case, ! ;; goto the top of the registry buffer. ! (or (car (overlays-at point)) ! (setq point (point-min))) ! point ! )))) ! ! ;; this is the action invoked when the user selects a patch from the meta ! ;; buffer. ! (defun ediff-patch-file-form-meta (file &optional startup-hooks) ! (let* ((pos (ediff-event-point last-command-event)) ! (meta-buf (ediff-event-buffer last-command-event)) ! ;; ediff-get-meta-info gives error if meta-buf or pos are invalid ! (info (ediff-get-meta-info meta-buf pos)) ! (meta-patchbuf ediff-meta-patchbufer) ! session-buf beg-marker end-marker) ! ! (if (or (file-directory-p file) (string-match "/dev/null" file)) ! (error "`%s' is not an ordinary file" (file-name-as-directory file))) ! (setq session-buf (ediff-get-session-buffer info) ! beg-marker (ediff-get-session-objB-name info) ! end-marker (ediff-get-session-objC-name info)) ! ! (or (ediff-buffer-live-p session-buf) ; either an active patch session ! (null session-buf) ; or it is a virgin session ! (error ! "Patch has been already applied to this file--cannot be repeated!")) ! ! (ediff-eval-in-buffer meta-patchbuf ! (save-restriction ! (widen) ! (narrow-to-region beg-marker end-marker) ! (ediff-patch-file-internal meta-patchbuf file startup-hooks))))) ! ! ! (defun ediff-meta-mark-equal-files () ! "Run though the session list and mark identical files. ! This is used only for sessions that involve 2 or 3 files at the same time." ! (interactive) ! (let ((list (cdr ediff-meta-list)) ! fileinfo1 fileinfo2 fileinfo3 elt) ! (while (setq elt (car list)) ! (setq fileinfo1 (ediff-get-session-objA elt) ! fileinfo2 (ediff-get-session-objB elt) ! fileinfo3 (ediff-get-session-objC elt)) ! (ediff-set-file-eqstatus fileinfo1 nil) ! (ediff-set-file-eqstatus fileinfo2 nil) ! (ediff-set-file-eqstatus fileinfo3 nil) ! ! (ediff-mark-if-equal fileinfo1 fileinfo2) ! (if (ediff-metajob3) ! (progn ! (ediff-mark-if-equal fileinfo1 fileinfo3) ! (ediff-mark-if-equal fileinfo2 fileinfo3))) ! (setq list (cdr list)))) ! (ediff-update-meta-buffer (current-buffer))) ! ! ;; mark files 1 and 2 as equal, if they are. ! (defun ediff-mark-if-equal (fileinfo1 fileinfo2) ! (get-buffer-create ediff-tmp-buffer) ! (or (file-directory-p (car fileinfo1)) ! (file-directory-p (car fileinfo2)) ! (if (= (ediff-make-diff2-buffer ! ediff-tmp-buffer (car fileinfo1) (car fileinfo2)) ! 0) ! (progn ! (ediff-set-file-eqstatus fileinfo1 t) ! (ediff-set-file-eqstatus fileinfo2 t))))) ! diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-ptch.el emacs-19.32/lisp/ediff-ptch.el *** emacs-19.31/lisp/ediff-ptch.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/ediff-ptch.el Fri Jun 21 21:44:35 1996 *************** *** 0 **** --- 1,562 ---- + ;;; ediff-ptch.el --- Ediff's patch support + + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Michael Kifer + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + + ;;; Code: + + (defvar ediff-last-dir-patch nil + "Last directory used by an Ediff command for file to patch.") + + (defvar ediff-backup-extension + (if (memq system-type '(vax-vms axp-vms emx ms-dos windows-nt windows-95)) + "_orig" ".orig") + "Default backup extension for the patch program.") + + (defvar ediff-patch-default-directory nil + "*Default directory to look for patches.") + + (defvar ediff-context-diff-label-regexp + (concat "\\(" ; context diff 2-liner + "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)" + "\\|" ; GNU unified format diff 2-liner + "^--- \\([^ \t]+\\)[^-]+[\t ]*\n\\+\\+\\+ \\([^ \t]+\\)" + "\\)") + "*Regexp matching filename 2-liners at the start of each context diff.") + + (defvar ediff-patch-program "patch" + "*Name of the program that applies patches.") + (defvar ediff-patch-options "" + "*Options to pass to ediff-patch-program.") + + ;; The buffer of the patch file. Local to control buffer. + (ediff-defvar-local ediff-patchbufer nil "") + + ;; The buffer where patch displays its diagnostics. + (ediff-defvar-local ediff-patch-diagnostics nil "") + + ;; Map of patch buffer. Has the form: + ;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...) + ;; where filenames are files to which patch would have applied the patch; + ;; marker1 delimits the beginning of the corresponding patch and marker2 does + ;; it for the end. + (ediff-defvar-local ediff-patch-map nil "") + + ;; strip prefix from filename + ;; returns /dev/null, if can't strip prefix + (defsubst ediff-file-name-sans-prefix (filename prefix) + (save-match-data + (if (string-match (concat "^" prefix) filename) + (substring filename (match-end 0)) + (concat "/null/" filename)))) + + + + ;; no longer used + ;; return the number of matches of regexp in buf starting from the beginning + (defun ediff-count-matches (regexp buf) + (ediff-eval-in-buffer buf + (let ((count 0) opoint) + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (progn (setq opoint (point)) + (re-search-forward regexp nil t))) + (if (= opoint (point)) + (forward-char 1) + (setq count (1+ count))))) + count))) + + ;; Scan BUF (which is supposed to contain a patch) and make a list of the form + ;; ((filename1 marker1 marker2) (filename2 marker1 marker2) ...) + ;; where filenames are files to which patch would have applied the patch; + ;; marker1 delimits the beginning of the corresponding patch and marker2 does + ;; it for the end. This list is then assigned to ediff-patch-map. + ;; Returns the number of elements in the list ediff-patch-map + (defun ediff-map-patch-buffer (buf) + (ediff-eval-in-buffer buf + (let ((count 0) + (mark1 (move-marker (make-marker) (point-min))) + (mark1-end (point-min)) + (possible-file-names '("/dev/null" . "/dev/null")) + mark2-end mark2 filenames + beg1 beg2 end1 end2 + patch-map opoint) + (save-excursion + (goto-char (point-min)) + (setq opoint (point)) + (while (and (not (eobp)) + (re-search-forward ediff-context-diff-label-regexp nil t)) + (if (= opoint (point)) + (forward-char 1) ; ensure progress towards the end + (setq mark2 (move-marker (make-marker) (match-beginning 0)) + mark2-end (match-end 0) + beg1 (match-beginning 2) + end1 (match-end 2) + beg2 (match-beginning 3) + end2 (match-end 3)) + ;; possible-file-names is holding the new file names until we + ;; insert the old file name in the patch map + ;; It is a pair (filename from 1st header line . fn from 2nd line) + (setq possible-file-names + (cons (if (and beg1 end1) + (buffer-substring beg1 end1) + "/dev/null") + (if (and beg2 end2) + (buffer-substring beg2 end2) + "/dev/null"))) + ;; check for any `Index:' or `Prereq:' lines, but don't use them + (if (re-search-backward "^Index:" mark1-end 'noerror) + (move-marker mark2 (match-beginning 0))) + (if (re-search-backward "^Prereq:" mark1-end 'noerror) + (move-marker mark2 (match-beginning 0))) + + (goto-char mark2-end) + + (if filenames + (setq patch-map (cons (list filenames mark1 mark2) patch-map))) + (setq mark1 mark2 + mark1-end mark2-end + filenames possible-file-names)) + (setq opoint (point) + count (1+ count)))) + (setq mark2 (point-max-marker) + patch-map (cons (list possible-file-names mark1 mark2) patch-map)) + (setq ediff-patch-map (nreverse patch-map)) + count))) + + ;; Fix up the file names in the list using the argument FILENAME + ;; Algorithm: find the first file's directory and cut it out from each file + ;; name in the patch. Prepend the directory of FILENAME to each file in the + ;; patch. In addition, the first file in the patch is replaced by FILENAME. + ;; Each file is actually a file-pair of files found in the context diff header + ;; In the end, for each pair, we select the shortest existing file. + ;; Note: Ediff doesn't recognize multi-file patches that are separated + ;; with the `Index:' line. It treats them as a single-file patch. + ;; + ;; Executes inside the patch buffer + (defun ediff-fixup-patch-map (filename) + (setq filename (expand-file-name filename)) + (let ((actual-dir (if (file-directory-p filename) + ;; directory part of filename + (file-name-as-directory filename) + (file-name-directory filename))) + ;; directory part of the first file in the patch + (base-dir1 (file-name-directory (car (car (car ediff-patch-map))))) + (base-dir2 (file-name-directory (cdr (car (car ediff-patch-map))))) + ) + + ;; chop off base-dirs + (mapcar (function (lambda (triple) + (or (string= (car (car triple)) "/dev/null") + (setcar (car triple) + (ediff-file-name-sans-prefix + (car (car triple)) base-dir1))) + (or (string= (cdr (car triple)) "/dev/null") + (setcdr (car triple) + (ediff-file-name-sans-prefix + (cdr (car triple)) base-dir2))) + )) + ediff-patch-map) + + ;; take the given file name into account + (or (file-directory-p filename) + (string= "/dev/null" filename) + (progn + (setcar (car ediff-patch-map) + (cons (file-name-nondirectory filename) + (file-name-nondirectory filename))))) + + ;; prepend actual-dir + (mapcar (function (lambda (triple) + (if (and (string-match "^/null/" (car (car triple))) + (string-match "^/null/" (cdr (car triple)))) + ;; couldn't strip base-dir1 and base-dir2 + ;; hence, something wrong + (progn + (with-output-to-temp-buffer ediff-msg-buffer + (princ + (format " + The patch file contains a context diff for + %s + %s + + However, Ediff cannot infer the name of the actual file + to be patched on your system. If you know the correct file name, + please enter it now. + + If you don't know and still would like to apply patches to + other files, enter /dev/null + " + (substring (car (car triple)) 6) + (substring (cdr (car triple)) 6)))) + (let ((directory t) + user-file) + (while directory + (setq user-file + (read-file-name + "Please enter file name: " + actual-dir actual-dir t)) + (if (not (file-directory-p user-file)) + (setq directory nil) + (setq directory t) + (beep) + (message "%s is a directory" user-file) + (sit-for 2))) + (setcar triple (cons user-file user-file)))) + (setcar (car triple) + (expand-file-name + (concat actual-dir (car (car triple))))) + (setcdr (car triple) + (expand-file-name + (concat actual-dir (cdr (car triple)))))) + )) + ediff-patch-map) + ;; check for the shorter existing file in each pair and discard the other + ;; one + (mapcar (function (lambda (triple) + (let* ((file1 (car (car triple))) + (file2 (cdr (car triple))) + (f1-exists (file-exists-p file1)) + (f2-exists (file-exists-p file2))) + (cond + ((and (< (length file2) (length file1)) + f2-exists) + (setcar triple file2)) + ((and (< (length file1) (length file2)) + f1-exists) + (setcar triple file1)) + ((and f1-exists f2-exists + (string= file1 file2)) + (setcar triple file1)) + ((and f1-exists f2-exists) + (with-output-to-temp-buffer ediff-msg-buffer + (princ (format " + Ediff has inferred that + %s + %s + are possible targets for applying the patch. + Both files seem to be plausible alternatives. + + Please advice: + Type `y' to use %s as the target; + Type `n' to use %s as the target. + " + file1 file2 file2 file1))) + (setcar triple + (if (y-or-n-p (format "Use %s ? " file2)) + file2 file1))) + (f2-exists (setcar triple file2)) + (f1-exists (setcar triple file1)) + (t + (with-output-to-temp-buffer ediff-msg-buffer + (princ (format " + Ediff inferred that + %s + %s + are possible alternative targets for this patch. + + However, these files do not exist. + + Please enter an alternative patch target ... + " + file1 file2))) + (let ((directory t) + target) + (while directory + (setq target (read-file-name + "Please enter a patch target: " + actual-dir actual-dir t)) + (if (not (file-directory-p target)) + (setq directory nil) + (beep) + (message "%s is a directory" target) + (sit-for 2))) + (setcar triple target))))))) + ediff-patch-map) + )) + + (defun ediff-show-patch-diagnostics () + (interactive) + (cond ((window-live-p ediff-window-A) + (set-window-buffer ediff-window-A ediff-patch-diagnostics)) + ((window-live-p ediff-window-B) + (set-window-buffer ediff-window-B ediff-patch-diagnostics)) + (t (display-buffer ediff-patch-diagnostics 'not-this-window)))) + + (defun ediff-get-patch-buffer () + "Obtain patch buffer. If patch is already in a buffer---use it. + Else, read patch file into a new buffer." + (let ((dir (cond (ediff-patch-default-directory) ; try patch default dir + (ediff-use-last-dir ediff-last-dir-patch) + (t default-directory))) + patch-buf) + (if (y-or-n-p "Is the patch already in a buffer? ") + (setq patch-buf + (get-buffer + (read-buffer + "Which buffer contains the patch? " + (current-buffer) 'must-match))) + (setq patch-buf + (find-file-noselect + (read-file-name "Which file contains the patch? " dir)))) + + (ediff-eval-in-buffer patch-buf + (goto-char (point-min)) + (or (ediff-get-visible-buffer-window patch-buf) + (progn + (pop-to-buffer patch-buf 'other-window) + (select-window (previous-window))))) + (ediff-map-patch-buffer patch-buf) + patch-buf)) + + ;; Dispatch the right patch file function: regular or meta-level, + ;; depending on how many patches are in the patch file. + ;; At present, there is no support for meta-level patches. + ;; Should return either the ctl buffer or the meta-buffer + (defun ediff-dispatch-file-patching-job (patch-buf filename + &optional startup-hooks) + (ediff-eval-in-buffer patch-buf + ;; relativize names in the patch with respect to source-file + (ediff-fixup-patch-map filename) + (if (< (length ediff-patch-map) 2) + (ediff-patch-file-internal + patch-buf + (if (and (not (string-match "^/dev/null" (car (car ediff-patch-map)))) + (> (length (car (car ediff-patch-map))) 1)) + (car (car ediff-patch-map)) + filename) + startup-hooks) + (ediff-multi-patch-internal patch-buf startup-hooks)) + )) + + + (defun ediff-patch-buffer-internal (patch-buf buf-to-patch-name + &optional startup-hooks) + (let* ((buf-to-patch (get-buffer buf-to-patch-name)) + (file-name-ok (if buf-to-patch (buffer-file-name buf-to-patch))) + (buf-mod-status (buffer-modified-p buf-to-patch)) + (multifile-patch-p (> (length (ediff-eval-in-buffer patch-buf + ediff-patch-map)) 1)) + default-dir file-name ctl-buf) + (if file-name-ok + (setq file-name file-name-ok) + (if multifile-patch-p + (error + "Can't apply multi-file patches to buffers that visit no files")) + (ediff-eval-in-buffer buf-to-patch + (setq default-dir default-directory) + (setq file-name (ediff-make-temp-file buf-to-patch)) + (set-visited-file-name file-name) + (setq buffer-auto-save-file-name nil) ; don't create auto-save file + ;;don't confuse the user with a new bufname + (rename-buffer buf-to-patch-name) + (set-buffer-modified-p nil) + (set-visited-file-modtime) ; sync buffer and temp file + (setq default-directory default-dir) + )) + + ;; dispatch a patch function + (setq ctl-buf (ediff-dispatch-file-patching-job + patch-buf file-name startup-hooks)) + + (if file-name-ok + () + ;; buffer wasn't visiting any file, + ;; so we will not run meta-level ediff here + (ediff-eval-in-buffer ctl-buf + (delete-file (buffer-file-name ediff-buffer-A)) + (delete-file (buffer-file-name ediff-buffer-B)) + (ediff-eval-in-buffer ediff-buffer-A + (if default-dir (setq default-directory default-dir)) + (set-visited-file-name nil) + (rename-buffer buf-to-patch-name) + (set-buffer-modified-p buf-mod-status)) + (ediff-eval-in-buffer ediff-buffer-B + (setq buffer-auto-save-file-name nil) ; don't create auto-save file + (if default-dir (setq default-directory default-dir)) + (set-visited-file-name nil) + (rename-buffer (ediff-unique-buffer-name + (concat buf-to-patch-name "_patched") "")) + (set-buffer-modified-p t)))) + )) + + (defun ediff-patch-file-internal (patch-buf source-filename + &optional startup-hooks) + (setq source-filename (expand-file-name source-filename)) + + (let* ((backup-extension + ;; if the user specified a -b option, extract the backup + ;; extension from there; else use ediff-backup-extension + (substring ediff-patch-options + (if (string-match "-b[ \t]+" ediff-patch-options) + (match-end 0) 0) + (if (string-match "-b[ \t]+[^ \t]+" ediff-patch-options) + (match-end 0) 0))) + (shell-file-name ediff-shell) + (patch-diagnostics (get-buffer-create "*ediff patch diagnostics*")) + ;; ediff-find-file may use a temp file to do the patch + ;; so, we save source-filename and true-source-filename as a var + ;; that initially is source-filename but may be changed to a temp + ;; file for the purpose of patching. + (true-source-filename source-filename) + (target-filename source-filename) + target-buf buf-to-patch file-name-magic-p ctl-buf backup-style) + + ;; if the user didn't specify a backup extension, use + ;; ediff-backup-extension + (if (string= backup-extension "") + (setq backup-extension ediff-backup-extension)) + (if (string-match "-V" ediff-patch-options) + (error + "Ediff doesn't take the -V option in `ediff-patch-options'--sorry")) + + ;; Make a temp file, if source-filename has a magic file handler (or if + ;; it is handled via auto-mode-alist and similar magic). + ;; Check if there is a buffer visiting source-filename and if they are in + ;; sync; arrange for the deletion of temp file. + (ediff-find-file 'true-source-filename 'buf-to-patch + 'ediff-last-dir-patch 'startup-hooks) + + ;; Check if source file name has triggered black magic, such as file name + ;; handlers or auto mode alist, and make a note of it. + ;; true-source-filename should be either the original name or a + ;; temporary file where we put the after-product of the file handler. + (setq file-name-magic-p (not (equal (file-truename true-source-filename) + (file-truename source-filename)))) + + ;; Checkout orig file, if necessary, so that the patched file could be + ;; checked back in. + (if (ediff-file-checked-in-p (buffer-file-name buf-to-patch)) + (ediff-toggle-read-only buf-to-patch)) + + (ediff-eval-in-buffer patch-diagnostics + (insert-buffer patch-buf) + (message "Applying patch ... ") + ;; fix environment for gnu patch, so it won't make numbered extensions + (setq backup-style (getenv "VERSION_CONTROL")) + (setenv "VERSION_CONTROL" nil) + ;; always pass patch the -f option, so it won't ask any questions + (shell-command-on-region + (point-min) (point-max) + (format "%s -f %s -b %s %s" + ediff-patch-program ediff-patch-options + backup-extension + (expand-file-name true-source-filename)) + t) + ;; restore environment for gnu patch + (setenv "VERSION_CONTROL" backup-style)) + + (message "Applying patch ... done") + (message "") + + (switch-to-buffer patch-diagnostics) + (sit-for 0) ; synchronize - let the user see diagnostics + + (or (file-exists-p (concat true-source-filename backup-extension)) + (error "Patch appears to have failed")) + + ;; If black magic is involved, apply patch to a temp copy of the + ;; file. Otherwise, apply patch to the orig copy. If patch is applied + ;; to temp copy, we name the result old-name_patched for local files + ;; and temp-copy_patched for remote files. The orig file name isn't + ;; changed, and the temp copy of the original is later deleted. + ;; Without magic, the original file is renamed (usually into + ;; old-name_orig) and the result of patching will have the same name as + ;; the original. + (if (not file-name-magic-p) + (ediff-eval-in-buffer buf-to-patch + (set-visited-file-name (concat source-filename backup-extension)) + (set-buffer-modified-p nil)) + + ;; Black magic in effect. + ;; If orig file was remote, put the patched file in the temp directory. + ;; If orig file is local, put the patched file in the directory of + ;; the orig file. + (setq target-filename + (concat + (if (ediff-file-remote-p (file-truename source-filename)) + true-source-filename + source-filename) + "_patched")) + + (rename-file true-source-filename target-filename t) + + ;; arrange that the temp copy of orig will be deleted + (rename-file (concat true-source-filename backup-extension) + true-source-filename t)) + + ;; make orig buffer read-only + (setq startup-hooks + (cons 'ediff-set-read-only-in-buf-A startup-hooks)) + + ;; set up a buf for the patched file + (setq target-buf (find-file-noselect target-filename)) + + (setq ctl-buf + (ediff-buffers-internal + buf-to-patch target-buf nil + startup-hooks 'epatch)) + (ediff-eval-in-buffer ctl-buf + (setq ediff-patchbufer patch-buf + ediff-patch-diagnostics patch-diagnostics)) + + (bury-buffer patch-diagnostics) + (message "Type `P', if you need to see patch diagnostics") + ctl-buf)) + + (defun ediff-multi-patch-internal (patch-buf &optional startup-hooks) + (let (meta-buf) + (setq startup-hooks + ;; this sets various vars in the meta buffer inside + ;; ediff-prepare-meta-buffer + (cons (` (lambda () + ;; tell what to do if the user clicks on a session record + (setq ediff-session-action-function + 'ediff-patch-file-form-meta + ediff-meta-patchbufer patch-buf) + )) + startup-hooks)) + (setq meta-buf (ediff-prepare-meta-buffer + 'ediff-filegroup-action + (ediff-eval-in-buffer patch-buf + ;; nil replaces a regular expression + (cons (list nil (format "%S" patch-buf)) + ediff-patch-map)) + "*Ediff Session Group Panel" + 'ediff-redraw-directory-group-buffer + 'ediff-multifile-patch + startup-hooks)) + (ediff-show-meta-buffer meta-buf) + )) + + + + + ;;; Local Variables: + ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) + ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) + ;;; End: + + (provide 'ediff-ptch) + + ;;; ediff-ptch.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-util.el emacs-19.32/lisp/ediff-util.el *** emacs-19.31/lisp/ediff-util.el Wed Feb 21 15:21:35 1996 --- emacs-19.32/lisp/ediff-util.el Fri Jun 21 21:48:02 1996 *************** *** 1,5 **** ;;; ediff-util.el --- the core commands and utilities of ediff ! ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-util.el --- the core commands and utilities of ediff ! ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 27,30 **** --- 27,35 ---- (require 'ediff-mult) + ;; Pacify compiler and avoid the need in checking for boundp + (defvar ediff-patch-diagnostics nil) + (defvar ediff-patchbufer nil) + ;; end pacifier + ;;; Functions *************** This mode is entered through one of the *** 36,42 **** --- 41,49 ---- `ediff-files' `ediff-buffers' + `ebuffers' `ediff3' `ediff-files3' `ediff-buffers3' + `ebuffers3' `ediff-merge' `ediff-merge-files' *************** to invocation.") *** 177,180 **** --- 184,189 ---- (define-key ediff-mode-map "wb" 'ediff-save-buffer) (define-key ediff-mode-map "wd" 'ediff-save-buffer) + (if (fboundp 'ediff-show-patch-diagnostics) + (define-key ediff-mode-map "P" 'ediff-show-patch-diagnostics)) (if ediff-3way-job (progn *************** to invocation.") *** 243,247 **** (make-local-hook 'pre-command-hook) (if (ediff-window-display-p) ! (add-hook 'pre-command-hook 'ediff-spy-after-mouse)) (setq ediff-mouse-pixel-position (mouse-pixel-position)) --- 252,256 ---- (make-local-hook 'pre-command-hook) (if (ediff-window-display-p) ! (add-hook 'pre-command-hook 'ediff-spy-after-mouse nil t)) (setq ediff-mouse-pixel-position (mouse-pixel-position)) *************** to invocation.") *** 274,278 **** (funcall (ediff-eval-in-buffer buf major-mode)) ;; after Stig@hackvan.com ! (add-hook 'local-write-file-hooks 'ediff-set-merge-mode) ))) (setq buffer-read-only nil --- 283,287 ---- (funcall (ediff-eval-in-buffer buf major-mode)) ;; after Stig@hackvan.com ! (add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t) ))) (setq buffer-read-only nil *************** Reestablish the default three-window dis *** 741,746 **** (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) ! (ediff-buffer-live-p ediff-buffer-C)) ! ) (progn (or no-rehighlight --- 750,754 ---- (ediff-buffer-live-p ediff-buffer-B) (or (not ediff-3way-job) ! (ediff-buffer-live-p ediff-buffer-C))) (progn (or no-rehighlight *************** This is especially useful when comparing *** 1171,1175 **** (defun ediff-toggle-multiframe () "Switch from the multiframe display to single-frame display and back. ! This is primarily for debugging, but one can use it for fun, too." (interactive) (ediff-barf-if-not-control-buffer) --- 1179,1184 ---- (defun ediff-toggle-multiframe () "Switch from the multiframe display to single-frame display and back. ! For a permanent change, set the variable `ediff-window-setup-function', ! which see." (interactive) (ediff-barf-if-not-control-buffer) *************** the width of the A/B/C windows." *** 1382,1386 **** ;;BEG, END show the region to be positioned. ! ;;JOB-NAME holds ediff-job-name. Ediff-windows job positions regions ;;differently. (defun ediff-position-region (beg end pos job-name) --- 1391,1395 ---- ;;BEG, END show the region to be positioned. ! ;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions ;;differently. (defun ediff-position-region (beg end pos job-name) *************** the width of the A/B/C windows." *** 1450,1480 **** (defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf) (ediff-eval-in-buffer (or ctl-buf ediff-control-buffer) ! (let* ((func (cond ((eq op 'scroll-down) 'ediff-get-lines-to-region-start) ! ((eq op 'scroll-up) 'ediff-get-lines-to-region-end) ! (t '(lambda (a b c) 0)))) ! (max-lines (max (funcall func 'A n ctl-buf) ! (funcall func 'B n ctl-buf) ! (if (ediff-buffer-live-p ediff-buffer-C) ! (funcall func 'C n ctl-buf) ! 0)))) ! ;; this covers the horizontal coefficient as well: ! ;; if max-lines = 0 then coef = 1 ! (if (> max-lines 0) ! (/ (+ (funcall func buf-type n ctl-buf) 0.0) ! (+ max-lines 0.0)) ! 1) ! ))) (defun ediff-next-difference (&optional arg) "Advance to the next difference. ! With a prefix argument, go back that many differences." ! (interactive "P") (ediff-barf-if-not-control-buffer) (if (< ediff-current-difference ediff-number-of-differences) (let ((n (min ediff-number-of-differences ! (+ ediff-current-difference (if arg arg 1)))) regexp-skip) --- 1459,1499 ---- + ;; region size coefficient is a coefficient by which to adjust scrolling + ;; up/down of the window displaying buffer of type BUFTYPE. + ;; The purpose of this coefficient is to make the windows scroll in sync, so + ;; that it won't happen that one diff region is scrolled off while the other is + ;; still seen. + ;; + ;; If the difference region is invalid, the coefficient is 1 (defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf) (ediff-eval-in-buffer (or ctl-buf ediff-control-buffer) ! (if (ediff-valid-difference-p n) ! (let* ((func (cond ((eq op 'scroll-down) ! 'ediff-get-lines-to-region-start) ! ((eq op 'scroll-up) ! 'ediff-get-lines-to-region-end) ! (t '(lambda (a b c) 0)))) ! (max-lines (max (funcall func 'A n ctl-buf) ! (funcall func 'B n ctl-buf) ! (if (ediff-buffer-live-p ediff-buffer-C) ! (funcall func 'C n ctl-buf) ! 0)))) ! ;; this covers the horizontal coefficient as well: ! ;; if max-lines = 0 then coef = 1 ! (if (> max-lines 0) ! (/ (+ (funcall func buf-type n ctl-buf) 0.0) ! (+ max-lines 0.0)) ! 1)) ! 1))) (defun ediff-next-difference (&optional arg) "Advance to the next difference. ! With a prefix argument, go forward that many differences." ! (interactive "p") (ediff-barf-if-not-control-buffer) (if (< ediff-current-difference ediff-number-of-differences) (let ((n (min ediff-number-of-differences ! (+ ediff-current-difference arg))) regexp-skip) *************** With a prefix argument, go back that man *** 1509,1516 **** "Go to the previous difference. With a prefix argument, go back that many differences." ! (interactive "P") (ediff-barf-if-not-control-buffer) (if (> ediff-current-difference -1) ! (let ((n (max -1 (- ediff-current-difference (if arg arg 1)))) regexp-skip) --- 1528,1535 ---- "Go to the previous difference. With a prefix argument, go back that many differences." ! (interactive "p") (ediff-barf-if-not-control-buffer) (if (> ediff-current-difference -1) ! (let ((n (max -1 (- ediff-current-difference arg))) regexp-skip) *************** With a prefix argument, go back that man *** 1542,1568 **** (error "At beginning of the difference list"))) (defun ediff-jump-to-difference (difference-number) ! "Go to the difference specified as a prefix argument." (interactive "p") (ediff-barf-if-not-control-buffer) ! (setq difference-number (1- difference-number)) (if (and (>= difference-number -1) ! (< difference-number (1+ ediff-number-of-differences))) (ediff-unselect-and-select-difference difference-number) ! (error "Bad difference number, %d. Valid numbers are 1 to %d" ! (1+ difference-number) ediff-number-of-differences))) ! (defun ediff-jump-to-difference-at-point () "Go to difference closest to the point in buffer A, B, or C. ! The type of buffer depends on last command character \(a, b, or c\) that ! invoked this command." ! (interactive) (ediff-barf-if-not-control-buffer) ! (let ((buf-type (ediff-char-to-buftype last-command-char))) ! (ediff-jump-to-difference (ediff-diff-at-point buf-type)))) ;; find region most related to the current point position (or POS, if given) ! (defun ediff-diff-at-point (buf-type &optional pos) (let ((buffer (ediff-get-buffer buf-type)) (ctl-buffer ediff-control-buffer) --- 1561,1647 ---- (error "At beginning of the difference list"))) + ;; The diff number is as perceived by the user (i.e., 1+ the internal + ;; representation) (defun ediff-jump-to-difference (difference-number) ! "Go to the difference specified as a prefix argument. ! If the prefix is negative, count differences from the end." (interactive "p") (ediff-barf-if-not-control-buffer) ! (setq difference-number ! (cond ((< difference-number 0) ! (+ ediff-number-of-differences difference-number)) ! ((> difference-number 0) (1- difference-number)) ! (t -1))) ! ;; -1 is allowed by ediff-unselect-and-select-difference --- it is the ! ;; position before the first one. (if (and (>= difference-number -1) ! (<= difference-number ediff-number-of-differences)) (ediff-unselect-and-select-difference difference-number) ! (error ediff-BAD-DIFF-NUMBER ! this-command (1+ difference-number) ediff-number-of-differences))) ! (defun ediff-jump-to-difference-at-point (arg) "Go to difference closest to the point in buffer A, B, or C. ! The buffer depends on last command character \(a, b, or c\) that invoked this ! command. For instance, if the command was `ga' then the point value in buffer A ! is used. ! With a prefix argument, synchronize all files around the current point position ! in the specified buffer." ! (interactive "P") (ediff-barf-if-not-control-buffer) ! (let* ((buf-type (ediff-char-to-buftype last-command-char)) ! (buffer (ediff-get-buffer buf-type)) ! (pt (ediff-eval-in-buffer buffer (point))) ! (diff-no (ediff-diff-at-point buf-type nil (if arg 'after))) ! (past-last-diff (< ediff-number-of-differences diff-no)) ! (beg (if past-last-diff ! (ediff-eval-in-buffer buffer (point-max)) ! (ediff-get-diff-posn buf-type 'beg (1- diff-no)))) ! ctl-wind wind-A wind-B wind-C ! shift) ! (if past-last-diff ! (ediff-jump-to-difference -1) ! (ediff-jump-to-difference diff-no)) ! (setq ctl-wind (selected-window) ! wind-A ediff-window-A ! wind-B ediff-window-B ! wind-C ediff-window-C) ! (if arg ! (progn ! (ediff-eval-in-buffer buffer ! (setq shift (- beg pt))) ! (select-window wind-A) ! (if past-last-diff (goto-char (point-max))) ! (condition-case nil ! (backward-char shift) ; noerror, if beginning of buffer ! (error)) ! (recenter) ! (select-window wind-B) ! (if past-last-diff (goto-char (point-max))) ! (condition-case nil ! (backward-char shift) ; noerror, if beginning of buffer ! (error)) ! (recenter) ! (if (window-live-p wind-C) ! (progn ! (select-window wind-C) ! (if past-last-diff (goto-char (point-max))) ! (condition-case nil ! (backward-char shift) ; noerror, if beginning of buffer ! (error)) ! (recenter) ! )) ! (select-window ctl-wind) ! )) ! )) ;; find region most related to the current point position (or POS, if given) ! ;; returns diff number as seen by the user (i.e., 1+ the internal ! ;; representation) ! ;; The optional argument WHICH-DIFF can be `after' or `before'. If `after', ! ;; find the diff after the point. If `before', find the diff before the ! ;; point. If the point is inside a diff, return that diff. ! (defun ediff-diff-at-point (buf-type &optional pos which-diff) (let ((buffer (ediff-get-buffer buf-type)) (ctl-buffer ediff-control-buffer) *************** invoked this command." *** 1585,1592 **** ) ! (if (< (abs (- pos prev-end)) ! (abs (- pos beg))) ! diff-no ! (1+ diff-no)) ; jump-to-diff works with diff nums higher by 1 ))) --- 1664,1679 ---- ) ! ;; boost diff-no by 1, if past the last diff region ! (if (and (memq which-diff '(after before)) ! (> pos beg) (= diff-no max-dif-num)) ! (setq diff-no (1+ diff-no))) ! ! (cond ((eq which-diff 'after) (1+ diff-no)) ! ((eq which-diff 'before) diff-no) ! ((< (abs (count-lines pos (max 1 prev-end))) ! (abs (count-lines pos (max 1 beg)))) ! diff-no) ; choose prev difference ! (t ! (1+ diff-no))) ; choose next difference ))) *************** determine the source and the target buff *** 1608,1613 **** (ediff-barf-if-not-control-buffer) (or keys (setq keys (this-command-keys))) ! (if (numberp arg) ! (ediff-jump-to-difference arg)) (let* ((key1 (aref keys 0)) (key2 (aref keys 1)) --- 1695,1701 ---- (ediff-barf-if-not-control-buffer) (or keys (setq keys (this-command-keys))) ! (if (eq arg '-) (setq arg -1)) ; translate neg arg to -1 ! (if (numberp arg) (ediff-jump-to-difference arg)) ! (let* ((key1 (aref keys 0)) (key2 (aref keys 1)) *************** a regular expression typed in by the use *** 1867,1871 **** (cond ((or (and (eq ediff-skip-diff-region-function ! 'ediff-focus-on-regexp-matches-function) (eq last-command-char ?f)) (and (eq ediff-skip-diff-region-function --- 1955,1959 ---- (cond ((or (and (eq ediff-skip-diff-region-function ! ediff-focus-on-regexp-matches-function) (eq last-command-char ?f)) (and (eq ediff-skip-diff-region-function *************** temporarily reverses the meaning of this *** 2064,2074 **** (interactive "P") (ediff-barf-if-not-control-buffer) ! (if (prog1 ! (y-or-n-p ! (format "Quit this Ediff session%s? " ! (if (ediff-buffer-live-p ediff-meta-buffer) ! " & show containing session group" ""))) ! (message "")) ! (ediff-really-quit reverse-default-keep-variants))) --- 2152,2162 ---- (interactive "P") (ediff-barf-if-not-control-buffer) ! (if (y-or-n-p (format "Quit this Ediff session%s? " ! (if (ediff-buffer-live-p ediff-meta-buffer) ! " & show containing session group" ""))) ! (progn ! (message "") ! (ediff-really-quit reverse-default-keep-variants)) ! (message ""))) *************** buffer in another session as well." *** 2259,2263 **** (buf-B-wind (ediff-get-visible-buffer-window buf-B)) (buf-C-wind (ediff-get-visible-buffer-window buf-C)) ! (buf-patch ediff-patch-buf) (buf-patch-diag ediff-patch-diagnostics) (buf-err ediff-error-buffer) --- 2347,2351 ---- (buf-B-wind (ediff-get-visible-buffer-window buf-B)) (buf-C-wind (ediff-get-visible-buffer-window buf-C)) ! (buf-patch ediff-patchbufer) (buf-patch-diag ediff-patch-diagnostics) (buf-err ediff-error-buffer) *************** Hit \\[ediff-recenter] to reset the wind *** 2317,2321 **** (save-excursion (ediff-skip-unsuitable-frames)) ! (with-output-to-temp-buffer " *ediff-info*" (princ (ediff-version)) (princ "\n\n") --- 2405,2410 ---- (save-excursion (ediff-skip-unsuitable-frames)) ! (with-output-to-temp-buffer ediff-msg-buffer ! (raise-frame (selected-frame)) (princ (ediff-version)) (princ "\n\n") *************** Hit \\[ediff-recenter] to reset the wind *** 2526,2536 **** (setq f (expand-file-name (read-file-name ! (format "%s%s: " prompt ! (if default-file ! (concat " (default " default-file ")") ! "")) default-dir ! default-file t ; must match, no-confirm (if default-file (file-name-directory default-file)) --- 2615,2626 ---- (setq f (expand-file-name (read-file-name ! (format "%s%s " prompt ! (cond (default-file ! (concat " (default " default-file "):")) ! ;;((string-match "[?:!,;][ \t]*$" prompt) "") ! (t (concat " (default " default-dir "):")))) default-dir ! (or default-file default-dir) t ; must match, no-confirm (if default-file (file-name-directory default-file)) *************** Hit \\[ediff-recenter] to reset the wind *** 2602,2608 **** ;; Signal an error if we can't make them the same, or the user doesn't want ;; to do what is necessary to make them the same. ! ;; If file has file handlers (indicated by the optional arg), then we ! ;; offer to revert instead of saving. This is one difference with Emerge. ! ;; Another is that we always offer to revert obsolete files, whether they ;; are modified or not. (defun ediff-verify-file-buffer (&optional file-magic) --- 2692,2696 ---- ;; Signal an error if we can't make them the same, or the user doesn't want ;; to do what is necessary to make them the same. ! ;; Also, Ediff always offers to revert obsolete buffers, whether they ;; are modified or not. (defun ediff-verify-file-buffer (&optional file-magic) *************** Hit \\[ediff-recenter] to reset the wind *** 2612,2630 **** ;; If buffer is not obsolete and is modified, offer to save (if (yes-or-no-p ! (format "Buffer out of sync with visited file. %s file %s? " ! (if file-magic "Revert" "Save") buffer-file-name)) ! (if (not file-magic) (save-buffer) ! ;; for some reason, file-name-handlers append instead of ! ;; replacing, so we have to erase first. ! (erase-buffer) ! (revert-buffer t t)) ! (error "Buffer out of sync for file %s" buffer-file-name)) ;; If buffer is not obsolete and is not modified, do nothing nil) ;; If buffer is obsolete, offer to revert (if (yes-or-no-p ! (format "Buffer out of sync with visited file. Revert file %s? " buffer-file-name)) (progn --- 2700,2716 ---- ;; If buffer is not obsolete and is modified, offer to save (if (yes-or-no-p ! (format "Buffer out of sync with visited file. Save file %s? " buffer-file-name)) ! (condition-case nil (save-buffer) ! (error ! (beep) ! (message "Couldn't save %s" buffer-file-name))) ! (error "Buffer is out of sync for file %s" buffer-file-name)) ;; If buffer is not obsolete and is not modified, do nothing nil) ;; If buffer is obsolete, offer to revert (if (yes-or-no-p ! (format "Buffer is out of sync with visited file. REVERT file %s? " buffer-file-name)) (progn *************** Without an argument, it saves customized *** 2777,2790 **** (defun ediff-get-diff-posn (buf-type pos &optional n control-buf) - "Returns positions of difference sectors in the BUF-TYPE buffer. - BUF-TYPE should be a symbol--either `A' or `B'. - POS is either `beg' or `end'--it specifies whether you want the position at the - beginning of a difference or at the end. - - The optional argument N says which difference \(default: - `ediff-current-difference'\). The optional argument CONTROL-BUF says - which control buffer is in effect in case it is not the current - buffer." (let (diff-overlay) (or control-buf --- 2863,2877 ---- + ;; Returns positions of difference sectors in the BUF-TYPE buffer. + ;; BUF-TYPE should be a symbol -- `A', `B', or `C'. + ;; POS is either `beg' or `end'--it specifies whether you want the position at + ;; the beginning of a difference or at the end. + ;; + ;; The optional argument N says which difference (default: + ;; `ediff-current-difference'). N is the internal difference number (1- what + ;; the user sees). The optional argument CONTROL-BUF says + ;; which control buffer is in effect in case it is not the current + ;; buffer. (defun ediff-get-diff-posn (buf-type pos &optional n control-buf) (let (diff-overlay) (or control-buf *************** buffer." *** 2795,2800 **** (if (or (< n 0) (>= n ediff-number-of-differences)) (if (> ediff-number-of-differences 0) ! (error "Bad difference number, %d. Valid numbers are 1 to %d" ! (1+ n) ediff-number-of-differences) (error ediff-NO-DIFFERENCES))) (setq diff-overlay (ediff-get-diff-overlay n buf-type))) --- 2882,2887 ---- (if (or (< n 0) (>= n ediff-number-of-differences)) (if (> ediff-number-of-differences 0) ! (error ediff-BAD-DIFF-NUMBER ! this-command (1+ n) ediff-number-of-differences) (error ediff-NO-DIFFERENCES))) (setq diff-overlay (ediff-get-diff-overlay n buf-type))) *************** Checks if overlay's buffer exists." *** 2958,2971 **** (if ediff-xemacs-p (make-extent beg end buff) ! ;; don't advance front, but advance rear (make-overlay beg end buff nil 'rear-advance))) ! (if ediff-emacs-p ! (ediff-overlay-put overl 'evaporate nil) ; don't detach ! (ediff-overlay-put overl 'detachable nil) ; don't detach ! ;; don't advance front, but advance rear ! (ediff-overlay-put overl 'start-open nil) ! (ediff-overlay-put overl 'end-open nil)) ! (ediff-overlay-put overl 'ediff-diff-num 0) overl)))) --- 3045,3060 ---- (if ediff-xemacs-p (make-extent beg end buff) ! ;; advance front and rear of the overlay (make-overlay beg end buff nil 'rear-advance))) ! ;; never detach ! (ediff-overlay-put ! overl (if ediff-emacs-p 'evaporate 'detachable) nil) ! ;; make vip-minibuffer-overlay open-ended ! ;; In emacs, it is made open ended at creation time ! (if ediff-xemacs-p ! (progn ! (ediff-overlay-put overl 'start-open nil) ! (ediff-overlay-put overl 'end-open nil))) (ediff-overlay-put overl 'ediff-diff-num 0) overl)))) *************** Mail anyway? (y or n) ") *** 3266,3271 **** (setq ediff-command-begin-time '(0 0 0)) (message "Ediff profiling disabled")) ! (add-hook pre-hook 'ediff-save-time t) ! (add-hook post-hook 'ediff-calc-command-time) (message "Ediff profiling enabled")))) --- 3355,3360 ---- (setq ediff-command-begin-time '(0 0 0)) (message "Ediff profiling disabled")) ! (add-hook pre-hook 'ediff-save-time t t) ! (add-hook post-hook 'ediff-calc-command-time nil t) (message "Ediff profiling enabled")))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-vers.el emacs-19.32/lisp/ediff-vers.el *** emacs-19.31/lisp/ediff-vers.el Fri Feb 16 01:36:08 1996 --- emacs-19.32/lisp/ediff-vers.el Fri Jun 21 21:46:24 1996 *************** *** 1,5 **** ;;; ediff-vers.el --- version control interface to Ediff ! ;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-vers.el --- version control interface to Ediff ! ;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 24,27 **** --- 24,41 ---- ;;; Code: + + ;; Compiler pacifier + (defvar rcs-default-co-switches) + (defvar sc-mode) + (defvar cvs-shell) + (defvar cvs-program) + (defvar cvs-cookie-handle) + + (eval-when-compile + (load "pcl-cvs" 'noerror) + (load "rcs" 'noerror) + (load "generic-sc" 'noerror) + (load "vc" 'noerror)) + ;; end pacifier ;; VC.el support diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff-wind.el emacs-19.32/lisp/ediff-wind.el *** emacs-19.31/lisp/ediff-wind.el Fri Feb 16 01:28:58 1996 --- emacs-19.32/lisp/ediff-wind.el Fri Jun 21 21:48:53 1996 *************** *** 1,5 **** ;;; ediff-wind.el --- window manipulation utilities ! ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff-wind.el --- window manipulation utilities ! ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 26,29 **** --- 26,41 ---- (require 'ediff-init) + ;; Compiler pacifier + (defvar icon-title-format) + (defvar top-toolbar-height) + (defvar bottom-toolbar-height) + (defvar left-toolbar-height) + (defvar right-toolbar-height) + (defvar left-toolbar-width) + (defvar right-toolbar-width) + (defvar default-menubar) + (defvar frame-icon-title-format) + ;; end pacifier + (defvar ediff-window-setup-function (if (ediff-window-display-p) *************** In this case, Ediff will use those frame *** 94,98 **** '(scrollbar-width . 0) ; XEmacs only '(menu-bar-lines . 0) ; Emacs only - '(visibility . nil) ; doesn't work for XEmacs yet ;; don't lower and auto-raise '(auto-lower . nil) --- 106,109 ---- *************** into icons, regardless of the window man *** 396,406 **** (defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf) ;;; Algorithm: ! ;;; If A and B are in the same frame but C's frame is different--- use one ! ;;; frame for A and B and use a separate frame for C. ! ;;; If C's frame is non-existent, then: if the first suitable ! ;;; non-dedicated frame is different from A&B's, then use it for C. ! ;;; Otherwise, put A,B, and C in one frame. ! ;;; If buffers A, B, C are is separate frames, use them to display these ! ;;; buffers. ;; Skip dedicated or iconified frames. --- 407,419 ---- (defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf) ;;; Algorithm: ! ;;; 1. Never use frames that have dedicated windows in them---it is bad to ! ;;; destroy dedicated windows. ! ;;; 2. If A and B are in the same frame but C's frame is different--- use one ! ;;; frame for A and B and use a separate frame for C. ! ;;; 3. If C's frame is non-existent, then: if the first suitable ! ;;; non-dedicated frame is different from A&B's, then use it for C. ! ;;; Otherwise, put A,B, and C in one frame. ! ;;; 4. If buffers A, B, C are is separate frames, use them to display these ! ;;; buffers. ;; Skip dedicated or iconified frames. *************** into icons, regardless of the window man *** 424,434 **** --- 437,456 ---- (orig-frame (selected-frame)) (use-same-frame (or force-one-frame + ;; A and C must be in one frame (eq frame-A (or frame-C orig-frame)) + ;; B and C must be in one frame (eq frame-B (or frame-C orig-frame)) + ;; A or B is not visible (not (frame-live-p frame-A)) (not (frame-live-p frame-B)) + ;; A or B is not suitable for display + (not (ediff-window-ok-for-display wind-A)) + (not (ediff-window-ok-for-display wind-B)) + ;; A and B in the same frame, and no good frame + ;; for C (and (eq frame-A frame-B) (not (frame-live-p frame-C))) )) + ;; use-same-frame-for-AB implies wind A and B are ok for display (use-same-frame-for-AB (and (not use-same-frame) (eq frame-A frame-B))) *************** into icons, regardless of the window man *** 441,475 **** ;; buf-A on its own (if (and (window-live-p wind-A) ! (null use-same-frame) (null use-same-frame-for-AB)) ! (progn (select-window wind-A) (delete-other-windows) - (switch-to-buffer buf-A) (setq wind-A (selected-window)) (setq done-A t))) ;; buf-B on its own ! (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own ! (progn (select-window wind-B) (delete-other-windows) - (switch-to-buffer buf-B) (setq wind-B (selected-window)) (setq done-B t))) ;; buf-C on its own ! (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own (progn (select-window wind-C) (delete-other-windows) - (switch-to-buffer buf-C) (setq wind-C (selected-window)) (setq done-C t))) ! (if use-same-frame-for-AB (progn ! (select-frame frame-A) ! (switch-to-buffer buf-A) (delete-other-windows) (setq wind-A (selected-window)) --- 463,502 ---- ;; buf-A on its own (if (and (window-live-p wind-A) ! (null use-same-frame) ; implies wind-A is suitable (null use-same-frame-for-AB)) ! (progn ; bug A on its own ! ;; buffer buf-A is seen in live wind-A (select-window wind-A) (delete-other-windows) (setq wind-A (selected-window)) (setq done-A t))) ;; buf-B on its own ! (if (and (window-live-p wind-B) ! (null use-same-frame) ; implies wind-B is suitable ! (null use-same-frame-for-AB)) ! (progn ; buf B on its own ! ;; buffer buf-B is seen in live wind-B (select-window wind-B) (delete-other-windows) (setq wind-B (selected-window)) (setq done-B t))) ;; buf-C on its own ! (if (and (window-live-p wind-C) ! (ediff-window-ok-for-display wind-C) ! (null use-same-frame)) ; buf C on its own (progn + ;; buffer buf-C is seen in live wind-C (select-window wind-C) (delete-other-windows) (setq wind-C (selected-window)) (setq done-C t))) ! (if (and use-same-frame-for-AB ; implies wind A and B are suitable ! (window-live-p wind-A)) (progn ! ;; wind-A must already be displaying buf-A ! (select-window wind-A) (delete-other-windows) (setq wind-A (selected-window)) *************** into icons, regardless of the window man *** 485,503 **** (if use-same-frame ! (let ((curr-frame (selected-frame)) ! (window-min-height 1)) ;; avoid dedicated and non-splittable windows (ediff-skip-unsuitable-frames) - (or (eq curr-frame (selected-frame)) - (setq wind-A nil - wind-B nil - wind-C nil - orig-wind (selected-window))) - - ;; set the right frame - (cond (wind-A (select-window wind-A)) - (wind-B (select-window wind-B)) - (wind-C (select-window wind-C)) - (t (select-window orig-wind))) (delete-other-windows) (setq merge-window-lines --- 512,518 ---- (if use-same-frame ! (let ((window-min-height 1)) ;; avoid dedicated and non-splittable windows (ediff-skip-unsuitable-frames) (delete-other-windows) (setq merge-window-lines *************** into icons, regardless of the window man *** 506,513 **** (setq wind-A (selected-window)) - ;; XEmacs used to have a lot of trouble with display - ;; It did't set things right unless we told it to catch breath - ;;(if ediff-xemacs-p (sit-for 0)) - (split-window-vertically (max 2 (- (window-height) merge-window-lines))) --- 521,524 ---- *************** into icons, regardless of the window man *** 530,535 **** )) ! (or done-A ; Buf A to be set in its own frame ! (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) --- 541,549 ---- )) ! (or done-A ; Buf A to be set in its own frame, ! ;;; or it was set before because use-same-frame = 1 ! (progn ! ;; Buf-A was not set up yet as it wasn't visible, ! ;; and use-same-frame = nil, use-same-frame-for-AB = nil (select-window orig-wind) (delete-other-windows) *************** into icons, regardless of the window man *** 537,542 **** (setq wind-A (selected-window)) )) ! (or done-B ; Buf B to be set in its own frame ! (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) --- 551,559 ---- (setq wind-A (selected-window)) )) ! (or done-B ; Buf B to be set in its own frame, ! ;;; or it was set before because use-same-frame = 1 ! (progn ! ;; Buf-B was not set up yet as it wasn't visible ! ;; and use-same-frame = nil, use-same-frame-for-AB = nil (select-window orig-wind) (delete-other-windows) *************** into icons, regardless of the window man *** 545,550 **** )) ! (or done-C ; Buf C to be set in its own frame. ! (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) --- 562,570 ---- )) ! (or done-C ; Buf C to be set in its own frame, ! ;;; or it was set before because use-same-frame = 1 ! (progn ! ;; Buf-C was not set up yet as it wasn't visible ! ;; and use-same-frame = nil (select-window orig-wind) (delete-other-windows) *************** into icons, regardless of the window man *** 603,609 **** --- 623,632 ---- (use-same-frame (or force-one-frame (eq frame-A frame-B) + (not (ediff-window-ok-for-display wind-A)) + (not (ediff-window-ok-for-display wind-B)) (if three-way-comparison (or (eq frame-A frame-C) (eq frame-B frame-C) + (not (ediff-window-ok-for-display wind-C)) (not (frame-live-p frame-A)) (not (frame-live-p frame-B)) *************** into icons, regardless of the window man *** 629,635 **** (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own (progn ! (select-window wind-A) (delete-other-windows) - (switch-to-buffer buf-A) (setq wind-A (selected-window)) (setq done-A t))) --- 652,658 ---- (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own (progn ! ;; buffer buf-A is seen in live wind-A ! (select-window wind-A) ; must be displaying buf-A (delete-other-windows) (setq wind-A (selected-window)) (setq done-A t))) *************** into icons, regardless of the window man *** 637,643 **** (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own (progn ! (select-window wind-B) (delete-other-windows) - (switch-to-buffer buf-B) (setq wind-B (selected-window)) (setq done-B t))) --- 660,666 ---- (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own (progn ! ;; buffer buf-B is seen in live wind-B ! (select-window wind-B) ; must be displaying buf-B (delete-other-windows) (setq wind-B (selected-window)) (setq done-B t))) *************** into icons, regardless of the window man *** 645,679 **** (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own (progn ! (select-window wind-C) (delete-other-windows) - (switch-to-buffer buf-C) (setq wind-C (selected-window)) (setq done-C t))) (if use-same-frame ! (let ((curr-frame (selected-frame)) ! ;; this affects 3way setups only ! wind-width-or-height) ;; avoid dedicated and non-splittable windows (ediff-skip-unsuitable-frames) - (or (eq curr-frame (selected-frame)) - (setq wind-A nil - wind-B nil - wind-C nil - orig-wind (selected-window))) - - ;; set the right frame - (cond (wind-A (select-window wind-A)) - (wind-B (select-window wind-B)) - (wind-C (select-window wind-C)) - (t (select-window orig-wind))) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) - ;; XEmacs used to have a lot of trouble with display - ;; It didn't set things right unless we told it to catch breath - ;;(if ediff-xemacs-p (sit-for 0)) - (if three-way-comparison (setq wind-width-or-height --- 668,685 ---- (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own (progn ! ;; buffer buf-C is seen in live wind-C ! (select-window wind-C) ; must be displaying buf-C (delete-other-windows) (setq wind-C (selected-window)) (setq done-C t))) (if use-same-frame ! (let (wind-width-or-height) ; this affects 3way setups only ;; avoid dedicated and non-splittable windows (ediff-skip-unsuitable-frames) (delete-other-windows) (switch-to-buffer buf-A) (setq wind-A (selected-window)) (if three-way-comparison (setq wind-width-or-height *************** into icons, regardless of the window man *** 703,707 **** (or done-A ; Buf A to be set in its own frame ! (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) --- 709,716 ---- (or done-A ; Buf A to be set in its own frame ! ;;; or it was set before because use-same-frame = 1 ! (progn ! ;; Buf-A was not set up yet as it wasn't visible, ! ;; and use-same-frame = nil (select-window orig-wind) (delete-other-windows) *************** into icons, regardless of the window man *** 710,714 **** )) (or done-B ; Buf B to be set in its own frame ! (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) --- 719,726 ---- )) (or done-B ; Buf B to be set in its own frame ! ;;; or it was set before because use-same-frame = 1 ! (progn ! ;; Buf-B was not set up yet as it wasn't visible, ! ;; and use-same-frame = nil (select-window orig-wind) (delete-other-windows) *************** into icons, regardless of the window man *** 719,723 **** (if three-way-comparison (or done-C ; Buf C to be set in its own frame ! (progn ; It was not set up yet as it wasn't visible (select-window orig-wind) (delete-other-windows) --- 731,738 ---- (if three-way-comparison (or done-C ; Buf C to be set in its own frame ! ;;; or it was set before because use-same-frame = 1 ! (progn ! ;; Buf-C was not set up yet as it wasn't visible, ! ;; and use-same-frame = nil (select-window orig-wind) (delete-other-windows) *************** into icons, regardless of the window man *** 735,740 **** (window-frame (minibuffer-window frame-A)))) ! ;; It is unlikely that we'll implement ediff-windows that would compare ! ;; 3 windows at once. So, we don't use buffer C here. (if ediff-windows-job (progn --- 750,755 ---- (window-frame (minibuffer-window frame-A)))) ! ;; It is unlikely that we'll implement a version of ediff-windows that ! ;; would compare 3 windows at once. So, we don't use buffer C here. (if ediff-windows-job (progn *************** into icons, regardless of the window man *** 745,749 **** )) ! ;; skip unsplittable and dedicated windows ;; create a new splittable frame if none is found (defun ediff-skip-unsuitable-frames (&optional ok-unsplittable) --- 760,764 ---- )) ! ;; skip unsplittable frames and frames that have dedicated windows. ;; create a new splittable frame if none is found (defun ediff-skip-unsuitable-frames (&optional ok-unsplittable) *************** into icons, regardless of the window man *** 752,756 **** (while (and (not (eq (selected-window) last-window)) (or ! (window-dedicated-p (selected-window)) (ediff-frame-iconified-p (selected-frame)) (< (frame-height (selected-frame)) --- 767,771 ---- (while (and (not (eq (selected-window) last-window)) (or ! (ediff-frame-has-dedicated-windows (selected-frame)) (ediff-frame-iconified-p (selected-frame)) (< (frame-height (selected-frame)) *************** into icons, regardless of the window man *** 766,777 **** ;; fed up, no appropriate frame (progn - ;;(redraw-display) (select-frame (make-frame '((unsplittable))))))))) ;; Prepare or refresh control frame (defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame) (let ((window-min-height 1) ctl-frame-iconified-p dont-iconify-ctl-frame deiconify-ctl-frame ! ctl-frame old-ctl-frame lines user-grabbed-mouse fheight fwidth adjusted-parameters) --- 781,819 ---- ;; fed up, no appropriate frame (progn (select-frame (make-frame '((unsplittable))))))))) + (defun ediff-frame-has-dedicated-windows (frame) + (let ((cur-fr (selected-frame)) + ans) + (select-frame frame) + (walk-windows + (function (lambda (wind) + (if (window-dedicated-p wind) + (setq ans t)))) + 'ignore-minibuffer + frame) + (select-frame cur-fr) + ans)) + + ;; window is ok, if it is only one window on the frame, not counting the + ;; minibuffer, or none of the frame's windows is dedicated. + ;; The idea is that it is bad to destroy dedicated windows while creating an + ;; ediff window setup + (defun ediff-window-ok-for-display (wind) + (and + (window-live-p wind) + (or + ;; only one window + (eq wind (next-window wind 'ignore-minibuffer (window-frame wind))) + ;; none is dedicated + (not (ediff-frame-has-dedicated-windows (window-frame wind))) + ))) + ;; Prepare or refresh control frame (defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame) (let ((window-min-height 1) ctl-frame-iconified-p dont-iconify-ctl-frame deiconify-ctl-frame ! ctl-frame old-ctl-frame lines ! ;; user-grabbed-mouse fheight fwidth adjusted-parameters) *************** into icons, regardless of the window man *** 814,818 **** fwidth (+ (ediff-help-message-line-length) 2) adjusted-parameters (append (list - '(visibility . t) ;; possibly change surrogate minibuffer (cons 'minibuffer --- 856,859 ---- *************** into icons, regardless of the window man *** 852,855 **** --- 893,897 ---- (modify-frame-parameters ctl-frame adjusted-parameters) + (make-frame-visible ctl-frame) ;; This works around a bug in 19.25 and earlier. There, if frame gets *************** into icons, regardless of the window man *** 866,874 **** (raise-frame ctl-frame))) ! (if ediff-xemacs-p ! (set-window-buffer-dedicated (selected-window) ctl-buffer) ! (set-window-dedicated-p (selected-window) t)) ! ;; resynch so the cursor will move to control frame ;; per RMS suggestion (if (ediff-window-display-p) --- 908,914 ---- (raise-frame ctl-frame))) ! (set-window-dedicated-p (selected-window) t) ! ;; synchronize so the cursor will move to control frame ;; per RMS suggestion (if (ediff-window-display-p) *************** into icons, regardless of the window man *** 887,892 **** (if ediff-xemacs-p (ediff-eval-in-buffer ctl-buffer ! (make-local-variable 'select-frame-hook) ! (add-hook 'select-frame-hook 'ediff-xemacs-select-frame-hook) )) --- 927,932 ---- (if ediff-xemacs-p (ediff-eval-in-buffer ctl-buffer ! (make-local-hook 'select-frame-hook) ! (add-hook 'select-frame-hook 'ediff-xemacs-select-frame-hook nil t) )) *************** It assumes that it is called from within *** 1022,1026 **** (list (if (ediff-narrow-control-frame-p) " " "-- ") mode-line-buffer-identification ! " Howdy!")) ;; control buffer id (setq mode-line-buffer-identification --- 1062,1066 ---- (list (if (ediff-narrow-control-frame-p) " " "-- ") mode-line-buffer-identification ! " Quick Help")) ;; control buffer id (setq mode-line-buffer-identification *************** It assumes that it is called from within *** 1073,1085 **** (defun ediff-refresh-control-frame () - (setq frame-title-format (ediff-make-narrow-control-buffer-id) - frame-icon-title-format (ediff-make-narrow-control-buffer-id) ; XEmacs - icon-title-format (ediff-make-narrow-control-buffer-id)) ; Emacs - ;; the emacs part will be modified once the 'name and 'title - ;; frame parameters are separated (if ediff-emacs-p (modify-frame-parameters ediff-control-frame ! (list (cons 'name (ediff-make-narrow-control-buffer-id)))) ;; force an update of the frame title (modify-frame-parameters ediff-control-frame '(())))) --- 1113,1126 ---- (defun ediff-refresh-control-frame () (if ediff-emacs-p + ;; set frame/icon titles for Emacs (modify-frame-parameters ediff-control-frame ! (list (cons 'title (ediff-make-base-title)) ! (cons 'icon-name (ediff-make-narrow-control-buffer-id)) ! )) ! ;; set frame/icon titles for XEmacs ! (setq frame-title-format (ediff-make-base-title) ! frame-icon-title-format (ediff-make-narrow-control-buffer-id)) ;; force an update of the frame title (modify-frame-parameters ediff-control-frame '(())))) *************** It assumes that it is called from within *** 1090,1096 **** (if skip-name " " ! (concat ! (cdr (assoc 'name ediff-control-frame-parameters)) ! ediff-control-buffer-suffix)) (cond ((< ediff-current-difference 0) (format " _/%d" ediff-number-of-differences)) --- 1131,1135 ---- (if skip-name " " ! (ediff-make-base-title)) (cond ((< ediff-current-difference 0) (format " _/%d" ediff-number-of-differences)) *************** It assumes that it is called from within *** 1101,1104 **** --- 1140,1148 ---- (1+ ediff-current-difference) ediff-number-of-differences))))) + + (defun ediff-make-base-title () + (concat + (cdr (assoc 'name ediff-control-frame-parameters)) + ediff-control-buffer-suffix)) (defun ediff-make-wide-control-buffer-id () *************** It assumes that it is called from within *** 1123,1128 **** (get-buffer-window buff 'visible)))) - ;;; Functions to decide when to redraw windows (defun ediff-keep-window-config (control-buf) --- 1167,1172 ---- (get-buffer-window buff 'visible)))) + ;;; Functions to decide when to redraw windows (defun ediff-keep-window-config (control-buf) *************** It assumes that it is called from within *** 1152,1155 **** --- 1196,1204 ---- ediff-wide-display-p))))))) + + ;;; Local Variables: + ;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun) + ;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1) + ;;; End: (provide 'ediff-wind) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ediff.el emacs-19.32/lisp/ediff.el *** emacs-19.31/lisp/ediff.el Fri Feb 16 01:29:00 1996 --- emacs-19.32/lisp/ediff.el Fri Jun 21 21:50:34 1996 *************** *** 1,5 **** ;;; ediff.el --- a comprehensive visual interface to diff & patch ! ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc. ;; Author: Michael Kifer --- 1,5 ---- ;;; ediff.el --- a comprehensive visual interface to diff & patch ! ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ;; Author: Michael Kifer *************** *** 7,12 **** ;; Keywords: comparing, merging, patching, version control. ! (defconst ediff-version "2.54" "The current version of Ediff") ! (defconst ediff-date "February 14, 1996" "Date of last update") ;; This file is part of GNU Emacs. --- 7,13 ---- ;; Keywords: comparing, merging, patching, version control. ! (defconst ediff-version "2.61" "The current version of Ediff") ! (defconst ediff-date "June 10, 1996" "Date of last update") ! ;; This file is part of GNU Emacs. *************** *** 30,34 **** ;; Never read that diff output again! ! ;; Apply patch selectively, like a pro! ;; Merge with ease! --- 31,35 ---- ;; Never read that diff output again! ! ;; Apply patch interactively! ;; Merge with ease! *************** *** 59,63 **** ;; compressed files. Details are given below. ! ;; Finally, Ediff supports directory-level comparison and merging operations. ;; See the on-line manual for details. --- 60,64 ---- ;; compressed files. Details are given below. ! ;; Finally, Ediff supports directory-level comparison, merging and patching. ;; See the on-line manual for details. *************** *** 107,112 **** --- 108,120 ---- (require 'ediff-init) + ;; ediff-mult is always required, because of the registry stuff (require 'ediff-mult) + (eval-when-compile + (load "dired") + (load-file "./ediff-ptch.el") + (load-file "./ediff-vers.el") + (load "pcl-cvs" 'noerror)) + (defvar ediff-use-last-dir nil "*If t, Ediff uses previous directory as default when reading file name.") *************** *** 120,265 **** (defvar ediff-last-dir-ancestor nil "Last directory used by an Ediff command for the ancestor file.") - (defvar ediff-last-dir-patch nil - "Last directory used by an Ediff command for file to patch.") ! ;;; Patching - (defvar ediff-backup-extension - (if (memq system-type '(vax-vms axp-vms emx ms-dos windows-nt windows-95)) - "_orig" ".orig") - "Default backup extension for the patch program.") - ;;;###autoload - (defun ediff-patch-file (source-filename &optional startup-hooks job-name) - "Run Ediff by patching SOURCE-FILENAME." - ;; This now returns the control buffer - (interactive - (list (ediff-read-file-name - "File to patch" - (if ediff-use-last-dir - ediff-last-dir-patch - default-directory) - (ediff-get-default-file-name)))) - - (setq source-filename (expand-file-name source-filename)) - (ediff-get-patch-buffer - (if (eq job-name 'ediff-patch-buffer) - (ediff-eval-in-buffer (get-file-buffer source-filename) - default-directory) - (file-name-directory source-filename))) - - (let* ((backup-extension - ;; if the user specified a -b option, extract the backup - ;; extension from there; else use ediff-backup-extension - (substring ediff-patch-options - (if (string-match "-b[ \t]+" ediff-patch-options) - (match-end 0) 0) - (if (string-match "-b[ \t]+[^ \t]+" ediff-patch-options) - (match-end 0) 0))) - (shell-file-name ediff-shell) - ;; ediff-find-file may use a temp file to do the patch - ;; so, we save source-filename and true-source-filename as a var - ;; that initially is source-filename but may be changed to a temp - ;; file for the purpose of patching. - (true-source-filename source-filename) - (target-filename source-filename) - target-buf buf-to-patch file-name-magic-p ctl-buf backup-style) - - ;; if the user didn't specify a backup extension, use - ;; ediff-backup-extension - (if (string= backup-extension "") - (setq backup-extension ediff-backup-extension)) - (if (string-match "-V" ediff-patch-options) - (error - "Ediff doesn't take the -V option in `ediff-patch-options'--sorry")) - - ;; Make a temp file, if source-filename has a magic file handler (or if - ;; it is handled via auto-mode-alist and similar magic). - ;; Check if there is a buffer visiting source-filename and if they are in - ;; sync; arrange for the deletion of temp file. - (ediff-find-file 'true-source-filename 'buf-to-patch - 'ediff-last-dir-patch 'startup-hooks) - - ;; Check if source file name has triggered black magic, such as file name - ;; handlers or auto mode alist, and make a note of it. - ;; true-source-filename should be either the original name or a - ;; temporary file where we put the after-product of the file handler. - (setq file-name-magic-p (not (equal (file-truename true-source-filename) - (file-truename source-filename)))) - - ;; Checkout orig file, if necessary, so that the patched file could be - ;; checked back in. - (if (ediff-file-checked-in-p (buffer-file-name buf-to-patch)) - (ediff-toggle-read-only buf-to-patch)) - - (ediff-eval-in-buffer ediff-patch-diagnostics - (message "Applying patch ... ") - ;; fix environment for gnu patch, so it won't make numbered extensions - (setq backup-style (getenv "VERSION_CONTROL")) - (setenv "VERSION_CONTROL" nil) - ;; always pass patch the -f option, so it won't ask any questions - (shell-command-on-region - (point-min) (point-max) - (format "%s -f %s -b %s %s" - ediff-patch-program ediff-patch-options - backup-extension - (expand-file-name true-source-filename)) - t) - ;; restore environment for gnu patch - (setenv "VERSION_CONTROL" backup-style)) - ;;(message "Applying patch ... done")(sit-for 0) - (switch-to-buffer ediff-patch-diagnostics) - (sit-for 0) ; synchronize - let the user see diagnostics - - (or (file-exists-p (concat true-source-filename backup-extension)) - (error "Patch failed or didn't modify the original file")) - - ;; If black magic is involved, apply patch to a temp copy of the - ;; file. Otherwise, apply patch to the orig copy. If patch is applied - ;; to temp copy, we name the result old-name_patched for local files - ;; and temp-copy_patched for remote files. The orig file name isn't - ;; changed, and the temp copy of the original is later deleted. - ;; Without magic, the original file is renamed (usually into - ;; old-name_orig) and the result of patching will have the same name as - ;; the original. - (if (not file-name-magic-p) - (ediff-eval-in-buffer buf-to-patch - (set-visited-file-name (concat source-filename backup-extension)) - (set-buffer-modified-p nil)) - - ;; Black magic in effect. - ;; If orig file was remote, put the patched file in the temp directory. - ;; If orig file is local, put the patched file in the directory of - ;; the orig file. - (setq target-filename - (concat - (if (ediff-file-remote-p (file-truename source-filename)) - true-source-filename - source-filename) - "_patched")) - - (rename-file true-source-filename target-filename t) - - ;; arrange that the temp copy of orig will be deleted - (rename-file (concat true-source-filename backup-extension) - true-source-filename t)) - - ;; make orig buffer read-only - (setq startup-hooks - (cons 'ediff-set-read-only-in-buf-A startup-hooks)) - - ;; set up a buf for the patched file - (setq target-buf (find-file-noselect target-filename)) - - (setq ctl-buf - (ediff-buffers-internal - buf-to-patch target-buf nil - startup-hooks (or job-name 'ediff-patch-file))) - - (bury-buffer ediff-patch-diagnostics) - (message "Patch diagnostics are available in buffer %s" - (buffer-name ediff-patch-diagnostics)) - ctl-buf)) - ;; Used as a startup hook to set `_orig' patch file read-only. (defun ediff-set-read-only-in-buf-A () --- 128,139 ---- (defvar ediff-last-dir-ancestor nil "Last directory used by an Ediff command for the ancestor file.") ! ;; Some defvars to reduce the number of compiler warnings ! (defvar cvs-cookie-handle) ! (defvar ediff-last-dir-patch) ! (defvar ediff-patch-default-directory) ! ;; end of compiler pacifier ;; Used as a startup hook to set `_orig' patch file read-only. (defun ediff-set-read-only-in-buf-A () *************** *** 279,287 **** )) - ;;;###autoload - (defalias 'epatch 'ediff-patch-file) - ;;;###autoload - (defalias 'epatch-buffer 'ediff-patch-buffer) - ;;; Compare files/buffers --- 153,156 ---- *************** *** 466,472 **** (ediff-other-buffer bf)) t)))) - (or job-name (setq job-name 'ediff-buffers)) (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name)) ;;;###autoload --- 335,344 ---- (ediff-other-buffer bf)) t)))) (or job-name (setq job-name 'ediff-buffers)) (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name)) + + ;;;###autoload + (defalias 'ebuffers 'ediff-buffers) + ;;;###autoload *************** *** 493,499 **** t) ))) - (or job-name (setq job-name 'ediff-buffers3)) (ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name)) --- 365,373 ---- t) ))) (or job-name (setq job-name 'ediff-buffers3)) (ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name)) + + ;;;###autoload + (defalias 'ebuffers3 'ediff-buffers3) *************** *** 560,569 **** "Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that ! further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil)) ! (ediff-read-file-name "Directory B to compare" (if ediff-use-last-dir ediff-last-dir-B --- 434,443 ---- "Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that ! can be used to filter out certain file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil)) ! (ediff-read-file-name "Directory B to compare:" (if ediff-use-last-dir ediff-last-dir-B *************** further filters the file names." *** 571,575 **** nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directories-internal --- 445,449 ---- nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directories-internal *************** names. Only the files that are under rev *** 589,595 **** (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name ! "Directory to compare with revision" dir-A nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal --- 463,469 ---- (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name ! "Directory to compare with revision:" dir-A nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal *************** names. Only the files that are under rev *** 605,619 **** "Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular ! expression that further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to compare" dir-A nil)) ! (setq f (ediff-read-file-name "Directory B to compare" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) ! (ediff-read-file-name "Directory C to compare" (if ediff-use-last-dir ediff-last-dir-C --- 479,493 ---- "Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular ! expression that can be used to filter out certain file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil)) ! (setq f (ediff-read-file-name "Directory B to compare:" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) ! (ediff-read-file-name "Directory C to compare:" (if ediff-use-last-dir ediff-last-dir-C *************** expression that further filters the file *** 621,625 **** nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directories-internal --- 495,499 ---- nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directories-internal *************** expression that further filters the file *** 634,643 **** "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that ! further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil)) ! (ediff-read-file-name "Directory B to merge" (if ediff-use-last-dir ediff-last-dir-B --- 508,517 ---- "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that ! can be used to filter out certain file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil)) ! (ediff-read-file-name "Directory B to merge:" (if ediff-use-last-dir ediff-last-dir-B *************** further filters the file names." *** 645,649 **** nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directories-internal --- 519,523 ---- nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directories-internal *************** further filters the file names." *** 655,672 **** ;;;###autoload ! (defun ediff-merge-directories-with-ancestor (dir1 dir2 dir3 regexp) ! "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have ! the same name in both. The third argument, REGEXP, is a regular expression that ! further filters the file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to merge" dir-A nil)) ! (setq f (ediff-read-file-name "Directory B to merge" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) ! (ediff-read-file-name "Ancestor directory: " (if ediff-use-last-dir ediff-last-dir-C --- 529,548 ---- ;;;###autoload ! (defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp) ! "Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors. ! Ediff merges files that have identical names in DIR1, DIR2. If a pair of files ! in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge ! without ancestor. The fourth argument, REGEXP, is a regular expression that ! can be used to filter out certain file names." (interactive (let ((dir-A (ediff-get-default-directory-name)) f) ! (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil)) ! (setq f (ediff-read-file-name "Directory B to merge:" (if ediff-use-last-dir ediff-last-dir-B (ediff-strip-last-dir f)) nil)) ! (ediff-read-file-name "Ancestor directory:" (if ediff-use-last-dir ediff-last-dir-C *************** further filters the file names." *** 674,681 **** nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directories-internal ! dir1 dir2 dir3 regexp 'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor )) --- 550,557 ---- nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directories-internal ! dir1 dir2 ancestor-dir regexp 'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor )) *************** names. Only the files that are under rev *** 689,695 **** (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name ! "Directory to merge with revisions" dir-A nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal --- 565,571 ---- (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name ! "Directory to merge with revisions:" dir-A nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal *************** names. Only the files that are under rev *** 708,714 **** (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name ! "Directory to merge with revisions and ancestors" dir-A nil) (read-string "Filter through regular expression: " ! nil ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal --- 584,590 ---- (let ((dir-A (ediff-get-default-directory-name))) (list (ediff-read-file-name ! "Directory to merge with revisions and ancestors:" dir-A nil) (read-string "Filter through regular expression: " ! nil 'ediff-filtering-regexp-history) ))) (ediff-directory-revisions-internal *************** names. Only the files that are under rev *** 727,732 **** ;; Run ediff-action (ediff-files, ediff-merge, ediff-merge-with-ancestors) ;; on a pair of directories (three directories, in case of ancestor). ! ;; The third argument, REGEXP, is a regular expression that further filters the ! ;; file names. ;; JOBNAME is the symbol indicating the meta-job to be performed. (defun ediff-directories-internal (dir1 dir2 dir3 regexp --- 603,608 ---- ;; Run ediff-action (ediff-files, ediff-merge, ediff-merge-with-ancestors) ;; on a pair of directories (three directories, in case of ancestor). ! ;; The third argument, REGEXP, is a regular expression that can be used to ! ;; filter out certain file names. ;; JOBNAME is the symbol indicating the meta-job to be performed. (defun ediff-directories-internal (dir1 dir2 dir3 regexp *************** names. Only the files that are under rev *** 764,768 **** startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer ! 'ediff-dir-action file-list "*Ediff Session Group Panel" --- 640,644 ---- startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer ! 'ediff-filegroup-action file-list "*Ediff Session Group Panel" *************** names. Only the files that are under rev *** 788,792 **** startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer ! 'ediff-dir-action file-list "*Ediff Session Group Panel" --- 664,668 ---- startup-hooks)) (setq meta-buf (ediff-prepare-meta-buffer ! 'ediff-filegroup-action file-list "*Ediff Session Group Panel" *************** file and then run `run-ediff-from-cvs-bu *** 1226,1291 **** ;;; Apply patch - - ;;;###autoload - (defun ediff-patch-buffer (buffer-name &optional startup-hooks) - "Run Ediff by patching BUFFER-NAME." - (interactive "bBuffer to patch: ") - - (let* ((buf-to-patch (get-buffer buffer-name)) - (file-name-ok (if buf-to-patch (buffer-file-name buf-to-patch))) - (buf-mod-status (buffer-modified-p buf-to-patch)) - default-dir file-name ctl-buf) - (if file-name-ok - (setq file-name file-name-ok) - (ediff-eval-in-buffer buffer-name - (setq default-dir default-directory) - (setq file-name (ediff-make-temp-file buffer-name)) - (set-visited-file-name file-name) - (setq buffer-auto-save-file-name nil) ; don't create auto-save file - (rename-buffer buffer-name) ; don't confuse the user with new buf name - (set-buffer-modified-p nil) - (set-visited-file-modtime) ; sync buffer and temp file - (setq default-directory default-dir) - )) - - (setq ctl-buf - (ediff-patch-file file-name startup-hooks 'ediff-patch-buffer)) - - (if file-name-ok - () - (ediff-eval-in-buffer ctl-buf - (delete-file (buffer-file-name ediff-buffer-A)) - (delete-file (buffer-file-name ediff-buffer-B)) - (ediff-eval-in-buffer ediff-buffer-A - (if default-dir (setq default-directory default-dir)) - (set-visited-file-name nil) - (rename-buffer buffer-name) - (set-buffer-modified-p buf-mod-status)) - (ediff-eval-in-buffer ediff-buffer-B - (setq buffer-auto-save-file-name nil) ; don't create auto-save file - (if default-dir (setq default-directory default-dir)) - (set-visited-file-name nil) - (rename-buffer (ediff-unique-buffer-name - (concat buffer-name "_patched") "")) - (set-buffer-modified-p t)))) - )) ! (defun ediff-get-patch-buffer (dir) ! "Obtain patch buffer. If patch is already in a buffer---use it. ! Else, read patch file into a new buffer." ! (if (y-or-n-p "Is the patch file already in a buffer? ") ! (setq ediff-patch-buf ! (get-buffer (read-buffer "Patch buffer name: " nil t))) ;must match ! (setq ediff-patch-buf ! (find-file-noselect (read-file-name "Patch file name: " dir)))) ! (setq ediff-patch-diagnostics ! (get-buffer-create "*ediff patch diagnostics*")) ! (ediff-eval-in-buffer ediff-patch-diagnostics ! (insert-buffer ediff-patch-buf))) - --- 1102,1147 ---- ;;; Apply patch + ;;;###autoload + (defun ediff-patch-file () + "Run Ediff by patching SOURCE-FILENAME." + ;; This now returns the control buffer + (interactive) + (let (source-dir source-file patch-buf) + (require 'ediff-ptch) + (setq patch-buf (ediff-get-patch-buffer)) + (setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch) + ((and (not ediff-patch-default-directory) + (buffer-file-name patch-buf)) + (file-name-directory + (expand-file-name + (buffer-file-name patch-buf)))) + (t default-directory))) + (setq source-file + ;; the default is the directory, not the visited file name + (ediff-read-file-name "Which file to patch? " source-dir source-dir)) + (ediff-dispatch-file-patching-job patch-buf source-file))) ! ;;;###autoload ! (defun ediff-patch-buffer () ! "Run Ediff by patching BUFFER-NAME." ! (interactive) ! (let (patch-buf) ! (require 'ediff-ptch) ! (setq patch-buf (ediff-get-patch-buffer)) ! (ediff-patch-buffer-internal ! patch-buf ! (read-buffer "Which buffer to patch? " ! (cond ((eq patch-buf (current-buffer)) ! (window-buffer (other-window 1))) ! (t (current-buffer))) ! 'must-match)))) ! ;;;###autoload ! (defalias 'epatch 'ediff-patch-file) ! ;;;###autoload ! (defalias 'epatch-buffer 'ediff-patch-buffer) *************** When called interactively, displays the *** 1344,1348 **** ;;;###autoload (defun ediff-documentation () ! "Jump to Ediff's Info file." (interactive) (let ((ctl-window ediff-control-window) --- 1200,1204 ---- ;;;###autoload (defun ediff-documentation () ! "Display Ediff's manual." (interactive) (let ((ctl-window ediff-control-window) *************** When called interactively, displays the *** 1356,1360 **** (message "Type `i' to search for a specific topic")) (error (beep 1) ! (with-output-to-temp-buffer " *ediff-info*" (princ (format " The Info file for Ediff does not seem to be installed. --- 1212,1216 ---- (message "Type `i' to search for a specific topic")) (error (beep 1) ! (with-output-to-temp-buffer ediff-msg-buffer (princ (format " The Info file for Ediff does not seem to be installed. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ehelp.el emacs-19.32/lisp/ehelp.el *** emacs-19.31/lisp/ehelp.el Fri Apr 5 11:04:11 1996 --- emacs-19.32/lisp/ehelp.el Fri May 31 11:32:33 1996 *************** will select it.)" *** 261,266 **** ;;;###autoload ! (defun electric-helpify (fun) ! (let ((name "*Help*")) (if (save-window-excursion ;; kludge-o-rama --- 261,266 ---- ;;;###autoload ! (defun electric-helpify (fun &optional name) ! (let ((name (or name "*Help*"))) (if (save-window-excursion ;; kludge-o-rama *************** will select it.)" *** 364,368 **** (defun electric-command-apropos () (interactive) ! (electric-helpify 'command-apropos)) ;(define-key help-map "a" 'electric-command-apropos) --- 364,368 ---- (defun electric-command-apropos () (interactive) ! (electric-helpify 'command-apropos "*Apropos*")) ;(define-key help-map "a" 'electric-command-apropos) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/emerge.el emacs-19.32/lisp/emerge.el *** emacs-19.31/lisp/emerge.el Sun Feb 25 17:46:32 1996 --- emacs-19.32/lisp/emerge.el Tue Jul 30 16:02:12 1996 *************** This is *not* a user option, since Emerg *** 859,868 **** (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) (emerge-files-internal file-A file-B startup-hooks ! (if file-out ! (cons (` (lambda () (emerge-files-exit (, file-out)))) ! quit-hooks) ! quit-hooks) file-out)) --- 859,867 ---- (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) + (if file-out + (add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out)))))) (emerge-files-internal file-A file-B startup-hooks ! quit-hooks file-out)) *************** This is *not* a user option, since Emerg *** 882,891 **** (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) (emerge-files-with-ancestor-internal file-A file-B file-ancestor startup-hooks ! (if file-out ! (cons (` (lambda () (emerge-files-exit (, file-out)))) ! quit-hooks) ! quit-hooks) file-out)) --- 881,889 ---- (emerge-read-file-name "Output file" emerge-last-dir-output f f nil))))) + (if file-out + (add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out)))))) (emerge-files-with-ancestor-internal file-A file-B file-ancestor startup-hooks ! quit-hooks file-out)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/etags.el emacs-19.32/lisp/etags.el *** emacs-19.31/lisp/etags.el Mon May 6 20:04:25 1996 --- emacs-19.32/lisp/etags.el Tue Jul 23 18:32:48 1996 *************** Pop back to the last location with \\[ne *** 101,108 **** ;; These variables are local in tags table buffers. - (defvar tag-lines-already-matched nil - "List of positions of beginnings of lines within the tags table - that are already matched.") - (defvar tags-table-files nil "List of file names covered by current tags table. --- 101,104 ---- *************** One argument, the tag info returned by ` *** 165,169 **** ;; made buffer-local and initialized to nil. (defun initialize-new-tags-table () - (set (make-local-variable 'tag-lines-already-matched) nil) (set (make-local-variable 'tags-table-files) nil) (set (make-local-variable 'tags-completion-table) nil) --- 161,164 ---- *************** See documentation of variable `tags-file *** 877,880 **** --- 872,877 ---- ;; avoid repetition. State is saved so that the loop can be continued. + (defvar tag-lines-already-matched nil) ;matches remembered here between calls + (defun find-tag-in-order (pattern search-forward-func *************** See documentation of variable `tags-file *** 887,895 **** (first-table t) (tag-order order) goto-func ) (save-excursion ! (or first-search ;find-tag-noselect has already done it. ! (visit-tags-table-buffer 'same)) ;; Get a qualified match. --- 884,904 ---- (first-table t) (tag-order order) + (match-marker (make-marker)) goto-func ) (save-excursion ! ! (if first-search ! ;; This is the start of a search for a fresh tag. ! ;; Clear the list of tags matched by the previous search. ! ;; find-tag-noselect has already put us in the first tags table ! ;; buffer before we got called. ! (setq tag-lines-already-matched nil) ! ;; Continuing to search for the tag specified last time. ! ;; tag-lines-already-matched lists locations matched in previous ! ;; calls so we don't visit the same tag twice if it matches twice ! ;; during two passes with different qualification predicates. ! ;; Switch to the current tags table buffer. ! (visit-tags-table-buffer 'same)) ;; Get a qualified match. *************** See documentation of variable `tags-file *** 900,906 **** (visit-tags-table-buffer t)) - (if first-search - (setq tag-lines-already-matched nil)) - (and first-search first-table ;; Start at beginning of tags file. --- 909,912 ---- *************** See documentation of variable `tags-file *** 915,921 **** (and (funcall (car order) pattern) ;; Make sure it is not a previous qualified match. ! ;; Use of `memq' depends on numbers being eq. ! (not (memq (save-excursion (beginning-of-line) (point)) ! tag-lines-already-matched)) (throw 'qualified-match-found nil)) (if next-line-after-failure-p --- 921,928 ---- (and (funcall (car order) pattern) ;; Make sure it is not a previous qualified match. ! (not (member (set-marker match-marker (save-excursion ! (beginning-of-line) ! (point))) ! tag-lines-already-matched)) (throw 'qualified-match-found nil)) (if next-line-after-failure-p *************** See documentation of variable `tags-file *** 926,929 **** --- 933,942 ---- (setq order tag-order)) ;; We throw out on match, so only get here if there were no matches. + ;; Clear out the markers we use to avoid duplicate matches so they + ;; don't slow down editting and are immediately available for GC. + (while tag-lines-already-matched + (set-marker (car tag-lines-already-matched) nil nil) + (setq tag-lines-already-matched (cdr tag-lines-already-matched))) + (set-marker match-marker nil nil) (error "No %stags %s %s" (if first-search "" "more ") matching pattern)) *************** See documentation of variable `tags-file *** 931,935 **** ;; Found a tag; extract location info. (beginning-of-line) ! (setq tag-lines-already-matched (cons (point) tag-lines-already-matched)) ;; Expand the filename, using the tags table buffer's default-directory. --- 944,948 ---- ;; Found a tag; extract location info. (beginning-of-line) ! (setq tag-lines-already-matched (cons match-marker tag-lines-already-matched)) ;; Expand the filename, using the tags table buffer's default-directory. *************** See documentation of variable `tags-file *** 1063,1071 **** (defun etags-goto-tag-location (tag-info) (let ((startpos (cdr (cdr tag-info))) offset found pat) (if (eq (car tag-info) t) ;; Direct file tag. (cond (line (goto-line line)) ! (position (goto-char position)) (t (error "etags.el BUG: bogus direct file tag"))) ;; This constant is 1/2 the initial search window. --- 1076,1085 ---- (defun etags-goto-tag-location (tag-info) (let ((startpos (cdr (cdr tag-info))) + (line (car (cdr tag-info))) offset found pat) (if (eq (car tag-info) t) ;; Direct file tag. (cond (line (goto-line line)) ! (startpos (goto-char startpos)) (t (error "etags.el BUG: bogus direct file tag"))) ;; This constant is 1/2 the initial search window. *************** See documentation of variable `tags-file *** 1083,1088 **** ;; If no char pos was given, try the given line number. (or startpos ! (if (car (cdr tag-info)) ! (setq startpos (progn (goto-line (car (cdr tag-info))) (point))))) (or startpos --- 1097,1102 ---- ;; If no char pos was given, try the given line number. (or startpos ! (if line ! (setq startpos (progn (goto-line line) (point))))) (or startpos *************** See documentation of variable `tags-file *** 1120,1124 **** (princ (if (looking-at "[^\n]+\001") ;; There is an explicit tag name; use that. ! (buffer-substring (point) (progn (skip-chars-forward "^\001") (point))) --- 1134,1138 ---- (princ (if (looking-at "[^\n]+\001") ;; There is an explicit tag name; use that. ! (buffer-substring (1+ (point)) ;skip \177 (progn (skip-chars-forward "^\001") (point))) *************** See documentation of variable `tags-file *** 1222,1231 **** (defun tag-word-match-p (tag) (and (looking-at "\\b.*\177") ! (save-excursion (backward-char (1+ (length tag))) (looking-at "\\b")))) (defun tag-exact-file-name-match-p (tag) (and (looking-at ",") ! (save-excursion (backward-char (1+ (length tag))) (looking-at "\f\n")))) --- 1236,1245 ---- (defun tag-word-match-p (tag) (and (looking-at "\\b.*\177") ! (save-excursion (backward-char (length tag)) (looking-at "\\b")))) (defun tag-exact-file-name-match-p (tag) (and (looking-at ",") ! (save-excursion (backward-char (length tag)) (looking-at "\f\n")))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/executable.el emacs-19.32/lisp/executable.el *** emacs-19.31/lisp/executable.el Fri Mar 1 00:26:23 1996 --- emacs-19.32/lisp/executable.el Sun Jul 21 15:48:54 1996 *************** See `compilation-error-regexp-alist'.") *** 120,125 **** ;; The C function openp slightly modified would do the trick fine (defun executable-find (command) ! "Search for COMMAND in $PATH and return the absolute file name. ! Return nil if COMMAND is not found anywhere in $PATH." (let ((list exec-path) file) --- 120,125 ---- ;; The C function openp slightly modified would do the trick fine (defun executable-find (command) ! "Search for COMMAND in exec-path and return the absolute file name. ! Return nil if COMMAND is not found anywhere in `exec-path'." (let ((list exec-path) file) *************** executable." *** 198,219 **** (if (looking-at "#![ \t]*\\(.*\\)$") (and (goto-char (match-beginning 1)) (not (string= argument (buffer-substring (point) (match-end 1)))) ! (or (not executable-query) no-query-flag ! (save-window-excursion ! ;; Make buffer visible before question. ! (switch-to-buffer (current-buffer)) ! (y-or-n-p (concat "Replace magic number by `" ! executable-prefix argument "'? ")))) ! (progn ! (replace-match argument t t nil 1) ! (message "Magic number changed to `%s'" ! (concat executable-prefix argument)))) (insert executable-prefix argument ?\n) (message "Magic number changed to `%s'" (concat executable-prefix argument))) ! (or insert-flag ! (eq executable-insert t) ! (set-buffer-modified-p buffer-modified-p))))) interpreter) --- 198,223 ---- (if (looking-at "#![ \t]*\\(.*\\)$") (and (goto-char (match-beginning 1)) + ;; If the line ends in a space, + ;; don't offer to change it. + (not (= (char-after (1- (match-end 1))) ?\ )) (not (string= argument (buffer-substring (point) (match-end 1)))) ! (if (or (not executable-query) no-query-flag ! (save-window-excursion ! ;; Make buffer visible before question. ! (switch-to-buffer (current-buffer)) ! (y-or-n-p (concat "Replace magic number by `" ! executable-prefix argument "'? ")))) ! (progn ! (replace-match argument t t nil 1) ! (message "Magic number changed to `%s'" ! (concat executable-prefix argument))))) (insert executable-prefix argument ?\n) (message "Magic number changed to `%s'" (concat executable-prefix argument))) ! ;;; (or insert-flag ! ;;; (eq executable-insert t) ! ;;; (set-buffer-modified-p buffer-modified-p)) ! ))) interpreter) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/facemenu.el emacs-19.32/lisp/facemenu.el *** emacs-19.31/lisp/facemenu.el Wed Mar 27 23:39:44 1996 --- emacs-19.32/lisp/facemenu.el Fri Jun 7 20:55:31 1996 *************** Automatically called when a new face is *** 633,637 **** (defun facemenu-complete-face-list (&optional oldlist) ! "Return list of all faces that are look different. Starts with given ALIST of faces, and adds elements only if they display differently from any face already on the list. --- 633,637 ---- (defun facemenu-complete-face-list (&optional oldlist) ! "Return list of all faces that look different. Starts with given ALIST of faces, and adds elements only if they display differently from any face already on the list. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/faces.el emacs-19.32/lisp/faces.el *** emacs-19.31/lisp/faces.el Mon Mar 25 10:09:30 1996 --- emacs-19.32/lisp/faces.el Sat Jun 22 12:50:08 1996 *************** selected frame." *** 1102,1106 **** (cdr (assq 'background-color params)) frame)) ! (/ (apply '+ (x-color-values "white" frame)) 3)) 'dark) (t 'light))) --- 1102,1109 ---- (cdr (assq 'background-color params)) frame)) ! ;; Just looking at the screen, ! ;; colors whose values add up to .6 of the white total ! ;; still look dark to me. ! (* (apply '+ (x-color-values "white" frame)) .6)) 'dark) (t 'light))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/fast-lock.el emacs-19.32/lisp/fast-lock.el *** emacs-19.31/lisp/fast-lock.el Fri Jan 26 03:26:26 1996 --- emacs-19.32/lisp/fast-lock.el Mon Jun 24 03:44:07 1996 *************** *** 5,9 **** ;; Author: Simon Marshall ;; Keywords: faces files ! ;; Version: 3.09 ;;; This file is part of GNU Emacs. --- 5,9 ---- ;; Author: Simon Marshall ;; Keywords: faces files ! ;; Version: 3.10 ;;; This file is part of GNU Emacs. *************** *** 38,42 **** ;; Put in your ~/.emacs: ;; ! ;; (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) ;; ;; Start up a new Emacs and use font-lock as usual (except that you can use the --- 38,42 ---- ;; Put in your ~/.emacs: ;; ! ;; (setq font-lock-support-mode 'fast-lock-mode) ;; ;; Start up a new Emacs and use font-lock as usual (except that you can use the *************** *** 153,165 **** ;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename' ;; 3.08--3.09: ! ;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is a list ;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock' ;; - Added `fast-lock-after-unfontify-buffer' (require 'font-lock) (eval-when-compile ! ;; Shut Emacs' byte-compiler up (cf. stop me getting mail from users). ! (setq byte-compile-warnings '(free-vars callargs redefine))) (defun fast-lock-submit-bug-report () --- 153,194 ---- ;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename' ;; 3.08--3.09: ! ;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is an a list ;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock' ;; - Added `fast-lock-after-unfontify-buffer' + ;; 3.09--3.10: + ;; - Rewrite for Common Lisp macros + ;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help) + ;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie + ;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list' + ;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode' + ;; - Wrap with `save-buffer-state' (Ray Van Tassle report) + ;; - Made `fast-lock-mode' wrap `font-lock-support-mode' (require 'font-lock) + ;; Make sure fast-lock.el is supported. + (if (and (eq system-type 'ms-dos) (not (msdos-long-file-names))) + (error "`fast-lock' was written for long file name systems")) + (eval-when-compile ! ;; ! ;; We don't do this at the top-level as we only use non-autoloaded macros. ! (require 'cl) ! ;; ! ;; I prefer lazy code---and lazy mode. ! (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t) ! ;; ! ;; We use this to preserve or protect things when modifying text properties. ! (defmacro save-buffer-state (varlist &rest body) ! "Bind variables according to VARLIST and eval BODY restoring buffer state." ! (` (let* ((,@ (append varlist ! '((modified (buffer-modified-p)) ! (inhibit-read-only t) (buffer-undo-list t) ! before-change-functions after-change-functions ! deactivate-mark buffer-file-name buffer-file-truename)))) ! (,@ body) ! (when (and (not modified) (buffer-modified-p)) ! (set-buffer-modified-p nil))))) ! (put 'save-buffer-state 'lisp-indent-function 1)) (defun fast-lock-submit-bug-report () *************** *** 167,171 **** (interactive) (let ((reporter-prompt-for-summary-p t)) ! (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.09" '(fast-lock-cache-directories fast-lock-minimum-size fast-lock-save-others fast-lock-save-events fast-lock-save-faces) --- 196,200 ---- (interactive) (let ((reporter-prompt-for-summary-p t)) ! (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.10" '(fast-lock-cache-directories fast-lock-minimum-size fast-lock-save-others fast-lock-save-events fast-lock-save-faces) *************** Start a fresh Emacs via `" invocation-na *** 179,184 **** In the `*scratch*' buffer, evaluate:")))) ! ;;;###autoload ! (defvar fast-lock-mode nil) ; for modeline (defvar fast-lock-cache-timestamp nil) ; for saving/reading (defvar fast-lock-cache-filename nil) ; for deleting --- 208,212 ---- In the `*scratch*' buffer, evaluate:")))) ! (defvar fast-lock-mode nil) (defvar fast-lock-cache-timestamp nil) ; for saving/reading (defvar fast-lock-cache-filename nil) ; for deleting *************** In the `*scratch*' buffer, evaluate:"))) *** 189,193 **** ; - `internal', keep each file's Font Lock cache file in the same file. ; - `external', keep each file's Font Lock cache file in the same directory. ! "Directories in which Font Lock cache files are saved and read. Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where DIR is a directory name (relative or absolute) and REGEXP is a regexp. --- 217,221 ---- ; - `internal', keep each file's Font Lock cache file in the same file. ; - `external', keep each file's Font Lock cache file in the same directory. ! "*Directories in which Font Lock cache files are saved and read. Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where DIR is a directory name (relative or absolute) and REGEXP is a regexp. *************** home directory hierarchy, or otherwise t *** 207,221 **** (defvar fast-lock-minimum-size (* 25 1024) ! "If non-nil, the minimum size for buffers. Only buffers more than this can have associated Font Lock cache files saved. If nil, means cache files are never created. If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c++-mode . 25600) (c-mode . 25600) (rmail-mode . 1048576)) ! means that the minimum size is 25K for buffers in `c++-mode' or `c-mode', one ! megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") (defvar fast-lock-save-events '(kill-buffer kill-emacs) ! "A list of events under which caches will be saved. Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. If concurrent editing sessions use the same associated cache file for a file's --- 235,249 ---- (defvar fast-lock-minimum-size (* 25 1024) ! "*Minimum size of a buffer for cached fontification. Only buffers more than this can have associated Font Lock cache files saved. If nil, means cache files are never created. If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) ! means that the minimum size is 25K for buffers in C or C++ modes, one megabyte ! for buffers in Rmail mode, and size is irrelevant otherwise.") (defvar fast-lock-save-events '(kill-buffer kill-emacs) ! "*Events under which caches will be saved. Valid events are `save-buffer', `kill-buffer' and `kill-emacs'. If concurrent editing sessions use the same associated cache file for a file's *************** buffer, then you should add `save-buffer *** 223,241 **** (defvar fast-lock-save-others t ! "If non-nil, save Font Lock cache files irrespective of file owner. If nil, means only buffer files known to be owned by you can have associated Font Lock cache files saved. Ownership may be unknown for networked files.") (defvar fast-lock-save-faces ! ;; Since XEmacs uses extents for everything, we have to pick the right ones. ! ;; In XEmacs 19.13 we can't identify which text properties are Font Lock's. ! (if (save-match-data (string-match "XEmacs" (emacs-version))) ! '(font-lock-string-face font-lock-doc-string-face font-lock-type-face ! font-lock-function-name-face font-lock-comment-face ! font-lock-keyword-face font-lock-reference-face ! font-lock-preprocessor-face) ! ;; For Emacs 19.30 I don't think this is generally necessary. ! nil) ! "A list of faces that will be saved in a Font Lock cache file. If nil, means information for all faces will be saved.") --- 251,263 ---- (defvar fast-lock-save-others t ! "*If non-nil, save Font Lock cache files irrespective of file owner. If nil, means only buffer files known to be owned by you can have associated Font Lock cache files saved. Ownership may be unknown for networked files.") (defvar fast-lock-save-faces ! (when (save-match-data (string-match "XEmacs" (emacs-version))) ! ;; XEmacs uses extents for everything, so we have to pick the right ones. ! font-lock-face-list) ! "Faces that will be saved in a Font Lock cache file. If nil, means information for all faces will be saved.") *************** With arg, turn Fast Lock mode on if and *** 248,252 **** is associated with a file. Enable it automatically in your `~/.emacs' by: ! (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) If Fast Lock mode is enabled, and the current buffer does not contain any text --- 270,274 ---- is associated with a file. Enable it automatically in your `~/.emacs' by: ! (setq font-lock-support-mode 'fast-lock-mode) If Fast Lock mode is enabled, and the current buffer does not contain any text *************** Use \\[fast-lock-submit-bug-report] to s *** 277,289 **** (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) (if (and fast-lock-mode (not font-lock-mode)) ! ;; Turned on `fast-lock-mode' rather than using `font-lock-mode-hook'. ! (progn ! (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) (font-lock-mode t)) ;; Let's get down to business. (set (make-local-variable 'fast-lock-cache-timestamp) nil) (set (make-local-variable 'fast-lock-cache-filename) nil) ! (if (and fast-lock-mode (not font-lock-fontified)) ! (fast-lock-read-cache)))) (defun fast-lock-read-cache () --- 299,310 ---- (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode)))) (if (and fast-lock-mode (not font-lock-mode)) ! ;; Turned on `fast-lock-mode' rather than `font-lock-mode'. ! (let ((font-lock-support-mode 'fast-lock-mode)) (font-lock-mode t)) ;; Let's get down to business. (set (make-local-variable 'fast-lock-cache-timestamp) nil) (set (make-local-variable 'fast-lock-cache-filename) nil) ! (when (and fast-lock-mode (not font-lock-fontified)) ! (fast-lock-read-cache)))) (defun fast-lock-read-cache () *************** See `fast-lock-mode'." *** 306,316 **** (while (and directories (not font-lock-fontified)) (let ((directory (fast-lock-cache-directory (car directories) nil))) ! (if (not directory) ! nil ! (setq fast-lock-cache-filename (fast-lock-cache-name directory)) ! (condition-case nil ! (if (file-readable-p fast-lock-cache-filename) ! (load fast-lock-cache-filename t t t)) ! (error nil) (quit nil))) (setq directories (cdr directories)))) ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if --- 327,336 ---- (while (and directories (not font-lock-fontified)) (let ((directory (fast-lock-cache-directory (car directories) nil))) ! (condition-case nil ! (when directory ! (setq fast-lock-cache-filename (fast-lock-cache-name directory)) ! (when (file-readable-p fast-lock-cache-filename) ! (load fast-lock-cache-filename t t t))) ! (error nil) (quit nil)) (setq directories (cdr directories)))) ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if *************** See `fast-lock-mode'." *** 318,323 **** ;; of `fast-lock-cache-timestamp'.) (set-buffer-modified-p modified) ! (if (not font-lock-fontified) ! (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) (defun fast-lock-save-cache (&optional buffer) --- 338,343 ---- ;; of `fast-lock-cache-timestamp'.) (set-buffer-modified-p modified) ! (unless font-lock-fontified ! (setq fast-lock-cache-filename nil font-lock-fontified fontified)))) (defun fast-lock-save-cache (&optional buffer) *************** See `fast-lock-mode'." *** 338,377 **** (interactive) (save-excursion ! (and buffer (set-buffer buffer)) ! (let ((min-size (if (not (consp fast-lock-minimum-size)) ! fast-lock-minimum-size ! (cdr (or (assq major-mode fast-lock-minimum-size) ! (assq t fast-lock-minimum-size))))) (file-timestamp (visited-file-modtime)) (saved nil)) ! (if (and fast-lock-mode ! ;; ! ;; "Only save if the buffer matches the file, the file has ! ;; changed, and it was changed by the current emacs session." ! ;; ! ;; Only save if the buffer is not modified, ! ;; (i.e., so we don't save for something not on disk) ! (not (buffer-modified-p)) ! ;; and the file's timestamp is the same as the buffer's, ! ;; (i.e., someone else hasn't written the file in the meantime) ! (verify-visited-file-modtime (current-buffer)) ! ;; and the file's timestamp is different from the cache's. ! ;; (i.e., a save has occurred since the cache was read) ! (not (equal fast-lock-cache-timestamp file-timestamp)) ! ;; ! ;; Only save if user's restrictions are satisfied. ! (and min-size (>= (buffer-size) min-size)) ! (or fast-lock-save-others ! (eq (user-uid) (nth 2 (file-attributes buffer-file-name)))) ! ;; ! ;; Only save if there are `face' properties to save. ! (text-property-not-all (point-min) (point-max) 'face nil)) ! ;; Try each directory until we manage to save or the user quits. ! (let ((directories fast-lock-cache-directories)) ! (while (and directories (memq saved '(nil error))) ! (let* ((dir (fast-lock-cache-directory (car directories) t)) ! (file (and dir (fast-lock-cache-name dir)))) ! (if (and file (file-writable-p file)) ! (setq saved (fast-lock-save-cache-1 file file-timestamp))) ! (setq directories (cdr directories))))))))) ;;;###autoload --- 358,396 ---- (interactive) (save-excursion ! (when buffer ! (set-buffer buffer)) ! (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size)) (file-timestamp (visited-file-modtime)) (saved nil)) ! (when (and fast-lock-mode ! ;; ! ;; "Only save if the buffer matches the file, the file has ! ;; changed, and it was changed by the current emacs session." ! ;; ! ;; Only save if the buffer is not modified, ! ;; (i.e., so we don't save for something not on disk) ! (not (buffer-modified-p)) ! ;; and the file's timestamp is the same as the buffer's, ! ;; (i.e., someone else hasn't written the file in the meantime) ! (verify-visited-file-modtime (current-buffer)) ! ;; and the file's timestamp is different from the cache's. ! ;; (i.e., a save has occurred since the cache was read) ! (not (equal fast-lock-cache-timestamp file-timestamp)) ! ;; ! ;; Only save if user's restrictions are satisfied. ! (and min-size (>= (buffer-size) min-size)) ! (or fast-lock-save-others ! (eq (user-uid) (nth 2 (file-attributes buffer-file-name)))) ! ;; ! ;; Only save if there are `face' properties to save. ! (text-property-not-all (point-min) (point-max) 'face nil)) ! ;; ! ;; Try each directory until we manage to save or the user quits. ! (let ((directories fast-lock-cache-directories)) ! (while (and directories (memq saved '(nil error))) ! (let* ((dir (fast-lock-cache-directory (car directories) t)) ! (file (and dir (fast-lock-cache-name dir)))) ! (when (and file (file-writable-p file)) ! (setq saved (fast-lock-save-cache-1 file file-timestamp))) ! (setq directories (cdr directories))))))))) ;;;###autoload *************** See `fast-lock-mode'." *** 384,391 **** (defun fast-lock-after-fontify-buffer () ;; Delete the Font Lock cache file used to restore fontification, if any. ! (if fast-lock-cache-filename ! (if (file-writable-p fast-lock-cache-filename) ! (delete-file fast-lock-cache-filename) ! (message "File %s font lock cache cannot be deleted" (buffer-name)))) ;; Flag so that a cache will be saved later even if the file is never saved. (setq fast-lock-cache-timestamp nil)) --- 403,410 ---- (defun fast-lock-after-fontify-buffer () ;; Delete the Font Lock cache file used to restore fontification, if any. ! (when fast-lock-cache-filename ! (if (file-writable-p fast-lock-cache-filename) ! (delete-file fast-lock-cache-filename) ! (message "File %s font lock cache cannot be deleted" (buffer-name)))) ;; Flag so that a cache will be saved later even if the file is never saved. (setq fast-lock-cache-timestamp nil)) *************** See `fast-lock-mode'." *** 396,413 **** ;; Miscellaneous Functions: ! (defun fast-lock-after-save-hook () ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. ! (if (memq 'save-buffer fast-lock-save-events) ! (fast-lock-save-cache))) ! (defun fast-lock-kill-buffer-hook () ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. ! (if (memq 'kill-buffer fast-lock-save-events) ! (fast-lock-save-cache))) ! (defun fast-lock-kill-emacs-hook () ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. ! (if (memq 'kill-emacs fast-lock-save-events) ! (mapcar 'fast-lock-save-cache (buffer-list)))) (defun fast-lock-cache-directory (directory create) --- 415,432 ---- ;; Miscellaneous Functions: ! (defun fast-lock-save-cache-after-save-file () ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'. ! (when (memq 'save-buffer fast-lock-save-events) ! (fast-lock-save-cache))) ! (defun fast-lock-save-cache-before-kill-buffer () ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'. ! (when (memq 'kill-buffer fast-lock-save-events) ! (fast-lock-save-cache))) ! (defun fast-lock-save-caches-before-kill-emacs () ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'. ! (when (memq 'kill-emacs fast-lock-save-events) ! (mapcar 'fast-lock-save-cache (buffer-list)))) (defun fast-lock-cache-directory (directory create) *************** See `fast-lock-cache-directories'." *** 427,432 **** (let ((bufile (expand-file-name buffer-file-truename)) (case-fold-search nil)) ! (if (save-match-data (string-match (car directory) bufile)) ! (cdr directory))))))) (cond ((not dir) nil) --- 446,451 ---- (let ((bufile (expand-file-name buffer-file-truename)) (case-fold-search nil)) ! (when (save-match-data (string-match (car directory) bufile)) ! (cdr directory))))))) (cond ((not dir) nil) *************** See `fast-lock-cache-directory'." *** 495,499 **** (error (setq saved 'error)) (quit (setq saved 'quit))) (kill-buffer tpbuf) ! (message "Saving %s font lock cache... %s." buname (cond ((eq saved 'error) "failed") ((eq saved 'quit) "aborted") --- 514,518 ---- (error (setq saved 'error)) (quit (setq saved 'quit))) (kill-buffer tpbuf) ! (message "Saving %s font lock cache...%s" buname (cond ((eq saved 'error) "failed") ((eq saved 'quit) "aborted") *************** See `fast-lock-cache-directory'." *** 505,509 **** &rest ignored) ;; Change from (HIGH LOW) for back compatibility. Remove for version 3! ! (if (consp (cdr-safe timestamp)) (setcdr timestamp (nth 1 timestamp))) ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't. (let ((current font-lock-keywords)) --- 524,529 ---- &rest ignored) ;; Change from (HIGH LOW) for back compatibility. Remove for version 3! ! (when (consp (cdr-safe timestamp)) ! (setcdr timestamp (nth 1 timestamp))) ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't. (let ((current font-lock-keywords)) *************** See `fast-lock-cache-directory'." *** 524,528 **** (fast-lock-set-face-properties properties) (error (setq loaded 'error)) (quit (setq loaded 'quit))) ! (message "Loading %s font lock cache... %s." buname (cond ((eq loaded 'error) "failed") ((eq loaded 'quit) "aborted") --- 544,548 ---- (fast-lock-set-face-properties properties) (error (setq loaded 'error)) (quit (setq loaded 'quit))) ! (message "Loading %s font lock cache...%s" buname (cond ((eq loaded 'error) "failed") ((eq loaded 'quit) "aborted") *************** Only those `face' VALUEs in `fast-lock-s *** 569,664 **** regions (cons start (cons end regions)))) ;; Add `face' face's regions, if any, to properties. ! (if regions (setq properties (cons (cons face regions) properties)))) properties))) (defun fast-lock-set-face-properties (properties) "Set all `face' text properties to PROPERTIES in the current buffer. ! Any existing `face' text properties are removed first. Leaves buffer modified. See `fast-lock-get-face-properties' for the format of PROPERTIES." ! (save-restriction ! (widen) ! (font-lock-unfontify-region (point-min) (point-max)) ! (while properties ! (let ((plist (list 'face (car (car properties)))) ! (regions (cdr (car properties)))) ;; Set the `face' property for each start/end region. (while regions (set-text-properties (nth 0 regions) (nth 1 regions) plist) ! (setq regions (nthcdr 2 regions))) ! (setq properties (cdr properties)))))) ;; Functions for XEmacs: ! (if (save-match-data (string-match "XEmacs" (emacs-version))) ! ;; It would be better to use XEmacs 19.12's `map-extents' over extents with ! ;; `font-lock' property, but `face' properties are on different extents. ! (defun fast-lock-get-face-properties () ! "Return a list of all `face' text properties in the current buffer. Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) where VALUE is a `face' property value and STARTx and ENDx are positions. Only those `face' VALUEs in `fast-lock-save-faces' are returned." ! (save-restriction ! (widen) ! (let ((properties ()) cell) ! (map-extents ! (function ! (lambda (extent ignore) ! (let ((value (extent-face extent))) ! ;; We're only interested if it's one of `fast-lock-save-faces'. ! (if (and value (or (null fast-lock-save-faces) (memq value fast-lock-save-faces))) ! (let ((start (extent-start-position extent)) ! (end (extent-end-position extent))) ! ;; Make or add to existing list of regions with the same ! ;; `face' property value. ! (if (setq cell (assq value properties)) ! (setcdr cell (cons start (cons end (cdr cell)))) ! (setq properties (cons (list value start end) ! properties))))) ! ;; Return nil to keep `map-extents' going. ! nil)))) ! properties)))) ! ! (if (save-match-data (string-match "XEmacs" (emacs-version))) ! ;; Make extents just like XEmacs's font-lock.el does. ! (defun fast-lock-set-face-properties (properties) ! "Set all `face' text properties to PROPERTIES in the current buffer. Any existing `face' text properties are removed first. See `fast-lock-get-face-properties' for the format of PROPERTIES." ! (save-restriction ! (widen) ! (font-lock-unfontify-region (point-min) (point-max)) ! (while properties ! (let ((face (car (car properties))) ! (regions (cdr (car properties)))) ! ;; Set the `face' property, etc., for each start/end region. ! (while regions ! (font-lock-set-face (nth 0 regions) (nth 1 regions) face) ! (setq regions (nthcdr 2 regions))) ! (setq properties (cdr properties))))))) ! ! (if (save-match-data (string-match "XEmacs" (emacs-version))) ! ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. ! (add-hook 'font-lock-after-fontify-buffer-hook ! 'fast-lock-after-fontify-buffer)) ! ! (or (boundp 'font-lock-inhibit-thing-lock) ! (defvar font-lock-inhibit-thing-lock nil ! "List of Font Lock mode related modes that should not be turned on.")) ! (or (fboundp 'font-lock-compile-keywords) ! (defalias 'font-lock-compile-keywords 'identity)) ;; Install ourselves: ! ;; We don't install ourselves on `font-lock-mode-hook' as packages with similar ! ;; functionality exist, and fast-lock.el should be dumpable without forcing ! ;; people to use caches or making it difficult for people to use alternatives. ! (add-hook 'after-save-hook 'fast-lock-after-save-hook) ! (add-hook 'kill-buffer-hook 'fast-lock-kill-buffer-hook) ! (add-hook 'kill-emacs-hook 'fast-lock-kill-emacs-hook) ! (or (assq 'fast-lock-mode minor-mode-alist) ! (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil))))) ;; Provide ourselves: --- 589,683 ---- regions (cons start (cons end regions)))) ;; Add `face' face's regions, if any, to properties. ! (when regions ! (push (cons face regions) properties))) properties))) (defun fast-lock-set-face-properties (properties) "Set all `face' text properties to PROPERTIES in the current buffer. ! Any existing `face' text properties are removed first. See `fast-lock-get-face-properties' for the format of PROPERTIES." ! (save-buffer-state (plist regions) ! (save-restriction ! (widen) ! (font-lock-unfontify-region (point-min) (point-max)) ! (while properties ! (setq plist (list 'face (car (car properties))) ! regions (cdr (car properties)) ! properties (cdr properties)) ;; Set the `face' property for each start/end region. (while regions (set-text-properties (nth 0 regions) (nth 1 regions) plist) ! (setq regions (nthcdr 2 regions))))))) ;; Functions for XEmacs: ! (when (save-match-data (string-match "XEmacs" (emacs-version))) ! ;; ! ;; It would be better to use XEmacs' `map-extents' over extents with a ! ;; `font-lock' property, but `face' properties are on different extents. ! (defun fast-lock-get-face-properties () ! "Return a list of all `face' text properties in the current buffer. Each element of the list is of the form (VALUE START1 END1 START2 END2 ...) where VALUE is a `face' property value and STARTx and ENDx are positions. Only those `face' VALUEs in `fast-lock-save-faces' are returned." ! (save-restriction ! (widen) ! (let ((properties ()) cell) ! (map-extents ! (function (lambda (extent ignore) ! (let ((value (extent-face extent))) ! ;; We're only interested if it's one of `fast-lock-save-faces'. ! (when (and value (or (null fast-lock-save-faces) (memq value fast-lock-save-faces))) ! (let ((start (extent-start-position extent)) ! (end (extent-end-position extent))) ! ;; Make or add to existing list of regions with the same ! ;; `face' property value. ! (if (setq cell (assq value properties)) ! (setcdr cell (cons start (cons end (cdr cell)))) ! (push (list value start end) properties)))) ! ;; Return nil to keep `map-extents' going. ! nil)))) ! properties))) ! ;; ! ;; Make extents just like XEmacs' font-lock.el does. ! (defun fast-lock-set-face-properties (properties) ! "Set all `face' text properties to PROPERTIES in the current buffer. Any existing `face' text properties are removed first. See `fast-lock-get-face-properties' for the format of PROPERTIES." ! (save-restriction ! (widen) ! (font-lock-unfontify-region (point-min) (point-max)) ! (while properties ! (let ((face (car (car properties))) ! (regions (cdr (car properties)))) ! ;; Set the `face' property, etc., for each start/end region. ! (while regions ! (font-lock-set-face (nth 0 regions) (nth 1 regions) face) ! (setq regions (nthcdr 2 regions))) ! (setq properties (cdr properties)))))) ! ;; ! ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook. ! (add-hook 'font-lock-after-fontify-buffer-hook ! 'fast-lock-after-fontify-buffer)) ! ! (unless (boundp 'font-lock-inhibit-thing-lock) ! (defvar font-lock-inhibit-thing-lock nil ! "List of Font Lock mode related modes that should not be turned on.")) ! (unless (fboundp 'font-lock-compile-keywords) ! (defalias 'font-lock-compile-keywords 'identity)) ;; Install ourselves: ! (add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file) ! (add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer) ! (add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs) ! ;;;###autoload ! (if (fboundp 'add-minor-mode) (add-minor-mode 'fast-lock-mode nil)) ! ;;;###dont-autoload ! (unless (assq 'fast-lock-mode minor-mode-alist) ! (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil))))) ;; Provide ourselves: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/files.el emacs-19.32/lisp/files.el *** emacs-19.31/lisp/files.el Tue May 21 13:18:29 1996 --- emacs-19.32/lisp/files.el Sun Jul 28 02:50:58 1996 *************** If the buffer is visiting a new file, th *** 124,127 **** --- 124,130 ---- (put 'buffer-file-number 'permanent-local t) + (defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt))) + "Non-nil means that buffer-file-number uniquely identifies files.") + (defconst file-precious-flag nil "*Non-nil means protect against I/O errors while saving files. *************** If the current buffer now contains an em *** 584,593 **** (kill-buffer " **lose**")) (rename-buffer " **lose**") - (setq buffer-file-name nil) - (setq buffer-file-number nil) - (setq buffer-file-truename nil) (unwind-protect (progn (unlock-buffer) (find-file filename)) (cond ((eq obuf (current-buffer)) --- 587,596 ---- (kill-buffer " **lose**")) (rename-buffer " **lose**") (unwind-protect (progn (unlock-buffer) + (setq buffer-file-name nil) + (setq buffer-file-number nil) + (setq buffer-file-truename nil) (find-file filename)) (cond ((eq obuf (current-buffer)) *************** This also substitutes \"~\" for the user *** 625,629 **** Type \\[describe-variable] directory-abbrev-alist RET for more information." ;; Get rid of the prefixes added by the automounter. ! (if (and (string-match automount-dir-prefix filename) (file-exists-p (file-name-directory (substring filename (1- (match-end 0)))))) --- 628,633 ---- Type \\[describe-variable] directory-abbrev-alist RET for more information." ;; Get rid of the prefixes added by the automounter. ! (if (and automount-dir-prefix ! (string-match automount-dir-prefix filename) (file-exists-p (file-name-directory (substring filename (1- (match-end 0)))))) *************** If there is no such live buffer, return *** 692,696 **** (let ((number (nthcdr 10 (file-attributes truename))) (list (buffer-list)) found) ! (and number (while (and (not found) list) (save-excursion --- 696,701 ---- (let ((number (nthcdr 10 (file-attributes truename))) (list (buffer-list)) found) ! (and buffer-file-numbers-unique ! number (while (and (not found) list) (save-excursion *************** run `normal-mode' explicitly." *** 936,939 **** --- 941,945 ---- ("\\.icn\\'" . icon-mode) ("\\.pl\\'" . perl-mode) + ("\\.pm\\'" . perl-mode) ("\\.cc\\'" . c++-mode) ("\\.hh\\'" . c++-mode) *************** run `normal-mode' explicitly." *** 986,989 **** --- 992,996 ---- ("\\.tar\\'" . tar-mode) ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode) + ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\)\\'" . archive-mode) ;; Mailer puts message to be edited in ;; /tmp/Re.... or Message *************** If `enable-local-variables' is nil, this *** 1145,1149 **** ;; outside the save-excursion. (if modes ! (progn (mapcar 'funcall modes) (setq done t))) ;; If we didn't find a mode from a -*- line, try using the file name. --- 1152,1156 ---- ;; outside the save-excursion. (if modes ! (progn (mapcar 'funcall (nreverse modes)) (setq done t))) ;; If we didn't find a mode from a -*- line, try using the file name. *************** If `enable-local-variables' is nil, this *** 1247,1253 **** (y-or-n-p (format "Set local variables as specified in -*- line of %s? " (file-name-nondirectory buffer-file-name))))))) ! (while result ! (hack-one-local-variable (car (car result)) (cdr (car result))) ! (setq result (cdr result))))))) (defvar hack-local-variables-hook nil --- 1254,1261 ---- (y-or-n-p (format "Set local variables as specified in -*- line of %s? " (file-name-nondirectory buffer-file-name))))))) ! (let ((enable-local-eval enable-local-eval)) ! (while result ! (hack-one-local-variable (car (car result)) (cdr (car result))) ! (setq result (cdr result)))))))) (defvar hack-local-variables-hook nil *************** in order to initialize other data struct *** 1348,1351 **** --- 1356,1361 ---- (put 'exec-directory 'risky-local-variable t) (put 'process-environment 'risky-local-variable t) + (put 'dabbrev-case-fold-search 'risky-local-variable t) + (put 'dabbrev-case-replace 'risky-local-variable t) ;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode. (put 'outline-level 'risky-local-variable t) *************** in order to initialize other data struct *** 1408,1417 **** ! (defun set-visited-file-name (filename) "Change name of file visited in current buffer to FILENAME. The next time the buffer is saved it will go in the newly specified file. nil or empty string as argument means make buffer not be visiting any file. Remember to delete the initial contents of the minibuffer ! if you wish to pass an empty string as the argument." (interactive "FSet visited file name: ") (if (buffer-base-buffer) --- 1418,1430 ---- ! (defun set-visited-file-name (filename &optional no-query) "Change name of file visited in current buffer to FILENAME. The next time the buffer is saved it will go in the newly specified file. nil or empty string as argument means make buffer not be visiting any file. Remember to delete the initial contents of the minibuffer ! if you wish to pass an empty string as the argument. ! ! The optional second argument NO-QUERY, if non-nil, inhibits asking for ! confirmation in the case where the file FILENAME already exists." (interactive "FSet visited file name: ") (if (buffer-base-buffer) *************** if you wish to pass an empty string as t *** 1430,1433 **** --- 1443,1447 ---- (let ((buffer (and filename (find-buffer-visiting filename)))) (and buffer (not (eq buffer (current-buffer))) + (not no-query) (not (y-or-n-p (message "A buffer is visiting %s; proceed? " filename))) *************** If WILDCARD, it also runs the shell spec *** 2650,2654 **** list) switches (substring switches (match-end 0)))) ! (setq list (cons switches list))))) (append list (list --- 2664,2668 ---- list) switches (substring switches (match-end 0)))) ! (setq list (nreverse (cons switches list)))))) (append list (list diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/fill.el emacs-19.32/lisp/fill.el *** emacs-19.31/lisp/fill.el Tue Mar 19 15:03:48 1996 --- emacs-19.32/lisp/fill.el Fri May 31 00:15:51 1996 *************** MAIL-FLAG for a mail message, i. e. don' *** 829,833 **** fill-prefix-regexp (regexp-quote fill-prefix))) (forward-line 1) ! (move-to-left-margin) ;; Now stop the loop if end of paragraph. (and (not (eobp)) --- 829,836 ---- fill-prefix-regexp (regexp-quote fill-prefix))) (forward-line 1) ! (if (bolp) ! ;; If forward-line went past a newline, ! ;; move further to the left margin. ! (move-to-left-margin)) ;; Now stop the loop if end of paragraph. (and (not (eobp)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/finder-inf.el emacs-19.32/lisp/finder-inf.el *** emacs-19.31/lisp/finder-inf.el Sat May 25 20:04:17 1996 --- emacs-19.32/lisp/finder-inf.el Thu Aug 1 21:59:09 1996 *************** *** 304,307 **** --- 304,310 ---- "support for multi-file/multi-buffer processing in Ediff" nil) + ("ediff-ptch.el" + "Ediff's patch support" + nil) ("ediff-util.el" "the core commands and utilities of ediff" *************** *** 448,451 **** --- 451,457 ---- "User friendly customization of Gnus" (help news)) + ("gnus-demon.el" + "daemonic Gnus behaviour" + (news)) ("gnus-edit.el" "Gnus SCORE file editing" *************** *** 454,457 **** --- 460,466 ---- "functions for making Gnus work under different Emacsen" (news)) + ("gnus-gl.el" + "an interface to GroupLens for Gnus" + (news score)) ("gnus-kill.el" "kill commands for Gnus" *************** *** 463,469 **** --- 472,496 ---- "mail and post interface for Gnus" (news)) + ("gnus-nocem.el" + "NoCeM pseudo-cancellation treatment" + (news)) + ("gnus-salt.el" + "alternate summary mode interfaces for Gnus" + nil) ("gnus-score.el" "scoring code for Gnus" (news)) + ("gnus-setup.el" + "Initialization & Setup for Gnus 5" + (news)) + ("gnus-soup.el" + "SOUP packet writing support for Gnus" + (news mail)) + ("gnus-srvr.el" + "virtual server support for Gnus" + (news)) + ("gnus-topic.el" + "a folding minor mode for Gnus group buffers" + (news)) ("gnus-uu.el" "extract (uu)encoded files in Gnus" *************** *** 583,586 **** --- 610,616 ---- "additions to shell mode for use with kermit, etc." (comm)) + ("lazy-lock.el" + "Lazy demand-driven fontification for fast Font Lock mode." + (faces files)) ("ledit.el" "Emacs side of ledit interface" *************** *** 646,649 **** --- 676,682 ---- "expand and complete mailing address aliases" (mail)) + ("mailheader.el" + "Mail header parsing, merging, formatting" + (tools mail news)) ("mailpost.el" "RMAIL coupler to /usr/uci/post mailer" *************** *** 670,673 **** --- 703,709 ---- "define a default menu bar." (internal)) + ("message.el" + "composing mail and news messages" + (mail news)) ("metamail.el" "Metamail interface for GNU Emacs" *************** *** 727,730 **** --- 763,769 ---- "rmail mbox access for Gnus" (news mail)) + ("nndb.el" + "nndb access for Gnus" + (news)) ("nndir.el" "single directory newsgroup access for Gnus" *************** *** 738,742 **** ("nnfolder.el" "mail folder access for Gnus" ! (news mail)) ("nnheader.el" "header access macros for Gnus and its backends" --- 777,781 ---- ("nnfolder.el" "mail folder access for Gnus" ! (mail)) ("nnheader.el" "header access macros for Gnus and its backends" *************** *** 757,760 **** --- 796,805 ---- "mail spool access for Gnus" (news mail)) + ("nnoo.el" + "OO Gnus Backends" + (news)) + ("nnsoup.el" + "SOUP access for Gnus" + (news mail)) ("nnspool.el" "spool access for GNU Emacs" *************** *** 849,853 **** ("reporter.el" "customizable bug reporting of lisp programs" ! (bug reports lisp)) ("reposition.el" "center a Lisp function or comment on the screen" --- 894,898 ---- ("reporter.el" "customizable bug reporting of lisp programs" ! (maint mail tools)) ("reposition.el" "center a Lisp function or comment on the screen" *************** *** 910,913 **** --- 955,961 ---- "Scheme mode, and its idiosyncratic commands." (languages lisp)) + ("score-mode.el" + "mode for editing Gnus score files" + (news mail)) ("scribe.el" "scribe mode, and its idiosyncratic commands." *************** *** 958,961 **** --- 1006,1012 ---- "Lisp language extension for writing statement skeletons" (extensions abbrev languages tools)) + ("smtpmail.el" + nil + (mail)) ("solar.el" "calendar functions for solar events." diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/font-lock.el emacs-19.32/lisp/font-lock.el *** emacs-19.31/lisp/font-lock.el Thu Mar 7 08:37:25 1996 --- emacs-19.32/lisp/font-lock.el Mon Jul 29 19:18:35 1996 *************** *** 48,53 **** ;; of decoration. The higher the level, the more decoration, but the more time ;; it takes to fontify. See the variable `font-lock-maximum-decoration', and ! ;; also the variable `font-lock-maximum-size'. ;; If you add patterns for a new mode, say foo.el's `foo-mode', say in which ;; you don't want syntactic fontification to occur, you can make Font Lock mode --- 48,103 ---- ;; of decoration. The higher the level, the more decoration, but the more time ;; it takes to fontify. See the variable `font-lock-maximum-decoration', and ! ;; also the variable `font-lock-maximum-size'. Support modes for Font Lock ! ;; mode can be used to speed up Font Lock mode. See `font-lock-support-mode'. ! ! ;; Constructing patterns: ! ;; ! ;; See the documentation for the variable `font-lock-keywords'. ! ;; ! ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" ! ;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for ! ;; efficiency. See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on ! ;; archive.cis.ohio-state.edu for this and other functions. + ;; Adding patterns for modes that already support Font Lock: + ;; + ;; Font Lock mode uses the buffer local variable `font-lock-keywords' for the + ;; highlighting patterns. This variable is set by Font Lock mode from (a) the + ;; buffer local variable `font-lock-defaults', if non-nil, or (b) the global + ;; variable `font-lock-defaults-alist', if the major mode has an entry. + ;; Font Lock mode is set up via (a) where a mode's patterns are distributed + ;; with the mode's package library, (b) where a mode's patterns are distributed + ;; with font-lock.el itself. An example of (a) is Pascal mode, an example of + ;; (b) is C/C++ modes. (Normally, the mechanism is (a); (b) is used where it + ;; is not clear which package library should contain the pattern definitions.) + ;; + ;; If, for a particular mode, mechanism (a) is used, you need to add your + ;; patterns after that package library has loaded, e.g.: + ;; + ;; (eval-after-load "pascal" '(add-to-list 'pascal-font-lock-keywords ...)) + ;; + ;; (Note that only one pattern can be added with `add-to-list'. For multiple + ;; patterns, use one `eval-after-load' form with one `setq' and `append' form, + ;; or multiple `eval-after-load' forms each with one `add-to-list' form.) + ;; If mechanism (b) is used, you need to add your patterns after font-lock.el + ;; itself has loaded, e.g.: + ;; + ;; (eval-after-load "font-lock" '(add-to-list 'c-font-lock-keywords ...)) + ;; + ;; Which variable you should add to depends on what level of fontification you + ;; choose and what level is supported. If you choose the maximum level, by + ;; setting the variable `font-lock-maximum-decoration', you change a different + ;; variable. Maximum level patterns for C are `c-font-lock-keywords-3', so: + ;; + ;; (setq font-lock-maximum-decoration t) + ;; (eval-after-load "font-lock" + ;; '(add-to-list 'c-font-lock-keywords-3 + ;; '("\\" . font-lock-type-face))) + ;; + ;; To see which variable to set, see the buffer's value of `font-lock-defaults' + ;; or the mode's entry in the global value of `font-lock-defaults-alist'. + + ;; Adding patterns for modes that do not support Font Lock: + ;; ;; If you add patterns for a new mode, say foo.el's `foo-mode', say in which ;; you don't want syntactic fontification to occur, you can make Font Lock mode *************** *** 57,66 **** ;; '(lambda () (make-local-variable 'font-lock-defaults) ;; (setq font-lock-defaults '(foo-font-lock-keywords t)))) ! ;; ! ;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo" ! ;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for ! ;; efficiency. See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on ! ;; archive.cis.ohio-state.edu for this and other functions. ! ;; What is fontification for? You might say, "It's to make my code look nice." ;; I think it should be for adding information in the form of cues. These cues --- 107,111 ---- ;; '(lambda () (make-local-variable 'font-lock-defaults) ;; (setq font-lock-defaults '(foo-font-lock-keywords t)))) ! ;; What is fontification for? You might say, "It's to make my code look nice." ;; I think it should be for adding information in the form of cues. These cues *************** *** 93,98 **** ;; User variables. ! (defvar font-lock-verbose t ! "*If non-nil, means show status messages when fontifying.") ;;;###autoload --- 138,144 ---- ;; User variables. ! (defvar font-lock-verbose (* 0 1024) ! "*If non-nil, means show status messages for buffer fontification. ! If a number, only buffers greater than this size have fontification messages.") ;;;###autoload *************** If a number, use that level of decoratio *** 104,110 **** If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c++-mode . 2) (c-mode . t) (t . 1)) ! means use level 2 decoration for buffers in `c++-mode', the maximum decoration ! available for buffers in `c-mode', and level 1 decoration otherwise.") ;;;###autoload --- 150,156 ---- If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c-mode . t) (c++-mode . 2) (t . 1)) ! means use the maximum decoration available for buffers in C mode, level 2 ! decoration for buffers in C++ mode, and level 1 decoration otherwise.") ;;;###autoload *************** If nil, means size is irrelevant. *** 115,121 **** If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576)) ! means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one ! megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") ;; Fontification variables: --- 161,167 ---- If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c-mode . 256000) (c++-mode . 256000) (rmail-mode . 1048576)) ! means that the maximum size is 250K for buffers in C or C++ modes, one megabyte ! for buffers in Rmail mode, and size is irrelevant otherwise.") ;; Fontification variables: *************** The value should be like the `cdr' of an *** 237,240 **** --- 283,287 ---- c-font-lock-keywords-2 c-font-lock-keywords-3) nil nil ((?_ . "w")) beginning-of-defun + (font-lock-comment-start-regexp . "/[*/]") (font-lock-mark-block-function . mark-defun))) (c++-mode-defaults *************** The value should be like the `cdr' of an *** 242,260 **** c++-font-lock-keywords-2 c++-font-lock-keywords-3) nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun (font-lock-mark-block-function . mark-defun))) (lisp-mode-defaults '((lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) ! nil nil ! ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w") ! (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w") ! (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w")) ! beginning-of-defun (font-lock-mark-block-function . mark-defun))) (scheme-mode-defaults ! '(scheme-font-lock-keywords nil t ! ((?: . "w") (?- . "w") (?* . "w") (?+ . "w") (?. . "w") (?< . "w") ! (?> . "w") (?= . "w") (?! . "w") (?? . "w") (?$ . "w") (?% . "w") ! (?_ . "w") (?& . "w") (?~ . "w") (?^ . "w") (?/ . "w")) ! beginning-of-defun (font-lock-mark-block-function . mark-defun))) ;; For TeX modes we could use `backward-paragraph' for the same reason. ;; But we don't, because paragraph breaks are arguably likely enough to --- 289,305 ---- c++-font-lock-keywords-2 c++-font-lock-keywords-3) nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun + (font-lock-comment-start-regexp . "/[*/]") (font-lock-mark-block-function . mark-defun))) (lisp-mode-defaults '((lisp-font-lock-keywords lisp-font-lock-keywords-1 lisp-font-lock-keywords-2) ! nil nil (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun ! (font-lock-comment-start-regexp . ";") ! (font-lock-mark-block-function . mark-defun))) (scheme-mode-defaults ! '(scheme-font-lock-keywords ! nil t (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun ! (font-lock-comment-start-regexp . ";") ! (font-lock-mark-block-function . mark-defun))) ;; For TeX modes we could use `backward-paragraph' for the same reason. ;; But we don't, because paragraph breaks are arguably likely enough to *************** The value should be like the `cdr' of an *** 262,270 **** ;; However, we do specify a MARK-BLOCK function as that cannot result ;; in a mis-fontification even if it might not fontify enough. --sm. ! (tex-mode-defaults '(tex-font-lock-keywords nil nil ((?$ . "\"")) nil ! (font-lock-mark-block-function . mark-paragraph))) ) (list - (cons 'bibtex-mode tex-mode-defaults) (cons 'c++-c-mode c-mode-defaults) (cons 'c++-mode c++-mode-defaults) --- 307,316 ---- ;; However, we do specify a MARK-BLOCK function as that cannot result ;; in a mis-fontification even if it might not fontify enough. --sm. ! (tex-mode-defaults ! '(tex-font-lock-keywords nil nil ((?$ . "\"")) nil ! (font-lock-comment-start-regexp . "%") ! (font-lock-mark-block-function . mark-paragraph))) ) (list (cons 'c++-c-mode c-mode-defaults) (cons 'c++-mode c++-mode-defaults) *************** If KEYWORDS-ONLY is non-nil, syntactic f *** 292,297 **** not performed. If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying. If SYNTAX-ALIST is non-nil, it should be a list of cons pairs ! of the form (CHAR . STRING) used to set the local Font Lock syntax table, for ! keyword and syntactic fontification (see `modify-syntax-entry'). If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move --- 338,343 ---- not performed. If CASE-FOLD is non-nil, the case of the keywords is ignored when fontifying. If SYNTAX-ALIST is non-nil, it should be a list of cons pairs ! of the form (CHAR-OR-STRING . STRING) used to set the local Font Lock syntax ! table, for keyword and syntactic fontification (see `modify-syntax-entry'). If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move *************** around a text block relevant to that mod *** 320,325 **** Other variables include those for buffer-specialised fontification functions, `font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function', ! `font-lock-fontify-region-function', `font-lock-unfontify-region-function' and ! `font-lock-inhibit-thing-lock'.") (defvar font-lock-keywords-only nil --- 366,372 ---- Other variables include those for buffer-specialised fontification functions, `font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function', ! `font-lock-fontify-region-function', `font-lock-unfontify-region-function', ! `font-lock-comment-start-regexp', `font-lock-inhibit-thing-lock' and ! `font-lock-maximum-size'.") (defvar font-lock-keywords-only nil *************** enclosing textual block and mark at the *** 351,354 **** --- 398,408 ---- This is normally set via `font-lock-defaults'.") + (defvar font-lock-comment-start-regexp nil + "*Regexp to match the start of a comment. + This need not discriminate between genuine comments and quoted comment + characters or comment characters within strings. + If nil, `comment-start-skip' is used instead; see that variable for more info. + This is normally set via `font-lock-defaults'.") + (defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer "Function to use for fontifying the buffer. *************** This is normally set via `font-lock-defa *** 378,382 **** (defvar font-lock-mode nil) ; For the modeline. (defvar font-lock-fontified nil) ; Whether we have fontified the buffer. - (put 'font-lock-fontified 'permanent-local t) ;;;###autoload --- 432,435 ---- *************** This is normally set via `font-lock-defa *** 384,388 **** "Function or functions to run on entry to Font Lock mode.") ! ;; User commands. ;;;###autoload --- 437,445 ---- "Function or functions to run on entry to Font Lock mode.") ! ;; Font Lock mode. ! ! (eval-when-compile ! ;; We don't do this at the top-level as we only use non-autoloaded macros. ! (require 'cl)) ;;;###autoload *************** the major mode's hook. For example, put *** 404,423 **** Alternatively, you can use Global Font Lock mode to automagically turn on Font ! Lock mode in buffers whose major mode supports it, or in buffers whose major ! mode is one of `font-lock-global-modes'. For example, put in your ~/.emacs: (global-font-lock-mode t) ! The default Font Lock mode faces and their attributes are defined in the ! variable `font-lock-face-attributes', and Font Lock mode default settings in ! the variable `font-lock-defaults-alist'. You can set your own default settings ! for some mode, by setting a buffer local value for `font-lock-defaults', via ! its mode hook. ! ! Where modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. To fontify a buffer, without turning on Font Lock mode and regardless of buffer size, you can use \\[font-lock-fontify-buffer]. --- 461,482 ---- Alternatively, you can use Global Font Lock mode to automagically turn on Font ! Lock mode in buffers whose major mode supports it and whose major mode is one ! of `font-lock-global-modes'. For example, put in your ~/.emacs: (global-font-lock-mode t) ! There are a number of support modes that may be used to speed up Font Lock mode ! in various ways, specified via the variable `font-lock-support-mode'. Where ! major modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. + For example, to specify that Font Lock mode use use Lazy Lock mode as a support + mode and use maximum levels of fontification, put in your ~/.emacs: + + (setq font-lock-support-mode 'lazy-lock-mode) + (setq font-lock-maximum-decoration t) + To fontify a buffer, without turning on Font Lock mode and regardless of buffer size, you can use \\[font-lock-fontify-buffer]. *************** size, you can use \\[font-lock-fontify-b *** 425,473 **** To fontify a block (the function or paragraph containing point, or a number of lines around point), perhaps because modification on the current line caused ! syntactic change on other lines, you can use \\[font-lock-fontify-block]." (interactive "P") ;; Don't turn on Font Lock mode if we don't have a display (we're running a ;; batch job) or if the buffer is invisible (the name starts with a space). ! (let ((maximum-size (font-lock-value-in-major-mode font-lock-maximum-size)) ! (on-p (and (not noninteractive) (not (eq (aref (buffer-name) 0) ?\ )) (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode))))) - (if (not on-p) - (remove-hook 'after-change-functions 'font-lock-after-change-function - t) - (make-local-hook 'after-change-functions) - (add-hook 'after-change-functions 'font-lock-after-change-function - nil t)) (set (make-local-variable 'font-lock-mode) on-p) ! (cond (on-p ! (font-lock-set-defaults) ! ;; If buffer is reverted, must clean up the state. ! (make-local-hook 'before-revert-hook) ! (make-local-hook 'after-revert-hook) ! (add-hook 'before-revert-hook 'font-lock-revert-setup nil t) ! (add-hook 'after-revert-hook 'font-lock-revert-cleanup nil t) ! (run-hooks 'font-lock-mode-hook) ! (cond (font-lock-fontified ! nil) ! ((or (null maximum-size) (<= (buffer-size) maximum-size) ! (not (eq font-lock-fontify-buffer-function ! (default-value ! 'font-lock-fontify-buffer-function)))) ! (font-lock-fontify-buffer)) ! (font-lock-verbose ! (message "Fontifying %s... buffer too big." (buffer-name))))) ! (font-lock-fontified ! (font-lock-unfontify-buffer) ! (remove-hook 'before-revert-hook 'font-lock-revert-setup t) ! (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) ! (font-lock-thing-lock-cleanup) ! (font-lock-unset-defaults)) ! (t ! (remove-hook 'before-revert-hook 'font-lock-revert-setup t) ! (remove-hook 'after-revert-hook 'font-lock-revert-cleanup t) ! (font-lock-thing-lock-cleanup) ! (font-lock-unset-defaults))) (force-mode-line-update))) --- 484,525 ---- To fontify a block (the function or paragraph containing point, or a number of lines around point), perhaps because modification on the current line caused ! syntactic change on other lines, you can use \\[font-lock-fontify-block]. ! ! The default Font Lock mode faces and their attributes are defined in the ! variable `font-lock-face-attributes', and Font Lock mode default settings in ! the variable `font-lock-defaults-alist'. You can set your own default settings ! for some mode, by setting a buffer local value for `font-lock-defaults', via ! its mode hook." (interactive "P") ;; Don't turn on Font Lock mode if we don't have a display (we're running a ;; batch job) or if the buffer is invisible (the name starts with a space). ! (let ((on-p (and (not noninteractive) (not (eq (aref (buffer-name) 0) ?\ )) (if arg (> (prefix-numeric-value arg) 0) (not font-lock-mode))))) (set (make-local-variable 'font-lock-mode) on-p) ! ;; Turn on Font Lock mode. ! (when on-p ! (font-lock-set-defaults) ! (unless (eq font-lock-fontify-region-function 'ignore) ! (make-local-hook 'after-change-functions) ! (add-hook 'after-change-functions 'font-lock-after-change-function nil t)) ! (font-lock-turn-on-thing-lock) ! (run-hooks 'font-lock-mode-hook) ! ;; Fontify the buffer if we have to. ! (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size))) ! (cond (font-lock-fontified ! nil) ! ((or (null max-size) (> max-size (buffer-size))) ! (font-lock-fontify-buffer)) ! (font-lock-verbose ! (message "Fontifying %s...buffer too big" (buffer-name)))))) ! ;; Turn off Font Lock mode. ! (when (not on-p) ! (remove-hook 'after-change-functions 'font-lock-after-change-function t) ! (font-lock-unfontify-buffer) ! (font-lock-turn-off-thing-lock) ! (font-lock-unset-defaults)) (force-mode-line-update))) *************** syntactic change on other lines, you can *** 475,488 **** (defun turn-on-font-lock () "Turn on Font Lock mode conditionally. ! Turn on only if the buffer mode supports it and the terminal can display it." ! (if (and window-system ! (not font-lock-mode) ! (or font-lock-defaults (assq major-mode font-lock-defaults-alist))) ! (font-lock-mode t))) ! ;; Code for Global Font Lock mode. ! ;; A few people have hassled in the past for a way to make it easier to turn on ! ;; Font Lock mode, perhaps the same way hilit19.el/hl319.el does. I've always ;; balked at that way, as I see it as just re-moulding the same problem in ;; another form. That is; some person would still have to keep track of which --- 527,539 ---- (defun turn-on-font-lock () "Turn on Font Lock mode conditionally. ! Turn on only if the terminal can display it." ! (when window-system ! (font-lock-mode t))) ! ;; Global Font Lock mode. ! ;; ;; A few people have hassled in the past for a way to make it easier to turn on ! ;; Font Lock mode, without the user needing to know for which modes s/he has to ! ;; turn it on, perhaps the same way hilit19.el/hl319.el does. I've always ;; balked at that way, as I see it as just re-moulding the same problem in ;; another form. That is; some person would still have to keep track of which *************** Turn on only if the buffer mode supports *** 490,496 **** ;; The list would always be out of date. And that person might have to be me. ! ;; In the latest of these discussions the following hack came to mind. It is a ! ;; gross hack, but it generally works. We use the convention that major modes ! ;; start by calling the function `kill-all-local-variables', which in turn runs ;; functions on the hook variable `change-major-mode-hook'. We attach our ;; function `font-lock-change-major-mode' to that hook. Of course, when this --- 541,549 ---- ;; The list would always be out of date. And that person might have to be me. ! ;; Implementation. ! ;; ! ;; In a previous discussion the following hack came to mind. It is a gross ! ;; hack, but it generally works. We use the convention that major modes start ! ;; by calling the function `kill-all-local-variables', which in turn runs ;; functions on the hook variable `change-major-mode-hook'. We attach our ;; function `font-lock-change-major-mode' to that hook. Of course, when this *************** Turn on only if the buffer mode supports *** 498,532 **** ;; know what the final major mode will be. So, `font-lock-change-major-mode' ;; only (a) notes the name of the current buffer, and (b) adds our function ! ;; `turn-on-font-lock-if-enabled' to the hook variable `post-command-hook'. ! ;; By the time the functions on `post-command-hook' are run, the new major mode ! ;; is assumed to be in place. ! ;; Naturally this requires that (a) major modes run `kill-all-local-variables', ;; as they are supposed to do, and (b) the major mode is in place after the ! ;; command that ran `kill-all-local-variables' has finished. Arguably, any ! ;; major mode that does not follow the convension (a) is broken, and I can't ! ;; think of any reason why (b) would not be met. I don't know of any major ! ;; modes that do not follow the convension (a), but I'm sure there are some ! ;; obscure ones out there somewhere. Even if it works, it is still not clean. ! ;; Probably the cleanest solution is to have each major mode function run some ;; hook, e.g., `major-mode-hook', but maybe implementing that change is ! ;; impractical. I am personally against making `setq' a macro or be advised ! ;; (space'n'speed), or have a special function such as `set-major-mode' (a ! ;; `major-mode-hook' is simpler), but maybe someone can come up with another ! ;; solution? --sm. (defvar font-lock-buffers nil) ; For remembering buffers. ! (defvar change-major-mode-hook nil) ; Make sure it's not void. ;;;###autoload (defvar font-lock-global-modes t ! "*Modes for which Font Lock mode is automatically turned on. Global Font Lock mode is controlled by the `global-font-lock-mode' command. If nil, means no modes have Font Lock mode automatically turned on. If t, all modes that support Font Lock mode have it automatically turned on. ! If a list, each element should be a major mode symbol name such as `c-mode'. ! Font Lock is automatically turned on if the buffer major mode supports it and ! is in this list. The sense of the list is negated if it begins with `not'.") ;;;###autoload --- 551,602 ---- ;; know what the final major mode will be. So, `font-lock-change-major-mode' ;; only (a) notes the name of the current buffer, and (b) adds our function ! ;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hooks' and ! ;; `post-command-hook' (for buffers that are not visiting files). By the time ! ;; the functions on the first of these hooks to be run are run, the new major ! ;; mode is assumed to be in place. This way we get a Font Lock function run ! ;; when a major mode is turned on, without knowing major modes or their hooks. ! ;; ;; Naturally this requires that (a) major modes run `kill-all-local-variables', ;; as they are supposed to do, and (b) the major mode is in place after the ! ;; file is visited or the command that ran `kill-all-local-variables' has ! ;; finished, whichever the sooner. Arguably, any major mode that does not ! ;; follow the convension (a) is broken, and I can't think of any reason why (b) ! ;; would not be met (except `gnudoit' on non-files). However, it is not clean. ! ;; ;; Probably the cleanest solution is to have each major mode function run some ;; hook, e.g., `major-mode-hook', but maybe implementing that change is ! ;; impractical. I am personally against making `setq' a macro or be advised, ! ;; or have a special function such as `set-major-mode', but maybe someone can ! ;; come up with another solution? ! ! ;; User interface. ! ;; ! ;; Although Global Font Lock mode is a pseudo-mode, I think that the user ! ;; interface should conform to the usual Emacs convention for modes, i.e., a ! ;; command to toggle the feature (`global-font-lock-mode') with a variable for ! ;; finer control of the mode's behaviour (`font-lock-global-modes'). ! ;; ! ;; I don't think it is better that the feature be enabled via a variable, since ! ;; it does not conform to the usual convention. I don't think the feature ! ;; should be enabled by loading font-lock.el, since other mechanisms such as ! ;; M-x font-lock-mode RET or (add-hook 'c-mode-hook 'turn-on-font-lock) would ! ;; cause Font Lock mode to be turned on everywhere, and it is not intuitive or ! ;; informative because loading a file tells you nothing about the feature or ! ;; how to control it. It would be contrary to the Principle of Least Surprise. (defvar font-lock-buffers nil) ; For remembering buffers. ! (defvar global-font-lock-mode nil) ;;;###autoload (defvar font-lock-global-modes t ! "*Modes for which Font Lock mode is automagically turned on. Global Font Lock mode is controlled by the `global-font-lock-mode' command. If nil, means no modes have Font Lock mode automatically turned on. If t, all modes that support Font Lock mode have it automatically turned on. ! If a list, it should be a list of `major-mode' symbol names for which Font Lock ! mode should be automatically turned on. The sense of the list is negated if it ! begins with `not'. For example: ! (c-mode c++-mode) ! means that Font Lock mode is turned on for buffers in C and C++ modes only.") ;;;###autoload *************** turned on in a buffer if its major mode *** 542,566 **** (let ((off-p (if arg (<= (prefix-numeric-value arg) 0) ! (memq 'font-lock-change-major-mode change-major-mode-hook)))) (if off-p ! (remove-hook 'change-major-mode-hook 'font-lock-change-major-mode) ! (add-hook 'change-major-mode-hook 'font-lock-change-major-mode) (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled) (setq font-lock-buffers (buffer-list))) ! (if message ! (message "Global Font Lock mode is now %s." (if off-p "OFF" "ON"))) ! (not off-p))) (defun font-lock-change-major-mode () ;; Gross hack warning: Delicate readers should avert eyes now. ;; Something is running `kill-all-local-variables', which generally means the ;; major mode is being changed. Run `turn-on-font-lock-if-enabled' after the ! ;; current command has finished. ! (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled) ! (add-to-list 'font-lock-buffers (current-buffer))) (defun turn-on-font-lock-if-enabled () ;; Gross hack warning: Delicate readers should avert eyes now. ! ;; Turn on Font Lock mode if it's one of `font-lock-global-modes'. (remove-hook 'post-command-hook 'turn-on-font-lock-if-enabled) (while font-lock-buffers --- 612,641 ---- (let ((off-p (if arg (<= (prefix-numeric-value arg) 0) ! global-font-lock-mode))) (if off-p ! (remove-hook 'find-file-hooks 'turn-on-font-lock-if-enabled) ! (add-hook 'find-file-hooks 'turn-on-font-lock-if-enabled) (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled) (setq font-lock-buffers (buffer-list))) ! (when message ! (message "Global Font Lock mode is now %s." (if off-p "OFF" "ON"))) ! (setq global-font-lock-mode (not off-p)))) (defun font-lock-change-major-mode () + ;; Turn off Font Lock mode if it's on. + (when font-lock-mode + (font-lock-mode nil)) ;; Gross hack warning: Delicate readers should avert eyes now. ;; Something is running `kill-all-local-variables', which generally means the ;; major mode is being changed. Run `turn-on-font-lock-if-enabled' after the ! ;; file is visited or the current command has finished. ! (when global-font-lock-mode ! (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled) ! (add-to-list 'font-lock-buffers (current-buffer)))) (defun turn-on-font-lock-if-enabled () ;; Gross hack warning: Delicate readers should avert eyes now. ! ;; Turn on Font Lock mode if it's supported by the major mode and enabled by ! ;; the user. (remove-hook 'post-command-hook 'turn-on-font-lock-if-enabled) (while font-lock-buffers *************** turned on in a buffer if its major mode *** 568,581 **** (save-excursion (set-buffer (car font-lock-buffers)) ! (if (or (eq font-lock-global-modes t) ! (if (eq (car-safe font-lock-global-modes) 'not) ! (not (memq major-mode (cdr font-lock-global-modes))) ! (memq major-mode font-lock-global-modes))) (let (inhibit-quit) (turn-on-font-lock))))) (setq font-lock-buffers (cdr font-lock-buffers)))) ;; End of Global Font Lock mode. ;; Fontification functions. --- 643,714 ---- (save-excursion (set-buffer (car font-lock-buffers)) ! (if (and (or font-lock-defaults ! (assq major-mode font-lock-defaults-alist)) ! (or (eq font-lock-global-modes t) ! (if (eq (car-safe font-lock-global-modes) 'not) ! (not (memq major-mode (cdr font-lock-global-modes))) ! (memq major-mode font-lock-global-modes)))) (let (inhibit-quit) (turn-on-font-lock))))) (setq font-lock-buffers (cdr font-lock-buffers)))) + (add-hook 'change-major-mode-hook 'font-lock-change-major-mode) + ;; End of Global Font Lock mode. + ;; Font Lock Support mode. + ;; + ;; This is the code used to interface font-lock.el with any of its add-on + ;; packages, and provide the user interface. Packages that have their own + ;; local buffer fontification functions (see below) may have to call + ;; `font-lock-after-fontify-buffer' and/or `font-lock-after-unfontify-buffer' + ;; themselves. + + ;;;###autoload + (defvar font-lock-support-mode nil + "*Support mode for Font Lock mode. + Support modes speed up Font Lock mode by being choosy about when fontification + occurs. Known support modes are Fast Lock mode (symbol `fast-lock-mode') and + Lazy Lock mode (symbol `lazy-lock-mode'). See those modes for more info. + If nil, means support for Font Lock mode is never performed. + If a symbol, use that support mode. + If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE), + where MAJOR-MODE is a symbol or t (meaning the default). For example: + ((c-mode . fast-lock-mode) (c++-mode . fast-lock-mode) (t . lazy-lock-mode)) + means that Fast Lock mode is used to support Font Lock mode for buffers in C or + C++ modes, and Lazy Lock mode is used to support Font Lock mode otherwise. + + The value of this variable is used when Font Lock mode is turned on.") + + (defun font-lock-turn-on-thing-lock () + (let ((thing-mode (font-lock-value-in-major-mode font-lock-support-mode))) + (cond ((eq thing-mode 'fast-lock-mode) + (fast-lock-mode t)) + ((eq thing-mode 'lazy-lock-mode) + (lazy-lock-mode t))))) + + (defvar fast-lock-mode nil) + (defvar lazy-lock-mode nil) + + (defun font-lock-turn-off-thing-lock () + (cond (fast-lock-mode + (fast-lock-mode nil)) + (lazy-lock-mode + (lazy-lock-mode nil)))) + + (defun font-lock-after-fontify-buffer () + (cond (fast-lock-mode + (fast-lock-after-fontify-buffer)) + (lazy-lock-mode + (lazy-lock-after-fontify-buffer)))) + + (defun font-lock-after-unfontify-buffer () + (cond (fast-lock-mode + (fast-lock-after-unfontify-buffer)) + (lazy-lock-mode + (lazy-lock-after-unfontify-buffer)))) + + ;; End of Font Lock Support mode. + ;; Fontification functions. *************** turned on in a buffer if its major mode *** 597,601 **** (defun font-lock-default-fontify-buffer () ! (let ((verbose (and font-lock-verbose (> (buffer-size) 0)))) (if verbose (message "Fontifying %s..." (buffer-name))) ;; Make sure we have the right `font-lock-keywords' etc. --- 730,736 ---- (defun font-lock-default-fontify-buffer () ! (let ((verbose (if (numberp font-lock-verbose) ! (> (buffer-size) font-lock-verbose) ! font-lock-verbose))) (if verbose (message "Fontifying %s..." (buffer-name))) ;; Make sure we have the right `font-lock-keywords' etc. *************** turned on in a buffer if its major mode *** 612,616 **** ;; We don't restore the old fontification, so it's best to unfontify. (quit (font-lock-unfontify-buffer)))) ! (if verbose (message "Fontifying %s... %s." (buffer-name) (if font-lock-fontified "done" "aborted"))))) --- 747,751 ---- ;; We don't restore the old fontification, so it's best to unfontify. (quit (font-lock-unfontify-buffer)))) ! (if verbose (message "Fontifying %s...%s" (buffer-name) (if font-lock-fontified "done" "aborted"))))) *************** delimit the region to fontify." *** 691,695 **** (funcall font-lock-mark-block-function) (font-lock-fontify-region (point) (mark))) ! ((error quit) (message "Fontifying block... %s" error-data))))))) (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block) --- 826,830 ---- (funcall font-lock-mark-block-function) (font-lock-fontify-region (point) (mark))) ! ((error quit) (message "Fontifying block...%s" error-data))))))) (define-key facemenu-keymap "\M-g" 'font-lock-fontify-block) *************** delimit the region to fontify." *** 707,716 **** "Put proper face on each string and comment between START and END. START should be at the beginning of a line." ! (let ((synstart (if comment-start-skip ! (concat "\\s\"\\|" comment-start-skip) ! "\\s\"")) ! (comstart (if comment-start-skip ! (concat "\\s<\\|" comment-start-skip) ! "\\s<")) state prev prevstate) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) --- 842,857 ---- "Put proper face on each string and comment between START and END. START should be at the beginning of a line." ! (let ((synstart (cond (font-lock-comment-start-regexp ! (concat "\\s\"\\|" font-lock-comment-start-regexp)) ! (comment-start-skip ! (concat "\\s\"\\|" comment-start-skip)) ! (t ! "\\s\""))) ! (comstart (cond (font-lock-comment-start-regexp ! font-lock-comment-start-regexp) ! (comment-start-skip ! (concat "\\s<\\|" comment-start-skip)) ! (t ! "\\s<"))) state prev prevstate) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) *************** START should be at the beginning of a li *** 776,780 **** ;; ;; We found a real comment start. ! (let ((beg (match-beginning 0))) (goto-char beg) (save-restriction --- 917,921 ---- ;; ;; We found a real comment start. ! (let ((beg (or (match-end 1) (match-beginning 0)))) (goto-char beg) (save-restriction *************** START should be at the beginning of a li *** 792,796 **** ;; ;; We found a real string start. ! (let ((beg (match-beginning 0))) (while (and (re-search-forward "\\s\"" end 'move) (nth 3 (parse-partial-sexp here (point) --- 933,937 ---- ;; ;; We found a real string start. ! (let ((beg (or (match-end 1) (match-beginning 0)))) (while (and (re-search-forward "\\s\"" end 'move) (nth 3 (parse-partial-sexp here (point) *************** START should be at the beginning of a li *** 969,1005 **** ;; Various functions. - ;; Turn off other related packages if they're on. I prefer a hook. --sm. - ;; These explicit calls are easier to understand - ;; because people know what they will do. - ;; A hook is a mystery because it might do anything whatever. --rms. - (defun font-lock-thing-lock-cleanup () - (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-mode -1)) - ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-mode -1)))) - - ;; Do something special for these packages after fontifying; I prefer a hook. - (defun font-lock-after-fontify-buffer () - (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-after-fontify-buffer)) - ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-after-fontify-buffer)))) - - ;; Do something special for these packages after unfontifying; I prefer a hook. - (defun font-lock-after-unfontify-buffer () - (cond ((and (boundp 'fast-lock-mode) fast-lock-mode) - (fast-lock-after-unfontify-buffer)) - ((and (boundp 'lazy-lock-mode) lazy-lock-mode) - (lazy-lock-after-unfontify-buffer)))) - - ;; If the buffer is about to be reverted, it won't be fontified afterward. - (defun font-lock-revert-setup () - (setq font-lock-fontified nil)) - - ;; If the buffer has just been reverted, normally that turns off - ;; 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 --- 1110,1113 ---- *************** Sets various variables using `font-lock- *** 1074,1080 **** (copy-syntax-table (syntax-table))) (while slist ! (modify-syntax-entry (car (car slist)) (cdr (car slist)) ! font-lock-syntax-table) ! (setq slist (cdr slist))))) ;; Syntax function for syntactic fontification? (if (nth 4 defaults) --- 1182,1195 ---- (copy-syntax-table (syntax-table))) (while slist ! ;; The character to modify may be a single CHAR or a STRING. ! (let ((chars (if (numberp (car (car slist))) ! (list (car (car slist))) ! (mapcar 'identity (car (car slist))))) ! (syntax (cdr (car slist)))) ! (while chars ! (modify-syntax-entry (car chars) syntax ! font-lock-syntax-table) ! (setq chars (cdr chars))) ! (setq slist (cdr slist)))))) ;; Syntax function for syntactic fontification? (if (nth 4 defaults) *************** See `font-lock-make-face' and `list-face *** 1179,1183 **** ((< (apply '+ (x-color-values (cdr (assq 'background-color params)))) ! (/ (apply '+ (x-color-values "white")) 3)) 'dark) (t 'light))))) --- 1294,1298 ---- ((< (apply '+ (x-color-values (cdr (assq 'background-color params)))) ! (* (apply '+ (x-color-values "white")) .6)) 'dark) (t 'light))))) *************** the face is also set; its value is the f *** 1438,1442 **** ;; with optional whitespace and a "(". Everything following the item (but ;; belonging to it) is expected to by skip-able by `forward-sexp', and items ! ;; are expected to be separated with a "," or ";". (if (looking-at "[ \t*&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*\\((\\)?") (save-match-data --- 1553,1565 ---- ;; with optional whitespace and a "(". Everything following the item (but ;; belonging to it) is expected to by skip-able by `forward-sexp', and items ! ;; are expected to be separated with a ",". ! ;; ! ;; The regexp matches: word::word ( ! ;; ^^^^ ^^^^ ^ ! ;; Match subexps are: 1 3 4 ! ;; ! ;; So, the item is delimited by (match-beginning 1) and (match-end 1). ! ;; If (match-beginning 3) is non-nil, that part of the item follows a ":". ! ;; If (match-beginning 4) is non-nil, the item is followed by a "(". (if (looking-at "[ \t*&]*\\(\\sw+\\)\\(::\\(\\sw+\\)\\)?[ \t]*\\((\\)?") (save-match-data *************** the face is also set; its value is the f *** 1447,1453 **** (goto-char (match-end 1)) ;; Move over any item value, etc., to the next item. ! (while (not (looking-at "[ \t]*\\([,;]\\|$\\)")) (goto-char (or (scan-sexps (point) 1) (point-max)))) ! (goto-char (match-end 0))) (error t))))) --- 1570,1576 ---- (goto-char (match-end 1)) ;; Move over any item value, etc., to the next item. ! (while (not (looking-at "[ \t]*\\(\\(,\\)\\|;\\|$\\)")) (goto-char (or (scan-sexps (point) 1) (point-max)))) ! (goto-char (match-end 2))) (error t))))) *************** the face is also set; its value is the f *** 1497,1502 **** '("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face) ;; ! ;; Fontify symbol names in #if ... defined preprocessor directives. ! '("^#[ \t]*if\\>" ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))) --- 1620,1625 ---- '("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face) ;; ! ;; Fontify symbol names in #elif or #if ... defined preprocessor directives. ! '("^#[ \t]*\\(elif\\|if\\)\\>" ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))) *************** the face is also set; its value is the f *** 1576,1580 **** font-lock-type-face font-lock-function-name-face)) ! (3 (if (match-beginning 2) font-lock-function-name-face) nil t)) ))) --- 1699,1703 ---- font-lock-type-face font-lock-function-name-face)) ! (3 font-lock-function-name-face nil t)) ))) *************** the face is also set; its value is the f *** 1587,1591 **** ;; ;; Fontify operator function name overloading. ! '("\\<\\(operator\\)\\>[ \t]*\\([][)(>[ \t]*\\([[(><=+-]?\\)?" (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t)) ;; *************** the face is also set; its value is the f *** 1684,1689 **** ;; Install ourselves: ! (or (assq 'font-lock-mode minor-mode-alist) ! (setq minor-mode-alist (cons '(font-lock-mode " Font") minor-mode-alist))) ;; Provide ourselves: --- 1807,1812 ---- ;; Install ourselves: ! (unless (assq 'font-lock-mode minor-mode-alist) ! (setq minor-mode-alist (cons '(font-lock-mode " Font") minor-mode-alist))) ;; Provide ourselves: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/frame.el emacs-19.32/lisp/frame.el *** emacs-19.31/lisp/frame.el Tue Feb 27 19:08:44 1996 --- emacs-19.32/lisp/frame.el Mon Jun 10 17:17:58 1996 *************** These supersede the values given in `def *** 153,157 **** ;; Are we actually running under a window system at all? ! (if (and window-system (not noninteractive)) (progn ;; Turn on special-display processing only if there's a window system. --- 153,157 ---- ;; Are we actually running under a window system at all? ! (if (and window-system (not noninteractive) (not (eq window-system 'pc))) (progn ;; Turn on special-display processing only if there's a window system. *************** These supersede the values given in `def *** 192,202 **** ;; No, we're not running a window system. Use make-terminal-frame if ;; we support that feature, otherwise arrange to cause errors. ! (setq frame-creation-function ! (if (fboundp 'make-terminal-frame) ! 'make-terminal-frame ! (function ! (lambda (parameters) ! (error ! "Can't create multiple frames without a window system"))))))) ;;; startup.el calls this function after loading the user's init --- 192,203 ---- ;; No, we're not running a window system. Use make-terminal-frame if ;; we support that feature, otherwise arrange to cause errors. ! (or (eq window-system 'pc) ! (setq frame-creation-function ! (if (fboundp 'make-terminal-frame) ! 'make-terminal-frame ! (function ! (lambda (parameters) ! (error ! "Can't create multiple frames without a window system")))))))) ;;; startup.el calls this function after loading the user's init *************** The optional second argument PARAMETERS *** 418,421 **** --- 419,429 ---- (make-frame (cons (cons 'display display) parameters))) + (defun make-frame-command () + "Make a new frame, and select it if the terminal displays only one frame." + (interactive) + (if (and window-system (not (eq window-system 'pc))) + (make-frame) + (select-frame (make-frame)))) + ;; Alias, kept temporarily. (defalias 'new-frame 'make-frame) *************** should use `set-frame-width' instead." *** 706,710 **** (define-key ctl-x-map "5" 'ctl-x-5-prefix) ! (define-key ctl-x-5-map "2" 'make-frame) (define-key ctl-x-5-map "0" 'delete-frame) (define-key ctl-x-5-map "o" 'other-frame) --- 714,718 ---- (define-key ctl-x-map "5" 'ctl-x-5-prefix) ! (define-key ctl-x-5-map "2" 'make-frame-command) (define-key ctl-x-5-map "0" 'delete-frame) (define-key ctl-x-5-map "o" 'other-frame) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-cache.el emacs-19.32/lisp/gnus-cache.el *** emacs-19.31/lisp/gnus-cache.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-cache.el Sun Jul 14 11:14:50 1996 *************** *** 1,5 **** ;;; gnus-cache.el --- cache interface for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; gnus-cache.el --- cache interface for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 28,35 **** (require 'gnus) ! (defvar gnus-cache-directory (concat gnus-article-save-directory "cache/") "*The directory where cached articles will be stored.") (defvar gnus-cache-enter-articles '(ticked dormant) "*Classes of articles to enter into the cache.") --- 27,40 ---- (require 'gnus) + (eval-when-compile (require 'cl)) ! (defvar gnus-cache-directory ! (nnheader-concat gnus-directory "cache/") "*The directory where cached articles will be stored.") + (defvar gnus-cache-active-file + (concat (file-name-as-directory gnus-cache-directory) "active") + "*The cache active file.") + (defvar gnus-cache-enter-articles '(ticked dormant) "*Classes of articles to enter into the cache.") *************** *** 38,70 **** "*Classes of articles to remove from the cache.") (defvar gnus-cache-buffer nil) ! (defun gnus-cache-change-buffer (group) ! (and gnus-cache-buffer ! ;; see if the current group's overview cache has been loaded ! (or (string= group (car gnus-cache-buffer)) ! ;; another overview cache is current, save it ! (gnus-cache-save-buffers))) ! ;; if gnus-cache buffer is nil, create it ! (or gnus-cache-buffer ! ;; create cache buffer ! (save-excursion ! (setq gnus-cache-buffer ! (cons group ! (set-buffer (get-buffer-create " *gnus-cache-overview*")))) ! (buffer-disable-undo (current-buffer)) ! ;; insert the contents of this groups cache overview ! (erase-buffer) ! (let ((file (gnus-cache-file-name group ".overview"))) ! (and (file-exists-p file) ! (insert-file-contents file))) ! ;; we have a fresh (empty/just loaded) buffer, ! ;; mark it as unmodified to save a redundant write later. ! (set-buffer-modified-p nil)))) (defun gnus-cache-save-buffers () --- 43,85 ---- "*Classes of articles to remove from the cache.") + (defvar gnus-uncacheable-groups nil + "*Groups that match this regexp will not be cached. + + If you want to avoid caching your nnml groups, you could set this + variable to \"^nnml\".") + + ;;; Internal variables. + (defvar gnus-cache-buffer nil) + (defvar gnus-cache-active-hashtb nil) + (defvar gnus-cache-active-altered nil) + + (eval-and-compile + (autoload 'nnml-generate-nov-databases-1 "nnml") + (autoload 'nnvirtual-find-group-art "nnvirtual")) ! ;;; Functions called from Gnus. + (defun gnus-cache-open () + "Initialize the cache." + (when (or (file-exists-p gnus-cache-directory) + (and gnus-use-cache + (not (eq gnus-use-cache 'passive)))) + (gnus-cache-read-active))) + + (condition-case () + (gnus-add-shutdown 'gnus-cache-close 'gnus) + ;; Complexities of byte-compiling makes this kludge necessary. Eeek. + (error nil)) + + (defun gnus-cache-close () + "Shut down the cache." + (gnus-cache-write-active) + (gnus-cache-save-buffers) + (setq gnus-cache-active-hashtb nil)) (defun gnus-cache-save-buffers () *************** *** 100,103 **** --- 115,365 ---- (setq gnus-cache-buffer nil)))) + (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) + (> article 0) + (vectorp headers)) ; 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 + (gnus-group-real-name group) article))) + (setq group (car result) + headers (copy-sequence headers)) + (mail-header-set-number headers (cdr result)))) + (let ((number (mail-header-number headers)) + file dir) + (when (and (> number 0) ; Reffed article. + (or (not gnus-uncacheable-groups) + (not (string-match gnus-uncacheable-groups group))) + (or force + (gnus-cache-member-of-class + gnus-cache-enter-articles ticked dormant unread)) + (not (file-exists-p (setq file (gnus-cache-file-name + group number))))) + ;; Possibly create the cache directory. + (or (file-exists-p (setq dir (file-name-directory file))) + (gnus-make-directory dir)) + ;; Save the article in the cache. + (if (file-exists-p file) + t ; The article already is saved. + (save-excursion + (set-buffer nntp-server-buffer) + (let ((gnus-use-cache nil)) + (gnus-request-article-this-buffer number group)) + (when (> (buffer-size) 0) + (write-region (point-min) (point-max) file nil 'quiet) + (gnus-cache-change-buffer group) + (set-buffer (cdr gnus-cache-buffer)) + (goto-char (point-max)) + (forward-line -1) + (while (condition-case () + (and (not (bobp)) + (> (read (current-buffer)) number)) + (error + ;; The line was malformed, so we just remove it!! + (gnus-delete-line) + t)) + (forward-line -1)) + (if (bobp) + (if (not (eobp)) + (progn + (beginning-of-line) + (if (< (read (current-buffer)) number) + (forward-line 1))) + (beginning-of-line)) + (forward-line 1)) + (beginning-of-line) + ;; [number subject from date id references chars lines xref] + (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" + (mail-header-number headers) + (mail-header-subject headers) + (mail-header-from headers) + (mail-header-date headers) + (mail-header-id headers) + (or (mail-header-references headers) "") + (or (mail-header-chars headers) "") + (or (mail-header-lines headers) "") + (or (mail-header-xref headers) ""))) + ;; Update the active info. + (set-buffer gnus-summary-buffer) + (gnus-cache-update-active group number) + (push article gnus-newsgroup-cached) + (gnus-summary-update-secondary-mark article)) + t)))))) + + (defun gnus-cache-enter-remove-article (article) + "Mark ARTICLE for later possible removal." + (when article + (push article gnus-cache-removable-articles))) + + (defun gnus-cache-possibly-remove-articles () + "Possibly remove some of the removable articles." + (if (not (gnus-virtual-group-p gnus-newsgroup-name)) + (gnus-cache-possibly-remove-articles-1) + (let ((arts gnus-cache-removable-articles) + ga) + (while arts + (when (setq ga (nnvirtual-find-group-art + (gnus-group-real-name gnus-newsgroup-name) (pop arts))) + (let ((gnus-cache-removable-articles (list (cdr ga))) + (gnus-newsgroup-name (car ga))) + (gnus-cache-possibly-remove-articles-1))))) + (setq gnus-cache-removable-articles nil))) + + (defun gnus-cache-possibly-remove-articles-1 () + "Possibly remove some of the removable articles." + (unless (eq gnus-use-cache 'passive) + (let ((articles gnus-cache-removable-articles) + (cache-articles gnus-newsgroup-cached) + article) + (gnus-cache-change-buffer gnus-newsgroup-name) + (while articles + (if (memq (setq article (pop articles)) cache-articles) + ;; The article was in the cache, so we see whether we are + ;; supposed to remove it from the cache. + (gnus-cache-possibly-remove-article + article (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-dormant) + (or (memq article gnus-newsgroup-unreads) + (memq article gnus-newsgroup-unselected)))))) + ;; The overview file might have been modified, save it + ;; safe because we're only called at group exit anyway. + (gnus-cache-save-buffers))) + + (defun gnus-cache-request-article (article group) + "Retrieve ARTICLE in GROUP from the cache." + (let ((file (gnus-cache-file-name group article)) + (buffer-read-only nil)) + (when (file-exists-p file) + (erase-buffer) + (gnus-kill-all-overlays) + (insert-file-contents file) + t))) + + (defun gnus-cache-possibly-alter-active (group active) + "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 + (< (car cache-active) (car active)) + (setcar active (car cache-active))) + (and cache-active + (> (cdr cache-active) (cdr active)) + (setcdr active (cdr cache-active)))))) + + (defun gnus-cache-retrieve-headers (articles group &optional fetch-old) + "Retrieve the headers for ARTICLES in GROUP." + (let ((cached + (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) + (if (not cached) + ;; No cached articles here, so we just retrieve them + ;; the normal way. + (let ((gnus-use-cache nil)) + (gnus-retrieve-headers articles group fetch-old)) + (let ((uncached-articles (gnus-sorted-intersection + (gnus-sorted-complement articles cached) + articles)) + (cache-file (gnus-cache-file-name group ".overview")) + type) + ;; 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 + uncached-articles group fetch-old))))) + (gnus-cache-save-buffers) + ;; Then we insert the cached headers. + (save-excursion + (cond + ((not (file-exists-p cache-file)) + ;; There are no cached headers. + type) + ((null type) + ;; There were no uncached headers (or retrieval was + ;; unsuccessful), so we use the cached headers exclusively. + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-file-contents cache-file) + 'nov) + ((eq type 'nov) + ;; We have both cached and uncached NOV headers, so we + ;; braid them. + (gnus-cache-braid-nov group cached) + type) + (t + ;; We braid HEADs. + (gnus-cache-braid-heads group (gnus-sorted-intersection + cached articles)) + type))))))) + + (defun gnus-cache-enter-article (&optional n) + "Enter the next N articles into the cache. + If not given a prefix, use the process marked articles instead. + Returns the list of articles entered." + (interactive "P") + (gnus-set-global-variables) + (let ((articles (gnus-summary-work-articles n)) + article out) + (while articles + (setq article (pop articles)) + (when (gnus-cache-possibly-enter-article + gnus-newsgroup-name article (gnus-summary-article-header article) + nil nil nil t) + (push article out)) + (gnus-summary-remove-process-mark article) + (gnus-summary-update-secondary-mark article)) + (gnus-summary-next-subject 1) + (gnus-summary-position-point) + (nreverse out))) + + (defun gnus-cache-remove-article (n) + "Remove the next N articles from the cache. + If not given a prefix, use the process marked articles instead. + Returns the list of articles removed." + (interactive "P") + (gnus-set-global-variables) + (gnus-cache-change-buffer gnus-newsgroup-name) + (let ((articles (gnus-summary-work-articles n)) + article out) + (while articles + (setq article (pop articles)) + (when (gnus-cache-possibly-remove-article article nil nil nil t) + (push article out)) + (gnus-summary-remove-process-mark article) + (gnus-summary-update-secondary-mark article)) + (gnus-summary-next-subject 1) + (gnus-summary-position-point) + (nreverse out))) + + (defun gnus-cached-article-p (article) + "Say whether ARTICLE is cached in the current group." + (memq article gnus-newsgroup-cached)) + + ;;; Internal functions. + + (defun gnus-cache-change-buffer (group) + (and gnus-cache-buffer + ;; See if the current group's overview cache has been loaded. + (or (string= group (car gnus-cache-buffer)) + ;; Another overview cache is current, save it. + (gnus-cache-save-buffers))) + ;; if gnus-cache buffer is nil, create it + (or gnus-cache-buffer + ;; Create cache buffer + (save-excursion + (setq gnus-cache-buffer + (cons group + (set-buffer (get-buffer-create " *gnus-cache-overview*")))) + (buffer-disable-undo (current-buffer)) + ;; Insert the contents of this group's cache overview. + (erase-buffer) + (let ((file (gnus-cache-file-name group ".overview"))) + (and (file-exists-p file) + (insert-file-contents file))) + ;; We have a fresh (empty/just loaded) buffer, + ;; mark it as unmodified to save a redundant write later. + (set-buffer-modified-p nil)))) ;; Return whether an article is a member of a class. *************** *** 106,282 **** (and dormant (memq 'dormant class)) (and unread (memq 'unread class)) ! (and (not unread) (memq 'read class)))) (defun gnus-cache-file-name (group article) (concat (file-name-as-directory gnus-cache-directory) ! (if (gnus-use-long-file-name 'not-cache) ! group ! (let ((group (concat group ""))) ! (if (string-match ":" group) ! (aset group (match-beginning 0) ?/)) ! (gnus-replace-chars-in-string group ?. ?/))) ! "/" (if (stringp article) article (int-to-string article)))) ! ! (defun gnus-cache-possibly-enter-article ! (group article headers ticked dormant unread) ! (let ((number (mail-header-number headers)) ! file dir) ! (if (or (not (vectorp headers)) ; This might be a dummy article. ! (< number 0) ; Reffed article from other group. ! (not (gnus-cache-member-of-class ! gnus-cache-enter-articles ticked dormant unread)) ! (file-exists-p (setq file (gnus-cache-file-name group article)))) ! () ; Do nothing. ! ;; Possibly create the cache directory. ! (or (file-exists-p (setq dir (file-name-directory file))) ! (gnus-make-directory dir)) ! ;; Save the article in the cache. ! (if (file-exists-p file) ! t ; The article already is saved, so we end here. ! (let ((gnus-use-cache nil)) ! (gnus-summary-select-article)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (widen) ! (write-region (point-min) (point-max) file nil 'quiet)) ! (gnus-cache-change-buffer group) ! (set-buffer (cdr gnus-cache-buffer)) ! (goto-char (point-max)) ! (forward-line -1) ! (while (condition-case () ! (and (not (bobp)) ! (> (read (current-buffer)) number)) ! (error ! ;; The line was malformed, so we just remove it!! ! (gnus-delete-line) ! t)) ! (forward-line -1)) ! (if (bobp) ! (if (not (eobp)) ! (progn ! (beginning-of-line) ! (if (< (read (current-buffer)) number) ! (forward-line 1))) ! (beginning-of-line)) ! (forward-line 1)) ! (beginning-of-line) ! ;; [number subject from date id references chars lines xref] ! (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" ! (mail-header-number headers) ! (mail-header-subject headers) ! (mail-header-from headers) ! (mail-header-date headers) ! (mail-header-id headers) ! (or (mail-header-references headers) "") ! (or (mail-header-chars headers) "") ! (or (mail-header-lines headers) "") ! (or (mail-header-xref headers) "")))) ! t)))) ! ! (defun gnus-cache-enter-remove-article (article) ! (setq gnus-cache-removable-articles ! (cons article gnus-cache-removable-articles))) ! ! (defsubst gnus-cache-possibly-remove-article ! (article ticked dormant unread) ! (let ((file (gnus-cache-file-name gnus-newsgroup-name article))) ! (if (or (not (file-exists-p file)) ! (not (gnus-cache-member-of-class ! gnus-cache-remove-articles ticked dormant unread))) ! nil (save-excursion (delete-file file) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-min)) ! (if (or (looking-at (concat (int-to-string article) "\t")) ! (search-forward (concat "\n" (int-to-string article) "\t") (point-max) t)) (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point)))))))) ! ! (defun gnus-cache-possibly-remove-articles () ! (let ((articles gnus-cache-removable-articles) ! (cache-articles (gnus-cache-articles-in-group gnus-newsgroup-name)) ! article) ! (gnus-cache-change-buffer gnus-newsgroup-name) ! (while articles ! (setq article (car articles) ! articles (cdr articles)) ! (if (memq article cache-articles) ! ;; The article was in the cache, so we see whether we are ! ;; supposed to remove it from the cache. ! (gnus-cache-possibly-remove-article ! article (memq article gnus-newsgroup-marked) ! (memq article gnus-newsgroup-dormant) ! (or (memq article gnus-newsgroup-unreads) ! (memq article gnus-newsgroup-unselected)))))) ! ;; the overview file might have been modified, save it ! ;; safe because we're only called at group exit anyway ! (gnus-cache-save-buffers)) ! ! ! (defun gnus-cache-request-article (article group) ! (let ((file (gnus-cache-file-name group article))) ! (if (not (file-exists-p file)) ! () ! (erase-buffer) ! ;; There may be some overlays that we have to kill... ! (insert "i") ! (let ((overlays (overlays-at (point-min)))) ! (while overlays ! (delete-overlay (car overlays)) ! (setq overlays (cdr overlays)))) ! (erase-buffer) ! (insert-file-contents file) t))) (defun gnus-cache-articles-in-group (group) (let ((dir (file-name-directory (gnus-cache-file-name group 1))) articles) ! (if (not (file-exists-p dir)) ! nil ! (setq articles (directory-files dir nil "^[0-9]+$" t)) ! (if (not articles) ! nil ! (sort (mapcar (function (lambda (name) ! (string-to-int name))) ! articles) ! '<))))) ! ! (defun gnus-cache-active-articles (group) ! (let ((articles (gnus-cache-articles-in-group group))) ! (and articles ! (cons (car articles) (gnus-last-element articles))))) ! ! (defun gnus-cache-possibly-alter-active (group active) ! (let ((cache-active (gnus-cache-active-articles group))) ! (and cache-active (< (car cache-active) (car active)) ! (setcar active (car cache-active))) ! (and cache-active (> (cdr cache-active) (cdr active)) ! (setcdr active (cdr cache-active))))) ! ! (defun gnus-cache-retrieve-headers (articles group) ! (let* ((cached (gnus-cache-articles-in-group group)) ! (articles (gnus-sorted-complement articles cached)) ! (cache-file (gnus-cache-file-name group ".overview")) ! type) ! (let ((gnus-use-cache nil)) ! (setq type (and articles (gnus-retrieve-headers articles group)))) ! (gnus-cache-save-buffers) ! (save-excursion ! (cond ((not (file-exists-p cache-file)) ! type) ! ((null type) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-file-contents cache-file) ! 'nov) ! ((eq type 'nov) ! (gnus-cache-braid-nov group cached) ! type) ! (t ! (gnus-cache-braid-heads group cached) ! type))))) (defun gnus-cache-braid-nov (group cached) --- 368,431 ---- (and dormant (memq 'dormant class)) (and unread (memq 'unread class)) ! (and (not unread) (not ticked) (not dormant) (memq 'read class)))) (defun gnus-cache-file-name (group article) (concat (file-name-as-directory gnus-cache-directory) ! (file-name-as-directory ! (if (gnus-use-long-file-name 'not-cache) ! group ! (let ((group (concat group ""))) ! (if (string-match ":" group) ! (aset group (match-beginning 0) ?/)) ! (nnheader-replace-chars-in-string group ?. ?/)))) ! (if (stringp article) article (int-to-string article)))) ! ! (defun gnus-cache-update-article (group article) ! "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-newsgroup-name article (gnus-summary-article-header article) ! nil nil nil t)))) ! ! (defun gnus-cache-possibly-remove-article (article ticked dormant unread ! &optional force) ! "Possibly remove ARTICLE from the cache." ! (let ((group gnus-newsgroup-name) ! (number article) ! file) ! ;; If this is a virtual group, we find the real group. ! (when (gnus-virtual-group-p group) ! (let ((result (nnvirtual-find-group-art ! (gnus-group-real-name group) article))) ! (setq group (car result) ! number (cdr result)))) ! (setq file (gnus-cache-file-name group number)) ! (when (and (file-exists-p file) ! (or force ! (gnus-cache-member-of-class ! gnus-cache-remove-articles ticked dormant unread))) (save-excursion (delete-file file) (set-buffer (cdr gnus-cache-buffer)) (goto-char (point-min)) ! (if (or (looking-at (concat (int-to-string number) "\t")) ! (search-forward (concat "\n" (int-to-string number) "\t") (point-max) t)) (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point))))) ! (setq gnus-newsgroup-cached ! (delq article gnus-newsgroup-cached)) ! (gnus-summary-update-secondary-mark article) t))) (defun gnus-cache-articles-in-group (group) + "Return a sorted list of cached articles in GROUP." (let ((dir (file-name-directory (gnus-cache-file-name group 1))) articles) ! (when (file-exists-p dir) ! (sort (mapcar (lambda (name) (string-to-int name)) ! (directory-files dir nil "^[0-9]+$" t)) ! '<)))) (defun gnus-cache-braid-nov (group cached) *************** *** 332,336 **** (insert-file-contents (gnus-cache-file-name group (car cached))) (goto-char (point-min)) ! (insert "220 " (int-to-string (car cached)) " Article retrieved.\n") (search-forward "\n\n" nil 'move) (delete-region (point) (point-max)) --- 481,487 ---- (insert-file-contents (gnus-cache-file-name group (car cached))) (goto-char (point-min)) ! (insert "220 ") ! (princ (car cached) (current-buffer)) ! (insert " Article retrieved.\n") (search-forward "\n\n" nil 'move) (delete-region (point) (point-max)) *************** *** 341,361 **** (kill-buffer cache-buf))) (defun gnus-jog-cache () "Go through all groups and put the articles into the cache." (interactive) ! (let ((newsrc (cdr gnus-newsrc-alist)) ! (gnus-cache-enter-articles '(unread)) ! (gnus-mark-article-hook nil) (gnus-expert-user t) (gnus-large-newsgroup nil)) ! (while newsrc ! (gnus-summary-read-group (car (car newsrc))) ! (if (not (eq major-mode 'gnus-summary-mode)) ! () ! (while gnus-newsgroup-unreads ! (gnus-summary-select-article t t nil (car gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-unreads (cdr gnus-newsgroup-unreads))) ! (kill-buffer (current-buffer))) ! (setq newsrc (cdr newsrc))))) (provide 'gnus-cache) --- 492,621 ---- (kill-buffer cache-buf))) + ;;;###autoload (defun gnus-jog-cache () "Go through all groups and put the articles into the cache." (interactive) ! (let ((gnus-mark-article-hook nil) (gnus-expert-user t) + (nnmail-spool-file nil) + (gnus-use-dribble-file nil) + (gnus-novice-user nil) (gnus-large-newsgroup nil)) ! ;; Start Gnus. ! (gnus) ! ;; Go through all groups... ! (gnus-group-mark-buffer) ! (gnus-group-universal-argument ! nil nil ! (lambda () ! (gnus-summary-read-group nil nil t) ! ;; ... and enter the articles into the cache. ! (when (eq major-mode 'gnus-summary-mode) ! (gnus-uu-mark-buffer) ! (gnus-cache-enter-article) ! (kill-buffer (current-buffer))))))) ! ! (defun gnus-cache-read-active (&optional force) ! "Read the cache active file." ! (unless (file-exists-p gnus-cache-directory) ! (make-directory gnus-cache-directory t)) ! (if (not (and (file-exists-p gnus-cache-active-file) ! (or force (not gnus-cache-active-hashtb)))) ! ;; There is no active file, so we generate one. ! (gnus-cache-generate-active) ! ;; We simply read the active file. ! (save-excursion ! (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 ! (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 ! (and gnus-cache-active-hashtb ! gnus-cache-active-altered)) ! (save-excursion ! (gnus-set-work-buffer) ! (mapatoms ! (lambda (sym) ! (when (and sym (boundp sym)) ! (insert (format "%s %d %d y\n" ! (symbol-name sym) (cdr (symbol-value sym)) ! (car (symbol-value sym)))))) ! gnus-cache-active-hashtb) ! (gnus-make-directory (file-name-directory gnus-cache-active-file)) ! (write-region ! (point-min) (point-max) gnus-cache-active-file nil 'silent)) ! ;; Mark the active hashtb as unaltered. ! (setq gnus-cache-active-altered nil))) ! ! (defun gnus-cache-update-active (group number &optional low) ! "Update the upper bound of the active info of GROUP to NUMBER. ! If LOW, update the lower bound instead." ! (let ((active (gnus-gethash group gnus-cache-active-hashtb))) ! (if (null active) ! ;; We just create a new active entry for this group. ! (gnus-sethash group (cons number number) gnus-cache-active-hashtb) ! ;; Update the lower or upper bound. ! (if low ! (setcar active number) ! (setcdr active number)) ! ;; Mark the active hashtb as altered. ! (setq gnus-cache-active-altered t)))) ! ! ;;;###autoload ! (defun gnus-cache-generate-active (&optional directory) ! "Generate the cache active file." ! (interactive) ! (let* ((top (null directory)) ! (directory (expand-file-name (or directory gnus-cache-directory))) ! (files (directory-files directory 'full)) ! (group ! (if top ! "" ! (string-match ! (concat "^" (file-name-as-directory ! (expand-file-name gnus-cache-directory))) ! (directory-file-name directory)) ! (nnheader-replace-chars-in-string ! (substring (directory-file-name directory) (match-end 0)) ! ?/ ?.))) ! nums alphs) ! (when top ! (gnus-message 5 "Generating the cache active file...") ! (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) ! ;; Separate articles from all other files and directories. ! (while files ! (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) ! (push (string-to-int (file-name-nondirectory (pop files))) nums) ! (push (pop files) alphs))) ! ;; If we have nums, then this is probably a valid group. ! (when (setq nums (sort nums '<)) ! (gnus-sethash group (cons (car nums) (gnus-last-element nums)) ! gnus-cache-active-hashtb)) ! ;; Go through all the other files. ! (while alphs ! (when (and (file-directory-p (car alphs)) ! (not (string-match "^\\.\\.?$" ! (file-name-nondirectory (car alphs))))) ! ;; We descend directories. ! (gnus-cache-generate-active (car alphs))) ! (setq alphs (cdr alphs))) ! ;; Write the new active file. ! (when top ! (gnus-cache-write-active t) ! (gnus-message 5 "Generating the cache active file...done")))) ! ! ;;;###autoload ! (defun gnus-cache-generate-nov-databases (dir) ! "Generate NOV files recursively starting in DIR." ! (interactive (list gnus-cache-directory)) ! (gnus-cache-close) ! (let ((nnml-generate-active-function 'identity)) ! (nnml-generate-nov-databases-1 dir))) (provide 'gnus-cache) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-cite.el emacs-19.32/lisp/gnus-cite.el *** emacs-19.31/lisp/gnus-cite.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-cite.el Tue Jun 25 17:58:34 1996 *************** *** 1,5 **** ;;; gnus-cite.el --- parse citations in articles for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen --- 1,4 ---- ;;; gnus-cite.el --- parse citations in articles for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Per Abrahamsen *************** *** 30,40 **** (require 'gnus-msg) (require 'gnus-ems) (eval-and-compile ! (autoload 'gnus-article-add-button "gnus-vis") ! ) ;;; Customization: (defvar gnus-cite-parse-max-size 25000 "Maximum article size (in bytes) where parsing citations is allowed. --- 29,45 ---- (require 'gnus-msg) (require 'gnus-ems) + (eval-when-compile (require 'cl)) (eval-and-compile ! (autoload 'gnus-article-add-button "gnus-vis")) ;;; Customization: + (defvar gnus-cited-text-button-line-format "%(%{[...]%}%)\n" + "Format of cited text buttons.") + + (defvar gnus-cited-lines-visible nil + "The number of lines of hidden cited text to remain visible.") + (defvar gnus-cite-parse-max-size 25000 "Maximum article size (in bytes) where parsing citations is allowed. *************** Set it to nil to parse all articles.") *** 46,63 **** (defvar gnus-cite-max-prefix 20 ! "Maximal possible length for a citation prefix.") (defvar gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") ! "Regexp matching normal SuperCite attribution lines. ! The first regexp group should match a prefix added by another package.") (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" ! "Regexp matching mangled SuperCite attribution lines. ! The first regexp group should match the SuperCite attribution.") (defvar gnus-cite-minimum-match-count 2 ! "Minimal number of identical prefix'es before we believe it is a citation.") ;see gnus-cus.el --- 51,68 ---- (defvar gnus-cite-max-prefix 20 ! "Maximum possible length for a citation prefix.") (defvar gnus-supercite-regexp (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" ">>>>> +\"\\([^\"\n]+\\)\" +==") ! "Regexp matching normal Supercite attribution lines. ! The first grouping must match prefixes added by other packages.") (defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" ! "Regexp matching mangled Supercite attribution lines. ! The first regexp group should match the Supercite attribution.") (defvar gnus-cite-minimum-match-count 2 ! "Minimum number of identical prefixes before we believe it's a citation.") ;see gnus-cus.el *************** The first regexp group should match the *** 79,83 **** "Regexp matching the beginning of an attribution line.") ! (defvar gnus-cite-attribution-postfix "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" "Regexp matching the end of an attribution line. --- 84,88 ---- "Regexp matching the beginning of an attribution line.") ! (defvar gnus-cite-attribution-suffix "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$" "Regexp matching the end of an attribution line. *************** The text matching the first grouping wil *** 113,119 **** ;;; Internal Variables: ! (defvar gnus-article-length nil) ! ;; Length of article last time we parsed it. ! ;; BUG! KLUDGE! UGLY! FIX ME! (defvar gnus-cite-prefix-alist nil) --- 118,122 ---- ;;; Internal Variables: ! (defvar gnus-cite-article nil) (defvar gnus-cite-prefix-alist nil) *************** The text matching the first grouping wil *** 136,140 **** ;; IN: is the line number of the previous line if part of the same attribution, ;; PREFIX: Is the citation prefix of the attribution line(s), and ! ;; TAG: Is a SuperCite tag, if any. ;;; Commands: --- 139,149 ---- ;; IN: is the line number of the previous line if part of the same attribution, ;; 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 ! `((?b beg ?d) ! (?e end ?d) ! (?l (- end beg) ?d))) ! (defvar gnus-cited-text-button-line-format-spec nil) ;;; Commands: *************** Text is considered cited if at least `gn *** 150,154 **** lines matches `gnus-cite-prefix-regexp' with the same prefix. ! Lines matching `gnus-cite-attribution-postfix' and perhaps `gnus-cite-attribution-prefix' are considered attribution lines." (interactive (list 'force)) --- 159,163 ---- 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." (interactive (list 'force)) *************** Lines matching `gnus-cite-attribution-po *** 194,198 **** ;; Add attribution button. (goto-line number) ! (if (re-search-forward gnus-cite-attribution-postfix (save-excursion (end-of-line 1) (point)) t) --- 203,207 ---- ;; Add attribution button. (goto-line number) ! (if (re-search-forward gnus-cite-attribution-suffix (save-excursion (end-of-line 1) (point)) t) *************** Lines matching `gnus-cite-attribution-po *** 211,238 **** (gnus-cite-add-face number skip gnus-cite-attribution-face))))) ! (defun gnus-article-hide-citation (&optional force) ! "Hide all cited text except attribution lines. ! See the documentation for `gnus-article-highlight-citation'." ! (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe force) ! (let ((buffer-read-only nil) ! (alist gnus-cite-prefix-alist) ! (inhibit-point-motion-hooks t) ! numbers number) (while alist ! (setq numbers (cdr (car alist)) ! alist (cdr alist)) (while numbers ! (setq number (car numbers) ! numbers (cdr numbers)) ! (goto-line number) ! (or (assq number gnus-cite-attribution-alist) ! (add-text-properties (point) (progn (forward-line 1) (point)) ! gnus-hidden-properties))))))) ! ! (defun gnus-article-hide-citation-maybe (&optional force) ! "Hide cited text that has an attribution line. This will do nothing unless at least `gnus-cite-hide-percentage' percent and at least `gnus-cite-hide-absolute' lines of the body is --- 220,361 ---- (gnus-cite-add-face number skip gnus-cite-attribution-face))))) ! (defun gnus-dissect-cited-text () ! "Dissect the article buffer looking for cited text." (save-excursion (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe) ! (let ((alist gnus-cite-prefix-alist) ! prefix numbers number marks m) ! ;; Loop through citation prefixes. (while alist ! (setq numbers (pop alist) ! prefix (pop numbers)) (while numbers ! (setq number (pop numbers)) ! (goto-char (point-min)) ! (forward-line number) ! (push (cons (point-marker) "") marks) ! (while (and numbers ! (= (1- number) (car numbers))) ! (setq number (pop numbers))) ! (goto-char (point-min)) ! (forward-line (1- number)) ! (push (cons (point-marker) prefix) marks))) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (push (cons (point-marker) "") marks) ! (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) ! (push (cons (point-marker) "") marks) ! (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) ! (let* ((omarks marks)) ! (setq marks nil) ! (while (cdr omarks) ! (if (= (caar omarks) (caadr omarks)) ! (progn ! (unless (equal (cdar omarks) "") ! (push (car omarks) marks)) ! (unless (equal (cdadr omarks) "") ! (push (cadr omarks) marks)) ! (setq omarks (cdr omarks))) ! (push (car omarks) marks)) ! (setq omarks (cdr omarks))) ! (when (car omarks) ! (push (car omarks) marks)) ! (setq marks (setq m (nreverse marks))) ! (while (cddr m) ! (if (and (equal (cdadr m) "") ! (equal (cdar m) (cdaddr m)) ! (goto-char (caadr m)) ! (forward-line 1) ! (= (point) (caaddr m))) ! (setcdr m (cdddr m)) ! (setq m (cdr m)))) ! marks)))) ! ! ! (defun gnus-article-fill-cited-article (&optional force) ! "Do word wrapping in the current article." ! (interactive (list t)) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (marks (gnus-dissect-cited-text)) ! (adaptive-fill-mode nil)) ! (save-restriction ! (while (cdr marks) ! (widen) ! (narrow-to-region (caar marks) (caadr marks)) ! (let ((adaptive-fill-regexp ! (concat "^" (regexp-quote (cdar marks)) " *")) ! (fill-prefix (cdar marks))) ! (fill-region (point-min) (point-max))) ! (set-marker (caar marks) nil) ! (setq marks (cdr marks))) ! (when marks ! (set-marker (caar marks) nil)))))) ! ! (defun gnus-article-hide-citation (&optional arg force) ! "Toggle hiding of all cited text except attribution lines. ! See the documentation for `gnus-article-highlight-citation'. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (append (gnus-hidden-arg) (list 'force))) ! (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)) ! (unless (gnus-article-check-hidden-text 'cite arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (marks (gnus-dissect-cited-text)) ! (inhibit-point-motion-hooks t) ! (props (nconc (list 'gnus-type 'cite) ! gnus-hidden-properties)) ! beg end) ! (while marks ! (setq beg nil ! end nil) ! (while (and marks (string= (cdar marks) "")) ! (setq marks (cdr marks))) ! (when marks ! (setq beg (caar marks))) ! (while (and marks (not (string= (cdar marks) ""))) ! (setq marks (cdr marks))) ! (when marks ! (setq end (caar marks))) ! ;; Skip past lines we want to leave visible. ! (when (and beg end gnus-cited-lines-visible) ! (goto-char beg) ! (forward-line gnus-cited-lines-visible) ! (if (>= (point) end) ! (setq beg nil) ! (setq beg (point-marker)))) ! (when (and beg end) ! (gnus-add-text-properties beg end props) ! (goto-char beg) ! (unless (save-excursion (search-backward "\n\n" nil t)) ! (insert "\n")) ! (gnus-article-add-button ! (point) ! (progn (eval gnus-cited-text-button-line-format-spec) (point)) ! `gnus-article-toggle-cited-text (cons beg end)) ! (set-marker beg (point)))))))) ! ! (defun gnus-article-toggle-cited-text (region) ! "Toggle hiding the text in REGION." ! (let (buffer-read-only) ! (funcall ! (if (text-property-any ! (car region) (1- (cdr region)) ! (car gnus-hidden-properties) (cadr gnus-hidden-properties)) ! 'remove-text-properties 'gnus-add-text-properties) ! (car region) (cdr region) gnus-hidden-properties))) ! ! (defun gnus-article-hide-citation-maybe (&optional arg force) ! "Toggle hiding of cited text that has an attribution line. ! If given a negative prefix, always show; if given a positive prefix, ! always hide. This will do nothing unless at least `gnus-cite-hide-percentage' percent and at least `gnus-cite-hide-absolute' lines of the body is *************** cited text with attributions. When call *** 240,278 **** variables are ignored. See also the documentation for `gnus-article-highlight-citation'." ! (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe force) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (let ((start (point)) ! (atts gnus-cite-attribution-alist) ! (buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (hiden 0) ! total) ! (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) ! (setq total (count-lines start (point))) ! (while atts ! (setq hiden (+ hiden (length (cdr (assoc (cdr (car atts)) ! gnus-cite-prefix-alist)))) ! atts (cdr atts))) ! (if (or force ! (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) ! (> hiden gnus-cite-hide-absolute))) ! (progn ! (setq atts gnus-cite-attribution-alist) ! (while atts ! (setq total (cdr (assoc (cdr (car atts)) gnus-cite-prefix-alist)) ! atts (cdr atts)) ! (while total ! (setq hiden (car total) ! total (cdr total)) ! (goto-line hiden) ! (or (assq hiden gnus-cite-attribution-alist) ! (add-text-properties (point) ! (progn (forward-line 1) (point)) ! gnus-hidden-properties))))))))) ;;; Internal functions: --- 363,414 ---- variables are ignored. See also the documentation for `gnus-article-highlight-citation'." ! (interactive (append (gnus-hidden-arg) (list 'force))) ! (unless (gnus-article-check-hidden-text 'cite arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe force) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (let ((start (point)) ! (atts gnus-cite-attribution-alist) ! (buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (hiden 0) ! total) ! (goto-char (point-max)) ! (re-search-backward gnus-signature-separator nil t) ! (setq total (count-lines start (point))) ! (while atts ! (setq hiden (+ hiden (length (cdr (assoc (cdar atts) ! gnus-cite-prefix-alist)))) ! atts (cdr atts))) ! (if (or force ! (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) ! (> hiden gnus-cite-hide-absolute))) ! (progn ! (setq atts gnus-cite-attribution-alist) ! (while atts ! (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) ! atts (cdr atts)) ! (while total ! (setq hiden (car total) ! total (cdr total)) ! (goto-line hiden) ! (or (assq hiden gnus-cite-attribution-alist) ! (gnus-add-text-properties ! (point) (progn (forward-line 1) (point)) ! (nconc (list 'gnus-type 'cite) ! gnus-hidden-properties))))))))))) ! ! (defun gnus-article-hide-citation-in-followups () ! "Hide cited text in non-root articles." ! (interactive) (save-excursion (set-buffer gnus-article-buffer) ! (let ((article (cdr gnus-article-current))) ! (unless (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-article-displayed-root-p article)) ! (gnus-article-hide-citation))))) ;;; Internal functions: *************** See also the documentation for `gnus-art *** 280,284 **** (defun gnus-cite-parse-maybe (&optional force) ;; Parse if the buffer has changes since last time. ! (if (eq gnus-article-length (- (point-max) (point-min))) () ;;Reset parser information. --- 416,420 ---- (defun gnus-cite-parse-maybe (&optional force) ;; Parse if the buffer has changes since last time. ! (if (equal gnus-cite-article gnus-article-current) () ;;Reset parser information. *************** See also the documentation for `gnus-art *** 292,296 **** (> (buffer-size) gnus-cite-parse-max-size)) () ! (setq gnus-article-length (- (point-max) (point-min))) (gnus-cite-parse)))) --- 428,433 ---- (> (buffer-size) gnus-cite-parse-max-size)) () ! (setq gnus-cite-article (cons (car gnus-article-current) ! (cdr gnus-article-current))) (gnus-cite-parse)))) *************** See also the documentation for `gnus-art *** 316,320 **** start end) (goto-char begin) ! ;; Ignore standard SuperCite attribution prefix. (if (looking-at gnus-supercite-regexp) (if (match-end 1) --- 453,457 ---- start end) (goto-char begin) ! ;; Ignore standard Supercite attribution prefix. (if (looking-at gnus-supercite-regexp) (if (match-end 1) *************** See also the documentation for `gnus-art *** 328,332 **** (setq end (match-end 0) prefix (buffer-substring begin end)) ! (set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) (if entry --- 465,469 ---- (setq end (match-end 0) prefix (buffer-substring begin end)) ! (gnus-set-text-properties 0 (length prefix) nil prefix) (setq entry (assoc prefix alist)) (if entry *************** See also the documentation for `gnus-art *** 375,379 **** (goto-char (point-min)) (search-forward "\n\n" nil t) ! (while (re-search-forward gnus-cite-attribution-postfix (point-max) t) (let* ((start (match-beginning 0)) (end (match-end 0)) --- 512,516 ---- (goto-char (point-min)) (search-forward "\n\n" nil t) ! (while (re-search-forward gnus-cite-attribution-suffix (point-max) t) (let* ((start (match-beginning 0)) (end (match-end 0)) *************** See also the documentation for `gnus-art *** 393,397 **** (point)) t) ! (not (re-search-forward gnus-cite-attribution-postfix start t)) (count-lines (point-min) (1+ (point))))))) --- 530,534 ---- (point)) t) ! (not (re-search-forward gnus-cite-attribution-suffix start t)) (count-lines (point-min) (1+ (point))))))) *************** See also the documentation for `gnus-art *** 464,468 **** ;; WROTE is the attribution line number. ;; PREFIX is the attribution line prefix. ! ;; TAG is the SuperCite tag on the attribution line. (let ((atts gnus-cite-loose-attribution-alist) (case-fold-search t) --- 601,605 ---- ;; WROTE is the attribution line number. ;; PREFIX is the attribution line prefix. ! ;; TAG is the Supercite tag on the attribution line. (let ((atts gnus-cite-loose-attribution-alist) (case-fold-search t) *************** See also the documentation for `gnus-art *** 537,544 **** (defun gnus-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. ! (if face ! (let ((inhibit-point-motion-hooks t) ! from to) ! (goto-line number) (forward-char (length prefix)) (skip-chars-forward " \t") --- 674,682 ---- (defun gnus-cite-add-face (number prefix face) ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. ! (when face ! (let ((inhibit-point-motion-hooks t) ! from to) ! (goto-line number) ! (unless (eobp) ;; Sometimes things become confused. (forward-char (length prefix)) (skip-chars-forward " \t") *************** See also the documentation for `gnus-art *** 547,552 **** (skip-chars-backward " \t") (setq to (point)) ! (if (< from to) ! (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) (defun gnus-cite-toggle (prefix) --- 685,690 ---- (skip-chars-backward " \t") (setq to (point)) ! (when (< from to) ! (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) (defun gnus-cite-toggle (prefix) *************** See also the documentation for `gnus-art *** 566,571 **** ((assq number gnus-cite-attribution-alist)) (t ! (add-text-properties (point) (progn (forward-line 1) (point)) ! gnus-hidden-properties))))))) (defun gnus-cite-find-prefix (line) --- 704,711 ---- ((assq number gnus-cite-attribution-alist)) (t ! (gnus-add-text-properties ! (point) (progn (forward-line 1) (point)) ! (nconc (list 'gnus-type 'cite) ! gnus-hidden-properties)))))))) (defun gnus-cite-find-prefix (line) *************** See also the documentation for `gnus-art *** 580,583 **** --- 720,728 ---- (setq prefix (car entry)))) prefix)) + + (gnus-add-shutdown 'gnus-cache-close 'gnus) + + (defun gnus-cache-close () + (setq gnus-cite-prefix-alist nil)) (gnus-ems-redefine) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-cus.el emacs-19.32/lisp/gnus-cus.el *** emacs-19.31/lisp/gnus-cus.el Tue Mar 26 19:14:06 1996 --- emacs-19.32/lisp/gnus-cus.el Sat Jul 20 02:07:24 1996 *************** *** 1,6 **** ;;; gnus-cus.el --- User friendly customization of Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ! ;; Author: Per Abrahamsen ;; Keywords: help, news --- 1,5 ---- ;;; gnus-cus.el --- User friendly customization of Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ! ;; ;; Author: Per Abrahamsen ;; Keywords: help, news *************** *** 30,39 **** (require 'custom) (require 'gnus-ems) ! ;; The following is just helper functions and data, not ment to be set ;; by the user. (defun gnus-make-face (color) ;; Create entry for face with COLOR. ! (custom-face-lookup color nil nil 'custom:asis 'custom:asis 'custom:asis)) (defvar gnus-face-light-name-list --- 29,40 ---- (require 'custom) (require 'gnus-ems) + (require 'browse-url) + (eval-when-compile (require 'cl)) ! ;; The following is just helper functions and data, not meant to be set ;; by the user. (defun gnus-make-face (color) ;; Create entry for face with COLOR. ! (custom-face-lookup color nil nil nil nil nil)) (defvar gnus-face-light-name-list *************** *** 43,124 **** (defvar gnus-face-dark-name-list ! '("RoyalBlue" "firebrick" ! "dark green" "OrangeRed" "dark khaki" "dark violet" ! "SteelBlue4")) ; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3 ; DarkOlviveGreen4 (custom-declare '() ! '((tag . "GNUS") (doc . "\ The coffee-brewing, all singing, all dancing, kitchen sink newsreader.") (type . group) ! (data ((tag . "Visual") ! (doc . "\ ! GNUS can be made colorful and fun or grey and dull as you wish.") ! (type . group) ! (data ((tag . "Visual") ! (doc . "Enable visual features. If `visual' is disabled, there will be no menus and few faces. Most of ! the visual customization options below will be ignored. GNUS will use less space and be faster as a result.") ! (default . t) ! (name . gnus-visual) ! (type . toggle)) ! ((tag . "WWW Browser") ! (doc . "\ WWW Browser to call when clicking on an URL button in the article buffer. You can choose between one of the predefined browsers, or `Other'.") ! (name . gnus-button-url) ! (calculate . (cond ((boundp 'browse-url-browser-function) ! browse-url-browser-function) ! ((fboundp 'w3-fetch) ! 'w3-fetch) ! ((eq window-system 'x) ! 'gnus-netscape-open-url))) ! (type . choice) ! (data ((tag . "W3") ! (type . const) ! (default . w3-fetch)) ! ((tag . "Netscape") ! (type . const) ! (default . gnus-netscape-open-url)) ! ((prompt . "Other") ! (doc . "\ You must specify the name of a Lisp function here. The lisp function should open a WWW browser when called with an URL (a string). ") ! (default . __uninitialized__) ! (type . symbol)))) ! ((tag . "Mouse Face") ! (doc . "\ Face used for group or summary buffer mouse highlighting. The line beneath the mouse pointer will be highlighted with this face.") ! (name . gnus-mouse-face) ! (calculate . (if (boundp 'gnus-mouse-face) ! gnus-mouse-face ! 'highlight)) ! (type . face)) ! ((tag . "Article Display") ! (doc . "Controls how the article buffer will look. ! ! The list below contains various filters you can use to change the look ! of the article. If you leave the list empty, the article will appear ! exactly as it is stored on the disk. The list entries will hide or ! highlight various parts of the article, making it easier to find the ! information you want.") ! (name . gnus-article-display-hook) ! (type . list) ! (default . (gnus-article-hide-headers-if-wanted ! gnus-article-treat-overstrike ! gnus-article-maybe-highlight)) ! (data ((type . repeat) ! (header . nil) ! (data (tag . "Filter") ! (type . choice) ! (data ((tag . "Treat Overstrike") ! (doc . "\ Convert use of overstrike into bold and underline. --- 44,155 ---- (defvar gnus-face-dark-name-list ! (list ! ;; Not all servers have dark blue in rgb.txt. ! (if (and (eq window-system 'x) (x-color-defined-p "dark blue")) ! "dark blue" ! "royal blue") ! "firebrick" "dark green" "OrangeRed" ! "dark khaki" "dark violet" "SteelBlue4")) ; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3 ; DarkOlviveGreen4 (custom-declare '() ! '((tag . "Gnus") (doc . "\ The coffee-brewing, all singing, all dancing, kitchen sink newsreader.") (type . group) ! (data ! ((tag . "Visual") ! (doc . "\ ! Gnus can be made colorful and fun or grey and dull as you wish.") ! (type . group) ! (data ! ((tag . "Visual") ! (doc . "Enable visual features. If `visual' is disabled, there will be no menus and few faces. Most of ! the visual customization options below will be ignored. Gnus will use less space and be faster as a result.") ! (default . ! (summary-highlight group-highlight ! article-highlight ! mouse-face ! summary-menu group-menu article-menu ! tree-highlight menu highlight ! browse-menu server-menu ! page-marker tree-menu binary-menu pick-menu ! grouplens-menu)) ! (name . gnus-visual) ! (type . sexp)) ! ((tag . "WWW Browser") ! (doc . "\ WWW Browser to call when clicking on an URL button in the article buffer. You can choose between one of the predefined browsers, or `Other'.") ! (name . browse-url-browser-function) ! (calculate . (cond ((boundp 'browse-url-browser-function) ! browse-url-browser-function) ! ((fboundp 'w3-fetch) ! 'w3-fetch) ! ((eq window-system 'x) ! 'gnus-netscape-open-url))) ! (type . choice) ! (data ! ((tag . "W3") ! (type . const) ! (default . w3-fetch)) ! ((tag . "Netscape") ! (type . const) ! (default . browse-url-netscape)) ! ((prompt . "Other") ! (doc . "\ You must specify the name of a Lisp function here. The lisp function should open a WWW browser when called with an URL (a string). ") ! (default . __uninitialized__) ! (type . symbol)))) ! ((tag . "Mouse Face") ! (doc . "\ Face used for group or summary buffer mouse highlighting. The line beneath the mouse pointer will be highlighted with this face.") ! (name . gnus-mouse-face) ! (calculate . (condition-case () ! (if (gnus-visual-p 'mouse-face 'highlight) ! (if (boundp 'gnus-mouse-face) ! gnus-mouse-face ! 'highlight) ! 'default) ! (error 'default))) ! (type . face)) ! ((tag . "Article Display") ! (doc . "Controls how the article buffer will look. ! ! If you leave the list empty, the article will appear exactly as it is ! stored on the disk. The list entries will hide or highlight various ! parts of the article, making it easier to find the information you ! want.") ! (name . gnus-article-display-hook) ! (type . list) ! (calculate ! . (if (and (string-match "xemacs" emacs-version) ! (featurep 'xface)) ! '(gnus-article-hide-headers-if-wanted ! gnus-article-hide-boring-headers ! gnus-article-treat-overstrike ! gnus-article-maybe-highlight ! gnus-article-display-x-face) ! '(gnus-article-hide-headers-if-wanted ! gnus-article-hide-boring-headers ! gnus-article-treat-overstrike ! gnus-article-maybe-highlight))) ! (data ! ((type . repeat) ! (header . nil) ! (data ! (tag . "Filter") ! (type . choice) ! (data ! ((tag . "Treat Overstrike") ! (doc . "\ Convert use of overstrike into bold and underline. *************** still in use on some newsgroups, in part *** 130,150 **** hierarchy. ") ! (type . const) ! (default . ! gnus-article-treat-overstrike)) ! ((tag . "Word Wrap") ! (doc . "\ Format too long lines. ") ! (type . const) ! (default . gnus-article-word-wrap)) ! ((tag . "Remove CR") ! (doc . "\ Remove carriage returns from an article. ") ! (type . const) ! (default . gnus-article-remove-cr)) ! ((tag . "Display X-Face") ! (doc . "\ Look for an X-Face header and display it if present. --- 161,181 ---- hierarchy. ") ! (type . const) ! (default . ! gnus-article-treat-overstrike)) ! ((tag . "Word Wrap") ! (doc . "\ Format too long lines. ") ! (type . const) ! (default . gnus-article-word-wrap)) ! ((tag . "Remove CR") ! (doc . "\ Remove carriage returns from an article. ") ! (type . const) ! (default . gnus-article-remove-cr)) ! ((tag . "Display X-Face") ! (doc . "\ Look for an X-Face header and display it if present. *************** See also `X Face Command' for a definiti *** 152,159 **** used for decoding and displaying the face. ") ! (type . const) ! (default . gnus-article-display-x-face)) ! ((tag . "Unquote Printable") ! (doc . "\ Transform MIME quoted printable into 8-bit characters. --- 183,190 ---- used for decoding and displaying the face. ") ! (type . const) ! (default . gnus-article-display-x-face)) ! ((tag . "Unquote Printable") ! (doc . "\ Transform MIME quoted printable into 8-bit characters. *************** Quoted printable is often seen by string *** 161,305 **** expect a non-English letter. ") ! (type . const) ! (default . ! gnus-article-de-quoted-unreadable)) ! ((tag . "Universal Time") ! (doc . "\ Convert date header to universal time. ") ! (type . const) ! (default . gnus-article-date-ut)) ! ((tag . "Local Time") ! (doc . "\ Convert date header to local timezone. ") ! (type . const) ! (default . gnus-article-date-local)) ! ((tag . "Lapsed Time") ! (doc . "\ Replace date header with a header showing the articles age. ") ! (type . const) ! (default . gnus-article-date-lapsed)) ! ((tag . "Highlight") ! (doc . "\ Highlight headers, citations, signature, and buttons. ") ! (type . const) ! (default . gnus-article-highlight)) ! ((tag . "Maybe Highlight") ! (doc . "\ Highlight headers, signature, and buttons if `Visual' is turned on. ") ! (type . const) ! (default . ! gnus-article-maybe-highlight)) ! ((tag . "Highlight Some") ! (doc . "\ Highlight headers, signature, and buttons. ") ! (type . const) ! (default . gnus-article-highlight-some)) ! ((tag . "Highlight Headers") ! (doc . "\ Highlight headers as specified by `Article Header Highlighting'. ") ! (type . const) ! (default . ! gnus-article-highlight-headers)) ! ((tag . "Highlight Signature") ! (doc . "\ Highlight the signature as specified by `Article Signature Face'. ") ! (type . const) ! (default . ! gnus-article-highlight-signature)) ! ((tag . "Citation") ! (doc . "\ Highlight the citations as specified by `Citation Faces'. ") ! (type . const) ! (default . ! gnus-article-highlight-citation)) ! ((tag . "Hide") ! (doc . "\ Hide unwanted headers, excess citation, and the signature. ") ! (type . const) ! (default . gnus-article-hide)) ! ((tag . "Hide Headers If Wanted") ! (doc . "\ Hide headers, but allow user to display them with `t' or `v'. ") ! (type . const) ! (default . ! gnus-article-hide-headers-if-wanted)) ! ((tag . "Hide Headers") ! (doc . "\ Hide unwanted headers and possibly sort them as well. Most likely you want to use `Hide Headers If Wanted' instead. ") ! (type . const) ! (default . gnus-article-hide-headers)) ! ((tag . "Hide Signature") ! (doc . "\ Hide the signature. ") ! (type . const) ! (default . gnus-article-hide-signature)) ! ((tag . "Hide Excess Citations") ! (doc . "\ Hide excess citation. Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'. ") ! (type . const) ! (default . ! gnus-article-hide-citation-maybe)) ! ((tag . "Hide Citations") ! (doc . "\ Hide all cited text. ") ! (type . const) ! (default . gnus-article-hide-citation)) ! ((tag . "Add Buttons") ! (doc . "\ Make URL's into clickable buttons. ") ! (type . const) ! (default . gnus-article-add-buttons)) ! ((prompt . "Other") ! (doc . "\ Name of Lisp function to call. Push the `Filter' button to select one of the predefined filters. ") ! (type . symbol))))))) ! ((tag . "Article Button Face") ! (doc . "\ Face used for highlighting buttons in the article buffer. An article button is a piece of text that you can activate by pressing `RET' or `mouse-2' above it.") ! (name . gnus-article-button-face) ! (default . bold) ! (type . face)) ! ((tag . "Article Mouse Face") ! (doc . "\ Face used for mouse highlighting in the article buffer. Article buttons will be displayed in this face when the cursor is above them.") ! (name . gnus-article-mouse-face) ! (default . highlight) ! (type . face)) ! ((tag . "Article Signature Face") ! (doc . "\ Face used for highlighting a signature in the article buffer.") ! (name . gnus-signature-face) ! (default . italic) ! (type . face)) ! ((tag . "Article Header Highlighting") ! (doc . "\ Controls highlighting of article header. --- 192,336 ---- expect a non-English letter. ") ! (type . const) ! (default . ! gnus-article-de-quoted-unreadable)) ! ((tag . "Universal Time") ! (doc . "\ Convert date header to universal time. ") ! (type . const) ! (default . gnus-article-date-ut)) ! ((tag . "Local Time") ! (doc . "\ Convert date header to local timezone. ") ! (type . const) ! (default . gnus-article-date-local)) ! ((tag . "Lapsed Time") ! (doc . "\ Replace date header with a header showing the articles age. ") ! (type . const) ! (default . gnus-article-date-lapsed)) ! ((tag . "Highlight") ! (doc . "\ Highlight headers, citations, signature, and buttons. ") ! (type . const) ! (default . gnus-article-highlight)) ! ((tag . "Maybe Highlight") ! (doc . "\ Highlight headers, signature, and buttons if `Visual' is turned on. ") ! (type . const) ! (default . ! gnus-article-maybe-highlight)) ! ((tag . "Highlight Some") ! (doc . "\ Highlight headers, signature, and buttons. ") ! (type . const) ! (default . gnus-article-highlight-some)) ! ((tag . "Highlight Headers") ! (doc . "\ Highlight headers as specified by `Article Header Highlighting'. ") ! (type . const) ! (default . ! gnus-article-highlight-headers)) ! ((tag . "Highlight Signature") ! (doc . "\ Highlight the signature as specified by `Article Signature Face'. ") ! (type . const) ! (default . ! gnus-article-highlight-signature)) ! ((tag . "Citation") ! (doc . "\ Highlight the citations as specified by `Citation Faces'. ") ! (type . const) ! (default . ! gnus-article-highlight-citation)) ! ((tag . "Hide") ! (doc . "\ Hide unwanted headers, excess citation, and the signature. ") ! (type . const) ! (default . gnus-article-hide)) ! ((tag . "Hide Headers If Wanted") ! (doc . "\ Hide headers, but allow user to display them with `t' or `v'. ") ! (type . const) ! (default . ! gnus-article-hide-headers-if-wanted)) ! ((tag . "Hide Headers") ! (doc . "\ Hide unwanted headers and possibly sort them as well. Most likely you want to use `Hide Headers If Wanted' instead. ") ! (type . const) ! (default . gnus-article-hide-headers)) ! ((tag . "Hide Signature") ! (doc . "\ Hide the signature. ") ! (type . const) ! (default . gnus-article-hide-signature)) ! ((tag . "Hide Excess Citations") ! (doc . "\ Hide excess citation. Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'. ") ! (type . const) ! (default . ! gnus-article-hide-citation-maybe)) ! ((tag . "Hide Citations") ! (doc . "\ Hide all cited text. ") ! (type . const) ! (default . gnus-article-hide-citation)) ! ((tag . "Add Buttons") ! (doc . "\ Make URL's into clickable buttons. ") ! (type . const) ! (default . gnus-article-add-buttons)) ! ((prompt . "Other") ! (doc . "\ Name of Lisp function to call. Push the `Filter' button to select one of the predefined filters. ") ! (type . symbol))))))) ! ((tag . "Article Button Face") ! (doc . "\ Face used for highlighting buttons in the article buffer. An article button is a piece of text that you can activate by pressing `RET' or `mouse-2' above it.") ! (name . gnus-article-button-face) ! (default . bold) ! (type . face)) ! ((tag . "Article Mouse Face") ! (doc . "\ Face used for mouse highlighting in the article buffer. Article buttons will be displayed in this face when the cursor is above them.") ! (name . gnus-article-mouse-face) ! (default . highlight) ! (type . face)) ! ((tag . "Article Signature Face") ! (doc . "\ Face used for highlighting a signature in the article buffer.") ! (name . gnus-signature-face) ! (default . italic) ! (type . face)) ! ((tag . "Article Header Highlighting") ! (doc . "\ Controls highlighting of article header. *************** header, specify `None' in the `Content' *** 323,390 **** `None' in the `Name' field if you only want to leave the name part alone.") ! (name . gnus-header-face-alist) ! (type . list) ! (calculate . (cond ((not (eq gnus-display-type 'color)) ! '(("" bold italic))) ! ((eq gnus-background-mode 'dark) ! (list (list "From" nil ! (custom-face-lookup ! "dark blue" nil nil t t ! 'custom:asis)) ! (list "Subject" nil ! (custom-face-lookup ! "pink" nil nil t t 'custom:asis)) ! (list "Newsgroups:.*," nil ! (custom-face-lookup ! "yellow" nil nil t t 'custom:asis)) ! (list "" ! (custom-face-lookup ! "cyan" nil nil t 'custom:asis 'custom:asis) ! (custom-face-lookup ! "forestgreen" ! nil nil 'custom:asis t 'custom:asis)))) ! (t ! (list (list "From" nil ! (custom-face-lookup ! "RoyalBlue" ! nil nil t t 'custom:asis)) ! (list "Subject" nil ! (custom-face-lookup ! "firebrick" ! nil nil t t 'custom:asis)) ! (list "Newsgroups:.*," nil ! (custom-face-lookup ! "indianred" nil nil t t 'custom:asis)) ! (list "" ! (custom-face-lookup ! "DarkGreen" ! nil nil t 'custom:asis 'custom:asis) ! (custom-face-lookup ! "DarkGreen" ! nil nil nil t 'custom:asis)))))) ! (data ((type . repeat) ! (header . nil) ! (data (type . list) ! (compact . t) ! (data ((type . string) ! (prompt . "Header") ! (tag . "Header ")) ! "\n " ! ((type . face) ! (prompt . "Name") ! (tag . "Name ")) ! "\n " ! ((type . face) ! (tag . "Content")) ! "\n"))))) ! ((tag . "Attribution Face") ! (doc . "\ Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution.") ! (name . gnus-cite-attribution-face) ! (default . underline) ! (type . face)) ! ((tag . "Citation Faces") ! (doc . "\ List of faces used for highlighting citations. --- 354,416 ---- `None' in the `Name' field if you only want to leave the name part alone.") ! (name . gnus-header-face-alist) ! (type . list) ! (calculate ! . (cond ! ((not (eq gnus-display-type 'color)) ! '(("" bold italic))) ! ((eq gnus-background-mode 'dark) ! (list ! (list "From" nil ! (custom-face-lookup "light blue" nil nil t t nil)) ! (list "Subject" nil ! (custom-face-lookup "pink" nil nil t t nil)) ! (list "Newsgroups:.*," nil ! (custom-face-lookup "yellow" nil nil t t nil)) ! (list ! "" ! (custom-face-lookup "cyan" nil nil t nil nil) ! (custom-face-lookup "forestgreen" nil nil nil t ! nil)))) ! (t ! (list ! (list "From" nil ! (custom-face-lookup "MidnightBlue" nil nil t t nil)) ! (list "Subject" nil ! (custom-face-lookup "firebrick" nil nil t t nil)) ! (list "Newsgroups:.*," nil ! (custom-face-lookup "indianred" nil nil t t nil)) ! (list "" ! (custom-face-lookup ! "DarkGreen" nil nil t nil nil) ! (custom-face-lookup "DarkGreen" nil nil ! nil t nil)))))) ! (data ! ((type . repeat) ! (header . nil) ! (data ! (type . list) ! (compact . t) ! (data ! ((type . string) ! (prompt . "Header") ! (tag . "Header ")) ! "\n " ! ((type . face) ! (prompt . "Name") ! (tag . "Name ")) ! "\n " ! ((type . face) ! (tag . "Content")) ! "\n"))))) ! ((tag . "Attribution Face") ! (doc . "\ Face used for attribution lines. It is merged with the face for the cited text belonging to the attribution.") ! (name . gnus-cite-attribution-face) ! (default . underline) ! (type . face)) ! ((tag . "Citation Faces") ! (doc . "\ List of faces used for highlighting citations. *************** When there are citations from multiple a *** 392,430 **** Gnus will try to give each citation from each article its own face. This should make it easier to see who wrote what.") ! (name . gnus-cite-face-list) ! (import . gnus-custom-import-cite-face-list) ! (type . list) ! (calculate . (cond ((not (eq gnus-display-type 'color)) ! '(italic)) ! ((eq gnus-background-mode 'dark) ! (mapcar 'gnus-make-face ! gnus-face-light-name-list)) ! (t ! (mapcar 'gnus-make-face ! gnus-face-dark-name-list)))) ! (data ((type . repeat) ! (header . nil) ! (data (type . face) ! (tag . "Face"))))) ! ((tag . "Citation Hide Percentage") ! (doc . "\ Only hide excess citation if above this percentage of the body.") ! (name . gnus-cite-hide-percentage) ! (default . 50) ! (type . integer)) ! ((tag . "Citation Hide Absolute") ! (doc . "\ Only hide excess citation if above this number of lines in the body.") ! (name . gnus-cite-hide-absolute) ! (default . 10) ! (type . integer)) ! ((tag . "Summary Selected Face") ! (doc . "\ Face used for highlighting the current article in the summary buffer.") ! (name . gnus-summary-selected-face) ! (default . underline) ! (type . face)) ! ((tag . "Summary Line Highlighting") ! (doc . "\ Controls the highlighting of summary buffer lines. --- 418,457 ---- Gnus will try to give each citation from each article its own face. This should make it easier to see who wrote what.") ! (name . gnus-cite-face-list) ! (import . gnus-custom-import-cite-face-list) ! (type . list) ! (calculate . (cond ((not (eq gnus-display-type 'color)) ! '(italic)) ! ((eq gnus-background-mode 'dark) ! (mapcar 'gnus-make-face ! gnus-face-light-name-list)) ! (t ! (mapcar 'gnus-make-face ! gnus-face-dark-name-list)))) ! (data ! ((type . repeat) ! (header . nil) ! (data (type . face) ! (tag . "Face"))))) ! ((tag . "Citation Hide Percentage") ! (doc . "\ Only hide excess citation if above this percentage of the body.") ! (name . gnus-cite-hide-percentage) ! (default . 50) ! (type . integer)) ! ((tag . "Citation Hide Absolute") ! (doc . "\ Only hide excess citation if above this number of lines in the body.") ! (name . gnus-cite-hide-absolute) ! (default . 10) ! (type . integer)) ! ((tag . "Summary Selected Face") ! (doc . "\ Face used for highlighting the current article in the summary buffer.") ! (name . gnus-summary-selected-face) ! (default . underline) ! (type . face)) ! ((tag . "Summary Line Highlighting") ! (doc . "\ Controls the highlighting of summary buffer lines. *************** default: The default article score. *** 444,528 **** below: The score below which articles are automatically marked as read. mark: The article's mark.") ! (name . gnus-summary-highlight) ! (type . list) ! (calculate . (cond ((not (eq gnus-display-type 'color)) ! '(((> score default) . bold) ! ((< score default) . italic))) ! ((eq gnus-background-mode 'dark) ! (list (cons '(= mark gnus-canceled-mark) ! (custom-face-lookup "yellow" "black" nil 'custom:asis 'custom:asis 'custom:asis)) ! (cons '(and (> score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "pink" nil nil t 'custom:asis 'custom:asis)) ! (cons '(and (< score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "pink" nil nil 'custom:asis t 'custom:asis)) ! (cons '(or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark)) ! (custom-face-lookup "pink" nil nil 'custom:asis 'custom:asis 'custom:asis)) ! ! (cons '(and (> score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "dark blue" nil nil t 'custom:asis 'custom:asis)) ! (cons '(and (< score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "SkyBlue" nil nil 'custom:asis t 'custom:asis)) ! (cons '(= mark gnus-ancient-mark) ! (custom-face-lookup "SkyBlue" nil nil 'custom:asis 'custom:asis 'custom:asis)) ! ! (cons '(and (> score default) (= mark gnus-unread-mark)) ! (custom-face-lookup "white" nil nil t 'custom:asis 'custom:asis)) ! (cons '(and (< score default) (= mark gnus-unread-mark)) ! (custom-face-lookup "white" nil nil 'custom:asis t 'custom:asis)) ! (cons '(= mark gnus-unread-mark) ! (custom-face-lookup "white" nil nil 'custom:asis 'custom:asis 'custom:asis)) ! ! (cons '(> score default) 'bold) ! (cons '(< score default) 'italic))) ! (t ! (list (cons '(= mark gnus-canceled-mark) ! (custom-face-lookup "yellow" "black" nil 'custom:asis 'custom:asis 'custom:asis)) ! (cons '(and (> score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "firebrick" nil nil t 'custom:asis 'custom:asis)) ! (cons '(and (< score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "firebrick" nil nil 'custom:asis t 'custom:asis)) ! (cons '(or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark)) ! (custom-face-lookup "firebrick" nil nil 'custom:asis 'custom:asis 'custom:asis)) ! ! (cons '(and (> score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "RoyalBlue" nil nil t 'custom:asis 'custom:asis)) ! (cons '(and (< score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "RoyalBlue" nil nil 'custom:asis t 'custom:asis)) ! (cons '(= mark gnus-ancient-mark) ! (custom-face-lookup "RoyalBlue" nil nil 'custom:asis 'custom:asis 'custom:asis)) ! ! (cons '(and (> score default) (/= mark gnus-unread-mark)) ! (custom-face-lookup "DarkGreen" nil nil t 'custom:asis 'custom:asis)) ! (cons '(and (< score default) (/= mark gnus-unread-mark)) ! (custom-face-lookup "DarkGreen" nil nil 'custom:asis t 'custom:asis)) ! (cons '(/= mark gnus-unread-mark) ! (custom-face-lookup "DarkGreen" nil nil 'custom:asis 'custom:asis 'custom:asis)) ! (cons '(> score default) 'bold) ! (cons '(< score default) 'italic))))) ! (data ((type . repeat) ! (header . nil) ! (data (type . pair) ! (compact . t) ! (data ((type . sexp) ! (width . 60) ! (tag . "Form")) ! "\n " ! ((type . face) ! (tag . "Face")) ! "\n"))))) ! ;; Do not define `gnus-button-alist' before we have ! ;; some `complexity' attribute so we can hide it from ! ;; beginners. ! ))))) (defun gnus-custom-import-cite-face-list (custom alist) --- 471,673 ---- below: The score below which articles are automatically marked as read. mark: The article's mark.") ! (name . gnus-summary-highlight) ! (type . list) ! (calculate ! . (cond ! ((not (eq gnus-display-type 'color)) ! '(((> score default) . bold) ! ((< score default) . italic))) ! ((eq gnus-background-mode 'dark) ! (list ! (cons ! '(= mark gnus-canceled-mark) ! (custom-face-lookup "yellow" "black" nil ! nil nil nil)) ! (cons '(and (> score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup ! "pink" nil nil t nil nil)) ! (cons '(and (< score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "pink" nil nil ! nil t nil)) ! (cons '(or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark)) ! (custom-face-lookup ! "pink" nil nil nil nil nil)) ! ! (cons ! '(and (> score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "medium blue" nil nil t ! nil nil)) ! (cons ! '(and (< score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "SkyBlue" nil nil ! nil t nil)) ! (cons ! '(= mark gnus-ancient-mark) ! (custom-face-lookup "SkyBlue" nil nil ! nil nil nil)) ! (cons '(and (> score default) (= mark gnus-unread-mark)) ! (custom-face-lookup "white" nil nil t ! nil nil)) ! (cons '(and (< score default) (= mark gnus-unread-mark)) ! (custom-face-lookup "white" nil nil ! nil t nil)) ! (cons '(= mark gnus-unread-mark) ! (custom-face-lookup ! "white" nil nil nil nil nil)) ! ! (cons '(> score default) 'bold) ! (cons '(< score default) 'italic))) ! (t ! (list ! (cons ! '(= mark gnus-canceled-mark) ! (custom-face-lookup ! "yellow" "black" nil nil nil nil)) ! (cons '(and (> score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "firebrick" nil nil ! t nil nil)) ! (cons '(and (< score default) ! (or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark))) ! (custom-face-lookup "firebrick" nil nil ! nil t nil)) ! (cons ! '(or (= mark gnus-dormant-mark) ! (= mark gnus-ticked-mark)) ! (custom-face-lookup ! "firebrick" nil nil nil nil nil)) ! ! (cons '(and (> score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "RoyalBlue" nil nil ! t nil nil)) ! (cons '(and (< score default) (= mark gnus-ancient-mark)) ! (custom-face-lookup "RoyalBlue" nil nil ! nil t nil)) ! (cons ! '(= mark gnus-ancient-mark) ! (custom-face-lookup ! "RoyalBlue" nil nil nil nil nil)) ! ! (cons '(and (> score default) (/= mark gnus-unread-mark)) ! (custom-face-lookup "DarkGreen" nil nil ! t nil nil)) ! (cons '(and (< score default) (/= mark gnus-unread-mark)) ! (custom-face-lookup "DarkGreen" nil nil ! nil t nil)) ! (cons ! '(/= mark gnus-unread-mark) ! (custom-face-lookup "DarkGreen" nil nil ! nil nil nil)) ! ! (cons '(> score default) 'bold) ! (cons '(< score default) 'italic))))) ! (data ! ((type . repeat) ! (header . nil) ! (data (type . pair) ! (compact . t) ! (data ((type . sexp) ! (width . 60) ! (tag . "Form")) ! "\n " ! ((type . face) ! (tag . "Face")) ! "\n"))))) ! ! ((tag . "Group Line Highlighting") ! (doc . "\ ! 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. ! ! It is also possible to change and add form fields, but currently that ! requires an understanding of Lisp expressions. Hopefully this will ! change in a future release. For now, you can use the following ! variables in the Lisp expression: ! ! group: The name of the group. ! unread: The number of unread articles in the group. ! method: The select method used. ! mailp: Whether it's a mail group or not. ! level: The level of the group. ! score: The score of the group. ! ticked: The number of ticked articles.") ! (name . gnus-group-highlight) ! (type . list) ! (calculate ! . (cond ! ((not (eq gnus-display-type 'color)) ! '((mailp . bold) ! ((= unread 0) . italic))) ! ((eq gnus-background-mode 'dark) ! `(((and (not mailp) (eq level 1)) . ! ,(custom-face-lookup "PaleTurquoise" nil nil t)) ! ((and (not mailp) (eq level 2)) . ! ,(custom-face-lookup "turquoise" nil nil t)) ! ((and (not mailp) (eq level 3)) . ! ,(custom-face-lookup "MediumTurquoise" nil nil t)) ! ((and (not mailp) (>= level 4)) . ! ,(custom-face-lookup "DarkTurquoise" nil nil t)) ! ((and mailp (eq level 1)) . ! ,(custom-face-lookup "aquamarine1" nil nil t)) ! ((and mailp (eq level 2)) . ! ,(custom-face-lookup "aquamarine2" nil nil t)) ! ((and mailp (eq level 3)) . ! ,(custom-face-lookup "aquamarine3" nil nil t)) ! ((and mailp (>= level 4)) . ! ,(custom-face-lookup "aquamarine4" nil nil t)) ! )) ! (t ! `(((and (not mailp) (<= level 3)) . ! ,(custom-face-lookup "ForestGreen" nil nil t)) ! ((and (not mailp) (eq level 4)) . ! ,(custom-face-lookup "DarkGreen" nil nil t)) ! ((and (not mailp) (eq level 5)) . ! ,(custom-face-lookup "CadetBlue4" nil nil t)) ! ((and mailp (eq level 1)) . ! ,(custom-face-lookup "DeepPink3" nil nil t)) ! ((and mailp (eq level 2)) . ! ,(custom-face-lookup "HotPink3" nil nil t)) ! ((and mailp (eq level 3)) . ! ,(custom-face-lookup ! ;; Not all servers have dark magenta in rgb.txt. ! (if (and (eq window-system 'x) ! (x-color-defined-p "dark magenta")) ! "dark magenta" ! "maroon") ! nil nil t)) ! ((and mailp (eq level 4)) . ! ,(custom-face-lookup "DeepPink4" nil nil t)) ! ((and mailp (> level 4)) . ! ,(custom-face-lookup "DarkOrchid4" nil nil t)) ! )))) ! (data ! ((type . repeat) ! (header . nil) ! (data (type . pair) ! (compact . t) ! (data ((type . sexp) ! (width . 60) ! (tag . "Form")) ! "\n " ! ((type . face) ! (tag . "Face")) ! "\n"))))) ! ! ;; Do not define `gnus-button-alist' before we have ! ;; some `complexity' attribute so we can hide it from ! ;; beginners. ! ))))) (defun gnus-custom-import-cite-face-list (custom alist) *************** mark: The article's mark.") *** 533,546 **** (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list)))) (funcall (custom-super custom 'import) custom alist)) - - ;(defun gnus-custom-import-swap-alist (custom alist) - ; ;; Swap key and value in CUSTOM ALIST. - ; (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) - ; (funcall (custom-super custom 'import) custom swap))) - - ;(defun gnus-custom-export-swap-alist (custom alist) - ; ;; Swap key and value in CUSTOM ALIST. - ; (let ((swap (mapcar (lambda (e) (cons (cdr e) (car e))) alist))) - ; (funcall (custom-super custom 'export) custom swap))) (provide 'gnus-cus) --- 678,681 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-demon.el emacs-19.32/lisp/gnus-demon.el *** emacs-19.31/lisp/gnus-demon.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-demon.el Tue Jun 25 18:29:48 1996 *************** *** 0 **** --- 1,222 ---- + ;;; gnus-demon.el --- daemonic Gnus behaviour + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + + (eval-when-compile (require 'cl)) + + (defvar gnus-demon-handlers nil + "Alist of daemonic handlers to be run at intervals. + Each handler is a list on the form + + \(FUNCTION TIME IDLE) + + 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 + of `gnus-demon-timestep's. If IDLE is nil, don't care about + 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.") + + (defvar gnus-demon-timestep 60 + "*Number of seconds in each demon timestep.") + + ;;; Internal variables. + + (defvar gnus-demon-timer nil) + (defvar gnus-demon-idle-has-been-called nil) + (defvar gnus-demon-idle-time 0) + (defvar gnus-demon-handler-state nil) + (defvar gnus-demon-is-idle nil) + (defvar gnus-demon-last-keys nil) + + (eval-and-compile + (autoload 'timezone-parse-date "timezone") + (autoload 'timezone-make-arpa-date "timezone")) + + ;;; Functions. + + (defun gnus-demon-add-handler (function time idle) + "Add the handler FUNCTION to be run at TIME and IDLE." + ;; First remove any old handlers that use this function. + (gnus-demon-remove-handler function) + ;; Then add the new one. + (push (list function time idle) gnus-demon-handlers) + (gnus-demon-init)) + + (defun gnus-demon-remove-handler (function &optional no-init) + "Remove the handler FUNCTION from the list of handlers." + (setq gnus-demon-handlers + (delq (assq function gnus-demon-handlers) + gnus-demon-handlers)) + (or no-init (gnus-demon-init))) + + (defun gnus-demon-init () + "Initialize the Gnus daemon." + (interactive) + (gnus-demon-cancel) + (if (null gnus-demon-handlers) + () ; Nothing to do. + ;; Set up timer. + (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 + (lambda (handler) + (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) + (nth 2 handler))) + gnus-demon-handlers)) + (setq gnus-demon-idle-time 0) + (setq gnus-demon-idle-has-been-called nil) + (setq gnus-use-demon t))) + + (gnus-add-shutdown 'gnus-demon-cancel 'gnus) + + (defun gnus-demon-cancel () + "Cancel any Gnus daemons." + (interactive) + (and gnus-demon-timer + (nnheader-cancel-timer gnus-demon-timer)) + (setq gnus-demon-timer nil + gnus-use-demon nil)) + + (defun gnus-demon-is-idle-p () + "Whether Emacs is idle or not." + ;; We do this simply by comparing the 100 most recent keystrokes + ;; with the ones we had last time. If they are the same, one might + ;; guess that Emacs is indeed idle. This only makes sense if one + ;; calls this function seldom -- like once a minute, which is what + ;; we do here. + (let ((keys (recent-keys))) + (or (equal keys gnus-demon-last-keys) + (progn + (setq gnus-demon-last-keys keys) + nil)))) + + (defun gnus-demon-time-to-step (time) + "Find out how many seconds to TIME, which is on the form \"17:43\"." + (if (not (stringp time)) + time + (let* ((date (current-time-string)) + (dv (timezone-parse-date 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 + (or (aref dv 4) "UT"))) + (nseconds (gnus-time-minus + (gnus-encode-date tdate) (gnus-encode-date date)))) + (round + (/ (if (< nseconds 0) + (+ nseconds (* 60 60 24)) + nseconds) gnus-demon-timestep))))) + + (defun gnus-demon () + "The Gnus daemon that takes care of running all Gnus handlers." + ;; Increase or reset the time Emacs has been idle. + (if (gnus-demon-is-idle-p) + (incf gnus-demon-idle-time) + (setq gnus-demon-idle-time 0) + (setq gnus-demon-idle-has-been-called nil)) + ;; Then we go through all the handler and call those that are + ;; sufficiently ripe. + (let ((handlers gnus-demon-handler-state) + handler time idle) + (while handlers + (setq handler (pop handlers)) + (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. + (or (zerop time) + (setcar (nthcdr 1 handler) (decf time))) + (and (zerop time) ; If the timer now is zero... + (or (not (setq idle (nth 2 handler))) ; Don't care about idle. + (and (numberp idle) ; Numerical idle... + (< idle gnus-demon-idle-time)) ; Idle timed out. + gnus-demon-is-idle) ; Or just need to be idle. + ;; So we call the handler. + (progn + (funcall (car handler)) + ;; And reset the timer. + (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. + ((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. + (funcall (car handler))) + (t + ;; We want to call this handler only if Emacs has been idle + ;; for a specified number of timesteps. + (and (not (memq (car handler) gnus-demon-idle-has-been-called)) + (< idle gnus-demon-idle-time) + (progn + (funcall (car handler)) + ;; Make sure the handler won't be called once more in + ;; this idle-cycle. + (push (car handler) gnus-demon-idle-has-been-called)))))))) + + (defun gnus-demon-add-nocem () + "Add daemonic NoCeM handling to Gnus." + (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t)) + + (defun gnus-demon-scan-nocem () + "Scan NoCeM groups for NoCeM messages." + (gnus-nocem-scan-groups)) + + (defun gnus-demon-add-disconnection () + "Add daemonic server disconnection to Gnus." + (gnus-demon-add-handler 'gnus-demon-close-connections nil 30)) + + (defun gnus-demon-close-connections () + (gnus-close-backends)) + + (defun gnus-demon-add-scanmail () + "Add daemonic scanning of mail from the mail backends." + (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) + + (defun gnus-demon-scan-mail () + (let ((servers gnus-opened-servers) + server) + (while (setq server (car (pop servers))) + (and (gnus-check-backend-function 'request-scan (car server)) + (or (gnus-server-opened server) + (gnus-open-server server)) + (gnus-request-scan nil server))))) + + (provide 'gnus-demon) + + ;;; gnus-demon.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-edit.el emacs-19.32/lisp/gnus-edit.el *** emacs-19.31/lisp/gnus-edit.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-edit.el Tue Jun 25 18:00:29 1996 *************** *** 1,29 **** ;;; gnus-edit.el --- Gnus SCORE file editing ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ! ;; Author: Per Abrahamsen ;; Keywords: news, help ;; Version: 0.2 - ;; This file is part of GNU Emacs. - - ;; GNU Emacs is free software; you can redistribute it and/or modify - ;; it under the terms of the GNU General Public License as published by - ;; the Free Software Foundation; either version 2, or (at your option) - ;; any later version. - - ;; GNU Emacs is distributed in the hope that it will be useful, - ;; but WITHOUT ANY WARRANTY; without even the implied warranty of - ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - ;; GNU General Public License for more details. - - ;; You should have received a copy of the GNU General Public License - ;; along with GNU Emacs; see the file COPYING. If not, write to the - ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, - ;; Boston, MA 02111-1307, USA. - ;;; Commentary: ! ;; Type `M-x gnus-score-customize RET' to invoke. --- 1,11 ---- ;;; gnus-edit.el --- Gnus SCORE file editing ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ! ;; ;; Author: Per Abrahamsen ;; Keywords: news, help ;; Version: 0.2 ;;; Commentary: ! ;; ;; Type `M-x gnus-score-customize RET' to invoke. *************** *** 32,35 **** --- 14,18 ---- (require 'custom) (require 'gnus-score) + (eval-when-compile (require 'cl)) (defconst gnus-score-custom-data *************** the score file and the value of the glob *** 65,69 **** ((name . file) (tag . "File") ! (directory . "~/News/") (default-file . "SCORE") (type . file)))) --- 48,52 ---- ((name . file) (tag . "File") ! (directory . gnus-kill-files-directory) (default-file . "SCORE") (type . file)))) *************** delete a score file from the list.") *** 80,84 **** (header . nil) (data (type . file) ! (directory . "~/News/"))))) ((name . exclude-files) (tag . "Exclude Files") --- 63,67 ---- (header . nil) (data (type . file) ! (directory . gnus-kill-files-directory))))) ((name . exclude-files) (tag . "Exclude Files") *************** delete a score file from the list.") *** 95,99 **** (header . nil) (data (type . file) ! (directory . "~/News/"))))) ((name . mark) (tag . "Mark") --- 78,82 ---- (header . nil) (data (type . file) ! (directory . gnus-kill-files-directory))))) ((name . mark) (tag . "Mark") *************** groups matched by the current score file *** 555,559 **** 'gnus-score-custom-save)) (make-local-variable 'gnus-score-custom-file) ! (setq gnus-score-custom-file (expand-file-name "SCORE" "~/News")) (make-local-variable 'gnus-score-alist) (setq gnus-score-alist nil) --- 538,543 ---- 'gnus-score-custom-save)) (make-local-variable 'gnus-score-custom-file) ! (setq gnus-score-custom-file ! (expand-file-name "SCORE" gnus-kill-files-directory)) (make-local-variable 'gnus-score-alist) (setq gnus-score-alist nil) *************** groups matched by the current score file *** 567,573 **** (mapcar 'gnus-score-custom-sanify (cdr entry)) (setq entry (assoc name gnus-score-alist)) ! (if (or (memq name '(files exclude-files local)) ! (and (eq name 'adapt) ! (not (symbolp (car (cdr entry)))))) (cdr entry) (car (cdr entry))))))) --- 551,557 ---- (mapcar 'gnus-score-custom-sanify (cdr entry)) (setq entry (assoc name gnus-score-alist)) ! (if (or (memq name '(files exclude-files local)) ! (and (eq name 'adapt) ! (not (symbolp (car (cdr entry)))))) (cdr entry) (car (cdr entry))))))) *************** groups matched by the current score file *** 619,627 **** (if (eq file custom-nil) (error "You must specify a file name")) ! (setq file (expand-file-name file "~/News")) (gnus-score-load file) (setq gnus-score-custom-file file) (custom-reset-all) ! (message "Loaded"))) (defun gnus-score-custom-save () --- 603,611 ---- (if (eq file custom-nil) (error "You must specify a file name")) ! (setq file (expand-file-name file gnus-kill-files-directory)) (gnus-score-load file) (setq gnus-score-custom-file file) (custom-reset-all) ! (gnus-message 4 "Loaded"))) (defun gnus-score-custom-save () *************** groups matched by the current score file *** 640,644 **** (write-region (point-min) (point-max) file nil 'silent) (kill-buffer (current-buffer)))) ! (message "Saved")) (provide 'gnus-edit) --- 624,628 ---- (write-region (point-min) (point-max) file nil 'silent) (kill-buffer (current-buffer)))) ! (gnus-message 4 "Saved")) (provide 'gnus-edit) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-ems.el emacs-19.32/lisp/gnus-ems.el *** emacs-19.31/lisp/gnus-ems.el Sun Apr 21 11:23:13 1996 --- emacs-19.32/lisp/gnus-ems.el Tue Jun 25 18:01:47 1996 *************** *** 1,5 **** ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; gnus-ems.el --- functions for making Gnus work under different Emacsen ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 25,175 **** ;;; Commentary: - ;;; This file has been censored by the Communications Decency Act. - ;;; That law was passed under the guise of a ban on pornography, but - ;;; it bans far more than that. This file did not contain pornography, - ;;; but it was censored nonetheless. - - ;;; For information on US government censorship of the Internet, and - ;;; what you can do to bring back freedom of the press, see the web - ;;; site http://www.vtw.org/ - ;;; Code: (defvar gnus-mouse-2 [mouse-2]) - (defvar gnus-group-mode-hook ()) - (defvar gnus-summary-mode-hook ()) - (defvar gnus-article-mode-hook ()) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) (or (fboundp 'mail-file-babyl-p) (fset 'mail-file-babyl-p 'rmail-file-p)) ! ;; Don't warn about these undefined variables. ! ;defined in gnus.el ! (defvar gnus-active-hashtb) ! (defvar gnus-article-buffer) ! (defvar gnus-auto-center-summary) ! (defvar gnus-buffer-list) ! (defvar gnus-current-headers) ! (defvar gnus-level-killed) ! (defvar gnus-level-zombie) ! (defvar gnus-newsgroup-bookmarks) ! (defvar gnus-newsgroup-dependencies) ! (defvar gnus-newsgroup-headers-hashtb-by-number) ! (defvar gnus-newsgroup-selected-overlay) ! (defvar gnus-newsrc-hashtb) ! (defvar gnus-read-mark) ! (defvar gnus-refer-article-method) ! (defvar gnus-reffed-article-number) ! (defvar gnus-unread-mark) ! (defvar gnus-version) ! (defvar gnus-view-pseudos) ! (defvar gnus-view-pseudos-separately) ! (defvar gnus-visual) ! (defvar gnus-zombie-list) ! ;defined in gnus-msg.el ! (defvar gnus-article-copy) ! (defvar gnus-check-before-posting) ! ;defined in gnus-vis.el ! (defvar gnus-article-button-face) ! (defvar gnus-article-mouse-face) ! (defvar gnus-summary-selected-face) ! ! ! ;; We do not byte-compile this file, because error messages are such a ! ;; bore. ! ! (defun gnus-set-text-properties-xemacs (start end props &optional buffer) ! "You should NEVER use this function. It is ideologically blasphemous. ! It is provided only to ease porting of broken FSF Emacs programs." ! (if (and (stringp buffer) (not (setq buffer (get-buffer buffer)))) ! nil ! (map-extents (lambda (extent ignored) ! (remove-text-properties ! start end ! (list (extent-property extent 'text-prop) nil) ! buffer)) ! buffer start end nil nil 'text-prop) ! (add-text-properties start end props buffer))) ! ! (eval ! '(progn ! (if (string-match "XEmacs\\|Lucid" emacs-version) ! () ! ;; Added by Per Abrahamsen . ! (defvar gnus-display-type ! (condition-case nil ! (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) ! (cond (display-resource (intern (downcase display-resource))) ! ((x-display-color-p) 'color) ! ((x-display-grayscale-p) 'grayscale) ! (t 'mono))) ! (error 'mono)) ! "A symbol indicating the display Emacs is running under. ! The symbol should be one of `color', `grayscale' or `mono'. If Emacs ! guesses this display attribute wrongly, either set this variable in ! your `~/.emacs' or set the resource `Emacs.displayType' in your ! `~/.Xdefaults'. See also `gnus-background-mode'. ! This is a meta-variable that will affect what default values other ! variables get. You would normally not change this variable, but ! pounce directly on the real variables themselves.") ! (defvar gnus-background-mode ! (condition-case nil ! (let ((bg-resource (x-get-resource ".backgroundMode" ! "BackgroundMode")) ! (params (frame-parameters))) ! (cond (bg-resource (intern (downcase bg-resource))) ! ((and (cdr (assq 'background-color params)) ! (< (apply '+ (x-color-values ! (cdr (assq 'background-color params)))) ! (/ (apply '+ (x-color-values "white")) 3))) ! 'dark) ! (t 'light))) ! (error 'light)) ! "A symbol indicating the Emacs background brightness. ! The symbol should be one of `light' or `dark'. ! If Emacs guesses this frame attribute wrongly, either set this variable in ! your `~/.emacs' or set the resource `Emacs.backgroundMode' in your ! `~/.Xdefaults'. ! See also `gnus-display-type'. ! This is a meta-variable that will affect what default values other ! variables get. You would normally not change this variable, but ! pounce directly on the real variables themselves.")) ! (cond ! ((string-match "XEmacs\\|Lucid" emacs-version) ! ;; XEmacs definitions. ! ! (setq gnus-mouse-2 [button2]) ! ! (or (memq 'underline (list-faces)) ! (and (fboundp 'make-face) ! (funcall (intern "make-face") 'underline))) ! ;; Must avoid calling set-face-underline-p directly, because it ! ;; is a defsubst in emacs19, and will make the .elc files non ! ;; portable! ! (or (face-differs-from-default-p 'underline) ! (funcall 'set-face-underline-p 'underline t)) ! ! (defalias 'gnus-make-overlay 'make-extent) ! (defalias 'gnus-overlay-put 'set-extent-property) ! (defun gnus-move-overlay (extent start end &optional buffer) ! (set-extent-endpoints extent start end)) ! ! (require 'text-props) ! (fset 'set-text-properties 'gnus-set-text-properties-xemacs) ! ! (or (boundp 'standard-display-table) (setq standard-display-table nil)) ! (or (boundp 'read-event) (fset 'read-event 'next-command-event)) ! ! ;; Fix by "jeff (j.d.) sparkes" . ! (defvar gnus-display-type (device-class) ! "A symbol indicating the display Emacs is running under. The symbol should be one of `color', `grayscale' or `mono'. If Emacs guesses this display attribute wrongly, either set this variable in --- 24,110 ---- ;;; Commentary: ;;; Code: + (eval-when-compile (require 'cl)) + (defvar gnus-mouse-2 [mouse-2]) (defalias 'gnus-make-overlay 'make-overlay) (defalias 'gnus-overlay-put 'overlay-put) (defalias 'gnus-move-overlay 'move-overlay) + (defalias 'gnus-overlay-end 'overlay-end) + (defalias 'gnus-extent-detached-p 'ignore) + (defalias 'gnus-extent-start-open 'ignore) + (defalias 'gnus-set-text-properties 'set-text-properties) + (defalias 'gnus-group-remove-excess-properties 'ignore) + (defalias 'gnus-topic-remove-excess-properties 'ignore) + (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) + (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) + (defalias 'gnus-make-local-hook 'make-local-hook) + (defalias 'gnus-add-hook 'add-hook) + (defalias 'gnus-character-to-event 'identity) + (defalias 'gnus-add-text-properties 'add-text-properties) + (defalias 'gnus-put-text-property 'put-text-property) + (defalias 'gnus-mode-line-buffer-identification 'identity) + + + (eval-and-compile + (autoload 'gnus-xmas-define "gnus-xmas") + (autoload 'gnus-xmas-redefine "gnus-xmas") + (autoload 'appt-select-lowest-window "appt.el")) (or (fboundp 'mail-file-babyl-p) (fset 'mail-file-babyl-p 'rmail-file-p)) ! ;;; Mule functions. ! (defun gnus-mule-cite-add-face (number prefix face) ! ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. ! (if face ! (let ((inhibit-point-motion-hooks t) ! from to) ! (goto-line number) ! (if (boundp 'MULE) ! (forward-char (chars-in-string prefix)) ! (forward-char (length prefix))) ! (skip-chars-forward " \t") ! (setq from (point)) ! (end-of-line 1) ! (skip-chars-backward " \t") ! (setq to (point)) ! (if (< from to) ! (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) ! ! (defun gnus-mule-max-width-function (el max-width) ! (` (let* ((val (eval (, el))) ! (valstr (if (numberp val) ! (int-to-string val) val))) ! (if (> (length valstr) (, max-width)) ! (truncate-string valstr (, max-width)) ! valstr)))) ! (eval-and-compile ! (if (string-match "XEmacs\\|Lucid" emacs-version) ! () ! (defvar gnus-mouse-face-prop 'mouse-face ! "Property used for highlighting mouse regions.") ! (defvar gnus-article-x-face-command ! "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" ! "String or function to be executed to display an X-Face header. ! If it is a string, the command will be executed in a sub-shell ! asynchronously. The compressed face will be piped to this command.") ! ! ;; Added by Per Abrahamsen . ! (defvar gnus-display-type ! (condition-case nil ! (let ((display-resource (x-get-resource ".displayType" "DisplayType"))) ! (cond (display-resource (intern (downcase display-resource))) ! ((x-display-color-p) 'color) ! ((x-display-grayscale-p) 'grayscale) ! (t 'mono))) ! (error 'mono)) ! "A symbol indicating the display Emacs is running under. The symbol should be one of `color', `grayscale' or `mono'. If Emacs guesses this display attribute wrongly, either set this variable in *************** variables get. You would normally not c *** 181,205 **** pounce directly on the real variables themselves.") ! ! (or (fboundp 'x-color-values) ! (fset 'x-color-values ! (lambda (color) ! (color-instance-rgb-components ! (make-color-instance color))))) ! ! (defvar gnus-background-mode ! (let ((bg-resource ! (condition-case () ! (x-get-resource ".backgroundMode" "BackgroundMode" 'string) ! (error nil))) ! (params (frame-parameters))) ! (cond (bg-resource (intern (downcase bg-resource))) ! ((and (assq 'background-color params) ! (< (apply '+ (x-color-values ! (cdr (assq 'background-color params)))) ! (/ (apply '+ (x-color-values "white")) 3))) ! 'dark) ! (t 'light))) ! "A symbol indicating the Emacs background brightness. The symbol should be one of `light' or `dark'. If Emacs guesses this frame attribute wrongly, either set this variable in --- 116,133 ---- pounce directly on the real variables themselves.") ! (defvar gnus-background-mode ! (condition-case nil ! (let ((bg-resource (x-get-resource ".backgroundMode" ! "BackgroundMode")) ! (params (frame-parameters))) ! (cond (bg-resource (intern (downcase bg-resource))) ! ((and (cdr (assq 'background-color params)) ! (< (apply '+ (x-color-values ! (cdr (assq 'background-color params)))) ! (* (apply '+ (x-color-values "white")) .6))) ! 'dark) ! (t 'light))) ! (error 'light)) ! "A symbol indicating the Emacs background brightness. The symbol should be one of `light' or `dark'. If Emacs guesses this frame attribute wrongly, either set this variable in *************** See also `gnus-display-type'. *** 210,235 **** This is a meta-variable that will affect what default values other variables get. You would normally not change this variable, but ! pounce directly on the real variables themselves.") ! (defun gnus-install-mouse-tracker () ! (require 'mode-motion) ! (setq mode-motion-hook 'mode-motion-highlight-line))) ! ! ((< emacs-minor-version 30) ! ;; Remove the `intangible' prop. ! (let ((props (and (boundp 'gnus-hidden-properties) ! gnus-hidden-properties))) ! (while (and props (not (eq (car (cdr props)) 'intangible))) ! (setq props (cdr props))) ! (and props (setcdr props (cdr (cdr (cdr props)))))) ! (or (fboundp 'buffer-substring-no-properties) ! (defun buffer-substring-no-properties (beg end) ! (format "%s" (buffer-substring beg end))))) ! ((boundp 'MULE) ! (provide 'gnusutil)) ! ! ))) (eval-and-compile --- 138,161 ---- This is a meta-variable that will affect what default values other variables get. You would normally not change this variable, but ! pounce directly on the real variables themselves.")) + (cond + ((string-match "XEmacs\\|Lucid" emacs-version) + (gnus-xmas-define)) ! ((or (not (boundp 'emacs-minor-version)) ! (< emacs-minor-version 30)) ! ;; Remove the `intangible' prop. ! (let ((props (and (boundp 'gnus-hidden-properties) ! gnus-hidden-properties))) ! (while (and props (not (eq (car (cdr props)) 'intangible))) ! (setq props (cdr props))) ! (and props (setcdr props (cdr (cdr (cdr props)))))) ! (or (fboundp 'buffer-substring-no-properties) ! (defun buffer-substring-no-properties (beg end) ! (format "%s" (buffer-substring beg end))))) ! ((boundp 'MULE) ! (provide 'gnusutil)))) (eval-and-compile *************** pounce directly on the real variables th *** 249,697 **** (file-exists-p file)))) (or (fboundp 'face-list) ! (defun face-list (&rest args))) ! ) ! (defun gnus-highlight-selected-summary-xemacs () ! ;; Highlight selected article in summary buffer ! (if gnus-summary-selected-face ! (progn ! (if gnus-newsgroup-selected-overlay ! (delete-extent 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)))) ! ! (defun gnus-summary-recenter-xemacs () ! (let* ((top (cond ((< (window-height) 4) 0) ! ((< (window-height) 7) 1) ! (t 2))) ! (height (- (window-height) 2)) ! (bottom (save-excursion (goto-char (point-max)) ! (forward-line (- height)) ! (point))) ! (window (get-buffer-window (current-buffer)))) ! (and ! ;; The user has to want it, ! gnus-auto-center-summary ! ;; the article buffer must be displayed, ! (get-buffer-window gnus-article-buffer) ! ;; Set the window start to either `bottom', which is the biggest ! ;; possible valid number, or the second line from the top, ! ;; whichever is the least. ! (set-window-start ! window (min bottom (save-excursion (forward-line (- top)) ! (point))))))) ! ! (defun gnus-group-insert-group-line-info-xemacs (group) ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) ! (beg (point)) ! active info) ! (if entry ! (progn ! (setq info (nth 2 entry)) ! (gnus-group-insert-group-line ! nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) ! (setq active (gnus-gethash group gnus-active-hashtb)) ! ! (gnus-group-insert-group-line ! nil group (if (member group gnus-zombie-list) gnus-level-zombie ! gnus-level-killed) ! nil (if active (- (1+ (cdr active)) (car active)) 0) nil)) ! (save-excursion ! (goto-char beg) ! (remove-text-properties ! (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) ! '(gnus-group nil))))) ! ! (defun gnus-summary-refer-article-xemacs (message-id) ! "Refer article specified by MESSAGE-ID. ! NOTE: This command only works with newsgroups that use real or simulated NNTP." ! (interactive "sMessage-ID: ") ! (if (or (not (stringp message-id)) ! (zerop (length message-id))) ! () ! ;; Construct the correct Message-ID if necessary. ! ;; Suggested by tale@pawl.rpi.edu. ! (or (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (or (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) ! (let ((header (car (gnus-gethash (downcase message-id) ! gnus-newsgroup-dependencies)))) ! (if header ! (or (gnus-summary-goto-article (mail-header-number header)) ! ;; The header has been read, but the article had been ! ;; expunged, so we insert it again. ! (let ((beg (point))) ! (gnus-summary-insert-line ! nil header 0 nil gnus-read-mark nil nil ! (mail-header-subject header)) ! (save-excursion ! (goto-char beg) ! (remove-text-properties ! (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) ! '(gnus-number nil gnus-mark nil gnus-level nil))) ! (forward-line -1) ! (mail-header-number header))) ! (let ((gnus-override-method gnus-refer-article-method) ! (gnus-ancient-mark gnus-read-mark) ! (tmp-point (window-start ! (get-buffer-window gnus-article-buffer))) ! number tmp-buf) ! (and gnus-refer-article-method ! (gnus-check-server gnus-refer-article-method)) ! ;; Save the old article buffer. ! (save-excursion ! (set-buffer gnus-article-buffer) ! (gnus-kill-buffer " *temp Article*") ! (setq tmp-buf (rename-buffer " *temp Article*"))) ! (prog1 ! (if (gnus-article-prepare ! message-id nil (gnus-read-header message-id)) ! (progn ! (setq number (mail-header-number gnus-current-headers)) ! (gnus-rebuild-thread message-id) ! (gnus-summary-goto-subject number) ! (gnus-summary-recenter) ! (gnus-article-set-window-start ! (cdr (assq number gnus-newsgroup-bookmarks))) ! message-id) ! ;; We restore the old article buffer. ! (save-excursion ! (kill-buffer gnus-article-buffer) ! (set-buffer tmp-buf) ! (rename-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (and tmp-point ! (set-window-start (get-buffer-window (current-buffer)) ! tmp-point))))))))))) ! ! (defun gnus-summary-insert-pseudos-xemacs (pslist &optional not-view) ! (let ((buffer-read-only nil) ! (article (gnus-summary-article-number)) ! b) ! (or (gnus-summary-goto-subject article) ! (error "No such article: %d" article)) ! (or gnus-newsgroup-headers-hashtb-by-number ! (gnus-make-headers-hashtable-by-number)) ! (gnus-summary-position-cursor) ! ;; If all commands are to be bunched up on one line, we collect ! ;; them here. ! (if gnus-view-pseudos-separately ! () ! (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) ! files action) ! (while ps ! (setq action (cdr (assq 'action (car ps)))) ! (setq files (list (cdr (assq 'name (car ps))))) ! (while (and ps (cdr ps) ! (string= (or action "1") ! (or (cdr (assq 'action (car (cdr ps)))) "2"))) ! (setq files (cons (cdr (assq 'name (car (cdr ps)))) files)) ! (setcdr ps (cdr (cdr ps)))) ! (if (not files) ! () ! (if (not (string-match "%s" action)) ! (setq files (cons " " files))) ! (setq files (cons " " files)) ! (and (assq 'execute (car ps)) ! (setcdr (assq 'execute (car ps)) ! (funcall (if (string-match "%s" action) ! 'format 'concat) ! action ! (mapconcat (lambda (f) f) files " "))))) ! (setq ps (cdr ps))))) ! (if (and gnus-view-pseudos (not not-view)) ! (while pslist ! (and (assq 'execute (car pslist)) ! (gnus-execute-command (cdr (assq 'execute (car pslist))) ! (eq gnus-view-pseudos 'not-confirm))) ! (setq pslist (cdr pslist))) ! (save-excursion ! (while pslist ! (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist))) ! (gnus-summary-article-number))) ! (forward-line 1) ! (setq b (point)) ! (insert " " ! (file-name-nondirectory (cdr (assq 'name (car pslist)))) ! ": " (or (cdr (assq 'execute (car pslist))) "") "\n") ! (add-text-properties ! b (1+ b) (list 'gnus-number gnus-reffed-article-number ! 'gnus-mark gnus-unread-mark ! 'gnus-level 0 ! 'gnus-pseudo (car pslist))) ! ;; Fire-trucking XEmacs redisplay bug with truncated lines. ! (goto-char b) ! (sit-for 0) ! ;; Grumble.. fire-trucking XEmacs stickiness of text properties. ! (remove-text-properties ! (1+ b) (1+ (gnus-point-at-eol)) ! '(gnus-number nil gnus-mark nil gnus-level nil)) ! (forward-line -1) ! (gnus-sethash (int-to-string gnus-reffed-article-number) ! (car pslist) gnus-newsgroup-headers-hashtb-by-number) ! (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) ! (setq pslist (cdr pslist))))))) ! ! ! (defun gnus-copy-article-buffer-xemacs (&optional article-buffer) ! (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) ! (buffer-disable-undo gnus-article-copy) ! (or (memq gnus-article-copy gnus-buffer-list) ! (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) ! (let ((article-buffer (or article-buffer gnus-article-buffer)) ! buf) ! (if (and (get-buffer article-buffer) ! (buffer-name (get-buffer article-buffer))) ! (save-excursion ! (set-buffer article-buffer) ! (widen) ! (setq buf (buffer-substring (point-min) (point-max))) ! (set-buffer gnus-article-copy) ! (erase-buffer) ! (insert (format "%s" buf)))))) ! ! (defun gnus-article-push-button-xemacs (event) ! "Check text under the mouse pointer for a callback function. ! If the text under the mouse pointer has a `gnus-callback' property, ! call it with the value of the `gnus-data' text property." ! (interactive "e") ! (set-buffer (window-buffer (event-window event))) ! (let* ((pos (event-closest-point event)) ! (data (get-text-property pos 'gnus-data)) ! (fun (get-text-property pos 'gnus-callback))) ! (if fun (funcall fun data)))) ! ! ;; Re-build the thread containing ID. ! (defun gnus-rebuild-thread-xemacs (id) ! (let ((dep gnus-newsgroup-dependencies) ! (buffer-read-only nil) ! parent headers refs thread art) ! (while (and id (setq headers ! (car (setq art (gnus-gethash (downcase id) ! dep))))) ! (setq parent art) ! (setq id (and (setq refs (mail-header-references headers)) ! (string-match "\\(<[^>]+>\\) *$" refs) ! (substring refs (match-beginning 1) (match-end 1))))) ! (setq thread (gnus-make-sub-thread (car parent))) ! (gnus-rebuild-remove-articles thread) ! (let ((beg (point))) ! (gnus-summary-prepare-threads (list thread) 0) ! (save-excursion ! (while (and (>= (point) beg) ! (not (bobp))) ! (or (eobp) ! (remove-text-properties ! (1+ (gnus-point-at-bol)) (1+ (gnus-point-at-eol)) ! '(gnus-number nil gnus-mark nil gnus-level nil))) ! (forward-line -1))) ! (gnus-summary-update-lines beg (point))))) ! ! ! ;; Fixed by Christopher Davis . ! (defun gnus-article-add-button-xemacs (from to fun &optional data) ! "Create a button between FROM and TO with callback FUN and data DATA." ! (and gnus-article-button-face ! (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (add-text-properties from to ! (append ! (and gnus-article-mouse-face ! (list 'mouse-face gnus-article-mouse-face)) ! (list 'gnus-callback fun) ! (and data (list 'gnus-data data)) ! (list 'highlight t)))) ! ! (defun gnus-window-top-edge-xemacs (&optional window) ! (nth 1 (window-pixel-edges window))) ! ! ;; Select the lowest window on the frame. ! (defun gnus-appt-select-lowest-window-xemacs () ! (let* ((lowest-window (selected-window)) ! (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) ! (last-window (previous-window)) ! (window-search t)) ! (while window-search ! (let* ((this-window (next-window)) ! (next-bottom-edge (car (cdr (cdr (cdr ! (window-pixel-edges ! this-window))))))) ! (if (< bottom-edge next-bottom-edge) ! (progn ! (setq bottom-edge next-bottom-edge) ! (setq lowest-window this-window))) ! ! (select-window this-window) ! (if (eq last-window this-window) ! (progn ! (select-window lowest-window) ! (setq window-search nil))))))) (defun gnus-ems-redefine () (cond ((string-match "XEmacs\\|Lucid" emacs-version) ! ;; XEmacs definitions. ! (fset 'gnus-mouse-face-function 'identity) ! (fset 'gnus-summary-make-display-table (lambda () nil)) ! (fset 'gnus-visual-turn-off-edit-menu 'identity) ! (fset 'gnus-highlight-selected-summary ! 'gnus-highlight-selected-summary-xemacs) ! (fset 'gnus-summary-recenter 'gnus-summary-recenter-xemacs) ! (fset 'gnus-group-insert-group-line-info ! 'gnus-group-insert-group-line-info-xemacs) ! (fset 'gnus-copy-article-buffer 'gnus-copy-article-buffer-xemacs) ! (fset 'gnus-summary-refer-article 'gnus-summary-refer-article-xemacs) ! (fset 'gnus-summary-insert-pseudos 'gnus-summary-insert-pseudos-xemacs) ! (fset 'gnus-article-push-button 'gnus-article-push-button-xemacs) ! (fset 'gnus-rebuild-thread 'gnus-rebuild-thread-xemacs) ! (fset 'gnus-article-add-button 'gnus-article-add-button-xemacs) ! (fset 'gnus-window-top-edge 'gnus-window-top-edge-xemacs) ! (fset 'set-text-properties 'gnus-set-text-properties-xemacs) ! ! (or (fboundp 'appt-select-lowest-window) ! (fset 'appt-select-lowest-window ! 'gnus-appt-select-lowest-window-xemacs)) ! ! (if (not gnus-visual) ! () ! (setq gnus-group-mode-hook ! (cons ! '(lambda () ! (easy-menu-add gnus-group-reading-menu) ! (easy-menu-add gnus-group-group-menu) ! (easy-menu-add gnus-group-misc-menu) ! (gnus-install-mouse-tracker)) ! gnus-group-mode-hook)) ! (setq gnus-summary-mode-hook ! (cons ! '(lambda () ! (easy-menu-add gnus-summary-article-menu) ! (easy-menu-add gnus-summary-thread-menu) ! (easy-menu-add gnus-summary-misc-menu) ! (easy-menu-add gnus-summary-post-menu) ! (easy-menu-add gnus-summary-kill-menu) ! (gnus-install-mouse-tracker)) ! gnus-summary-mode-hook)) ! (setq gnus-article-mode-hook ! (cons ! '(lambda () ! (easy-menu-add gnus-article-article-menu) ! (easy-menu-add gnus-article-treatment-menu)) ! gnus-article-mode-hook))) ! ! (defvar gnus-logo (make-glyph (make-specifier 'image))) ! ! (defun gnus-group-startup-xmessage (&optional x y) ! "Insert startup message in current buffer." ! ;; Insert the message. ! (erase-buffer) ! (if (featurep 'xpm) ! (progn ! (set-glyph-property gnus-logo 'image "~/tmp/gnus.xpm") ! (set-glyph-image gnus-logo "~/tmp/gnus.xpm" 'global 'x) ! ! (insert " ") ! (set-extent-begin-glyph (make-extent (point) (point)) gnus-logo) ! (insert " ! Gnus * A newsreader for Emacsen ! A Praxis Release * larsi@ifi.uio.no") ! (goto-char (point-min)) ! (while (not (eobp)) ! (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) ! ? )) ! (forward-line 1)) ! (goto-char (point-min)) ! ;; +4 is fuzzy factor. ! (insert-char ?\n (/ (max (- (window-height) (or y 24)) 0) 2))) ! ! (insert ! (format " ! %s ! A newsreader ! for GNU Emacs ! ! Based on GNUS ! written by ! Masanobu UMEDA ! ! A Praxis Release ! larsi@ifi.uio.no ! " ! gnus-version)) ! ;; And then hack it. ! ;; 18 is the longest line. ! (indent-rigidly (point-min) (point-max) ! (/ (max (- (window-width) (or x 28)) 0) 2)) ! (goto-char (point-min)) ! ;; +4 is fuzzy factor. ! (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))) ! ! ;; Fontify some. ! (goto-char (point-min)) ! (search-forward "Praxis") ! (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) ! (goto-char (point-min))) ! ! ! ! ) ((boundp 'MULE) ;; Mule definitions - (if (not (fboundp 'truncate-string)) - (defun truncate-string (str width) - (let ((w (string-width str)) - (col 0) (idx 0) (p-idx 0) chr) - (if (<= w width) - str - (while (< col width) - (setq chr (aref str idx) - col (+ col (char-width chr)) - p-idx idx - idx (+ idx (char-bytes chr)) - )) - (substring str 0 (if (= col width) - idx - p-idx)) - ))) - ) (defalias 'gnus-truncate-string 'truncate-string) - (defun gnus-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (if face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (if (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) - - (defun gnus-max-width-function (el max-width) - (` (let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) - valstr)))) - (fset 'gnus-summary-make-display-table (lambda () nil)) (if (boundp 'gnus-check-before-posting) (setq gnus-check-before-posting (delq 'long-lines ! (delq 'control-chars gnus-check-before-posting))) ! ) ! ) ! )) (provide 'gnus-ems) --- 175,236 ---- (file-exists-p file)))) (or (fboundp 'face-list) ! (defun face-list (&rest args)))) ! (eval-and-compile ! (let ((case-fold-search t)) ! (cond ! ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type)) ! (setq nnheader-file-name-translation-alist ! (append nnheader-file-name-translation-alist ! '((?: . ?_) ! (?+ . ?-)))))))) ! ! (defvar gnus-tmp-unread) ! (defvar gnus-tmp-replied) ! (defvar gnus-tmp-score-char) ! (defvar gnus-tmp-indentation) ! (defvar gnus-tmp-opening-bracket) ! (defvar gnus-tmp-lines) ! (defvar gnus-tmp-name) ! (defvar gnus-tmp-closing-bracket) ! (defvar gnus-tmp-subject-or-nil) (defun gnus-ems-redefine () (cond ((string-match "XEmacs\\|Lucid" emacs-version) ! (gnus-xmas-redefine)) ((boundp 'MULE) ;; Mule definitions (defalias 'gnus-truncate-string 'truncate-string) (fset 'gnus-summary-make-display-table (lambda () nil)) + (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) + (fset 'gnus-max-width-function 'gnus-mule-max-width-function) (if (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 ! gnus-tmp-score-char gnus-tmp-indentation) ! (put-text-property ! (point) ! (progn ! (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)) ! gnus-tmp-closing-bracket) ! (point)) ! gnus-mouse-face-prop gnus-mouse-face) ! (insert " " gnus-tmp-subject-or-nil "\n")) ! ))) ! (provide 'gnus-ems) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-gl.el emacs-19.32/lisp/gnus-gl.el *** emacs-19.31/lisp/gnus-gl.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-gl.el Tue Jun 25 18:29:58 1996 *************** *** 0 **** --- 1,872 ---- + ;;; gnus-gl.el --- an interface to GroupLens for Gnus + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Brad Miller + ;; Keywords: news, score + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; GroupLens software and documentation is copyright (c) 1995 by Paul + ;; Resnick (Massachusetts Institute of Technology); Brad Miller, John + ;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), + ;; and David Maltz (Carnegie-Mellon University). + ;; + ;; Permission to use, copy, modify, and distribute this documentation + ;; for non-commercial and commercial purposes without fee is hereby + ;; granted provided that this copyright notice and permission notice + ;; appears in all copies and that the names of the individuals and + ;; institutions holding this copyright are not used in advertising or + ;; publicity pertaining to this software without specific, written + ;; prior permission. The copyright holders make no representations + ;; about the suitability of this software and documentation for any + ;; purpose. It is provided ``as is'' without express or implied + ;; warranty. + ;; + ;; 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. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Author: Brad Miller + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; User Documentation: + ;; To use GroupLens you must load this file. + ;; You must also register a pseudonym with the Better Bit Bureau. + ;; http://www.cs.umn.edu/Research/GroupLens + ;; + ;; ---------------- For your .emacs or .gnus file ---------------- + ;; + ;; 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) + ;; (setq grouplens-pseudonym "") + ;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") + ;; + ;; (setq gnus-summary-default-score 0) + ;; + ;; USING GROUPLENS + ;; How do I Rate an article?? + ;; Before you type n to go to the next article, hit a number from 1-5 + ;; Type r in the summary buffer and you will be prompted. + ;; Note that when you're in grouplens-minor-mode 'r' maskes the + ;; usual reply binding for 'r' + ;; + ;; What if, Gasp, I find a bug??? + ;; 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 aritcle: + ;; If you set the gnus-summary-line-format as shown above, the score + ;; (prediction) will be shown automatically. + ;; + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Programmer Notes + ;; 10/9/95 + ;; gnus-scores-articles contains the articles + ;; When scoring is done, the call tree looks something like: + ;; gnus-possibly-score-headers + ;; ==> gnus-score-headers + ;; ==> gnus-score-load-file + ;; ==> get-all-mids (from the eval form) + ;; + ;; it would be nice to have one that gets called after all the other + ;; headers have been scored. + ;; we may want a variable gnus-grouplens-scale-factor + ;; and gnus-grouplens-offset this would probably be either -3 or 0 + ;; to make the scores centered around zero or not. + ;; Notes 10/12/95 + ;; According to Lars, Norse god of gnus, the simple way to insert a + ;; call to an external function is to have a function added to the + ;; variable gnus-score-find-files-function This new function + ;; gnus-grouplens-score-alist will return a core alist that + ;; has (("message-id" ("" score) ("" score)) + ;; This seems like it would be pretty inefficient, though workable. + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; TODO + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; 3. Add some more ways to rate messages + ;; 4. Better error handling for token timeouts. + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; bugs + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + + ;;; Code: + + (require 'gnus-score) + (require 'cl) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; User variables + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defvar gnus-summary-grouplens-line-format + "%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n" + "*The line format spec in summary GroupLens mode buffers.") + + (defvar grouplens-pseudonym "" + "User's pseudonym. This pseudonym is obtained during the registration process") + + (defvar grouplens-bbb-host "grouplens.cs.umn.edu" + "Host where the bbbd is running" ) + + (defvar grouplens-bbb-port 9000 + "Port where the bbbd is listening" ) + + (defvar grouplens-newsgroups + '("comp.lang.c++" "rec.humor" "rec.food.recipes" "comp.groupware" + "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" + "comp.lang.java" "comp.os.linux.announce" "comp.os.linux.misc" + "comp.os.linux.development.apps" "comp.os.linux.development.system") + "*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, + 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, + confidence-spot -- ) * | the spot gets bigger with more confidence, + prediction-num -- plain-old numeric value, + confidence-plus-minus -- prediction +/i confidence") + + (defvar grouplens-score-offset 0 + "Offset the prediction by this value. + Setting this variable to -2 would have the following effect on + GroupLens scores: + + 1 --> -2 + 2 --> -1 + 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. + The scale factor is applied after the offset.") + + (defvar gnus-grouplens-override-scoring 'override + "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 + 'separate -- treat grouplens scores completely separate from gnus") + + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; Program global variables + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defvar grouplens-bbb-token "0" + "Current session token number") + + (defvar grouplens-bbb-process nil + "Process Id of current bbbd network stream process") + + (defvar grouplens-bbb-buffer nil + "Buffer associated with the BBBD process") + + (defvar grouplens-rating-alist nil + "Current set of message-id rating pairs") + + (defvar grouplens-current-hashtable (make-hash-table :test 'equal :size 100)) + ;; this seems like a pretty ugly way to get around the problem, but If + ;; I don't do this, then the compiler complains when I call gethash + ;; + (eval-when-compile (setq grouplens-current-hashtable + (make-hash-table :test 'equal :size 100))) + + (defvar grouplens-current-group nil) + + (defvar bbb-mid-list nil) + + (defvar bbb-alist nil) + + (defvar bbb-timeout-secs 10 + "Number of seconds to wait for some response from the BBB. + If this times out we give up and assume that something has died..." ) + + (defvar grouplens-previous-article nil + "Message-ID of the last article read.") + + (defvar bbb-read-point) + (defvar bbb-response-point) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; Utility Functions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun bbb-connect-to-bbbd (host port) + (unless grouplens-bbb-buffer + (setq grouplens-bbb-buffer + (get-buffer-create (format " *BBBD trace: %s*" host))) + (save-excursion + (set-buffer grouplens-bbb-buffer) + (make-local-variable 'bbb-read-point) + (setq bbb-read-point (point-min)))) + ;; clear the trace buffer of old output + (save-excursion + (set-buffer grouplens-bbb-buffer) + (erase-buffer)) + ;; open the connection to the server + (setq grouplens-bbb-process nil) + (catch 'done + (condition-case error + (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) + (throw 'done nil)) + ;; (set-process-filter grouplens-bbb-process 'bbb-process-filter) + (save-excursion + (set-buffer grouplens-bbb-buffer) + (setq bbb-read-point (point-min)) + (or (bbb-read-response grouplens-bbb-process) + (throw 'done nil)))) + grouplens-bbb-process) + + ;; (defun bbb-process-filter (process output) + ;; (save-excursion + ;; (set-buffer (bbb-process-buffer process)) + ;; (goto-char (point-max)) + ;; (insert output))) + + (defun bbb-send-command (process command) + (goto-char (point-max)) + (insert command) + (insert "\r\n") + (setq bbb-read-point (point)) + (setq bbb-response-point (point)) + (set-marker (process-mark process) (point)) ; process output also comes here + (process-send-string process command) + (process-send-string process "\r\n")) + + (defun bbb-read-response (process) ; &optional return-response-string) + "This function eats the initial response of OK or ERROR from the BBB." + (let ((case-fold-search nil) + match-end) + (goto-char bbb-read-point) + (while (and (not (search-forward "\r\n" nil t)) + (accept-process-output process bbb-timeout-secs)) + (goto-char bbb-read-point)) + (setq match-end (point)) + (goto-char bbb-read-point) + (setq bbb-read-point match-end) + (looking-at "OK"))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; Login Functions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun bbb-login () + "return the token number if login is successful, otherwise return nil" + (interactive) + (setq grouplens-bbb-token nil) + (if (not (equal grouplens-pseudonym "")) + (let ((bbb-process + (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) + (if bbb-process + (save-excursion + (set-buffer (process-buffer bbb-process)) + (bbb-send-command bbb-process + (concat "login " grouplens-pseudonym)) + (if (bbb-read-response bbb-process) + (setq grouplens-bbb-token (bbb-extract-token-number)) + (gnus-message 3 "Error: Grouplens login failed"))))) + (gnus-message 3 "Error: you must set a pseudonym")) + grouplens-bbb-token) + + (defun bbb-extract-token-number () + (let ((token-pos (search-forward "token=" nil t) )) + (if (looking-at "[0-9]+") + (buffer-substring token-pos (match-end 0))))) + + (gnus-add-shutdown 'bbb-logout 'gnus) + + (defun bbb-logout () + "logout of bbb session" + (let ((bbb-process + (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) + (if bbb-process + (save-excursion + (set-buffer (process-buffer bbb-process)) + (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) + (bbb-read-response bbb-process)) + nil))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; Get Predictions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defun bbb-build-mid-scores-alist (groupname) + "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. + + *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 + recommend using both scores and grouplens predictions together." + (setq grouplens-current-group groupname) + (if (member groupname grouplens-newsgroups) + (let* ((mid-list (bbb-get-all-mids)) + (predict-list (bbb-get-predictions mid-list groupname))) + (setq grouplens-previous-article nil) + ;; scores-alist should be a list of lists: + ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) + ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value + (list (list (list (append (list "message-id") predict-list))))) + nil)) + + (defun bbb-get-predictions (midlist groupname) + "Ask the bbb for predictions, and build up the score alist." + (if (or (null grouplens-bbb-token) + (equal grouplens-bbb-token "0")) + (progn + (gnus-message 3 "Error: You are not logged in to a BBB") + nil) + (gnus-message 5 "Fetching Predictions...") + (let (predict-list + (predict-command (bbb-build-predict-command midlist groupname + grouplens-bbb-token)) + (bbb-process (bbb-connect-to-bbbd grouplens-bbb-host + grouplens-bbb-port))) + (if bbb-process + (save-excursion + (set-buffer (process-buffer bbb-process)) + (bbb-send-command bbb-process predict-command) + (if (bbb-read-response bbb-process) + (setq predict-list (bbb-get-prediction-response bbb-process)) + (gnus-message 1 "Invalid Token, login and try again") + (ding)))) + (setq bbb-alist predict-list)))) + + (defun bbb-get-all-mids () + (let ((index (nth 1 (assoc "message-id" gnus-header-index))) + (articles gnus-newsgroup-headers) + art this) + (setq bbb-mid-list nil) + (while articles + (progn (setq art (car articles) + this (aref art index) + articles (cdr articles)) + (setq bbb-mid-list (cons this bbb-mid-list)))) + bbb-mid-list)) + + (defun bbb-build-predict-command (mlist grpname token) + (let ((cmd (concat "getpredictions " token " " grpname "\r\n")) + art) + (while mlist + (setq art (car mlist) + cmd (concat cmd art "\r\n") + mlist (cdr mlist))) + (setq cmd (concat cmd ".\r\n")) + cmd)) + + (defun bbb-get-prediction-response (process) + (let ((case-fold-search nil) + match-end) + (goto-char bbb-read-point) + (while (and (not (search-forward ".\r\n" nil t)) + (accept-process-output process bbb-timeout-secs)) + (goto-char bbb-read-point)) + (setq match-end (point)) + (goto-char (+ bbb-response-point 4)) ;; we ought to be right before OK + (bbb-build-response-alist))) + + ;; build-response-alist assumes that the cursor has been positioned at + ;; the first line of the list of mid/rating pairs. For now we will + ;; use a prediction of 99 to signify no prediction. Ultimately, we + ;; should just ignore messages with no predictions. + (defun bbb-build-response-alist () + (let ((resp nil) + (match-end (point))) + (setq grouplens-current-hashtable (make-hash-table :test 'equal :size 100)) + (while + (cond ((looking-at "\\(<.*>\\) :nopred=") + (push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) + (forward-line 1) + t) + ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") + (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp) + (cl-puthash (bbb-get-mid) + (list (bbb-get-pred) (bbb-get-confl) (bbb-get-confh)) + grouplens-current-hashtable) + (forward-line 1) + t) + ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") + (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp) + (cl-puthash (bbb-get-mid) + (list (bbb-get-pred) 0 0) + grouplens-current-hashtable) + (forward-line 1) + t) + (t nil))) + resp)) + + ;; these two functions assume that there is an active match lying + ;; around. Where the first parenthesized expression is the + ;; message-id, and the second is the prediction. 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) + (match-end 2))))) + (if (> tpred 0) + (round (* grouplens-score-scale-factor (+ grouplens-score-offset tpred))) + 1))) + + (defun bbb-get-confl () + (string-to-number (buffer-substring (match-beginning 3) (match-end 3)))) + + (defun bbb-get-confh () + (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; Prediction Display + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defconst grplens-rating-range 4.0) + (defconst grplens-maxrating 5) + (defconst grplens-minrating 1) + (defconst grplens-predstringsize 12) + + (defvar gnus-tmp-score) + (defun bbb-grouplens-score (header) + (if (eq gnus-grouplens-override-scoring 'separate) + (bbb-grouplens-other-score header) + (let* ((rate-string (make-string 12 ? )) + (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) + (hashent (gethash mid grouplens-current-hashtable)) + (iscore gnus-tmp-score) + (low (car (cdr hashent))) + (high (car (cdr (cdr hashent))))) + (aset rate-string 0 ?|) + (aset rate-string 11 ?|) + (unless (member grouplens-current-group grouplens-newsgroups) + (unless (equal grouplens-prediction-display 'prediction-num) + (cond ((< iscore 0) + (setq iscore 1)) + ((> iscore 5) + (setq iscore 5)))) + (setq low 0) + (setq high 0)) + (if (and (bbb-valid-score iscore) + (not (null mid))) + (cond + ;; prediction-spot + ((equal grouplens-prediction-display 'prediction-spot) + (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) + ;; confidence-interval + ((equal grouplens-prediction-display 'confidence-interval) + (setq rate-string (bbb-fmt-confidence-interval iscore low high))) + ;; prediction-bar + ((equal grouplens-prediction-display 'prediction-bar) + (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) + ;; confidence-bar + ((equal grouplens-prediction-display 'confidence-bar) + (setq rate-string (format "| %4.2f |" iscore))) + ;; confidence-spot + ((equal grouplens-prediction-display 'confidence-spot) + (setq rate-string (format "| %4.2f |" iscore))) + ;; prediction-num + ((equal grouplens-prediction-display 'prediction-num) + (setq rate-string (bbb-fmt-prediction-num iscore))) + ;; confidence-plus-minus + ((equal grouplens-prediction-display 'confidence-plus-minus) + (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) + ) + (t (gnus-message 3 "Invalid prediction display type"))) + (aset rate-string 5 ?N) (aset rate-string 6 ?A)) + rate-string))) + + ;; + ;; Gnus user format function that doesn't depend on + ;; bbb-build-mid-scores-alist being used as the score function, but is + ;; instead called from gnus-select-group-hook. -- LAB + (defun bbb-grouplens-other-score (header) + (if (not (member grouplens-current-group grouplens-newsgroups)) + ;; Return an empty string + "" + (let* ((rate-string (make-string 12 ? )) + (mid (aref header (nth 1 (assoc "message-id" gnus-header-index)))) + (hashent (gethash mid grouplens-current-hashtable)) + (pred (or (nth 0 hashent) 0)) + (low (nth 1 hashent)) + (high (nth 2 hashent))) + ;; Init rate-string + (aset rate-string 0 ?|) + (aset rate-string 11 ?|) + (unless (equal grouplens-prediction-display 'prediction-num) + (cond ((< pred 0) + (setq pred 1)) + ((> pred 5) + (setq pred 5)))) + ;; If no entry in BBB hash mark rate string as NA and return + (cond + ((null hashent) + (aset rate-string 5 ?N) + (aset rate-string 6 ?A) + rate-string) + + ((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)) + + ((equal grouplens-prediction-display 'confidence-bar) + (format "| %4.2f |" pred)) + + ((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 + (gnus-message 3 "Invalid prediction display type") + (aset rate-string 0 ?|) + (aset rate-string 11 ?|) + rate-string))))) + + (defun bbb-valid-score (score) + (or (equal grouplens-prediction-display 'prediction-num) + (and (>= score grplens-minrating) + (<= score grplens-maxrating)))) + + (defun bbb-requires-confidence (format-type) + (or (equal format-type 'confidence-plus-minus) + (equal format-type 'confidence-spot) + (equal format-type 'confidence-interval))) + + (defun bbb-have-confidence (clow chigh) + (not (or (null clow) + (null chigh)))) + + (defun bbb-fmt-prediction-spot (rate-string score) + (aset rate-string + (round (* (/ (- score grplens-minrating) grplens-rating-range) + (+ (- grplens-predstringsize 4) 1.49))) + ?*) + rate-string) + + (defun bbb-fmt-confidence-interval (score low high) + (if (bbb-have-confidence low high) + (format "|%4.2f-%4.2f |" low high) + (bbb-fmt-prediction-num score))) + + (defun bbb-fmt-confidence-plus-minus (score low high) + (if (bbb-have-confidence low high) + (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) + (bbb-fmt-prediction-num score))) + + (defun bbb-fmt-prediction-bar (rate-string score) + (let* ((i 1) + (step (/ grplens-rating-range (- grplens-predstringsize 4))) + (half-step (/ step 2)) + (loc (- grplens-minrating half-step))) + (while (< i (- grplens-predstringsize 2)) + (if (> score loc) + (aset rate-string i ?#) + (aset rate-string i ? )) + (setq i (+ i 1)) + (setq loc (+ loc step))) + ) + rate-string) + + (defun bbb-fmt-prediction-num (score) + (format "| %4.2f |" score)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;; Put Ratings + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;; The message-id for the current article can be found in + ;; (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index))) + + (defun bbb-put-ratings () + (if (and grouplens-rating-alist + (member gnus-newsgroup-name grouplens-newsgroups)) + (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 + (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 + "Token timed out: call bbb-login and quit again") + (ding)) + (gnus-message 5 "Sending Ratings...Done")) + (gnus-message 3 "No BBB connection"))) + (setq grouplens-rating-alist nil))) + + (defun bbb-build-rate-command (rate-alist) + (let (this + (cmd (concat "putratings " grouplens-bbb-token + " " grouplens-current-group " \r\n"))) + (while rate-alist + (setq this (car rate-alist) + cmd (concat cmd (car this) " :rating=" (cadr this) ".00" + " :time=" (cddr this) "\r\n") + rate-alist (cdr rate-alist))) + (concat cmd ".\r\n"))) + + ;; Interactive rating functions. + (defun bbb-summary-rate-article (rating &optional midin) + (interactive "nRating: ") + (when (member gnus-newsgroup-name grouplens-newsgroups) + (let ((mid (or midin (bbb-get-current-id)))) + (if (and rating + (>= rating grplens-minrating) + (<= rating grplens-maxrating) + mid) + (let ((oldrating (assoc mid grouplens-rating-alist))) + (if oldrating + (setcdr oldrating (cons rating 0)) + (push `(,mid . (,rating . 0)) grouplens-rating-alist)) + (gnus-summary-mark-article nil (int-to-string rating))) + (gnus-message 3 "Invalid rating"))))) + + (defun grouplens-next-unread-article (rating) + "Select unread article after current one." + (interactive "P") + (if rating (bbb-summary-rate-article rating)) + (gnus-summary-next-unread-article)) + + (defun grouplens-best-unread-article (rating) + "Select unread article after current one." + (interactive "P") + (if rating (bbb-summary-rate-article rating)) + (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 + marked as read." + (interactive "P") + (if rating + (bbb-summary-rate-article rating)) + (if (numberp rating) + (gnus-summary-catchup-and-exit) + (gnus-summary-catchup-and-exit rating))) + + (defun grouplens-score-thread (score) + "Raise the score of the articles in the current thread with SCORE." + (interactive "nRating: ") + (let (e) + (save-excursion + (let ((articles (gnus-summary-articles-in-thread))) + (while articles + (gnus-summary-goto-subject (car articles)) + (gnus-set-global-variables) + (bbb-summary-rate-article score + (mail-header-id + (gnus-summary-article-header + (car articles)))) + (setq articles (cdr articles)))) + (setq e (point))) + (let ((gnus-summary-check-current t)) + (or (zerop (gnus-summary-next-subject 1 t)) + (goto-char e)))) + (gnus-summary-recenter) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary)) + + + (defun bbb-get-current-id () + (if gnus-current-headers + (aref gnus-current-headers + (nth 1 (assoc "message-id" gnus-header-index))) + (gnus-message 3 "You must select an article before you rate it"))) + + (defun bbb-grouplens-group-p (group) + "Say whether GROUP is a GroupLens group." + (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; TIME SPENT READING + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defvar grouplens-current-starting-time nil) + + (defun grouplens-start-timer () + (setq grouplens-current-starting-time (current-time))) + + (defun grouplens-elapsed-time () + (let ((et (bbb-time-float (current-time)))) + (- et (bbb-time-float grouplens-current-starting-time)))) + + (defun bbb-time-float (timeval) + (+ (* (car timeval) 65536) + (cadr timeval))) + + (defun grouplens-do-time () + (when (member gnus-newsgroup-name grouplens-newsgroups) + (when grouplens-previous-article + (let ((elapsed-time (grouplens-elapsed-time)) + (oldrating (assoc grouplens-previous-article + grouplens-rating-alist))) + (if (not oldrating) + (push `(,grouplens-previous-article . (0 . ,elapsed-time)) + grouplens-rating-alist) + (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) + (grouplens-start-timer) + (setq grouplens-previous-article (bbb-get-current-id)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; BUG REPORTING + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defconst gnus-gl-version "gnus-gl.el 2.12") + (defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") + (defun gnus-gl-submit-bug-report () + "Submit via mail a bug report on gnus-gl" + (interactive) + (require 'reporter) + (reporter-submit-bug-report gnus-gl-maintainer-address + (concat "gnus-gl.el " gnus-gl-version) + (list 'grouplens-pseudonym + 'grouplens-bbb-host + 'grouplens-bbb-port + 'grouplens-newsgroups + 'grouplens-bbb-token + 'grouplens-bbb-process + 'grouplens-current-group + 'grouplens-previous-article + 'grouplens-mid-list + 'bbb-alist) + nil + 'gnus-gl-get-trace)) + + (defun gnus-gl-get-trace () + "Insert the contents of the BBBD trace buffer" + (if grouplens-bbb-buffer (insert-buffer grouplens-bbb-buffer))) + + ;;; + ;;; Additions to make gnus-grouplens-mode Warning Warning!! + ;;; This version of the gnus-grouplens-mode does + ;;; not work with gnus-5.x. The "old" way of + ;;; setting up GroupLens still works however. + ;;; + (defvar gnus-grouplens-mode nil + "Minor mode for providing a GroupLens interface in Gnus summary buffers.") + + (defvar gnus-grouplens-mode-map nil) + + (unless gnus-grouplens-mode-map + (setq gnus-grouplens-mode-map (make-keymap)) + (gnus-define-keys + gnus-grouplens-mode-map + "n" grouplens-next-unread-article + "r" bbb-summary-rate-article + "k" grouplens-score-thread + "c" grouplens-summary-catchup-and-exit + "," grouplens-best-unread-article)) + + (defun gnus-grouplens-make-menu-bar () + (unless (boundp 'gnus-grouplens-menu) + (easy-menu-define + gnus-grouplens-menu gnus-grouplens-mode-map "" + '("GroupLens" + ["Login" bbb-login t] + ["Rate" bbb-summary-rate-article t] + ["Next article" grouplens-next-unread-article t] + ["Best article" grouplens-best-unread-article t] + ["Raise thread" grouplens-score-thread t] + ["Report bugs" gnus-gl-submit-bug-report t])))) + + (defun gnus-grouplens-mode (&optional arg) + "Minor mode for providing a GroupLens interface in Gnus summary buffers." + (interactive "P") + (when (and (eq major-mode 'gnus-summary-mode) + (member gnus-newsgroup-name grouplens-newsgroups)) + (make-local-variable 'gnus-grouplens-mode) + (setq gnus-grouplens-mode + (if (null arg) (not gnus-grouplens-mode) + (> (prefix-numeric-value arg) 0))) + (when gnus-grouplens-mode + (if (not (fboundp 'make-local-hook)) + (add-hook 'gnus-select-article-hook 'grouplens-do-time) + (make-local-hook 'gnus-select-article-hook) + (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)) + (if (not (fboundp 'make-local-hook)) + (add-hook 'gnus-exit-group-hook 'bbb-put-ratings) + (make-local-hook 'gnus-exit-group-hook) + (add-hook 'gnus-exit-group-hook 'bbb-put-ratings nil 'local)) + (make-local-variable 'gnus-score-find-score-files-function) + (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 + 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 + '(lambda() + (bbb-build-mid-scores-alist gnus-newsgroup-name)))) + ;; default is to override + (t (setq gnus-score-find-score-files-function + 'bbb-build-mid-scores-alist))) + (make-local-variable 'gnus-summary-line-format) + (setq gnus-summary-line-format + gnus-summary-grouplens-line-format) + (make-local-variable 'gnus-summary-line-format-spec) + (setq gnus-summary-line-format-spec nil) + + ;; Set up the menu. + (when (and menu-bar-mode + (gnus-visual-p 'grouplens-menu 'menu)) + (gnus-grouplens-make-menu-bar)) + (unless (assq 'gnus-grouplens-mode minor-mode-alist) + (push '(gnus-grouplens-mode " GroupLens") minor-mode-alist)) + (unless (assq 'gnus-grouplens-mode minor-mode-map-alist) + (push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map) + minor-mode-map-alist)) + (run-hooks 'gnus-grouplens-mode-hook)))) + + (provide 'gnus-gl) + + ;;; gnus-gl.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-kill.el emacs-19.32/lisp/gnus-kill.el *** emacs-19.31/lisp/gnus-kill.el Thu Feb 15 10:54:19 1996 --- emacs-19.32/lisp/gnus-kill.el Tue Jun 25 18:02:30 1996 *************** *** 1,5 **** ;;; gnus-kill.el --- kill commands for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA --- 1,4 ---- ;;; gnus-kill.el --- kill commands for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA *************** *** 29,32 **** --- 28,32 ---- (require 'gnus) + (eval-when-compile (require 'cl)) (defvar gnus-kill-file-mode-hook nil *************** *** 44,53 **** (defmacro gnus-raise (field expression level) ! (` (gnus-kill (, field) (, expression) ! (function (gnus-summary-raise-score (, level))) t))) (defmacro gnus-lower (field expression level) ! (` (gnus-kill (, field) (, expression) ! (function (gnus-summary-raise-score (- (, level)))) t))) ;;; --- 44,53 ---- (defmacro gnus-raise (field expression level) ! `(gnus-kill ,field ,expression ! (function (gnus-summary-raise-score ,level)) t)) (defmacro gnus-lower (field expression level) ! `(gnus-kill ,field ,expression ! (function (gnus-summary-raise-score (- ,level))) t)) ;;; *************** *** 57,77 **** (defvar gnus-kill-file-mode-map nil) ! (if gnus-kill-file-mode-map ! nil ! (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map)) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-t" 'gnus-kill-file-kill-by-thread) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-k\C-x" 'gnus-kill-file-kill-by-xref) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-a" 'gnus-kill-file-apply-buffer) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-e" 'gnus-kill-file-apply-last-sexp) ! (define-key gnus-kill-file-mode-map ! "\C-c\C-c" 'gnus-kill-file-exit)) (defun gnus-kill-file-mode () --- 57,70 ---- (defvar gnus-kill-file-mode-map nil) ! (unless gnus-kill-file-mode-map ! (gnus-define-keymap ! (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map)) ! "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject ! "\C-c\C-k\C-a" gnus-kill-file-kill-by-author ! "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread ! "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref ! "\C-c\C-a" gnus-kill-file-apply-buffer ! "\C-c\C-e" gnus-kill-file-apply-last-sexp ! "\C-c\C-c" gnus-kill-file-exit)) (defun gnus-kill-file-mode () *************** If NEWSGROUP is nil, the global kill fil *** 182,186 **** (bury-buffer buffer))) ! (defun gnus-kill-file-enter-kill (field regexp) ;; Enter kill file entry. ;; FIELD: String containing the name of the header field to kill. --- 175,179 ---- (bury-buffer buffer))) ! (defun gnus-kill-file-enter-kill (field regexp &optional dont-move) ;; Enter kill file entry. ;; FIELD: String containing the name of the header field to kill. *************** If NEWSGROUP is nil, the global kill fil *** 190,195 **** (or (eq major-mode 'gnus-kill-file-mode) (gnus-kill-set-kill-buffer)) ! (current-buffer) ! (goto-char (point-max)) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) (gnus-kill-file-apply-string string)))) --- 183,188 ---- (or (eq major-mode 'gnus-kill-file-mode) (gnus-kill-set-kill-buffer)) ! (unless dont-move ! (goto-char (point-max))) (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) (gnus-kill-file-apply-string string)))) *************** If NEWSGROUP is nil, the global kill fil *** 203,207 **** (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) ! ""))) (defun gnus-kill-file-kill-by-author () --- 196,200 ---- (regexp-quote (gnus-simplify-subject (mail-header-subject gnus-current-headers))) ! "") t)) (defun gnus-kill-file-kill-by-author () *************** If NEWSGROUP is nil, the global kill fil *** 212,216 **** (if (vectorp gnus-current-headers) (regexp-quote (mail-header-from gnus-current-headers)) ! ""))) (defun gnus-kill-file-kill-by-thread () --- 205,209 ---- (if (vectorp gnus-current-headers) (regexp-quote (mail-header-from gnus-current-headers)) ! "") t)) (defun gnus-kill-file-kill-by-thread () *************** If NEWSGROUP is nil, the global kill fil *** 238,243 **** gnus-newsgroup-name)) (gnus-kill-file-enter-kill ! "Xref" (concat " " (regexp-quote group) ":")))) ! (gnus-kill-file-enter-kill "Xref" "")))) (defun gnus-kill-file-raise-followups-to-author (level) --- 231,236 ---- gnus-newsgroup-name)) (gnus-kill-file-enter-kill ! "Xref" (concat " " (regexp-quote group) ":") t))) ! (gnus-kill-file-enter-kill "Xref" "" t)))) (defun gnus-kill-file-raise-followups-to-author (level) *************** If NEWSGROUP is nil, the global kill fil *** 259,263 **** (insert string) (gnus-kill-file-apply-string string)) ! (message "Added temporary score file entry for followups to %s." name))) (defun gnus-kill-file-apply-buffer () --- 252,257 ---- (insert string) (gnus-kill-file-apply-string string)) ! (gnus-message ! 6 "Added temporary score file entry for followups to %s." name))) (defun gnus-kill-file-apply-buffer () *************** If NEWSGROUP is nil, the global kill fil *** 268,272 **** ;; Assume newsgroup is selected. (gnus-kill-file-apply-string (buffer-string)) ! (ding) (message "No newsgroup is selected."))) (defun gnus-kill-file-apply-string (string) --- 262,266 ---- ;; Assume newsgroup is selected. (gnus-kill-file-apply-string (buffer-string)) ! (ding) (gnus-message 2 "No newsgroup is selected."))) (defun gnus-kill-file-apply-string (string) *************** If NEWSGROUP is nil, the global kill fil *** 292,296 **** (pop-to-buffer gnus-summary-buffer) (eval (car (read-from-string string)))))) ! (ding) (message "No newsgroup is selected."))) (defun gnus-kill-file-exit () --- 286,290 ---- (pop-to-buffer gnus-summary-buffer) (eval (car (read-from-string string)))))) ! (ding) (gnus-message 2 "No newsgroup is selected."))) (defun gnus-kill-file-exit () *************** If NEWSGROUP is nil, return the global k *** 319,334 **** (string-equal newsgroup "")) ;; The global kill file is placed at top of the directory. ! (expand-file-name gnus-kill-file-name ! (or gnus-kill-files-directory "~/News"))) (gnus-use-long-file-name ;; Append ".KILL" to capitalized newsgroup name. (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) "." gnus-kill-file-name) ! (or gnus-kill-files-directory "~/News"))) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) ! (or gnus-kill-files-directory "~/News"))))) (defun gnus-expunge (marks) --- 313,327 ---- (string-equal newsgroup "")) ;; The global kill file is placed at top of the directory. ! (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) (gnus-use-long-file-name ;; Append ".KILL" to capitalized newsgroup name. (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) "." gnus-kill-file-name) ! gnus-kill-files-directory)) (t ;; Place "KILL" under the hierarchical directory. (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) "/" gnus-kill-file-name) ! gnus-kill-files-directory)))) (defun gnus-expunge (marks) *************** If NEWSGROUP is nil, return the global k *** 336,340 **** (save-excursion (set-buffer gnus-summary-buffer) ! (gnus-summary-remove-lines-marked-with marks))) (defun gnus-apply-kill-file-internal () --- 329,347 ---- (save-excursion (set-buffer gnus-summary-buffer) ! (gnus-summary-limit-to-marks marks 'reverse))) ! ! (defun gnus-apply-kill-file-unless-scored () ! "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." ! (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) ! ;; Ignores global KILL. ! (if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) ! (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" ! gnus-newsgroup-name)) ! 0) ! ((or (file-exists-p (gnus-newsgroup-kill-file nil)) ! (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) ! (gnus-apply-kill-file-internal)) ! (t ! 0))) (defun gnus-apply-kill-file-internal () *************** Returns the number of articles marked as *** 347,352 **** beg) (setq gnus-newsgroup-kill-headers nil) - (or gnus-newsgroup-headers-hashtb-by-number - (gnus-make-headers-hashtable-by-number)) ;; If there are any previously scored articles, we remove these ;; from the `gnus-newsgroup-headers' list that the score functions --- 354,357 ---- *************** Returns the number of articles marked as *** 379,383 **** (if (not (file-exists-p (car kill-files))) () ! (message "Processing kill file %s..." (car kill-files)) (find-file (car kill-files)) (gnus-add-current-to-buffer-list) --- 384,388 ---- (if (not (file-exists-p (car kill-files))) () ! (gnus-message 6 "Processing kill file %s..." (car kill-files)) (find-file (car kill-files)) (gnus-add-current-to-buffer-list) *************** Returns the number of articles marked as *** 389,393 **** (gnus-kill-parse-rn-kill-file)) ! (message "Processing kill file %s...done" (car kill-files))) (setq kill-files (cdr kill-files))))) --- 394,399 ---- (gnus-kill-parse-rn-kill-file)) ! (gnus-message ! 6 "Processing kill file %s...done" (car kill-files))) (setq kill-files (cdr kill-files))))) *************** Returns the number of articles marked as *** 397,401 **** (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) (or (eq nunreads 0) ! (message "Marked %d articles as read" nunreads)) nunreads) 0)))) --- 403,407 ---- (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) (or (eq nunreads 0) ! (gnus-message 6 "Marked %d articles as read" nunreads)) nunreads) 0)))) *************** Returns the number of articles marked as *** 409,413 **** (insert string ":\n\n") (while alist ! (insert (format " %c: %s\n" (car (car alist)) (nth idx (car alist)))) (setq alist (cdr alist))))) --- 415,419 ---- (insert string ":\n\n") (while alist ! (insert (format " %c: %s\n" (caar alist) (nth idx (car alist)))) (setq alist (cdr alist))))) *************** COMMAND must be a lisp expression or a s *** 539,543 **** (not (consp (cdr (nth 2 object)))) (and (eq 'quote (car (nth 2 object))) ! (not (consp (cdr (car (cdr (nth 2 object)))))))) (concat "\n" (prin1-to-string object)) (save-excursion --- 545,549 ---- (not (consp (cdr (nth 2 object)))) (and (eq 'quote (car (nth 2 object))) ! (not (consp (cdadr (nth 2 object)))))) (concat "\n" (prin1-to-string object)) (save-excursion *************** COMMAND must be a lisp expression or a s *** 546,550 **** (erase-buffer) (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) ! (let ((klist (car (cdr (nth 2 object)))) (first t)) (while klist --- 552,556 ---- (erase-buffer) (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) ! (let ((klist (cadr (nth 2 object))) (first t)) (while klist *************** COMMAND must be a lisp expression or a s *** 581,587 **** (setq value (prin1-to-string value))) (setq did-kill (string-match regexp value))) ! (if (stringp form) ;Keyboard macro. ! (execute-kbd-macro form) ! (funcall form)))) ;; Search article body. (let ((gnus-current-article nil) ;Save article pointer. --- 587,596 ---- (setq value (prin1-to-string value))) (setq did-kill (string-match regexp value))) ! (cond ((stringp form) ;Keyboard macro. ! (execute-kbd-macro form)) ! ((gnus-functionp form) ! (funcall form)) ! (t ! (eval form))))) ;; Search article body. (let ((gnus-current-article nil) ;Save article pointer. *************** COMMAND must be a lisp expression or a s *** 589,593 **** (gnus-break-pages nil) ;No need to break pages. (gnus-mark-article-hook nil)) ;Inhibit marking as read. ! (message "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) --- 598,603 ---- (gnus-break-pages nil) ;No need to break pages. (gnus-mark-article-hook nil)) ;Inhibit marking as read. ! (gnus-message ! 6 "Searching for article: %d..." (mail-header-number header)) (gnus-article-setup-buffer) (gnus-article-prepare (mail-header-number header) t) *************** marked as read or ticked are ignored." *** 610,635 **** (let ((killed-no 0) function article header) ! (if (or (null field) (string-equal field "")) ! (setq function nil) ! ;; Get access function of header filed. ! (setq function (intern-soft (concat "gnus-header-" (downcase field)))) ! (if (and function (fboundp function)) ! (setq function (symbol-function function)) ! (error "Unknown header field: \"%s\"" field)) ! ;; Make FORM funcallable. ! (if (and (listp form) (not (eq (car form) 'lambda))) ! (setq form (list 'lambda nil form)))) ;; Starting from the current article. ! (while (or (and (not article) ! (setq article (gnus-summary-article-number)) ! t) ! (setq article ! (gnus-summary-search-subject ! backward (not ignore-marked)))) (and (or (null gnus-newsgroup-kill-headers) (memq article gnus-newsgroup-kill-headers)) ! (vectorp (setq header (gnus-get-header-by-number article))) (gnus-execute-1 function regexp form header) (setq killed-no (1+ killed-no)))) killed-no))) --- 620,655 ---- (let ((killed-no 0) function article header) ! (cond ! ;; Search body. ! ((or (null field) ! (string-equal field "")) ! (setq function nil)) ! ;; Get access function of header field. ! ((fboundp ! (setq function ! (intern-soft ! (concat "mail-header-" (downcase field))))) ! (setq function `(lambda (h) (,function h)))) ! ;; Signal error. ! (t ! (error "Unknown header field: \"%s\"" field))) ;; Starting from the current article. ! (while (or ! ;; First article. ! (and (not article) ! (setq article (gnus-summary-article-number))) ! ;; Find later articles. ! (setq article ! (gnus-summary-search-forward ! (not ignore-marked) nil backward))) (and (or (null gnus-newsgroup-kill-headers) (memq article gnus-newsgroup-kill-headers)) ! (vectorp (setq header (gnus-summary-article-header article))) (gnus-execute-1 function regexp form header) (setq killed-no (1+ killed-no)))) + ;; Return the number of killed articles. killed-no))) + (provide 'gnus-kill) + + ;;; gnus-kill.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-mh.el emacs-19.32/lisp/gnus-mh.el *** emacs-19.31/lisp/gnus-mh.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-mh.el Tue Jun 25 18:03:18 1996 *************** *** 1,5 **** ;;; gnus-mh.el --- mh-e interface for Gnus ! ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA --- 1,4 ---- ;;; gnus-mh.el --- mh-e interface for Gnus ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA *************** *** 39,42 **** --- 38,42 ---- (require 'gnus) (require 'gnus-msg) + (eval-when-compile (require 'cl)) (defun gnus-summary-save-article-folder (&optional arg) *************** Optional argument FOLDER specifies folde *** 56,208 **** (mh-find-path) (let ((folder ! (or folder ! (mh-prompt-for-folder ! "Save article in" ! (funcall gnus-folder-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-folder) ! t))) ! (errbuf (get-buffer-create " *Gnus rcvstore*"))) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-restriction ! (widen) ! (unwind-protect ! (call-process-region (point-min) (point-max) ! (expand-file-name "rcvstore" mh-lib) ! nil errbuf nil folder) ! (set-buffer errbuf) ! (if (zerop (buffer-size)) ! (message "Article saved in folder: %s" folder) ! (message "%s" (buffer-string))) ! (kill-buffer errbuf)))) ! (setq gnus-newsgroup-last-folder folder))) ! ! (defun gnus-mail-reply-using-mhe (&optional yank) ! "Compose reply mail using mh-e. ! Optional argument YANK means yank original article. ! The command \\[mh-yank-cur-msg] yank the original message into current buffer." ! (let (from cc subject date to reply-to to-userid orig-to ! references message-id ! (config (current-window-configuration)) ! buffer) ! (pop-to-buffer gnus-article-buffer) ! (setq buffer (current-buffer)) ! (save-excursion (save-restriction ! (or gnus-user-login-name ; we need this ! (setq gnus-user-login-name (or (getenv "USER") ! (getenv "LOGNAME")))) ! ! (gnus-article-show-all-headers);; so colors are happy ! ;; lots of junk to avoid mh-send deleting other windows ! (setq from (or (gnus-fetch-field "from") "") ! subject (let ((subject (or (gnus-fetch-field "subject") ! "(None)"))) ! (if (and subject ! (not (string-match "^[Rr][Ee]:.+$" subject))) ! (concat "Re: " subject) subject)) ! reply-to (gnus-fetch-field "reply-to") ! cc (gnus-fetch-field "cc") ! orig-to (or (gnus-fetch-field "to") "") ! date (gnus-fetch-field "date") ! references (gnus-fetch-field "references") ! message-id (gnus-fetch-field "message-id")) ! (setq to (or reply-to from)) ! (setq to-userid (mail-strip-quoted-names orig-to)) ! (if (or (string-match "," orig-to) ! (not (string-match (substring to-userid 0 ! (string-match "@" to-userid)) ! gnus-user-login-name))) ! (setq cc (concat (if cc (concat cc ", ") "") orig-to))) ! ;; mh-yank-cur-msg needs to have mh-show-buffer set in the ! ;; *Article* buffer ! (setq mh-show-buffer buffer))) ! ! (mh-find-path) ! (mh-send-sub (or to "") (or cc "") ! (or subject "(None)") config);; Erik Selberg 1/23/94 ! ! (let ((draft (current-buffer)) ! (gnus-mail-buffer (current-buffer)) ! mail-buf) ! (if (not yank) ! (gnus-configure-windows 'reply 'force) ! (gnus-configure-windows 'reply-yank 'force)) ! (setq mail-buf gnus-mail-buffer) ! (pop-to-buffer mail-buf);; always in the display, so won't have window probs ! (switch-to-buffer draft)) ! ! ;; (mh-send to (or cc "") subject);; shouldn't use according to mhe ! ! ;; note - current buffer is now draft! ! (save-excursion ! (mh-insert-fields ! "In-reply-to:" ! (concat ! (substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from)) ! "'s message of " date)) ! (nnheader-insert-references references message-id)) ! ! ;; need this for mh-yank-cur-msg ! (setq mh-sent-from-folder buffer) ! (setq mh-sent-from-msg 1) ! (setq mh-show-buffer buffer) ! (setq mh-previous-window-config config)) ! ! ;; Then, yank original article if requested. ! (if yank ! (let ((last (point))) ! (mh-yank-cur-msg) ! (goto-char last))) ! ! (run-hooks 'gnus-mail-hook)) ! ! ! ;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh ! ;; ! ! (defun gnus-mail-forward-using-mhe (&optional buffer) ! "Forward the current message to another user using mh-e." ! ;; First of all, prepare mhe mail buffer. ! (let* ((to (read-string "To: ")) ! (cc (read-string "Cc: ")) ! (buffer (or buffer gnus-article-buffer)) ! (config (current-window-configuration));; need to add this - erik ! (subject (gnus-forward-make-subject buffer))) ! (setq mh-show-buffer buffer) ! (mh-find-path) ! (mh-send-sub to (or cc "") (or subject "(None)") config);; Erik Selberg 1/23/94 ! (let ((draft (current-buffer)) ! (gnus-mail-buffer (current-buffer)) ! mail-buf) ! (gnus-configure-windows 'reply-yank 'force) ! (setq mail-buf (eval (cdr (assq 'mail gnus-window-to-buffer)))) ! (pop-to-buffer mail-buf);; always in the display, so won't have window probs ! (switch-to-buffer draft) ! ) ! (save-excursion ! (goto-char (point-max)) ! (insert "\n------- Forwarded Message\n\n") ! (insert-buffer buffer) ! (goto-char (point-max)) ! (insert "\n------- End of Forwarded Message\n") ! (setq mh-sent-from-folder buffer) ! (setq mh-sent-from-msg 1) ! (setq mh-previous-window-config config) ! (run-hooks 'gnus-mail-hook) ! ))) ! ! (defun gnus-mail-other-window-using-mhe () ! "Compose mail other window using mh-e." ! (let ((to (read-string "To: ")) ! (cc (read-string "Cc: ")) ! (subject (read-string "Subject: "))) ! (gnus-article-show-all-headers) ;I don't think this is really needed. ! (setq mh-show-buffer (current-buffer)) ! (mh-find-path) ! (mh-send-other-window to cc subject) ! (setq mh-sent-from-folder (current-buffer)) ! (setq mh-sent-from-msg 1) ! (run-hooks 'gnus-mail-hook))) (defun gnus-Folder-save-name (newsgroup headers &optional last-folder) --- 56,83 ---- (mh-find-path) (let ((folder ! (cond ((and (eq folder 'default) ! gnus-newsgroup-last-folder) ! gnus-newsgroup-last-folder) ! (folder folder) ! (t (mh-prompt-for-folder ! "Save article in" ! (funcall gnus-folder-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-folder) ! t)))) ! (errbuf (get-buffer-create " *Gnus rcvstore*")) ! ;; Find the rcvstore program. ! (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) ! (gnus-eval-in-buffer-window gnus-original-article-buffer (save-restriction ! (widen) ! (unwind-protect ! (call-process-region ! (point-min) (point-max) "rcvstore" nil errbuf nil folder) ! (set-buffer errbuf) ! (if (zerop (buffer-size)) ! (message "Article saved in folder: %s" folder) ! (message "%s" (buffer-string))) ! (kill-buffer errbuf)))) ! (setq gnus-newsgroup-last-folder folder))) (defun gnus-Folder-save-name (newsgroup headers &optional last-folder) *************** Otherwise, it is like +news/group." *** 225,228 **** --- 100,105 ---- newsgroup (gnus-newsgroup-directory-form newsgroup))))) + + (provide 'gnus-mh) ;;; gnus-mh.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-msg.el emacs-19.32/lisp/gnus-msg.el *** emacs-19.31/lisp/gnus-msg.el Tue Feb 20 14:21:02 1996 --- emacs-19.32/lisp/gnus-msg.el Fri Jun 28 20:17:58 1996 *************** *** 1,5 **** ;;; gnus-msg.el --- mail and post interface for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA --- 1,4 ---- ;;; gnus-msg.el --- mail and post interface for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA *************** *** 29,242 **** (require 'gnus) - (require 'sendmail) (require 'gnus-ems) ! (defvar gnus-organization-file "/usr/lib/news/organization" ! "*Local news organization file.") ! ! (defvar gnus-prepare-article-hook (list 'gnus-inews-insert-signature) ! "*A hook called after preparing body, but before preparing header headers. ! The default hook (`gnus-inews-insert-signature') inserts a signature ! file specified by the variable `gnus-signature-file'.") ! ! (defvar gnus-post-prepare-function nil ! "*Function that is run after a post buffer has been prepared. ! It is called with the name of the newsgroup that is posted to. It ! might be used, for instance, for inserting signatures based on the ! newsgroup name. (In that case, `gnus-signature-file' and ! `mail-signature' should both be set to nil).") ! ! (defvar gnus-post-prepare-hook nil ! "*Hook that is run after a post buffer has been prepared. ! If you want to insert the signature, you might put ! `gnus-inews-insert-signature' in this hook.") ! ! (defvar gnus-use-followup-to t ! "*Specifies what to do with Followup-To header. ! If nil, ignore the header. If it is t, use its value, but ignore ! `poster'. If it is the symbol `ask', query the user before posting. ! If it is the symbol `use', always use the value.") ! ! (defvar gnus-followup-to-function nil ! "*A variable that contains a function that returns a followup address. ! The function will be called in the buffer of the article that is being ! followed up. The buffer will be narrowed to the headers of the ! article. To pick header headers, one might use `mail-fetch-field'. The ! function will be called with the name of the current newsgroup as the ! argument. ! ! Here's an example `gnus-followup-to-function': ! ! (setq gnus-followup-to-function ! (lambda (group) ! (cond ((string= group \"mail.list\") ! (or (mail-fetch-field \"sender\") ! (mail-fetch-field \"from\"))) ! (t ! (or (mail-fetch-field \"reply-to\") ! (mail-fetch-field \"from\"))))))") ! ! (defvar gnus-reply-to-function nil ! "*A variable that contains a function that returns a reply address. ! See the `gnus-followup-to-function' variable for an explanation of how ! this variable is used. ! ! This function should return a string that will be used to fill in the ! header. This function may also return a list. In that case, every ! list element should be a cons where the first car should be a string ! with the header name, and the cdr should be a string with the header ! value.") ! ! (defvar gnus-author-copy (getenv "AUTHORCOPY") ! "*Save outgoing articles in this file. ! Initialized from the AUTHORCOPY environment variable. ! ! If this variable begins with the character \"|\", outgoing articles ! will be piped to the named program. It is possible to save an article ! in an MH folder as follows: ! ! \(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\") ! ! If the first character is not a pipe, articles are saved using the ! function specified by the `gnus-author-copy-saver' variable.") ! ! (defvar gnus-mail-self-blind nil ! "*Non-nil means insert a BCC header in all outgoing articles. ! This will result in having a copy of the article mailed to yourself. ! The BCC header is inserted when the post buffer is initialized, so you ! can remove or alter the BCC header to override the default.") ! ! (defvar gnus-author-copy-saver (function rmail-output) ! "*A function called to save outgoing articles. ! This function will be called with the same of the file to store the ! article in. The default function is `rmail-output' which saves in Unix ! mailbox format.") ! ! (defvar gnus-user-login-name nil ! "*The login name of the user. ! Got from the function `user-login-name' if undefined.") ! ! (defvar gnus-user-full-name nil ! "*The full name of the user. ! Got from the NAME environment variable if undefined.") ! ! (defvar gnus-user-from-line nil ! "*Your full, complete e-mail address. ! Overrides the other Gnus variables if it is non-nil. ! ! Here are two example values of this variable: ! ! \"Lars Magne Ingebrigtsen \" ! ! and ! ! \"larsi@ifi.uio.no (Lars Magne Ingebrigtsen)\" ! ! The first version is recommended, but the name has to be quoted if it ! contains non-alphanumerical characters.") ! ! (defvar gnus-signature-file "~/.signature" ! "*Your signature file. ! If the variable is a string that doesn't correspond to a file, the ! string itself is inserted.") ! ! (defvar gnus-signature-function nil ! "*A function that should return a signature file name. ! The function will be called with the name of the newsgroup being ! posted to. ! If the function returns a string that doesn't correspond to a file, the ! string itself is inserted. ! If the function returns nil, the `gnus-signature-file' variable will ! be used instead.") ! ! (defvar gnus-required-headers ! '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader) ! "*Headers to be generated or prompted for when posting an article. ! RFC977 and RFC1036 require From, Date, Newsgroups, Subject, ! Message-ID. Organization, Lines and X-Newsreader are optional. If ! you want Gnus not to insert some header, remove it from this list.") ! ! (defvar gnus-deletable-headers '(Message-ID Date) ! "*Headers to be deleted if they already exists and were generated by Gnus previously.") ! ! (defvar gnus-removable-headers '(NNTP-Posting-Host Bcc Xref) ! "*Headers to be removed unconditionally before posting.") ! ! (defvar gnus-check-before-posting ! '(subject-cmsg multiple-headers sendsys message-id from ! long-lines control-chars size new-text ! signature) ! "In non-nil, Gnus will attempt to run some checks on outgoing posts. ! If this variable is t, Gnus will check everything it can. If it is a ! list, then those elements in that list will be checked.") ! ! (defvar gnus-delete-supersedes-headers ! "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Supersedes:" ! "*Header lines matching this regexp will be deleted before posting. ! It's best to delete old Path and Date headers before posting to avoid ! any confusion.") ! ! (defvar gnus-auto-mail-to-author nil ! "*If non-nil, mail the authors of articles a copy of your follow-ups. ! If this variable is `ask', the user will be prompted for whether to ! mail a copy. The string given by `gnus-mail-courtesy-message' will be ! inserted at the beginning of the mail copy. ! ! Mail is sent using the function specified by the ! `gnus-mail-send-method' variable.") ! ! ;; Added by Ethan Bradford . ! (defvar gnus-mail-courtesy-message ! "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" ! "*This is inserted at the start of a mailed copy of a posted message. ! If this variable is nil, no such courtesy message will be added.") ! ! (defvar gnus-mail-reply-method (function gnus-mail-reply-using-mail) ! "*Function to compose a reply. ! Three pre-made functions are `gnus-mail-reply-using-mail' (sendmail); ! `gnus-mail-reply-using-mhe' (MH-E); and `gnus-mail-reply-using-vm'.") ! ! (defvar gnus-mail-forward-method (function gnus-mail-forward-using-mail) ! "*Function to forward the current message to another user. ! Three pre-made functions are `gnus-mail-forward-using-mail' (sendmail); ! `gnus-mail-forward-using-mhe' (MH-E); and `gnus-mail-forward-using-vm'.") ! ! (defvar gnus-mail-other-window-method 'gnus-mail-other-window-using-mail ! "*Function to compose mail in the other window. ! Three pre-made functions are `gnus-mail-other-window-using-mail' ! (sendmail); `gnus-mail-other-window-using-mhe' (MH-E); and ! `gnus-mail-other-window-using-vm'.") ! ! (defvar gnus-mail-send-method send-mail-function ! "*Function to mail a message which is also being posted as an article. ! The message must have To or Cc header. The default is copied from ! the variable `send-mail-function'.") ! ! (defvar gnus-inews-article-function 'gnus-inews-article ! "*Function to post an article.") ! ! (defvar gnus-inews-article-hook (list 'gnus-inews-do-fcc) ! "*A hook called before finally posting an article. ! The default hook (`gnus-inews-do-fcc') does FCC processing (ie. saves ! the article to a file).") ! ! (defvar gnus-inews-article-header-hook nil ! "*A hook called after inserting the headers in an article to be posted. ! The hook is called from the *post-news* buffer, narrowed to the ! headers.") ! (defvar gnus-mail-hook nil ! "*A hook called as the last thing after setting up a mail buffer.") ;;; Internal variables. ! (defvar gnus-post-news-buffer "*post-news*") ! (defvar gnus-mail-buffer "*mail*") ! (defvar gnus-summary-send-map nil) (defvar gnus-article-copy nil) ! (defvar gnus-reply-subject nil) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) (autoload 'rmail-output "rmailout")) --- 28,83 ---- (require 'gnus) (require 'gnus-ems) + (require 'message) + (eval-when-compile (require 'cl)) ! ;; Added by Sudish Joseph . ! (defvar gnus-post-method nil ! "*Preferred method for posting USENET news. ! If this variable is nil, Gnus will use the current method to decide ! which method to use when posting. If it is non-nil, it will override ! the current method. This method will not be used in mail groups and ! the like, only in \"real\" newsgroups. ! ! The value must be a valid method as discussed in the documentation of ! `gnus-select-method'. It can also be a list of methods. If that is ! the case, the user will be queried for what select method to use when ! posting.") ! ! (defvar gnus-outgoing-message-group nil ! "*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. ! ! 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 ! current newsgroup name and then returns a suitable group name (or list ! of names).") ! ! (defvar gnus-mailing-list-groups nil ! "*Regexp matching groups that are really mailing lists. ! This is useful when you're reading a mailing list that has been ! gatewayed to a newsgroup, and you want to followup to an article in ! the group.") ! ! (defvar gnus-sent-message-ids-file ! (nnheader-concat gnus-directory "Sent-Message-IDs") ! "File where Gnus saves a cache of sent message ids.") ! (defvar gnus-sent-message-ids-length 1000 ! "The number of sent Message-IDs to save.") ;;; Internal variables. ! (defvar gnus-message-buffer "*Mail Gnus*") (defvar gnus-article-copy nil) ! (defvar gnus-last-posting-server nil) (eval-and-compile (autoload 'gnus-uu-post-news "gnus-uu" nil t) + (autoload 'news-setup "rnewspost") + (autoload 'news-reply-mode "rnewspost") + (autoload 'rmail-dont-reply-to "mail-utils") (autoload 'rmail-output "rmailout")) *************** headers.") *** 246,275 **** ;;; ! (define-prefix-command 'gnus-summary-send-map) ! (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) ! (define-key gnus-summary-send-map "p" 'gnus-summary-post-news) ! (define-key gnus-summary-send-map "f" 'gnus-summary-followup) ! (define-key gnus-summary-send-map "F" 'gnus-summary-followup-with-original) ! (define-key gnus-summary-send-map "b" 'gnus-summary-followup-and-reply) ! (define-key gnus-summary-send-map "B" 'gnus-summary-followup-and-reply-with-original) ! (define-key gnus-summary-send-map "c" 'gnus-summary-cancel-article) ! (define-key gnus-summary-send-map "s" 'gnus-summary-supersede-article) ! (define-key gnus-summary-send-map "r" 'gnus-summary-reply) ! (define-key gnus-summary-send-map "R" 'gnus-summary-reply-with-original) ! (define-key gnus-summary-send-map "m" 'gnus-summary-mail-other-window) ! (define-key gnus-summary-send-map "u" 'gnus-uu-post-news) ! (define-key gnus-summary-send-map "om" 'gnus-summary-mail-forward) ! (define-key gnus-summary-send-map "op" 'gnus-summary-post-forward) ! (define-key gnus-summary-send-map "Om" 'gnus-uu-digest-mail-forward) ! (define-key gnus-summary-send-map "Op" 'gnus-uu-digest-post-forward) ;;; Internal functions. ! (defun gnus-number-base36 (num len) ! (if (if (< len 0) (<= num 0) (= len 0)) ! "" ! (concat (gnus-number-base36 (/ num 36) (1- len)) ! (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" ! (% num 36)))))) ;;; Post news commands of Gnus group mode and summary mode --- 87,151 ---- ;;; ! (gnus-define-keys ! (gnus-summary-send-map "S" gnus-summary-mode-map) ! "p" gnus-summary-post-news ! "f" gnus-summary-followup ! "F" gnus-summary-followup-with-original ! "c" gnus-summary-cancel-article ! "s" gnus-summary-supersede-article ! "r" gnus-summary-reply ! "R" gnus-summary-reply-with-original ! "m" gnus-summary-mail-other-window ! "u" gnus-uu-post-news ! "om" gnus-summary-mail-forward ! "op" gnus-summary-post-forward ! "Om" gnus-uu-digest-mail-forward ! "Op" gnus-uu-digest-post-forward) ! ! (gnus-define-keys ! (gnus-send-bounce-map "D" gnus-summary-send-map) ! "b" gnus-summary-resend-bounced-mail ! ; "c" gnus-summary-send-draft ! "r" gnus-summary-resend-message) ;;; Internal functions. ! (defvar gnus-article-reply nil) ! (defmacro gnus-setup-message (config &rest forms) ! (let ((winconf (make-symbol "winconf")) ! (buffer (make-symbol "buffer")) ! (article (make-symbol "article"))) ! `(let ((,winconf (current-window-configuration)) ! (,buffer (current-buffer)) ! (,article (and gnus-article-reply (gnus-summary-article-number))) ! (message-header-setup-hook ! (copy-sequence message-header-setup-hook))) ! (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) ! (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) ! ,@forms ! (gnus-inews-add-send-actions ,winconf ,buffer ,article) ! (setq gnus-message-buffer (current-buffer)) ! (gnus-configure-windows ,config t)))) ! ! (defun gnus-inews-add-send-actions (winconf buffer article) ! (gnus-make-local-hook 'message-sent-hook) ! (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) ! (setq message-post-method ! `(lambda (arg) ! (gnus-post-method arg ,gnus-newsgroup-name))) ! (setq message-newsreader (setq message-mailer (gnus-extended-version))) ! (message-add-action ! `(set-window-configuration ,winconf) 'exit 'postpone 'kill) ! (message-add-action ! `(when (buffer-name ,buffer) ! (save-excursion ! (set-buffer ,buffer) ! ,(when article ! `(gnus-summary-mark-article-as-replied ,article)))) ! 'send)) ! ! (put 'gnus-setup-message 'lisp-indent-function 1) ! (put 'gnus-setup-message 'lisp-indent-hook 1) ! (put 'gnus-setup-message 'edebug-form-spec '(form body)) ;;; Post news commands of Gnus group mode and summary mode *************** headers.") *** 278,335 **** "Start composing a mail." (interactive) ! (funcall gnus-mail-other-window-method)) ! (defun gnus-group-post-news () ! "Post an article." ! (interactive) ! (let ((gnus-newsgroup-name nil)) ! (gnus-post-news 'post nil nil gnus-article-buffer))) (defun gnus-summary-post-news () ! "Post an article." (interactive) (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) ! (defun gnus-summary-followup (yank &optional yank-articles) "Compose a followup to an article. If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive "P") (gnus-set-global-variables) ! (if yank-articles (gnus-summary-goto-subject (car yank-articles))) (save-window-excursion (gnus-summary-select-article)) ! (let ((headers (gnus-get-header-by-number (gnus-summary-article-number))) (gnus-newsgroup-name gnus-newsgroup-name)) ! ;; Check Followup-To: poster. ! (set-buffer gnus-article-buffer) ! (if (and gnus-use-followup-to ! (string-equal "poster" (gnus-fetch-field "followup-to")) ! (or (not (memq gnus-use-followup-to '(t ask))) ! (not (gnus-y-or-n-p ! "Do you want to ignore `Followup-To: poster'? ")))) ! ;; Mail to the poster. ! (gnus-summary-reply yank) ! (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer ! (or yank-articles (not (not yank))))))) ! (defun gnus-summary-followup-with-original (n) "Compose a followup to an article and include the original article." (interactive "P") ! (gnus-summary-followup t (gnus-summary-work-articles n))) ! ! ;; Suggested by Daniel Quinlan . ! (defun gnus-summary-followup-and-reply (yank &optional yank-articles) ! "Compose a followup and do an auto mail to author." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-auto-mail-to-author t)) ! (gnus-summary-followup yank yank-articles))) ! (defun gnus-summary-followup-and-reply-with-original (n) ! "Compose a followup, include the original, and do an auto mail to author." ! (interactive "P") ! (gnus-summary-followup-and-reply t (gnus-summary-work-articles n))) (defun gnus-summary-cancel-article (n) --- 154,221 ---- "Start composing a mail." (interactive) ! (gnus-setup-message 'message ! (message-mail))) ! (defun gnus-group-post-news (&optional arg) ! "Start composing a news message. ! If ARG, post to the group under point. ! If ARG is 1, prompt for a group name." ! (interactive "P") ! ;; Bind this variable here to make message mode hooks ! ;; work ok. ! (let ((gnus-newsgroup-name ! (if arg ! (if (= 1 (prefix-numeric-value arg)) ! (completing-read "Newsgroup: " gnus-active-hashtb nil ! (gnus-read-active-file-p)) ! (gnus-group-group-name)) ! ""))) ! (gnus-post-news 'post gnus-newsgroup-name))) (defun gnus-summary-post-news () ! "Start composing a news message." (interactive) (gnus-set-global-variables) (gnus-post-news 'post gnus-newsgroup-name)) ! (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 ! (gnus-summary-work-articles 1)))) (gnus-set-global-variables) ! (when yank ! (gnus-summary-goto-subject (car yank))) (save-window-excursion (gnus-summary-select-article)) ! (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) (gnus-newsgroup-name gnus-newsgroup-name)) ! ;; Send a followup. ! (gnus-post-news nil gnus-newsgroup-name ! headers gnus-article-buffer ! yank nil force-news))) ! (defun gnus-summary-followup-with-original (n &optional force-news) "Compose a followup to an article and include the original article." (interactive "P") ! (gnus-summary-followup (gnus-summary-work-articles n) force-news)) ! (defun gnus-inews-yank-articles (articles) ! (let (beg article) ! (while (setq article (pop articles)) ! (save-window-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-select-article nil nil nil article) ! (gnus-summary-remove-process-mark article)) ! (gnus-copy-article-buffer) ! (let ((message-reply-buffer gnus-article-copy) ! (message-reply-headers gnus-current-headers)) ! (message-yank-original) ! (setq beg (or beg (mark t)))) ! (when articles (insert "\n"))) ! ! (push-mark) ! (goto-char beg))) (defun gnus-summary-cancel-article (n) *************** If prefix argument YANK is non-nil, orig *** 337,348 **** (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n))) ! (while articles ! (gnus-summary-select-article t nil nil (car articles)) ! (and (gnus-eval-in-buffer-window gnus-article-buffer (gnus-cancel-news)) ! (gnus-summary-mark-as-read (car articles) gnus-canceled-mark)) ! (gnus-summary-remove-process-mark (car articles)) ! (gnus-article-hide-headers-if-wanted) ! (setq articles (cdr articles))))) (defun gnus-summary-supersede-article () --- 223,239 ---- (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n)) ! (message-post-method ! `(lambda (arg) ! (gnus-post-method nil ,gnus-newsgroup-name))) ! article) ! (while (setq article (pop articles)) ! (when (gnus-summary-select-article t nil nil article) ! (when (gnus-eval-in-buffer-window ! gnus-original-article-buffer (message-cancel-news)) ! (gnus-summary-mark-as-read article gnus-canceled-mark) ! (gnus-cache-remove-article 1)) ! (gnus-article-hide-headers-if-wanted)) ! (gnus-summary-remove-process-mark article)))) (defun gnus-summary-supersede-article () *************** header line with the old Message-ID." *** 352,395 **** (interactive) (gnus-set-global-variables) ! (gnus-summary-select-article t) ! (if (not ! (string-equal ! (downcase (mail-strip-quoted-names ! (mail-header-from gnus-current-headers))) ! (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) ! (error "This article is not yours.")) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (if (not (re-search-backward "^Message-ID: " nil t)) ! (error "No Message-ID in this article")))) ! (if (gnus-post-news 'post gnus-newsgroup-name) ! (progn ! (erase-buffer) ! (insert-buffer gnus-article-buffer) ! (if (search-forward "\n\n" nil t) ! (forward-char -1) ! (goto-char (point-max))) ! (narrow-to-region (point-min) (point)) ! (goto-char (point-min)) ! (and gnus-delete-supersedes-headers ! (delete-matching-lines gnus-delete-supersedes-headers)) ! (goto-char (point-min)) ! (if (not (re-search-forward "^Message-ID: " nil t)) ! (error "No Message-ID in this article") ! (replace-match "Supersedes: " t t)) ! (goto-char (point-max)) ! (insert mail-header-separator) ! (widen) ! (forward-line 1)))) - ;;;###autoload - (defalias 'sendnews 'gnus-post-news) - - ;;;###autoload - (defalias 'postnews 'gnus-post-news) (defun gnus-copy-article-buffer (&optional article-buffer) --- 243,257 ---- (interactive) (gnus-set-global-variables) ! (let ((article (gnus-summary-article-number))) ! (gnus-setup-message 'reply-yank ! (gnus-summary-select-article t) ! (set-buffer gnus-original-article-buffer) ! (message-supersede) ! (push ! `((lambda () ! (gnus-cache-possibly-remove-article ,article nil nil nil t))) ! message-send-actions)))) (defun gnus-copy-article-buffer (&optional article-buffer) *************** header line with the old Message-ID." *** 402,1203 **** (or (memq gnus-article-copy gnus-buffer-list) (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) ! (let ((article-buffer (or article-buffer gnus-article-buffer))) ! (if (and (get-buffer article-buffer) ! (buffer-name (get-buffer article-buffer))) ! (save-excursion ! (set-buffer article-buffer) (widen) ! (copy-to-buffer gnus-article-copy (point-min) (point-max)) ! (set-text-properties (point-min) (point-max) ! nil gnus-article-copy))))) ! ! ;;;###autoload ! (defun gnus-post-news (post &optional group header article-buffer yank subject) ! "Begin editing a new USENET news article to be posted. ! Type \\[describe-mode] in the buffer to get a list of commands." ! (interactive (list t)) ! (gnus-copy-article-buffer article-buffer) ! (if (or (not gnus-novice-user) ! gnus-expert-user ! (not (eq 'post ! (nth 1 (assoc ! (format "%s" (car (gnus-find-method-for-group ! gnus-newsgroup-name))) ! gnus-valid-select-methods)))) ! (and group ! (assq 'to-address ! (nth 5 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))) ! (gnus-y-or-n-p "Are you sure you want to post to all of USENET? ")) ! (let ((sumart (if (not post) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (cons (current-buffer) gnus-current-article)))) ! (from (and header (mail-header-from header))) ! (winconf (current-window-configuration)) ! real-group) ! (and gnus-interactive-post ! (not gnus-expert-user) ! post (not group) ! (progn ! (setq gnus-newsgroup-name ! (setq group ! (completing-read "Group: " gnus-active-hashtb))) ! (or subject ! (setq subject (read-string "Subject: "))))) ! (setq mail-reply-buffer gnus-article-copy) ! ! (let ((newsgroup-name (or group gnus-newsgroup-name ""))) ! (setq real-group (and group (gnus-group-real-name group))) ! (setq gnus-post-news-buffer ! (gnus-request-post-buffer ! post real-group subject header gnus-article-copy ! (nth 2 (and group (gnus-gethash group gnus-newsrc-hashtb))) ! (or (cdr (assq 'to-group ! (nth 5 (nth 2 (gnus-gethash ! newsgroup-name ! gnus-newsrc-hashtb))))) ! (if (and (boundp 'gnus-followup-to-function) ! gnus-followup-to-function ! gnus-article-copy) ! (save-excursion ! (set-buffer gnus-article-copy) ! (funcall gnus-followup-to-function group)))) ! gnus-use-followup-to)) (if post - (gnus-configure-windows 'post 'force) - (if yank - (gnus-configure-windows 'followup-yank 'force) - (gnus-configure-windows 'followup 'force))) - (gnus-overload-functions) - (make-local-variable 'gnus-article-reply) - (make-local-variable 'gnus-article-check-size) - (make-local-variable 'gnus-reply-subject) - (setq gnus-reply-subject (and header (mail-header-subject header))) - (setq gnus-article-reply sumart) - ;; Handle `gnus-auto-mail-to-author'. - ;; Suggested by Daniel Quinlan . - ;; Revised to respect Reply-To by Ulrik Dickow . - (let ((to (and (not post) - (if (if (eq gnus-auto-mail-to-author 'ask) - (y-or-n-p "Also send mail to author? ") - gnus-auto-mail-to-author) - (or (save-excursion - (set-buffer gnus-article-copy) - (gnus-fetch-field "reply-to")) - from))))) - (if to - (if (mail-fetch-field "To") - (progn - (beginning-of-line) - (insert "Cc: " to "\n")) - (mail-position-on-field "To") - (insert to)))) - ;; Handle author copy using BCC field. - (if (and gnus-mail-self-blind - (not (mail-fetch-field "bcc"))) (progn ! (mail-position-on-field "Bcc") ! (insert (if (stringp gnus-mail-self-blind) ! gnus-mail-self-blind ! (user-login-name))))) ! ;; Handle author copy using FCC field. ! (if gnus-author-copy ! (progn ! (mail-position-on-field "Fcc") ! (insert gnus-author-copy))) ! (goto-char (point-min)) ! (if post ! (cond ((not group) ! (re-search-forward "^Newsgroup:" nil t) ! (end-of-line)) ! ((not subject) ! (re-search-forward "^Subject:" nil t) ! (end-of-line)) ! (t ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line 1))) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line 1) ! (if (not yank) ! () ! (save-excursion ! (if (not (listp yank)) ! (news-reply-yank-original nil) ! (setq yank (reverse yank)) ! (while yank ! (save-excursion ! (save-window-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-select-article nil nil nil (car yank)) ! (gnus-summary-remove-process-mark (car yank))) ! (let ((mail-reply-buffer gnus-article-copy)) ! (gnus-copy-article-buffer) ! (let ((news-reply-yank-message-id ! (save-excursion ! (set-buffer gnus-article-copy) ! (mail-fetch-field "message-id"))) ! (news-reply-yank-from ! (save-excursion ! (set-buffer gnus-article-copy) ! (mail-fetch-field "from")))) ! (news-reply-yank-original nil)) ! (setq yank (cdr yank))))))))) ! (if gnus-post-prepare-function ! (funcall gnus-post-prepare-function group)) ! (run-hooks 'gnus-post-prepare-hook) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf)))) ! (setq gnus-article-check-size (cons (buffer-size) (gnus-article-checksum))) ! (message "") ! t) ! ! (defun gnus-inews-news (&optional use-group-method) ! "Send a news message. ! If given a prefix, and the group is a foreign group, this function ! will attempt to use the foreign server to post the article." ! (interactive "P") ! (or gnus-current-select-method ! (setq gnus-current-select-method gnus-select-method)) ! (let* ((case-fold-search nil) ! (server-running (gnus-server-opened gnus-current-select-method)) ! (reply gnus-article-reply) ! error post-result) ! (save-excursion ! ;; Connect to default NNTP server if necessary. ! ;; Suggested by yuki@flab.fujitsu.junet. ! (gnus-start-news-server) ;Use default server. ! ;; NNTP server must be opened before current buffer is modified. ! (widen) ! (goto-char (point-min)) ! (run-hooks 'news-inews-hook) ! (save-restriction ! (narrow-to-region ! (point-min) ! (progn ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (match-beginning 0))) ! ! ;; Correct newsgroups field: change sequence of spaces to comma and ! ;; eliminate spaces around commas. Eliminate embedded line breaks. ! (goto-char (point-min)) ! (if (re-search-forward "^Newsgroups: +" nil t) ! (save-restriction ! (narrow-to-region ! (point) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (forward-line 1) ! (point))) ! (goto-char (point-min)) ! (while (re-search-forward "\n[ \t]+" nil t) ! (replace-match " " t t)) ;No line breaks (too confusing) ! (goto-char (point-min)) ! (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) ! (replace-match "," t t)) ! (goto-char (point-min)) ! ;; Remove a trailing comma. ! (if (re-search-forward ",$" nil t) ! (replace-match "" t t)))) ! ! ;; Added by Per Abrahamsen . ! ;; Help save the the world! ! (or ! gnus-expert-user ! (let ((newsgroups (mail-fetch-field "newsgroups")) ! (followup-to (mail-fetch-field "followup-to")) ! groups to) ! (if (and newsgroups ! (string-match "," newsgroups) (not followup-to)) ! (progn ! (while (string-match "," newsgroups) ! (setq groups ! (cons (list (substring newsgroups ! 0 (match-beginning 0))) ! groups)) ! (setq newsgroups (substring newsgroups (match-end 0)))) ! (setq groups (nreverse (cons (list newsgroups) groups))) ! ! (setq to ! (completing-read "Followups to: (default all groups) " ! groups)) ! (if (> (length to) 0) ! (progn ! (goto-char (point-min)) ! (insert "Followup-To: " to "\n"))))))) ! ! ;; Cleanup Followup-To. ! (goto-char (point-min)) ! (if (search-forward-regexp "^Followup-To: +" nil t) ! (save-restriction ! (narrow-to-region ! (point) ! (if (re-search-forward "^[^ \t]" nil 'end) ! (match-beginning 0) ! (point-max))) ! (goto-char (point-min)) ! (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) ! (goto-char (point-min)) ! (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ","))) ! ! ;; Mail the message too if To:, Bcc:. or Cc: exists. ! (let* ((types '("to" "bcc" "cc")) ! (ty types) ! fcc-line) ! (while ty ! (or (mail-fetch-field (car ty) nil t) ! (setq types (delete (car ty) types))) ! (setq ty (cdr ty))) ! ! (if (not types) ! ;; We do not want to send mail. ! () ! (if (not gnus-mail-send-method) ! (progn ! (ding) ! (gnus-message ! 1 "No mailer defined. To: and/or Cc: fields ignored.") ! (sit-for 1)) ! (save-excursion ! ;; We want to remove Fcc, because we want to handle ! ;; that one ourselves... ! ! (goto-char (point-min)) ! (if (re-search-forward "^Fcc: " nil t) ! (progn ! (setq fcc-line ! (buffer-substring ! (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point)))) ! (forward-line -1) ! (gnus-delete-line))) ! ! ;; We generate a Message-ID so that the mail and the ! ;; news copy of the message both get the same ID. ! (or (mail-fetch-field "message-id") ! (not (memq 'Message-ID gnus-required-headers)) ! (progn ! (goto-char (point-max)) ! (insert "Message-ID: " (gnus-inews-message-id) "\n"))) ! (save-restriction ! (widen) ! (gnus-message 5 "Sending via mail...") ! (if (and gnus-mail-courtesy-message ! (or (member "to" types) ! (member "cc" types))) ! ;; We only want to insert the courtesy mail ! ;; message if we use to or cc; bcc should not ! ;; have one. Well, if both bcc and to are ! ;; present, it will get one anyway. ! (progn ! ;; Insert "courtesy" mail message. ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote ! mail-header-separator) "$")) ! (forward-line 1) ! (insert gnus-mail-courtesy-message) ! (funcall gnus-mail-send-method) ! (goto-char (point-min)) ! (search-forward gnus-mail-courtesy-message) ! (replace-match "" t t)) ! (funcall gnus-mail-send-method)) ! ! (gnus-message 5 "Sending via mail...done") ! ! (goto-char (point-min)) ! (narrow-to-region ! (point) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$"))) ! (goto-char (point-min)) ! (while (re-search-forward "^BCC:" nil t) ! (delete-region (match-beginning 0) ! ;; There might be continuation headers. ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! ;; Uhm... or something like this. ! (forward-line 1) ! (point))))) ! (if fcc-line ! (progn ! (goto-char (point-max)) ! (insert fcc-line)))))))) ! ! ;; Send to server. ! (gnus-message 5 "Posting to USENET...") ! (setq post-result (funcall gnus-inews-article-function use-group-method)) ! (cond ((eq post-result 'illegal) ! (setq error t) ! (ding)) ! (post-result ! (gnus-message 5 "Posting to USENET...done") ! (if (gnus-buffer-exists-p (car-safe reply)) ! (progn ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-mark-article-as-replied ! (cdr reply))))) ! (set-buffer-modified-p nil)) ! (t ! ;; We cannot signal an error. ! (setq error t) ! (ding) ! (gnus-message 1 "Article rejected: %s" ! (gnus-status-message gnus-select-method))))) ! ;; If NNTP server is opened by gnus-inews-news, close it by myself. ! (or server-running ! (gnus-close-server (gnus-find-method-for-group gnus-newsgroup-name))) ! (let ((conf gnus-prev-winconf)) ! (if (not error) ! (progn ! (bury-buffer) ! ;; Restore last window configuration. ! (and conf (set-window-configuration conf))))))) ! ! (defun gnus-inews-check-post () ! "Check whether the post looks ok." ! (or ! (not gnus-check-before-posting) ! (and ! ;; We narrow to the headers and check them first. ! (save-excursion ! (save-restriction ! (goto-char (point-min)) ! (narrow-to-region ! (point) ! (progn ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (match-beginning 0))) ! (goto-char (point-min)) ! (and ! ;; Check for commands in Subject. ! (or ! (gnus-check-before-posting 'subject-cmsg) ! (save-excursion ! (if (string-match "^cmsg " (mail-fetch-field "subject")) ! (gnus-y-or-n-p ! "The control code \"cmsg \" is in the subject. Really post? ") ! t))) ! ;; Check for multiple identical headers. ! (or (gnus-check-before-posting 'multiple-headers) ! (save-excursion ! (let (found) ! (while (and (not found) (re-search-forward "^[^ \t:]+: " ! nil t)) ! (save-excursion ! (or (re-search-forward ! (concat "^" (setq found ! (buffer-substring ! (match-beginning 0) ! (- (match-end 0) 2)))) ! nil t) ! (setq found nil)))) ! (if found ! (gnus-y-or-n-p ! (format "Multiple %s headers. Really post? " found)) ! t)))) ! ;; Check for version and sendsys. ! (or (gnus-check-before-posting 'sendsys) ! (save-excursion ! (if (re-search-forward "^Sendsys:\\|^Version:" nil t) ! (gnus-y-or-n-p ! (format "The article contains a %s command. Really post? " ! (buffer-substring (match-beginning 0) ! (1- (match-end 0))))) ! t))) ! ;; Check the Message-Id header. ! (or (gnus-check-before-posting 'message-id) ! (save-excursion ! (let* ((case-fold-search t) ! (message-id (mail-fetch-field "message-id"))) ! (or (not message-id) ! (and (string-match "@" message-id) ! (string-match "@[^\\.]*\\." message-id)) ! (gnus-y-or-n-p ! (format ! "The Message-ID looks strange: \"%s\". Really post? " ! message-id)))))) ! ;; Check the From header. ! (or (gnus-check-before-posting 'from) ! (save-excursion ! (let* ((case-fold-search t) ! (from (mail-fetch-field "from"))) ! (cond ! ((not from) ! (gnus-y-or-n-p "There is no From line. Really post? ")) ! ((not (string-match "@[^\\.]*\\." from)) ! (gnus-y-or-n-p ! (format ! "The address looks strange: \"%s\". Really post? " from))) ! ((string-match "(.*).*(.*)" from) ! (gnus-y-or-n-p ! (format ! "The From header looks strange: \"%s\". Really post? " ! from))) ! (t t))))) ! ))) ! ;; Check for long lines. ! (or (gnus-check-before-posting 'long-lines) ! (save-excursion ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (while (and ! (progn ! (end-of-line) ! (< (current-column) 80)) ! (zerop (forward-line 1)))) ! (or (bolp) ! (eobp) ! (gnus-y-or-n-p ! (format ! "You have lines longer than 79 characters. Really post? "))))) ! ;; Check for control characters. ! (or (gnus-check-before-posting 'control-chars) ! (save-excursion ! (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) ! (gnus-y-or-n-p ! "The article contains control characters. Really post? ") ! t))) ! ;; Check excessive size. ! (or (gnus-check-before-posting 'size) ! (if (> (buffer-size) 60000) ! (gnus-y-or-n-p ! (format "The article is %d octets long. Really post? " ! (buffer-size))) ! t)) ! ;; Use the (size . checksum) variable to see whether the ! ;; article is empty or has only quoted text. ! (or ! (gnus-check-before-posting 'new-text) ! (if (and (= (buffer-size) (car gnus-article-check-size)) ! (= (gnus-article-checksum) (cdr gnus-article-check-size))) ! (gnus-y-or-n-p ! "It looks like there's no new text in your article. Really post? ") ! t)) ! ;; Check the length of the signature. ! (or (gnus-check-before-posting 'signature) ! (progn ! (goto-char (point-max)) ! (if (not (re-search-backward gnus-signature-separator nil t)) ! t ! (if (> (count-lines (point) (point-max)) 5) ! (gnus-y-or-n-p ! (format ! "Your .sig is %d lines; it should be max 4. Really post? " ! (count-lines (point) (point-max)))) ! t))))))) ! (defun gnus-article-checksum () ! (let ((sum 0)) ! (save-excursion ! (while (not (eobp)) ! (setq sum (logxor sum (following-char))) ! (forward-char 1))) ! sum)) ! ! ;; Returns non-nil if this type is not to be checked. ! (defun gnus-check-before-posting (type) ! (not ! (or (not gnus-check-before-posting) ! (if (listp gnus-check-before-posting) ! (memq type gnus-check-before-posting) ! t)))) ! ! (defun gnus-cancel-news () ! "Cancel an article you posted." ! (interactive) ! (if (or gnus-expert-user ! (gnus-yes-or-no-p "Do you really want to cancel this article? ")) ! (let ((from nil) ! (newsgroups nil) ! (message-id nil) ! (distribution nil)) ! (or (gnus-member-of-valid 'post gnus-newsgroup-name) ! (error "This backend does not support canceling")) ! (save-excursion ! ;; Get header info. from original article. ! (save-restriction ! (gnus-article-show-all-headers) ! (goto-char (point-min)) ! (search-forward "\n\n" nil 'move) ! (narrow-to-region (point-min) (point)) ! (setq from (mail-fetch-field "from")) ! (setq newsgroups (mail-fetch-field "newsgroups")) ! (setq message-id (mail-fetch-field "message-id")) ! (setq distribution (mail-fetch-field "distribution"))) ! ;; Verify if the article is absolutely user's by comparing ! ;; user id with value of its From: field. ! (if (not ! (string-equal ! (downcase (mail-strip-quoted-names from)) ! (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) ! (progn ! (ding) (gnus-message 3 "This article is not yours.") ! nil) ! ;; Make control article. ! (set-buffer (get-buffer-create " *Gnus-canceling*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (insert "Newsgroups: " newsgroups "\n" ! "Subject: cancel " message-id "\n" ! "Control: cancel " message-id "\n" ! (if distribution ! (concat "Distribution: " distribution "\n") ! "") ! mail-header-separator "\n" ! "This is a cancel message from " from ".\n") ! ;; Send the control article to NNTP server. ! (gnus-message 5 "Canceling your article...") ! (prog1 ! (if (funcall gnus-inews-article-function) ! (gnus-message 5 "Canceling your article...done") ! (progn ! (ding) ! (gnus-message 1 "Cancel failed; %s" ! (gnus-status-message gnus-newsgroup-name)) ! nil) ! t) ! ;; Kill the article buffer. ! (kill-buffer (current-buffer)))))))) - ;;; Lowlevel inews interface ! (defun gnus-inews-article (&optional use-group-method) ! "Post an article in current buffer using NNTP protocol." ! (let ((artbuf (current-buffer)) ! (tmpbuf (get-buffer-create " *Gnus-posting*"))) ! (widen) ! (goto-char (point-max)) ! ;; require a newline at the end for inews to append .signature to ! (or (= (preceding-char) ?\n) ! (insert ?\n)) ! ;; Prepare article headers. All message body such as signature ! ;; must be inserted before Lines: field is prepared. ! (save-restriction ! (goto-char (point-min)) ! (narrow-to-region ! (point-min) ! (save-excursion ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (match-beginning 0))) ! (gnus-inews-remove-headers) ! (gnus-inews-insert-headers) ! (run-hooks 'gnus-inews-article-header-hook) ! (widen)) ! ;; Check whether the article is a good Net Citizen. ! (if (and gnus-article-check-size ! (not (gnus-inews-check-post))) ! ;; Aber nein! ! 'illegal ! ;; Looks ok, so we do the nasty. ! (save-excursion ! (set-buffer tmpbuf) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (insert-buffer-substring artbuf) ! ;; Remove the header separator. ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (replace-match "" t t) ! ;; This hook may insert a signature. ! (save-excursion ! (goto-char (point-min)) ! (let ((gnus-newsgroup-name (or (mail-fetch-field "newsgroups") ! gnus-newsgroup-name))) ! (run-hooks 'gnus-prepare-article-hook))) ! ;; Run final inews hooks. This hook may do FCC. ! ;; The article must be saved before being posted because ! ;; `gnus-request-post' modifies the buffer. ! (run-hooks 'gnus-inews-article-hook) ! ;; Post an article to NNTP server. ! ;; Return NIL if post failed. ! (prog1 ! (gnus-request-post ! (if use-group-method ! (gnus-find-method-for-group gnus-newsgroup-name) ! gnus-select-method) use-group-method) ! (kill-buffer (current-buffer))))))) ! ! (defun gnus-inews-remove-headers () ! (let ((case-fold-search t) ! (headers gnus-removable-headers)) ! ;; Remove toxic headers. ! (while headers ! (goto-char (point-min)) ! (and (re-search-forward ! (concat "^" (downcase (format "%s" (car headers)))) ! nil t) ! (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point)))) ! (setq headers (cdr headers))))) ! ! (defun gnus-inews-insert-headers () ! "Prepare article headers. ! Headers already prepared in the buffer are not modified. ! Headers in `gnus-required-headers' will be generated." ! (let ((Date (gnus-inews-date)) ! (Message-ID (gnus-inews-message-id)) ! (Organization (gnus-inews-organization)) ! (From (gnus-inews-user-name)) ! (Path (gnus-inews-path)) ! (Subject nil) ! (Newsgroups nil) ! (Distribution nil) ! (Lines (gnus-inews-lines)) ! (X-Newsreader gnus-version) ! (headers gnus-required-headers) ! (case-fold-search t) ! header value elem) ! ;; First we remove any old generated headers. ! (let ((headers gnus-deletable-headers)) ! (while headers ! (goto-char (point-min)) ! (and (re-search-forward ! (concat "^" (symbol-name (car headers)) ": *") nil t) ! (get-text-property (1+ (match-beginning 0)) 'gnus-deletable) ! (gnus-delete-line)) ! (setq headers (cdr headers)))) ! ;; If there are References, and no "Re: ", then the thread has ! ;; changed name. See Son-of-1036. ! (if (and (mail-fetch-field "references") ! (get-buffer gnus-article-buffer)) ! (let ((psubject (gnus-simplify-subject-re ! (mail-fetch-field "subject")))) ! (or (and psubject gnus-reply-subject ! (string= (gnus-simplify-subject-re gnus-reply-subject) ! psubject)) ! (progn ! (string-match "@" Message-ID) ! (setq Message-ID ! (concat (substring Message-ID 0 (match-beginning 0)) ! "_-_" ! (substring Message-ID (match-beginning 0)))))))) ! ;; 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. ! (while headers ! (goto-char (point-min)) ! (setq elem (car headers)) ! (if (consp elem) ! (setq header (car elem)) ! (setq header elem)) ! (if (or (not (re-search-forward ! (concat "^" (downcase (symbol-name header)) ":") nil t)) ! (progn ! ;; The header was found. We insert a space after the ! ;; colon, if there is none. ! (if (/= (following-char) ? ) (insert " ")) ! ;; Find out whether the header is empty... ! (looking-at "[ \t]*$"))) ! ;; So we find out what value we should insert. ! (progn ! (setq value ! (or (if (consp elem) ! ;; The element is a cons. Either the cdr is ! ;; a string to be inserted verbatim, or it ! ;; is a function, and we insert the value ! ;; returned from this function. ! (or (and (stringp (cdr elem)) (cdr elem)) ! (and (fboundp (cdr elem)) (funcall (cdr elem)))) ! ;; The element is a symbol. We insert the ! ;; value of this symbol, if any. ! (and (boundp header) (symbol-value header))) ! ;; We couldn't generate a value for this header, ! ;; so we just ask the user. ! (read-from-minibuffer ! (format "Empty header for %s; enter value: " header)))) ! ;; Finally insert the header. ! (save-excursion ! (if (bolp) ! (progn ! (goto-char (point-max)) ! (insert (symbol-name header) ": " value "\n") ! (forward-line -1)) ! (replace-match value t t)) ! ;; Add the deletable property to the headers that require it. ! (and (memq header gnus-deletable-headers) ! (progn (beginning-of-line) (looking-at "[^:]+: ")) ! (add-text-properties ! (point) (match-end 0) ! '(gnus-deletable t face italic) (current-buffer)))))) ! (setq headers (cdr headers))) ! ;; Insert new Sender if the From is strange. ! (let ((from (mail-fetch-field "from")) ! (sender (mail-fetch-field "sender"))) ! (if (and from ! (not (string= ! (downcase ! (car (cdr (gnus-extract-address-components from)))) ! (downcase (gnus-inews-real-user-address)))) ! (or (null sender) ! (not ! (string= ! (downcase ! (car (cdr (gnus-extract-address-components sender)))) ! (downcase (gnus-inews-real-user-address)))))) ! (progn ! (goto-char (point-min)) ! (and (re-search-forward "^Sender:" nil t) ! (progn ! (beginning-of-line) ! (insert "Original-") ! (beginning-of-line))) ! (insert "Sender: " (gnus-inews-real-user-address) "\n")))))) ! ! ! (defun gnus-inews-insert-signature () ! "Insert a signature file. ! If `gnus-signature-function' is bound and returns a string, this ! string is used instead of the variable `gnus-signature-file'. ! In either case, if the string is a file name, this file is ! inserted. If the string is not a file name, the string itself is ! inserted. ! If you never want any signature inserted, set both of these variables to ! nil." ! (save-excursion ! (let ((signature ! (or (and gnus-signature-function ! (funcall gnus-signature-function gnus-newsgroup-name)) ! gnus-signature-file))) ! (if (and signature ! (or (file-exists-p signature) ! (string-match " " signature) ! (not (string-match ! "^/[^/]+/" (expand-file-name signature))))) ! (progn ! (goto-char (point-max)) ! (if (and mail-signature (search-backward "\n-- \n" nil t)) ! () ! ;; Delete any previous signatures. ! (if (search-backward "\n-- \n" nil t) ! (delete-region (point) (point-max))) ! (or (eolp) (insert "\n")) ! (insert "-- \n") ! (if (file-exists-p signature) ! (insert-file-contents signature) ! (insert signature)) ! (goto-char (point-max)) ! (or (bolp) (insert "\n")))))))) ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () ! (let ((mail-header-separator "")) (or (mail-position-on-field "Mime-Version") (insert "1.0") ! (cond ((save-excursion ! (beginning-of-buffer) (re-search-forward "[\200-\377]" nil t)) (or (mail-position-on-field "Content-Type") --- 264,483 ---- (or (memq gnus-article-copy gnus-buffer-list) (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list))) ! (let ((article-buffer (or article-buffer gnus-article-buffer)) ! end beg contents) ! (when (and (get-buffer article-buffer) ! (buffer-name (get-buffer article-buffer))) ! (save-excursion ! (set-buffer article-buffer) ! (save-restriction (widen) ! (setq contents (format "%s" (buffer-string))) ! (set-buffer gnus-original-article-buffer) ! (goto-char (point-min)) ! (while (looking-at message-unix-mail-delimiter) ! (forward-line 1)) ! (setq beg (point)) ! (setq end (or (search-forward "\n\n" nil t) (point))) ! (set-buffer gnus-article-copy) ! (erase-buffer) ! (insert contents) ! (delete-region (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point))) ! (insert-buffer-substring gnus-original-article-buffer beg end))) ! gnus-article-copy))) ! ! (defun gnus-post-news (post &optional group header article-buffer yank subject ! force-news) ! (when article-buffer ! (gnus-copy-article-buffer)) ! (let ((gnus-article-reply article-buffer)) ! (gnus-setup-message (cond (yank 'reply-yank) ! (article-buffer 'reply) ! (t 'message)) ! (let* ((group (or group gnus-newsgroup-name)) ! (pgroup group) ! to-address to-group mailing-list to-list) ! (when group ! (setq to-address (gnus-group-get-parameter group 'to-address) ! to-group (gnus-group-get-parameter group 'to-group) ! to-list (gnus-group-get-parameter group 'to-list) ! mailing-list (when gnus-mailing-list-groups ! (string-match gnus-mailing-list-groups group)) ! group (gnus-group-real-name group))) ! (if (or (and to-group ! (gnus-news-group-p to-group)) ! force-news ! (and (gnus-news-group-p ! (or pgroup gnus-newsgroup-name) ! (if header (mail-header-number header) ! gnus-current-article)) ! (not mailing-list) ! (not to-list) ! (not to-address))) ! ;; This is news. ! (if post ! (message-news (or to-group group)) ! (set-buffer gnus-article-copy) ! (message-followup)) ! ;; The is mail. (if post (progn ! (message-mail (or to-address to-list)) ! ;; Arrange for mail groups that have no `to-address' to ! ;; get that when the user sends off the mail. ! (push (list 'gnus-inews-add-to-address group) ! message-send-actions)) ! (set-buffer gnus-article-copy) ! (message-wide-reply to-address))) ! (when yank ! (gnus-inews-yank-articles yank)))))) ! ! (defun gnus-post-method (arg group &optional silent) ! "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 ! ;; the default method. ! ((null arg) ! (or gnus-post-method gnus-select-method message-post-method)) ! ;; We want this group's method. ! ((and arg (not (eq arg 0))) ! group-method) ! ;; We query the user for a post method. ! ((or arg ! (and gnus-post-method ! (listp (car gnus-post-method)))) ! (let* ((methods ! ;; Collect all methods we know about. ! (append ! (when gnus-post-method ! (if (listp (car gnus-post-method)) ! gnus-post-method ! (list gnus-post-method))) ! gnus-secondary-select-methods ! (list gnus-select-method) ! (list group-method))) ! method-alist post-methods method) ! ;; Weed out all mail methods. ! (while methods ! (setq method (gnus-server-get-method "" (pop methods))) ! (when (or (gnus-method-option-p method 'post) ! (gnus-method-option-p method 'post-mail)) ! (push method post-methods))) ! ;; Create a name-method alist. ! (setq method-alist ! (mapcar ! (lambda (m) ! (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) ! post-methods)) ! ;; Query the user. ! (cadr ! (assoc ! (setq gnus-last-posting-server ! (if (and silent ! gnus-last-posting-server) ! ;; Just use the last value. ! gnus-last-posting-server ! (completing-read ! "Posting method: " method-alist nil t ! (cons (or gnus-last-posting-server "") 0)))) ! method-alist)))) ! ;; Override normal method. ! ((and gnus-post-method ! (or (gnus-method-option-p group-method 'post) ! (gnus-method-option-p group-method 'post-mail))) ! gnus-post-method) ! ;; Perhaps this is a mail group? ! ((and (not (gnus-member-of-valid 'post group)) ! (not (gnus-method-option-p group-method 'post-mail))) ! group-method) ! ;; Use the normal select method. ! (t gnus-select-method)))) ! ! (defun gnus-inews-narrow-to-headers () ! (widen) ! (narrow-to-region ! (goto-char (point-min)) ! (or (and (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$") nil t) ! (match-beginning 0)) ! (point-max))) ! (goto-char (point-min))) ! ;;; ! ;;; Check whether the message has been sent already. ! ;;; ! (defvar gnus-inews-sent-ids nil) ! (defun gnus-inews-reject-message () ! "Check whether this message has already been sent." ! (when gnus-sent-message-ids-file ! (let ((message-id (save-restriction (gnus-inews-narrow-to-headers) ! (mail-fetch-field "message-id"))) ! end) ! (when message-id ! (unless gnus-inews-sent-ids ! (condition-case () ! (load t t t) ! (error nil))) ! (if (member message-id gnus-inews-sent-ids) ! ;; Reject this message. ! (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 ! gnus-inews-sent-ids)) ! (setcdr end nil)) ! (nnheader-temp-write gnus-sent-message-ids-file ! (prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids) ! (current-buffer))) ! nil))))) ! ;; Dummy to avoid byte-compile warning. ! (defvar nnspool-rejected-article-hook) ! ;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might ! ;;; as well include the Emacs version as well. ! ;;; The following function works with later GNU Emacs, and XEmacs. ! (defun gnus-extended-version () ! "Stringified Gnus version and Emacs version" ! (interactive) ! (concat ! gnus-version ! "/" ! (cond ! ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) ! (concat "Emacs " (substring emacs-version ! (match-beginning 1) ! (match-end 1)))) ! ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version) ! (concat (substring emacs-version ! (match-beginning 1) ! (match-end 1)) ! (format " %d.%d" emacs-major-version emacs-minor-version))) ! (t emacs-version)))) ;; Written by "Mr. Per Persson" . (defun gnus-inews-insert-mime-headers () ! (goto-char (point-min)) ! (let ((mail-header-separator ! (progn ! (goto-char (point-min)) ! (if (and (search-forward (concat "\n" mail-header-separator "\n") ! nil t) ! (not (search-backward "\n\n" nil t))) ! mail-header-separator ! "")))) (or (mail-position-on-field "Mime-Version") (insert "1.0") ! (cond ((save-restriction ! (widen) ! (goto-char (point-min)) (re-search-forward "[\200-\377]" nil t)) (or (mail-position-on-field "Content-Type") *************** nil." *** 1210,1433 **** (insert "7bit"))))))) - (defun gnus-inews-do-fcc () - "Process FCC: fields in current article buffer. - Unless the first character of the field is `|', the article is saved - to the specified file using the function specified by the variable - gnus-author-copy-saver. The default function rmail-output saves in - Unix mailbox format. - If the first character is `|', the contents of the article is send to - a program specified by the rest of the value." - (let ((fcc-list nil) - (fcc-file nil) - (case-fold-search t)) ;Should ignore case. - (save-excursion - (save-restriction - (goto-char (point-min)) - (search-forward "\n\n") - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (re-search-forward "^FCC:[ \t]*" nil t) - (setq fcc-list - (cons (buffer-substring - (point) - (progn - (end-of-line) - (skip-chars-backward " \t") - (point))) - fcc-list)) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - ;; Process FCC operations. - (widen) - (while fcc-list - (setq fcc-file (car fcc-list)) - (setq fcc-list (cdr fcc-list)) - (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) - (let ((program (substring fcc-file - (match-beginning 1) (match-end 1)))) - ;; Suggested by yuki@flab.fujitsu.junet. - ;; Send article to named program. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil "-c" program))) - (t - ;; Suggested by hyoko@flab.fujitsu.junet. - ;; Save article in Unix mail format by default. - (gnus-make-directory (file-name-directory fcc-file)) - (if (and gnus-author-copy-saver - (not (eq gnus-author-copy-saver 'rmail-output))) - (funcall gnus-author-copy-saver fcc-file) - (if (and (file-readable-p fcc-file) - (mail-file-babyl-p fcc-file)) - (gnus-output-to-rmail fcc-file) - (rmail-output fcc-file 1 t t)))))))))) - - (defun gnus-inews-path () - "Return uucp path." - (let ((login-name (gnus-inews-login-name))) - (cond ((null gnus-use-generic-path) - (concat (nth 1 gnus-select-method) "!" login-name)) - ((stringp gnus-use-generic-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat gnus-use-generic-path "!" login-name)) - (t login-name)))) - - (defun gnus-inews-user-name () - "Return user's network address as \"NAME@DOMAIN (FULL-NAME)\"." - (let ((full-name (gnus-inews-full-name)) - (address (if (or gnus-user-login-name gnus-use-generic-from - gnus-local-domain (getenv "DOMAINNAME")) - (concat (gnus-inews-login-name) "@" - (gnus-inews-domain-name gnus-use-generic-from)) - user-mail-address))) - (or gnus-user-from-line - (concat address - ;; User's full name. - (cond ((string-equal full-name "&") ;Unix hack. - (concat " (" (user-login-name) ")")) - ((string-match "[^ ]+@[^ ]+ +(.*)" address) - "") - (t - (concat " (" full-name ")"))))))) - - (defun gnus-inews-real-user-address () - "Return the \"real\" user address. - This function tries to ignore all user modifications, and - give as trustworthy answer as possible." - (concat (user-login-name) "@" (gnus-inews-full-address))) - - (defun gnus-inews-login-name () - "Return login name." - (or gnus-user-login-name (getenv "LOGNAME") (user-login-name))) - - (defun gnus-inews-full-name () - "Return full user name." - (or gnus-user-full-name (getenv "NAME") (user-full-name))) - - (defun gnus-inews-domain-name (&optional genericfrom) - "Return user's domain name. - If optional argument GENERICFROM is a string, use it as the domain - name; if it is non-nil, strip off local host name from the domain name. - If the function `system-name' returns full internet name and the - domain is undefined, the domain name is got from it." - (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) - (let* ((system-name (system-name)) - (domain - (or (if (stringp genericfrom) genericfrom) - (getenv "DOMAINNAME") - gnus-local-domain - ;; Function `system-name' may return full internet name. - ;; Suggested by Mike DeCorte . - (if (string-match "\\." system-name) - (substring system-name (match-end 0))) - (read-string "Domain name (no host): "))) - (host (or (if (string-match "\\." system-name) - (substring system-name 0 (match-beginning 0))) - system-name))) - (if (string-equal "." (substring domain 0 1)) - (setq domain (substring domain 1))) - ;; Support GENERICFROM as same as standard Bnews system. - ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. - (cond ((null genericfrom) - (concat host "." domain)) - ;;((stringp genericfrom) genericfrom) - (t domain))) - (if (string-match "\\." (system-name)) - (system-name) - (substring user-mail-address - (1+ (string-match "@" user-mail-address)))))) - - (defun gnus-inews-full-address () - (let ((domain (gnus-inews-domain-name)) - (system (system-name)) - (case-fold-search t)) - (if (string-match "\\." system) system - (if (string-match (concat "^" (regexp-quote system)) domain) domain - (concat system "." domain))))) - - (defun gnus-inews-message-id () - "Generate unique Message-ID for user." - ;; Message-ID should not contain a slash and should be terminated by - ;; a number. I don't know the reason why it is so. - (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-full-address) ">")) - - (defvar gnus-unique-id-char nil) - - ;; If you ever change this function, make sure the new version - ;; cannot generate IDs that the old version could. - ;; You might for example insert a "." somewhere (not next to another dot - ;; or string boundary), or modify the newsreader name to "Ding". - (defun gnus-inews-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq gnus-unique-id-char - (% (1+ (or gnus-unique-id-char (logand (random t) (1- (lsh 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (if (fboundp 'current-time) - (current-time) '(12191 46742 287898)))) - (concat - (if (memq system-type '(ms-dos emx vax-vms)) - (let ((user (downcase (gnus-inews-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (gnus-number-base36 (user-uid) -1)) - (gnus-number-base36 (+ (car tm) (lsh (% gnus-unique-id-char 25) 16)) 4) - (gnus-number-base36 (+ (nth 1 tm) (lsh (/ gnus-unique-id-char 25) 16)) 4) - ;; Append the newsreader name, because while the generated - ;; ID is unique to this newsreader, other newsreaders might - ;; otherwise generate the same ID via another algorithm. - ".fsf"))) - - - (defun gnus-inews-date () - "Current time string." - (timezone-make-date-arpa-standard - (current-time-string) (current-time-zone))) - - (defun gnus-inews-organization () - "Return user's organization. - The ORGANIZATION environment variable is used if defined. - If not, the variable `gnus-local-organization' is used instead. - If it is a function, the function will be called with the current - newsgroup name as the argument. - If this is a file name, the contents of this file will be used as the - organization." - (let* ((organization - (or (getenv "ORGANIZATION") - (if gnus-local-organization - (if (and (symbolp gnus-local-organization) - (fboundp gnus-local-organization)) - (funcall gnus-local-organization gnus-newsgroup-name) - gnus-local-organization)) - gnus-organization-file - "~/.organization"))) - (and (stringp organization) - (> (length organization) 0) - (or (file-exists-p organization) - (string-match " " organization) - (not (string-match "^/usr/lib/" organization))) - (save-excursion - (gnus-set-work-buffer) - (if (file-exists-p organization) - (insert-file-contents organization) - (insert organization)) - (goto-char (point-min)) - (while (re-search-forward " *\n *" nil t) - (replace-match " " t t)) - (buffer-substring (point-min) (point-max)))))) - - (defun gnus-inews-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (int-to-string (count-lines (point) (point-max)))))) - ;;; --- 490,493 ---- *************** organization." *** 1437,1471 **** ;;; Mail reply commands of Gnus summary mode ! (defun gnus-summary-reply (yank &optional yank-articles) "Reply mail to news author. ! If prefix argument YANK is non-nil, original article is yanked automatically. ! Customize the variable gnus-mail-reply-method to use another mailer." ! (interactive "P") ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (if yank-articles (gnus-summary-goto-subject (car yank-articles))) ! (gnus-summary-select-article) ! (let ((gnus-newsgroup-name gnus-newsgroup-name)) ! (bury-buffer gnus-article-buffer) ! (funcall gnus-mail-reply-method (or yank-articles (not (not yank)))))) (defun gnus-summary-reply-with-original (n) ! "Reply mail to news author with original article. ! Customize the variable gnus-mail-reply-method to use another mailer." (interactive "P") ! (gnus-summary-reply t (gnus-summary-work-articles n))) ! (defun gnus-summary-mail-forward (post) ! "Forward the current message to another user. ! Customize the variable gnus-mail-forward-method to use another mailer." (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-copy-article-buffer) ! (let ((gnus-newsgroup-name gnus-newsgroup-name)) ! (if post ! (gnus-forward-using-post gnus-article-copy) ! (funcall gnus-mail-forward-method gnus-article-copy)))) (defun gnus-summary-post-forward () --- 497,541 ---- ;;; Mail reply commands of Gnus summary mode ! (defun gnus-summary-reply (&optional yank) "Reply mail to news author. ! If prefix argument YANK is non-nil, original article is yanked automatically." ! (interactive ! (list (and current-prefix-arg ! (gnus-summary-work-articles 1)))) ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) ;; Stripping headers should be specified with mail-yank-ignored-headers. (gnus-set-global-variables) ! (when yank ! (gnus-summary-goto-subject (car yank))) ! (let ((gnus-article-reply t)) ! (gnus-setup-message (if yank 'reply-yank 'reply) ! (gnus-summary-select-article) ! (set-buffer (gnus-copy-article-buffer)) ! (message-reply nil nil (gnus-group-get-parameter ! gnus-newsgroup-name 'broken-reply-to)) ! (when yank ! (gnus-inews-yank-articles yank))))) (defun gnus-summary-reply-with-original (n) ! "Reply mail to news author with original article." (interactive "P") ! (gnus-summary-reply (gnus-summary-work-articles n))) ! (defun gnus-summary-mail-forward (&optional post) ! "Forward the current message to another user." (interactive "P") (gnus-set-global-variables) + (gnus-setup-message 'forward + (gnus-summary-select-article) + (set-buffer gnus-original-article-buffer) + (message-forward post))) + + (defun gnus-summary-resend-message (address) + "Resend the current article to ADDRESS." + (interactive "sResend message to: ") (gnus-summary-select-article) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (message-resend address))) (defun gnus-summary-post-forward () *************** The current group name will be inserted *** 1487,1609 **** (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) ! (set-buffer gnus-mail-buffer) (insert (format gnus-nastygram-message group)) ! (gnus-mail-send-and-exit)))) (defun gnus-summary-mail-other-window () ! "Compose mail in other window. ! Customize the variable `gnus-mail-other-window-method' to use another ! mailer." (interactive) ! (gnus-set-global-variables) ! (let ((gnus-newsgroup-name gnus-newsgroup-name)) ! (funcall gnus-mail-other-window-method))) ! ! (defun gnus-mail-reply-using-mail (&optional yank to-address) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((group (gnus-group-real-name gnus-newsgroup-name)) ! (cur (cons (current-buffer) (cdr gnus-article-current))) ! (winconf (current-window-configuration)) ! from subject date reply-to message-of ! references message-id sender follow-to sendto elt) ! (set-buffer (get-buffer-create gnus-mail-buffer)) ! (mail-mode) ! (make-local-variable 'gnus-article-reply) ! (setq gnus-article-reply cur) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (if (and (buffer-modified-p) ! (> (buffer-size) 0) ! (not (gnus-y-or-n-p ! "Unsent article being composed; erase it? "))) ! () ! (erase-buffer) ! (save-excursion ! (gnus-copy-article-buffer) ! (save-restriction ! (set-buffer gnus-article-copy) ! (gnus-narrow-to-headers) ! (if (and (boundp 'gnus-reply-to-function) ! gnus-reply-to-function) ! (setq follow-to (funcall gnus-reply-to-function group))) ! (setq from (mail-fetch-field "from")) ! (setq date (or (mail-fetch-field "date") ! (mail-header-date gnus-current-headers))) ! (and from ! (let ((stop-pos ! (string-match " *at \\| *@ \\| *(\\| *<" from))) ! (setq message-of ! (concat (if stop-pos (substring from 0 stop-pos) from) ! "'s message of " date)))) ! (setq sender (mail-fetch-field "sender")) ! (setq subject (or (mail-fetch-field "subject") ! "Re: none")) ! (or (string-match "^[Rr][Ee]:" subject) ! (setq subject (concat "Re: " subject))) ! (setq reply-to (mail-fetch-field "reply-to")) ! (setq references (mail-fetch-field "references")) ! (setq message-id (mail-fetch-field "message-id")) ! (widen)) ! (setq news-reply-yank-from (or from "(nobody)"))) ! (setq news-reply-yank-message-id ! (or message-id "(unknown Message-ID)")) ! ! ;; Gather the "to" addresses out of the follow-to list and remove ! ;; them as we go. ! (if (and follow-to (listp follow-to)) ! (while (setq elt (assoc "To" follow-to)) ! (setq sendto (concat sendto (and sendto ", ") (cdr elt))) ! (setq follow-to (delq elt follow-to)))) ! ! (mail-setup (or to-address ! (if (and follow-to (not (stringp follow-to))) sendto ! (or follow-to reply-to from sender ""))) ! subject message-of nil gnus-article-copy nil) ! ! (auto-save-mode auto-save-default) ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) ! (if (and follow-to (listp follow-to)) ! (progn ! (goto-char (point-min)) ! (re-search-forward "^To:" nil t) ! (beginning-of-line) ! (forward-line 1) ! (while follow-to ! (insert (car (car follow-to)) ": " (cdr (car follow-to)) "\n") ! (setq follow-to (cdr follow-to))))) ! (nnheader-insert-references references message-id) ! (goto-char (point-min)) ! (re-search-forward ! (concat "^" (regexp-quote mail-header-separator) "$")) ! (forward-line 1) ! (if (not yank) ! (gnus-configure-windows 'reply 'force) ! (let ((last (point)) ! end) ! (if (not (listp yank)) ! (progn ! (save-excursion ! (mail-yank-original nil)) ! (or mail-yank-hooks mail-citation-hook ! (run-hooks 'news-reply-header-hook))) ! (while yank ! (save-window-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-summary-select-article nil nil nil (car yank)) ! (gnus-summary-remove-process-mark (car yank))) ! (save-excursion ! (gnus-copy-article-buffer) ! (mail-yank-original nil) ! (setq end (point))) ! (or mail-yank-hooks mail-citation-hook ! (run-hooks 'news-reply-header-hook)) ! (goto-char end) ! (setq yank (cdr yank)))) ! (goto-char last)) ! (gnus-configure-windows 'reply-yank 'force)) ! (run-hooks 'gnus-mail-hook))))) (defun gnus-mail-yank-original () --- 557,596 ---- (let ((group gnus-newsgroup-name)) (gnus-summary-reply-with-original n) ! (set-buffer gnus-message-buffer) (insert (format gnus-nastygram-message group)) ! (message-send-and-exit)))) (defun gnus-summary-mail-other-window () ! "Compose mail in other window." (interactive) ! (gnus-setup-message 'message ! (message-mail))) ! (defun gnus-mail-parse-comma-list () ! (let (accumulated ! beg) ! (skip-chars-forward " ") ! (while (not (eobp)) ! (setq beg (point)) ! (skip-chars-forward "^,") ! (while (zerop ! (save-excursion ! (save-restriction ! (let ((i 0)) ! (narrow-to-region beg (point)) ! (goto-char beg) ! (logand (progn ! (while (search-forward "\"" nil t) ! (incf i)) ! (if (zerop i) 2 i)) 2))))) ! (skip-chars-forward ",") ! (skip-chars-forward "^,")) ! (skip-chars-backward " ") ! (setq accumulated ! (cons (buffer-substring beg (point)) ! accumulated)) ! (skip-chars-forward "^,") ! (skip-chars-forward ", ")) ! accumulated)) (defun gnus-mail-yank-original () *************** mailer." *** 1614,1622 **** (run-hooks 'news-reply-header-hook))) ! (defun gnus-mail-send-and-exit () (interactive) (let ((reply gnus-article-reply) ! (winconf gnus-prev-winconf)) ! (mail-send-and-exit nil) (if (get-buffer gnus-group-buffer) (progn --- 601,639 ---- (run-hooks 'news-reply-header-hook))) ! (defun gnus-inews-add-to-address (group) ! (let ((to-address (mail-fetch-field "to"))) ! (when (and to-address ! (gnus-alive-p)) ! ;; This mail group doesn't have a `to-list', so we add one ! ;; here. Magic! ! (gnus-group-add-parameter group (cons 'to-list to-address))))) ! ! (defun gnus-put-message () ! "Put the current message in some group and return to Gnus." (interactive) (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)))) ! (and (gnus-gethash group gnus-newsrc-hashtb) ! (error "No such group: %s" group)) ! ! (save-excursion ! (save-restriction ! (widen) ! (gnus-inews-narrow-to-headers) ! (let (gnus-deletable-headers) ! (if (message-news-p) ! (message-generate-headers message-required-news-headers) ! (message-generate-headers message-required-mail-headers))) ! (goto-char (point-max)) ! (insert "Gcc: " group "\n") ! (widen))) ! ! (gnus-inews-do-gcc) ! (if (get-buffer gnus-group-buffer) (progn *************** mailer." *** 1629,1699 **** (and winconf (set-window-configuration winconf)))))) - (defun gnus-forward-make-subject (buffer) - (save-excursion - (set-buffer buffer) - (concat "[" (if (memq 'mail (assoc (symbol-name - (car (gnus-find-method-for-group - gnus-newsgroup-name))) - gnus-valid-select-methods)) - (gnus-fetch-field "From") - gnus-newsgroup-name) - "] " (or (gnus-fetch-field "Subject") "")))) - - (defun gnus-forward-insert-buffer (buffer) - (let ((beg (goto-char (point-max)))) - (insert "------- Start of forwarded message -------\n") - (insert-buffer buffer) - (goto-char (point-max)) - (insert "------- End of forwarded message -------\n") - ;; Suggested by Sudish Joseph . - (goto-char beg) - (while (setq beg (next-single-property-change (point) 'invisible)) - (goto-char beg) - (delete-region beg (or (next-single-property-change - (point) 'invisible) - (point-max)))))) - - (defun gnus-mail-forward-using-mail (&optional buffer) - "Forward the current message to another user using mail." - ;; This is almost a carbon copy of rmail-forward in rmail.el. - (let* ((forward-buffer (or buffer (current-buffer))) - (winconf (current-window-configuration)) - (subject (gnus-forward-make-subject forward-buffer))) - (set-buffer forward-buffer) - (mail nil nil subject) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (gnus-forward-insert-buffer forward-buffer) - (goto-char (point-min)) - (re-search-forward "^To: " nil t) - (gnus-configure-windows 'mail-forward 'force) - ;; You have a chance to arrange the message. - (run-hooks 'gnus-mail-forward-hook) - (run-hooks 'gnus-mail-hook))) - - (defun gnus-forward-using-post (&optional buffer) - (save-excursion - (let* ((forward-buffer (or buffer (current-buffer))) - (subject (gnus-forward-make-subject forward-buffer)) - (gnus-newsgroup-name nil)) - (gnus-post-news 'post nil nil nil nil subject) - (save-excursion - (gnus-forward-insert-buffer forward-buffer) - ;; You have a chance to arrange the message. - (run-hooks 'gnus-mail-forward-hook))))) - - (defun gnus-mail-other-window-using-mail () - "Compose mail other window using mail." - (let ((winconf (current-window-configuration))) - (mail-other-window nil nil nil nil nil (get-buffer gnus-article-buffer)) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf) - (run-hooks 'gnus-mail-hook) - (gnus-configure-windows 'summary-mail 'force))) - (defun gnus-article-mail (yank) "Send a reply to the address near point. --- 646,649 ---- *************** If YANK is non-nil, include the original *** 1704,1716 **** (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) ! (and address ! (progn ! (switch-to-buffer gnus-summary-buffer) ! (funcall gnus-mail-reply-method yank address))))) (defun gnus-bug () "Send a bug report to the Gnus maintainers." (interactive) ! (let ((winconf (current-window-configuration))) (delete-other-windows) (switch-to-buffer "*Gnus Help Bug*") --- 654,666 ---- (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) ! (when address ! (message-reply address) ! (when yank ! (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) (defun gnus-bug () "Send a bug report to the Gnus maintainers." (interactive) ! (gnus-setup-message 'bug (delete-other-windows) (switch-to-buffer "*Gnus Help Bug*") *************** If YANK is non-nil, include the original *** 1718,1734 **** (insert gnus-bug-message) (goto-char (point-min)) ! (pop-to-buffer "*Gnus Bug*") ! (erase-buffer) ! (mail-mode) ! (mail-setup gnus-maintainer nil nil nil nil nil) ! (auto-save-mode auto-save-default) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (use-local-map (copy-keymap mail-mode-map)) ! (local-set-key "\C-c\C-c" 'gnus-bug-mail-send-and-exit) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version))) (gnus-debug) (goto-char (point-min)) --- 668,680 ---- (insert gnus-bug-message) (goto-char (point-min)) ! (message-pop-to-buffer "*Gnus Bug*") ! (message-setup `((To . ,gnus-maintainer) (Subject . ""))) ! (push `(gnus-bug-kill-buffer) message-send-actions) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) ! (insert (gnus-version) "\n") ! (insert (emacs-version)) ! (insert "\n\n\n\n\n") (gnus-debug) (goto-char (point-min)) *************** If YANK is non-nil, include the original *** 1736,1745 **** (message ""))) ! (defun gnus-bug-mail-send-and-exit () ! "Send the bug message and exit." ! (interactive) (and (get-buffer "*Gnus Help Bug*") ! (kill-buffer "*Gnus Help Bug*")) ! (gnus-mail-send-and-exit)) (defun gnus-debug () --- 682,688 ---- (message ""))) ! (defun gnus-bug-kill-buffer () (and (get-buffer "*Gnus Help Bug*") ! (kill-buffer "*Gnus Help Bug*"))) (defun gnus-debug () *************** If YANK is non-nil, include the original *** 1747,1753 **** The source file has to be in the Emacs load path." (interactive) ! (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el")) file dirs expr olist sym) ! (message "Please wait while we snoop your variables...") (sit-for 0) (save-excursion --- 690,697 ---- The source file has to be in the Emacs load path." (interactive) ! (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el" ! "message.el")) file dirs expr olist sym) ! (gnus-message 4 "Please wait while we snoop your variables...") (sit-for 0) (save-excursion *************** The source file has to be in the Emacs l *** 1767,1796 **** (insert-file-contents file) (goto-char (point-min)) ! (or (re-search-forward "^;;* *Internal variables" nil t) ! (error "Malformed sources in file %s" file)) ! (narrow-to-region (point-min) (point)) ! (goto-char (point-min)) ! (while (setq expr (condition-case () ! (read (current-buffer)) (error nil))) ! (condition-case () ! (and (eq (car expr) 'defvar) ! (stringp (nth 3 expr)) ! (or (not (boundp (nth 1 expr))) ! (not (equal (eval (nth 2 expr)) ! (symbol-value (nth 1 expr))))) ! (setq olist (cons (nth 1 expr) olist))) ! (error nil))))) (setq files (cdr files))) (kill-buffer (current-buffer))) ! (insert "------------------- Environment follows -------------------\n\n") (while olist (if (boundp (car olist)) ! (insert "(setq " (symbol-name (car olist)) ! (if (or (consp (setq sym (symbol-value (car olist)))) ! (and (symbolp sym) ! (not (or (eq sym nil) ! (eq sym t))))) ! " '" " ") ! (prin1-to-string (symbol-value (car olist))) ")\n") (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) --- 711,745 ---- (insert-file-contents file) (goto-char (point-min)) ! (if (not (re-search-forward "^;;* *Internal variables" nil t)) ! (gnus-message 4 "Malformed sources in file %s" file) ! (narrow-to-region (point-min) (point)) ! (goto-char (point-min)) ! (while (setq expr (condition-case () ! (read (current-buffer)) (error nil))) ! (condition-case () ! (and (eq (car expr) 'defvar) ! (stringp (nth 3 expr)) ! (or (not (boundp (nth 1 expr))) ! (not (equal (eval (nth 2 expr)) ! (symbol-value (nth 1 expr))))) ! (setq olist (cons (nth 1 expr) olist))) ! (error nil)))))) (setq files (cdr files))) (kill-buffer (current-buffer))) ! (when (setq olist (nreverse olist)) ! (insert "------------------ Environment follows ------------------\n\n")) (while olist (if (boundp (car olist)) ! (condition-case () ! (pp `(setq ,(car olist) ! ,(if (or (consp (setq sym (symbol-value (car olist)))) ! (and (symbolp sym) ! (not (or (eq sym nil) ! (eq sym t))))) ! (list 'quote (symbol-value (car olist))) ! (symbol-value (car olist)))) ! (current-buffer)) ! (error ! (format "(setq %s 'whatever)\n" (car olist)))) (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) (setq olist (cdr olist))) *************** The source file has to be in the Emacs l *** 1801,1804 **** --- 750,925 ---- (while (re-search-forward "[\000\200]" nil t) (replace-match "" t t)))) + + ;;; Treatment of rejected articles. + ;;; Bounced mail. + + (defun gnus-summary-resend-bounced-mail (&optional fetch) + "Re-mail the current message. + This only makes sense if the current message is a bounce message than + contains some mail you have written which has been bounced back to + you. + If FETCH, try to fetch the article that this is a reply to, if indeed + this is a reply." + (interactive "P") + (gnus-summary-select-article t) + (set-buffer gnus-original-article-buffer) + (gnus-setup-message 'compose-bounce + (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. + (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. + (defun gnus-inews-do-gcc (&optional gcc) + (when (gnus-alive-p) + (save-excursion + (save-restriction + (message-narrow-to-headers) + (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) + (cur (current-buffer)) + groups group method) + (when gcc + (message-remove-header "gcc") + (widen) + (setq groups (message-tokenize-header gcc " ,")) + ;; Copy the article over to some group(s). + (while (setq group (pop groups)) + (gnus-check-server + (setq method + (cond ((and (null (gnus-get-info group)) + (eq (car gnus-message-archive-method) + (car + (gnus-server-to-method + (gnus-group-method group))))) + ;; If the group doesn't exist, we assume + ;; it's an archive group... + gnus-message-archive-method) + ;; Use the method. + ((gnus-info-method (gnus-get-info group)) + (gnus-info-method (gnus-get-info group))) + ;; Find the method. + (t (gnus-group-method group))))) + (gnus-check-server method) + (unless (gnus-request-group group t method) + (gnus-request-create-group group method)) + (save-excursion + (nnheader-set-temp-buffer " *acc*") + (insert-buffer-substring cur) + (goto-char (point-min)) + (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" + group (gnus-status-message method)) + (sit-for 2)) + (kill-buffer (current-buffer)))))))))) + + (defun gnus-inews-insert-gcc () + "Insert Gcc headers based on `gnus-outgoing-message-group'." + (save-excursion + (save-restriction + (gnus-inews-narrow-to-headers) + (let* ((group gnus-outgoing-message-group) + (gcc (cond + ((gnus-functionp group) + (funcall group)) + ((or (stringp group) (list group)) + group)))) + (when gcc + (insert "Gcc: " + (if (stringp gcc) gcc + (mapconcat 'identity gcc " ")) + "\n")))))) + + (defun gnus-inews-insert-archive-gcc (&optional group) + "Insert the Gcc to say where the article is to be archived." + (let* ((var gnus-message-archive-group) + (group (or group gnus-newsgroup-name "")) + result + (groups + (cond + ((null gnus-message-archive-method) + ;; Ignore. + nil) + ((stringp var) + ;; Just a single group. + (list var)) + ((null var) + ;; We don't want this. + nil) + ((and (listp var) (stringp (car var))) + ;; A list of groups. + var) + ((gnus-functionp var) + ;; A function. + (funcall var group)) + (t + ;; An alist of regexps/functions/forms. + (while (and var + (not + (setq result + (cond + ((stringp (caar var)) + ;; Regexp. + (when (string-match (caar var) group) + (cdar var))) + ((gnus-functionp (car var)) + ;; Function. + (funcall (car var) group)) + (t + (eval (car var))))))) + (setq var (cdr var))) + result))) + name) + (when groups + (when (stringp groups) + (setq groups (list groups))) + (save-excursion + (save-restriction + (gnus-inews-narrow-to-headers) + (goto-char (point-max)) + (insert "Gcc: ") + (while (setq name (pop groups)) + (insert (if (string-match ":" name) + name + (gnus-group-prefixed-name + name gnus-message-archive-method))) + (if groups (insert " "))) + (insert "\n")))))) + + (defun gnus-summary-send-draft () + "Enter a mail/post buffer to edit and send the draft." + (interactive) + (gnus-set-global-variables) + (let (buf) + (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) + (when (eq major-mode 'news-reply-mode) + (local-set-key "\C-c\C-c" 'gnus-inews-news)) + ;; Insert the separator. + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (insert mail-header-separator) + ;; Configure windows. + (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) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-nocem.el emacs-19.32/lisp/gnus-nocem.el *** emacs-19.31/lisp/gnus-nocem.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-nocem.el Fri Jun 28 20:17:18 1996 *************** *** 0 **** --- 1,247 ---- + ;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (require 'nnmail) + (eval-when-compile (require 'cl)) + + (defvar gnus-nocem-groups + '("alt.nocem.misc" "news.admin.net-abuse.announce") + "*List of groups that will be searched for NoCeM messages.") + + (defvar gnus-nocem-issuers + '("Automoose-1" ; The CancelMoose[tm] on autopilot. + "clewis@ferret.ocunix.on.ca;" ; Chris Lewis -- Canadian angel & despammer. + "jem@xpat.com;" ; John Milburn -- despammer in Korea. + "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; Spew/bincancel guy. + ) + "*List of NoCeM issuers to pay attention to.") + + (defvar gnus-nocem-directory + (concat (file-name-as-directory gnus-article-save-directory) "NoCeM/") + "*Directory where NoCeM files will be stored.") + + (defvar gnus-nocem-expiry-wait 15 + "*Number of days to keep NoCeM headers in the cache.") + + (defvar gnus-nocem-verifyer nil + "*Function called to verify that the NoCeM message is valid. + One likely value is `mc-verify'. If the function in this variable + isn't bound, the message will be used unconditionally.") + + ;;; Internal variables + + (defvar gnus-nocem-active nil) + (defvar gnus-nocem-alist nil) + (defvar gnus-nocem-touched-alist nil) + (defvar gnus-nocem-hashtb nil) + + ;;; Functions + + (defun gnus-nocem-active-file () + (concat (file-name-as-directory gnus-nocem-directory) "active")) + + (defun gnus-nocem-cache-file () + (concat (file-name-as-directory gnus-nocem-directory) "cache")) + + (defun gnus-nocem-scan-groups () + "Scan all NoCeM groups for new NoCeM messages." + (interactive) + (let ((groups gnus-nocem-groups) + group active gactive articles) + (or (file-exists-p gnus-nocem-directory) + (make-directory gnus-nocem-directory t)) + ;; Load any previous NoCeM headers. + (gnus-nocem-load-cache) + ;; Read the active file if it hasn't been read yet. + (and (file-exists-p (gnus-nocem-active-file)) + (not gnus-nocem-active) + (condition-case () + (load (gnus-nocem-active-file) t t t) + (error nil))) + ;; Go through all groups and see whether new articles have + ;; arrived. + (while (setq group (pop groups)) + (if (not (setq gactive (gnus-activate-group group))) + () ; This group doesn't exist. + (setq active (nth 1 (assoc group gnus-nocem-active))) + (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. + (or (not active) + (< (cdr active) (cdr gactive)))) + ;; Ok, there are new articles in this group, se we fetch the + ;; headers. + (save-excursion + (let ((dependencies (make-vector 10 nil)) + (buffer (nnheader-set-temp-buffer " *Gnus NoCeM*")) + headers) + (setq headers + (if (eq 'nov + (gnus-retrieve-headers + (setq articles + (gnus-uncompress-range + (cons + (if active (1+ (cdr active)) + (car gactive)) + (cdr gactive)))) + group)) + (gnus-get-newsgroup-headers-xover + articles nil dependencies) + (gnus-get-newsgroup-headers dependencies))) + (while headers + ;; We take a closer look on all articles that have + ;; "@@NCM" in the subject. + (when (string-match "@@NCM" + (mail-header-subject (car headers))) + (gnus-nocem-check-article group (car headers))) + (setq headers (cdr headers))) + (kill-buffer (current-buffer))))) + (setq gnus-nocem-active + (cons (list group gactive) + (delq (assoc group gnus-nocem-active) + gnus-nocem-active))))) + ;; Save the results, if any. + (gnus-nocem-save-cache) + (gnus-nocem-save-active))) + + (defun gnus-nocem-check-article (group header) + "Check whether the current article is an NCM article and that we want it." + ;; Get the article. + (gnus-message 7 "Checking article %d in %s for NoCeM..." + (mail-header-number header) group) + (let ((date (mail-header-date header)) + issuer b e) + (when (or (not date) + (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) + (goto-char (point-min)) + ;; The article has to have proper NoCeM headers. + (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) + (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) + ;; We get the name of the issuer. + (narrow-to-region b e) + (setq issuer (mail-fetch-field "issuer")) + (and (member issuer gnus-nocem-issuers) ; We like her... + (gnus-nocem-verify-issuer issuer) ; She is who she says she is.. + (gnus-nocem-enter-article)))))) ; We gobble the message. + + (defun gnus-nocem-verify-issuer (person) + "Verify using PGP that the canceler is who she says she is." + (widen) + (if (fboundp gnus-nocem-verifyer) + (funcall gnus-nocem-verifyer) + ;; If we don't have MailCrypt, then we use the message anyway. + t)) + + (defun gnus-nocem-enter-article () + "Enter the current article into the NoCeM cache." + (goto-char (point-min)) + (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) + (e (search-forward "\n@@END NCM BODY\n" nil t)) + (buf (current-buffer)) + ncm id) + (when (and b e) + (narrow-to-region b (1+ (match-beginning 0))) + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (when (condition-case nil + (boundp (let ((obarray gnus-active-hashtb)) (read buf))) + (error nil)) + (beginning-of-line) + (while (= (following-char) ?\t) + (forward-line -1)) + (setq id (buffer-substring (point) (1- (search-forward "\t")))) + (push id ncm) + (gnus-sethash id t gnus-nocem-hashtb) + (forward-line 1) + (while (= (following-char) ?\t) + (forward-line 1)))) + (when ncm + (setq gnus-nocem-touched-alist t) + (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) + ncm) + gnus-nocem-alist))))) + + (defun gnus-nocem-load-cache () + "Load the NoCeM cache." + (unless gnus-nocem-alist + ;; The buffer doesn't exist, so we create it and load the NoCeM + ;; 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 + gnus-nocem-touched-alist) + (nnheader-temp-write (gnus-nocem-cache-file) + (prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist) (current-buffer))) + (setq gnus-nocem-touched-alist nil))) + + (defun gnus-nocem-save-active () + "Save the NoCeM active file." + (nnheader-temp-write (gnus-nocem-active-file) + (prin1 `(setq gnus-nocem-active ',gnus-nocem-active) (current-buffer)))) + + (defun gnus-nocem-alist-to-hashtb () + "Create a hashtable from the Message-IDs we have." + (let* ((alist gnus-nocem-alist) + (pprev (cons nil alist)) + (prev pprev) + (expiry (nnmail-days-to-time gnus-nocem-expiry-wait)) + entry) + (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) + (while (setq entry (car alist)) + (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry)) + ;; This entry has expired, so we remove it. + (setcdr prev (cdr alist)) + (setq prev alist) + ;; This is ok, so we enter it into the hashtable. + (setq entry (cdr entry)) + (while entry + (gnus-sethash (car entry) t gnus-nocem-hashtb) + (setq entry (cdr entry)))) + (setq alist (cdr alist))))) + + (gnus-add-shutdown 'gnus-nocem-close 'gnus) + + (defun gnus-nocem-close () + "Clear internal NoCeM variables." + (setq gnus-nocem-alist nil + gnus-nocem-hashtb nil + gnus-nocem-active nil + gnus-nocem-touched-alist nil)) + + (defun gnus-nocem-unwanted-article-p (id) + "Say whether article ID in the current group is wanted." + (gnus-gethash id gnus-nocem-hashtb)) + + (provide 'gnus-nocem) + + ;;; gnus-nocem.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-salt.el emacs-19.32/lisp/gnus-salt.el *** emacs-19.31/lisp/gnus-salt.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-salt.el Tue Jun 25 18:30:10 1996 *************** *** 0 **** --- 1,654 ---- + ;;; gnus-salt.el --- alternate summary mode interfaces for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (eval-when-compile (require 'cl)) + + ;;; + ;;; gnus-pick-mode + ;;; + + (defvar gnus-pick-mode nil + "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") + + (defvar gnus-pick-display-summary nil + "*Display summary while reading.") + + (defvar gnus-pick-mode-hook nil + "Hook run in summary pick mode buffers.") + + ;;; Internal variables. + + (defvar gnus-pick-mode-map nil) + + (unless gnus-pick-mode-map + (setq gnus-pick-mode-map (make-sparse-keymap)) + + (gnus-define-keys + gnus-pick-mode-map + "t" gnus-uu-mark-thread + "T" gnus-uu-unmark-thread + " " gnus-summary-mark-as-processable + "u" gnus-summary-unmark-as-processable + "U" gnus-summary-unmark-all-processable + "v" gnus-uu-mark-over + "r" gnus-uu-mark-region + "R" gnus-uu-unmark-region + "e" gnus-uu-mark-by-regexp + "E" gnus-uu-mark-by-regexp + "b" gnus-uu-mark-buffer + "B" gnus-uu-unmark-buffer + "\r" gnus-pick-start-reading)) + + (defun gnus-pick-make-menu-bar () + (unless (boundp 'gnus-pick-menu) + (easy-menu-define + gnus-pick-menu gnus-pick-mode-map "" + '("Pick" + ("Pick" + ["Article" gnus-summary-mark-as-processable t] + ["Thread" gnus-uu-mark-thread t] + ["Region" gnus-uu-mark-region t] + ["Regexp" gnus-uu-mark-regexp t] + ["Buffer" gnus-uu-mark-buffer t]) + ("Unpick" + ["Article" gnus-summary-unmark-as-processable t] + ["Thread" gnus-uu-unmark-thread t] + ["Region" gnus-uu-unmark-region t] + ["Regexp" gnus-uu-unmark-regexp t] + ["Buffer" gnus-uu-unmark-buffer t]) + ["Start reading" gnus-pick-start-reading t] + ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) + + (defun gnus-pick-mode (&optional arg) + "Minor mode for providing a pick-and-read interface in Gnus summary buffers. + + \\{gnus-pick-mode-map}" + (interactive "P") + (when (eq major-mode 'gnus-summary-mode) + (make-local-variable 'gnus-pick-mode) + (setq gnus-pick-mode + (if (null arg) (not gnus-pick-mode) + (> (prefix-numeric-value arg) 0))) + (when gnus-pick-mode + ;; Make sure that we don't select any articles upon group entry. + (make-local-variable 'gnus-auto-select-first) + (setq gnus-auto-select-first nil) + ;; Set up the menu. + (when (and menu-bar-mode + (gnus-visual-p 'pick-menu 'menu)) + (gnus-pick-make-menu-bar)) + (unless (assq 'gnus-pick-mode minor-mode-alist) + (push '(gnus-pick-mode " Pick") minor-mode-alist)) + (unless (assq 'gnus-pick-mode minor-mode-map-alist) + (push (cons 'gnus-pick-mode gnus-pick-mode-map) + minor-mode-map-alist)) + (run-hooks 'gnus-pick-mode-hook)))) + + (defun gnus-pick-start-reading (&optional catch-up) + "Start reading the picked articles. + If given a prefix, mark all unpicked articles as read." + (interactive "P") + (unless gnus-newsgroup-processable + (error "No articles have been picked")) + (gnus-summary-limit-to-articles nil) + (when catch-up + (gnus-summary-limit-mark-excluded-as-read)) + (gnus-summary-first-unread-article) + (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t)) + + + ;;; + ;;; gnus-binary-mode + ;;; + + (defvar gnus-binary-mode nil + "Minor mode for provind a binary group interface in Gnus summary buffers.") + + (defvar gnus-binary-mode-hook nil + "Hook run in summary binary mode buffers.") + + (defvar gnus-binary-mode-map nil) + + (unless gnus-binary-mode-map + (setq gnus-binary-mode-map (make-sparse-keymap)) + + (gnus-define-keys + gnus-binary-mode-map + "g" gnus-binary-show-article)) + + (defun gnus-binary-make-menu-bar () + (unless (boundp 'gnus-binary-menu) + (easy-menu-define + gnus-binary-menu gnus-binary-mode-map "" + '("Pick" + ["Switch binary mode off" gnus-binary-mode t])))) + + (defun gnus-binary-mode (&optional arg) + "Minor mode for providing a binary group interface in Gnus summary buffers." + (interactive "P") + (when (eq major-mode 'gnus-summary-mode) + (make-local-variable 'gnus-binary-mode) + (setq gnus-binary-mode + (if (null arg) (not gnus-binary-mode) + (> (prefix-numeric-value arg) 0))) + (when gnus-binary-mode + ;; Make sure that we don't select any articles upon group entry. + (make-local-variable 'gnus-auto-select-first) + (setq gnus-auto-select-first nil) + (make-local-variable 'gnus-summary-display-article-function) + (setq gnus-summary-display-article-function 'gnus-binary-display-article) + ;; Set up the menu. + (when (and menu-bar-mode + (gnus-visual-p 'binary-menu 'menu)) + (gnus-binary-make-menu-bar)) + (unless (assq 'gnus-binary-mode minor-mode-alist) + (push '(gnus-binary-mode " Binary") minor-mode-alist)) + (unless (assq 'gnus-binary-mode minor-mode-map-alist) + (push (cons 'gnus-binary-mode gnus-binary-mode-map) + minor-mode-map-alist)) + (run-hooks 'gnus-binary-mode-hook)))) + + (defun gnus-binary-display-article (article &optional all-header) + "Run ARTICLE through the binary decode functions." + (when (gnus-summary-goto-subject article) + (let ((gnus-view-pseudos 'automatic)) + (gnus-uu-decode-uu)))) + + (defun gnus-binary-show-article (&optional arg) + "Bypass the binary functions and show the article." + (interactive "P") + (let (gnus-summary-display-article-function) + (gnus-summary-show-article arg))) + + ;;; + ;;; gnus-tree-mode + ;;; + + (defvar gnus-tree-line-format "%(%[%3,3n%]%)" + "Format of tree elements.") + + (defvar gnus-tree-minimize-window t + "If non-nil, minimize the tree buffer window. + If a number, never let the tree buffer grow taller than that number of + lines.") + + (defvar gnus-selected-tree-face 'modeline + "*Face used for highlighting selected articles in the thread tree.") + + (defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) + (?\{ . ?\}) (?< . ?>)) + "Brackets used in tree nodes.") + + (defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) + "Charaters used to connect parents with children.") + + (defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z" + "*The format specification for the tree mode line.") + + (defvar gnus-generate-tree-function 'gnus-generate-vertical-tree + "*Function for generating a thread tree. + Two predefined functions are available: + `gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.") + + (defvar gnus-tree-mode-hook nil + "*Hook run in tree mode buffers.") + + ;;; Internal variables. + + (defvar gnus-tree-line-format-alist + `((?n gnus-tmp-name ?s) + (?f gnus-tmp-from ?s) + (?N gnus-tmp-number ?d) + (?\[ gnus-tmp-open-bracket ?c) + (?\] gnus-tmp-close-bracket ?c) + (?s gnus-tmp-subject ?s))) + + (defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist) + + (defvar gnus-tree-mode-line-format-spec nil) + (defvar gnus-tree-line-format-spec nil) + + (defvar gnus-tree-node-length nil) + (defvar gnus-selected-tree-overlay nil) + + (defvar gnus-tree-displayed-thread nil) + + (defvar gnus-tree-mode-map nil) + (put 'gnus-tree-mode 'mode-class 'special) + + (unless gnus-tree-mode-map + (setq gnus-tree-mode-map (make-keymap)) + (suppress-keymap gnus-tree-mode-map) + (gnus-define-keys + gnus-tree-mode-map + "\r" gnus-tree-select-article + gnus-mouse-2 gnus-tree-pick-article + "\C-?" gnus-tree-read-summary-keys + + "\C-c\C-i" gnus-info-find-node) + + (substitute-key-definition + 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) + + (defun gnus-tree-make-menu-bar () + (unless (boundp 'gnus-tree-menu) + (easy-menu-define + gnus-tree-menu gnus-tree-mode-map "" + '("Tree" + ["Select article" gnus-tree-select-article t])))) + + (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 + gnus-summary-mode-line-format-alist)) + (setq gnus-tree-line-format-spec + (gnus-parse-format gnus-tree-line-format + gnus-tree-line-format-alist t)) + (when (and menu-bar-mode + (gnus-visual-p 'tree-menu 'menu)) + (gnus-tree-make-menu-bar)) + (kill-all-local-variables) + (gnus-simplify-mode-line) + (setq mode-name "Tree") + (setq major-mode 'gnus-tree-mode) + (use-local-map gnus-tree-mode-map) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) + (setq truncate-lines t) + (save-excursion + (gnus-set-work-buffer) + (gnus-tree-node-insert (make-mail-header "") nil) + (setq gnus-tree-node-length (1- (point)))) + (run-hooks 'gnus-tree-mode-hook)) + + (defun gnus-tree-read-summary-keys (&optional arg) + "Read a summary buffer key sequence and execute it." + (interactive "P") + (let ((buf (current-buffer)) + win) + (gnus-article-read-summary-keys arg nil t) + (when (setq win (get-buffer-window buf)) + (select-window win) + (when gnus-selected-tree-overlay + (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) + (gnus-tree-minimize)))) + + (defun gnus-tree-select-article (article) + "Select the article under point, if any." + (interactive (list (gnus-tree-article-number))) + (let ((buf (current-buffer))) + (when article + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-goto-article article)) + (select-window (get-buffer-window buf))))) + + (defun gnus-tree-pick-article (e) + "Select the article under the mouse pointer." + (interactive "e") + (mouse-set-point e) + (gnus-tree-select-article (gnus-tree-article-number))) + + (defun gnus-tree-article-number () + (get-text-property (point) 'gnus-number)) + + (defun gnus-tree-article-region (article) + "Return a cons with BEG and END of the article region." + (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (when pos + (cons pos (next-single-property-change pos 'gnus-number))))) + + (defun gnus-tree-goto-article (article) + (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) + (when pos + (goto-char pos)))) + + (defun gnus-tree-recenter () + "Center point in the tree window." + (let ((selected (selected-window)) + (tree-window (get-buffer-window gnus-tree-buffer t))) + (when tree-window + (select-window tree-window) + (when gnus-selected-tree-overlay + (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) + (let* ((top (cond ((< (window-height) 4) 0) + ((< (window-height) 7) 1) + (t 2))) + (height (1- (window-height))) + (bottom (save-excursion (goto-char (point-max)) + (forward-line (- height)) + (point)))) + ;; Set the window start to either `bottom', which is the biggest + ;; possible valid number, or the second line from the top, + ;; whichever is the least. + (set-window-start + tree-window (min bottom (save-excursion + (forward-line (- top)) (point))))) + (select-window selected)))) + + (defun gnus-get-tree-buffer () + "Return the tree buffer properly initialized." + (save-excursion + (set-buffer (get-buffer-create gnus-tree-buffer)) + (unless (eq major-mode 'gnus-tree-mode) + (gnus-add-current-to-buffer-list) + (gnus-tree-mode)) + (current-buffer))) + + (defun gnus-tree-minimize () + (when (and gnus-tree-minimize-window + (not (one-window-p))) + (let ((windows 0) + tot-win-height) + (walk-windows (lambda (window) (incf windows))) + (setq tot-win-height + (- (frame-height) + (* window-min-height (1- windows)) + 2)) + (let* ((window-min-height 2) + (height (count-lines (point-min) (point-max))) + (min (max (1- window-min-height) height)) + (tot (if (numberp gnus-tree-minimize-window) + (min gnus-tree-minimize-window min) + min)) + (win (get-buffer-window (current-buffer))) + (wh (and win (1- (window-height win))))) + (setq tot (min tot tot-win-height)) + (when (and win + (not (eq tot wh))) + (let ((selected (selected-window))) + (select-window win) + (enlarge-window (- tot wh)) + (select-window selected))))))) + + ;;; Generating the tree. + + (defun gnus-tree-node-insert (header sparse &optional adopted) + (let* ((dummy (stringp header)) + (header (if (vectorp header) header + (progn + (setq header (make-mail-header "*****")) + (mail-header-set-number header 0) + (mail-header-set-lines header 0) + (mail-header-set-chars header 0) + header))) + (gnus-tmp-from (mail-header-from header)) + (gnus-tmp-subject (mail-header-subject header)) + (gnus-tmp-number (mail-header-number header)) + (gnus-tmp-name + (cond + ((string-match "(.+)" gnus-tmp-from) + (substring gnus-tmp-from + (1+ (match-beginning 0)) (1- (match-end 0)))) + ((string-match "<[^>]+> *$" gnus-tmp-from) + (let ((beg (match-beginning 0))) + (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) + (substring gnus-tmp-from (1+ (match-beginning 0)) + (1- (match-end 0)))) + (substring gnus-tmp-from 0 beg)))) + ((memq gnus-tmp-number sparse) + "***") + (t gnus-tmp-from))) + (gnus-tmp-open-bracket + (cond ((memq gnus-tmp-number sparse) + (caadr gnus-tree-brackets)) + (dummy (caaddr gnus-tree-brackets)) + (adopted (car (nth 3 gnus-tree-brackets))) + (t (caar gnus-tree-brackets)))) + (gnus-tmp-close-bracket + (cond ((memq gnus-tmp-number sparse) + (cdadr gnus-tree-brackets)) + (adopted (cdr (nth 3 gnus-tree-brackets))) + (dummy + (cdaddr gnus-tree-brackets)) + (t (cdar gnus-tree-brackets)))) + (buffer-read-only nil) + beg end) + (gnus-add-text-properties + (setq beg (point)) + (setq end (progn (eval gnus-tree-line-format-spec) (point))) + (list 'gnus-number gnus-tmp-number)) + (when (or t (gnus-visual-p 'tree-highlight 'highlight)) + (gnus-tree-highlight-node gnus-tmp-number beg end)))) + + (defun gnus-tree-highlight-node (article beg end) + "Highlight current line according to `gnus-summary-highlight'." + (let ((list gnus-summary-highlight) + face) + (save-excursion + (set-buffer gnus-summary-buffer) + (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) + gnus-summary-default-score 0)) + (default gnus-summary-default-score) + (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) + ;; Eval the cars of the lists until we find a match. + (while (and list + (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 + (if (boundp face) (symbol-value face) face))))) + + (defun gnus-tree-indent (level) + (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) + + (defvar gnus-tmp-limit) + (defvar gnus-tmp-sparse) + (defvar gnus-tmp-indent) + + (defun gnus-generate-tree (thread) + "Generate a thread tree for THREAD." + (save-excursion + (set-buffer (gnus-get-tree-buffer)) + (let ((buffer-read-only nil) + (gnus-tmp-indent 0)) + (erase-buffer) + (funcall gnus-generate-tree-function thread 0) + (gnus-set-mode-line 'tree) + (goto-char (point-min)) + (gnus-tree-minimize) + (gnus-tree-recenter) + (let ((selected (selected-window))) + (when (get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) + (gnus-horizontal-recenter) + (select-window selected)))))) + + (defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted) + "Generate a horizontal tree." + (let* ((dummy (stringp (car thread))) + (do (or dummy + (memq (mail-header-number (car thread)) gnus-tmp-limit))) + col beg) + (if (not do) + ;; We don't want this article. + (setq thread (cdr thread)) + (if (not (bolp)) + ;; Not the first article on the line, so we insert a "-". + (insert (car gnus-tree-parent-child-edges)) + ;; If the level isn't zero, then we insert some indentation. + (unless (zerop level) + (gnus-tree-indent level) + (insert (cadr gnus-tree-parent-child-edges)) + (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) + ;; Draw "|" lines upwards. + (while (progn + (forward-line -1) + (forward-char col) + (= (following-char) ? )) + (delete-char 1) + (insert (caddr gnus-tree-parent-child-edges))) + (goto-char beg))) + (setq dummyp nil) + ;; Insert the article node. + (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)) + (if (null thread) + ;; End of the thread, so we go to the next line. + (unless (bolp) + (insert "\n")) + ;; Recurse downwards in all children of this article. + (while thread + (gnus-generate-horizontal-tree + (pop thread) (if do (1+ level) level) + (or dummyp dummy) dummy))))) + + (defsubst gnus-tree-indent-vertical () + (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) + (- (point) (gnus-point-at-bol))))) + (when (> len 0) + (insert (make-string len ? ))))) + + (defsubst gnus-tree-forward-line (n) + (while (>= (decf n) 0) + (unless (zerop (forward-line 1)) + (end-of-line) + (insert "\n"))) + (end-of-line)) + + (defun gnus-generate-vertical-tree (thread level &optional dummyp adopted) + "Generate a vertical tree." + (let* ((dummy (stringp (car thread))) + (do (or dummy + (memq (mail-header-number (car thread)) gnus-tmp-limit))) + beg) + (if (not do) + ;; We don't want this article. + (setq thread (cdr thread)) + (if (not (save-excursion (beginning-of-line) (bobp))) + ;; Not the first article on the line, so we insert a "-". + (progn + (gnus-tree-indent-vertical) + (insert (make-string (/ gnus-tree-node-length 2) ? )) + (insert (caddr gnus-tree-parent-child-edges)) + (gnus-tree-forward-line 1)) + ;; If the level isn't zero, then we insert some indentation. + (unless (zerop gnus-tmp-indent) + (gnus-tree-forward-line (1- (* 2 level))) + (gnus-tree-indent-vertical) + (delete-char -1) + (insert (cadr gnus-tree-parent-child-edges)) + (setq beg (point)) + ;; Draw "-" lines leftwards. + (while (progn + (forward-char -2) + (= (following-char) ? )) + (delete-char 1) + (insert (car gnus-tree-parent-child-edges))) + (goto-char beg) + (gnus-tree-forward-line 1))) + (setq dummyp nil) + ;; Insert the article node. + (gnus-tree-indent-vertical) + (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted) + (gnus-tree-forward-line 1)) + (if (null thread) + ;; End of the thread, so we go to the next line. + (progn + (goto-char (point-min)) + (end-of-line) + (incf gnus-tmp-indent)) + ;; Recurse downwards in all children of this article. + (while thread + (gnus-generate-vertical-tree + (pop thread) (if do (1+ level) level) + (or dummyp dummy) dummy))))) + + ;;; Interface functions. + + (defun gnus-possibly-generate-tree (article &optional force) + "Generate the thread tree for ARTICLE if it isn't displayed already." + (when (save-excursion + (set-buffer gnus-summary-buffer) + (and gnus-use-trees + (vectorp (gnus-summary-article-header article)))) + (save-excursion + (let ((top (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-cut-thread + (gnus-remove-thread + (mail-header-id + (gnus-summary-article-header article)) t)))) + (gnus-tmp-limit gnus-newsgroup-limit) + (gnus-tmp-sparse gnus-newsgroup-sparse)) + (when (or force + (not (eq top gnus-tree-displayed-thread))) + (gnus-generate-tree top) + (setq gnus-tree-displayed-thread top)))))) + + (defun gnus-tree-open (group) + (gnus-get-tree-buffer)) + + (defun gnus-tree-close (group) + ;(gnus-kill-buffer gnus-tree-buffer) + ) + + (defun gnus-highlight-selected-tree (article) + "Highlight the selected article in the tree." + (let ((buf (current-buffer)) + region) + (set-buffer gnus-tree-buffer) + (when (setq region (gnus-tree-article-region article)) + (when (or (not gnus-selected-tree-overlay) + (gnus-extent-detached-p gnus-selected-tree-overlay)) + ;; Create a new overlay. + (gnus-overlay-put + (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-selected-tree-overlay (goto-char (car region)) (cdr region)) + (gnus-tree-minimize) + (gnus-tree-recenter) + (let ((selected (selected-window))) + (when (get-buffer-window (set-buffer gnus-tree-buffer) t) + (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) + (gnus-horizontal-recenter) + (select-window selected)))) + ;; If we remove this save-excursion, it updates the wrong mode lines?!? + (save-excursion + (set-buffer gnus-tree-buffer) + (gnus-set-mode-line 'tree)) + (set-buffer buf))) + + (defun gnus-tree-highlight-article (article face) + (save-excursion + (set-buffer (gnus-get-tree-buffer)) + (let (region) + (when (setq region (gnus-tree-article-region article)) + (gnus-put-text-property (car region) (cdr region) 'face face) + (set-window-point + (get-buffer-window (current-buffer) t) (cdr region)))))) + + ;;; Allow redefinition of functions. + (gnus-ems-redefine) + + (provide 'gnus-salt) + + ;;; gnus-salt.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-score.el emacs-19.32/lisp/gnus-score.el *** emacs-19.31/lisp/gnus-score.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-score.el Fri Jun 28 20:16:37 1996 *************** *** 1,5 **** ;;; gnus-score.el --- scoring code for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Per Abrahamsen --- 1,4 ---- ;;; gnus-score.el --- scoring code for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Per Abrahamsen *************** *** 29,35 **** (require 'gnus) (defvar gnus-score-expiry-days 7 ! "*Number of days before unused score file entries are expired.") (defvar gnus-orphan-score nil --- 28,109 ---- (require 'gnus) + (eval-when-compile (require 'cl)) + + (defvar gnus-global-score-files nil + "*List of global score files and directories. + Set this variable if you want to use people's score files. One entry + for each score file or each score file directory. Gnus will decide + by itself what score files are applicable to which group. + + Say you want to use the single score file + \"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all + score files in the \"/ftp.some-where:/pub/score\" directory. + + (setq gnus-global-score-files + '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\" + \"/ftp.some-where:/pub/score\"))") + + (defvar gnus-score-file-single-match-alist nil + "*Alist mapping regexps to lists of score files. + Each element of this alist should be of the form + (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) + + If the name of a group is matched by REGEXP, the corresponding scorefiles + will be used for that group. + The first match found is used, subsequent matching entries are ignored (to + use multiple matches, see gnus-score-file-multiple-match-alist). + + These score files are loaded in addition to any files returned by + gnus-score-find-score-files-function (which see).") + + (defvar gnus-score-file-multiple-match-alist nil + "*Alist mapping regexps to lists of score files. + Each element of this alist should be of the form + (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) + + If the name of a group is matched by REGEXP, the corresponding scorefiles + will be used for that group. + If multiple REGEXPs match a group, the score files corresponding to each + match will be used (for only one match to be used, see + gnus-score-file-single-match-alist). + + These score files are loaded in addition to any files returned by + gnus-score-find-score-files-function (which see).") + + (defvar gnus-score-file-suffix "SCORE" + "*Suffix of the score files.") + + (defvar gnus-adaptive-file-suffix "ADAPT" + "*Suffix of the adaptive score files.") + + (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews + "*Function used to find score files. + The function will be called with the group name as the argument, and + should return a list of score files to apply to that group. The score + files do not actually have to exist. + + Predefined values are: + + gnus-score-find-single: Only apply the group's own score file. + gnus-score-find-hierarchical: Also apply score files from parent groups. + gnus-score-find-bnews: Apply score files whose names matches. + + See the documentation to these functions for more information. + + This variable can also be a list of functions to be called. Each + function should either return a list of score files, or a list of + score alists.") + + (defvar gnus-score-interactive-default-score 1000 + "*Scoring commands will raise/lower the score with this number as the default.") (defvar gnus-score-expiry-days 7 ! "*Number of days before unused score file entries are expired. ! If this variable is nil, no score file entries will be expired.") ! ! (defvar gnus-update-score-entry-dates t ! "*In non-nil, update matching score entry dates. ! If this variable is nil, then score entries that provide matches ! will be expired along with non-matching score entries.") (defvar gnus-orphan-score nil *************** *** 51,55 **** "*Number that says how long a match has to be before using substring matching. When doing adaptive scoring, one normally uses fuzzy or substring ! matching. However, if the header one matches is short, the possibility for false positives is great, so if the length of the match is less than this variable, exact matching will be used. --- 125,129 ---- "*Number that says how long a match has to be before using substring matching. When doing adaptive scoring, one normally uses fuzzy or substring ! matching. However, if the header one matches is short, the possibility for false positives is great, so if the length of the match is less than this variable, exact matching will be used. *************** than this variable, exact matching will *** 57,64 **** --- 131,199 ---- If this variable is nil, exact matching will always be used.") + (defvar gnus-score-uncacheable-files "ADAPT$" + "*All score files that match this regexp will not be cached.") + + (defvar gnus-score-default-header nil + "Default header when entering new scores. + + Should be one of the following symbols. + + a: from + s: subject + b: body + h: head + i: message-id + t: references + x: xref + l: lines + d: date + f: followup + + If nil, the user will be asked for a header.") + + (defvar gnus-score-default-type nil + "Default match type when entering new scores. + + Should be one of the following symbols. + + s: substring + e: exact string + f: fuzzy string + r: regexp string + b: before date + a: at date + n: this date + <: less than number + >: greater than number + =: equal to number + + If nil, the user will be asked for a match type.") + + (defvar gnus-score-default-fold nil + "Use case folding for new score file entries iff not nil.") + + (defvar gnus-score-default-duration nil + "Default duration of effect when entering new scores. + + Should be one of the following symbols. + + t: temporary + p: permanent + i: immediate + + If nil, the user will be asked for a duration.") + + (defvar gnus-score-after-write-file-function nil + "*Function called with the name of the score file just written to disk.") + ;; Internal variables. + (defvar gnus-internal-global-score-files nil) + (defvar gnus-score-file-list nil) + + (defvar gnus-short-name-score-file-cache nil) + (defvar gnus-score-help-winconf nil) (defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) *************** of the last successful match.") *** 84,112 **** (defvar gnus-score-cache nil) (defvar gnus-scores-articles nil) - (defvar gnus-header-index nil) (defvar gnus-score-index nil) - (eval-and-compile - (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap) - (autoload 'appt-select-lowest-window "appt.el")) - - ;;; Summary mode score maps. ! (defvar gnus-summary-score-map nil) ! (define-prefix-command 'gnus-summary-score-map) ! (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map) ! (define-key gnus-summary-score-map "s" 'gnus-summary-set-score) ! (define-key gnus-summary-score-map "a" 'gnus-summary-score-entry) ! (define-key gnus-summary-score-map "S" 'gnus-summary-current-score) ! (define-key gnus-summary-score-map "c" 'gnus-score-change-score-file) ! (define-key gnus-summary-score-map "m" 'gnus-score-set-mark-below) ! (define-key gnus-summary-score-map "x" 'gnus-score-set-expunge-below) ! (define-key gnus-summary-score-map "e" 'gnus-score-edit-alist) ! (define-key gnus-summary-score-map "f" 'gnus-score-edit-file) ! (define-key gnus-summary-score-map "t" 'gnus-score-find-trace) ! (define-key gnus-summary-score-map "C" 'gnus-score-customize) ;; Summary score file commands --- 219,261 ---- (defvar gnus-score-cache nil) (defvar gnus-scores-articles nil) (defvar gnus-score-index nil) ! (defconst gnus-header-index ! ;; Name to index alist. ! '(("number" 0 gnus-score-integer) ! ("subject" 1 gnus-score-string) ! ("from" 2 gnus-score-string) ! ("date" 3 gnus-score-date) ! ("message-id" 4 gnus-score-string) ! ("references" 5 gnus-score-string) ! ("chars" 6 gnus-score-integer) ! ("lines" 7 gnus-score-integer) ! ("xref" 8 gnus-score-string) ! ("head" -1 gnus-score-body) ! ("body" -1 gnus-score-body) ! ("all" -1 gnus-score-body) ! ("followup" 2 gnus-score-followup) ! ("thread" 5 gnus-score-thread))) ! (eval-and-compile ! (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap)) + ;;; Summary mode score maps. + (gnus-define-keys + (gnus-summary-score-map "V" gnus-summary-mode-map) + "s" gnus-summary-set-score + "a" gnus-summary-score-entry + "S" gnus-summary-current-score + "c" gnus-score-change-score-file + "m" gnus-score-set-mark-below + "x" gnus-score-set-expunge-below + "R" gnus-summary-rescore + "e" gnus-score-edit-current-scores + "f" gnus-score-edit-file + "F" gnus-score-flush-cache + "t" gnus-score-find-trace + "C" gnus-score-customize) ;; Summary score file commands *************** used as score." *** 123,126 **** --- 272,290 ---- (gnus-summary-increase-score (- (gnus-score-default score)))) + (defvar gnus-score-default-header nil + "*The default header to score on when entering a score rule interactively.") + + (defvar gnus-score-default-type nil + "*The default score type to use when entering a score rule interactively.") + + (defvar gnus-score-default-duration nil + "*The default score duration to use on when entering a score rule interactively.") + + (defun gnus-score-kill-help-buffer () + (when (get-buffer "*Score Help*") + (kill-buffer "*Score Help*") + (and gnus-score-help-winconf + (set-window-configuration gnus-score-help-winconf)))) + (defun gnus-summary-increase-score (&optional score) "Make a score entry based on the current article. *************** used as score." *** 139,147 **** (?h "head" "" nil body-string) (?i "message-id" nil t string) ! (?t "references" "message-id" t string) (?x "xref" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) ! (?f "followup" nil nil string))) (char-to-type '((?s s "substring" string) --- 303,312 ---- (?h "head" "" nil body-string) (?i "message-id" nil t string) ! (?t "references" "message-id" nil string) (?x "xref" nil nil string) (?l "lines" nil nil number) (?d "date" nil nil date) ! (?f "followup" nil nil string) ! (?T "thread" nil nil string))) (char-to-type '((?s s "substring" string) *************** used as score." *** 149,154 **** (?f f "fuzzy string" string) (?r r "regexp string" string) ! (?s s "substring" body-string) ! (?r s "regexp string" body-string) (?b before "before date" date) (?a at "at date" date) --- 314,319 ---- (?f f "fuzzy string" string) (?r r "regexp string" string) ! (?z s "substring" body-string) ! (?p s "regexp string" body-string) (?b before "before date" date) (?a at "at date" date) *************** used as score." *** 161,282 **** '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) ! hchar entry temporary tchar pchar end type) ! ;; First we read the header to score. ! (while (not hchar) ! (if mimic ! (progn ! (sit-for 1) ! (message "%c-" prefix)) ! (message "%s header (%s?): " (if increase "Increase" "Lower") ! (mapconcat (lambda (s) (char-to-string (car s))) ! char-to-header ""))) ! (setq hchar (read-char)) ! (if (not (or (= hchar ??) (= hchar ?\C-h))) ! () ! (setq hchar nil) ! (gnus-score-insert-help "Match on header" char-to-header 1))) ! ! (and (get-buffer "*Score Help*") ! (progn ! (kill-buffer "*Score Help*") ! (and gnus-score-help-winconf ! (set-window-configuration gnus-score-help-winconf)))) ! ! (or (setq entry (assq (downcase hchar) char-to-header)) ! (progn ! (ding) ! (setq end t) ! (if mimic (message "%c %c" prefix hchar) (message "")))) ! (if (or end (/= (downcase hchar) hchar)) (progn - ;; This was a majuscle, so we end reading and set the defaults. - (if mimic (message "%c %c" prefix hchar) (message "")) - (setq type nil - temporary (current-time-string))) - - ;; We continue reading - the type. - (while (not tchar) - (if mimic - (progn - (sit-for 1) - (message "%c %c-" prefix hchar)) - (message "%s header '%s' with match type (%s?): " - (if increase "Increase" "Lower") - (nth 1 entry) - (mapconcat (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - (char-to-string (car s)) - "")) - char-to-type ""))) - (setq tchar (read-char)) - (if (not (or (= tchar ??) (= tchar ?\C-h))) - () - (setq tchar nil) - (gnus-score-insert-help "Match type" char-to-type 2))) ! (and (get-buffer "*Score Help*") ! (progn ! (and gnus-score-help-winconf ! (set-window-configuration gnus-score-help-winconf)) ! (kill-buffer "*Score Help*"))) ! ! (or (setq type (nth 1 (assq (downcase tchar) char-to-type))) ! (progn ! (ding) (if mimic (message "%c %c" prefix hchar) (message "")) ! (setq end t))) ! (if (or end (/= (downcase tchar) tchar)) ! (progn ;; It was a majuscle, so we end reading and the the default. (if mimic (message "%c %c %c" prefix hchar tchar) (message "")) ! (setq temporary (current-time-string))) ! ;; We continue reading. ! (while (not pchar) ! (if mimic ! (progn ! (sit-for 1) ! (message "%c %c %c-" prefix hchar tchar)) ! (message "%s permanence (%s?): " (if increase "Increase" "Lower") ! (mapconcat (lambda (s) (char-to-string (car s))) ! char-to-perm ""))) ! (setq pchar (read-char)) ! (if (not (or (= pchar ??) (= pchar ?\C-h))) ! () ! (setq pchar nil) ! (gnus-score-insert-help "Match permanence" char-to-perm 2))) ! ! (and (get-buffer "*Score Help*") ! (progn ! (and gnus-score-help-winconf ! (set-window-configuration gnus-score-help-winconf)) ! (kill-buffer "*Score Help*"))) ! ! (if mimic (message "%c %c %c" prefix hchar tchar pchar) ! (message "")) ! (if (setq temporary (nth 1 (assq pchar char-to-perm))) ! () ! (ding) ! (setq end t) ! (if mimic ! (message "%c %c %c %c" prefix hchar tchar pchar) ! (message ""))))) ;; We have all the data, so we enter this score. ! (if end ! () ! (gnus-summary-score-entry ! (nth 1 entry) ; Header ! (if (string= (nth 2 entry) "") "" ! (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))) ; Match ! type ; Type ! (if (eq 's score) nil score) ; Score ! (if (eq 'perm temporary) ; Temp ! nil ! temporary) ! (not (nth 3 entry))) ; Prompt ! ))) (defun gnus-score-insert-help (string alist idx) --- 326,449 ---- '(?p perm "permanent") '(?i now "immediate"))) (mimic gnus-score-mimic-keymap) ! (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 ! (sit-for 1) ! (message "%c-" prefix)) ! (message "%s header (%s?): " (if increase "Increase" "Lower") ! (mapconcat (lambda (s) (char-to-string (car s))) ! char-to-header ""))) ! (setq hchar (read-char)) ! (when (or (= hchar ??) (= hchar ?\C-h)) ! (setq hchar nil) ! (gnus-score-insert-help "Match on header" char-to-header 1))) ! ! (gnus-score-kill-help-buffer) ! (unless (setq entry (assq (downcase hchar) char-to-header)) ! (if mimic (error "%c %c" prefix hchar) (error ""))) ! ! (when (/= (downcase hchar) hchar) ! ;; This was a majuscle, so we end reading and set the defaults. (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 ! (progn ! (sit-for 1) (message "%c %c-" prefix hchar)) ! (message "%s header '%s' with match type (%s?): " ! (if increase "Increase" "Lower") ! (nth 1 entry) ! (mapconcat (lambda (s) ! (if (eq (nth 4 entry) ! (nth 3 s)) ! (char-to-string (car s)) ! "")) ! char-to-type ""))) ! (setq tchar (read-char)) ! (when (or (= tchar ??) (= tchar ?\C-h)) ! (setq tchar nil) ! (gnus-score-insert-help ! "Match type" ! (delq nil ! (mapcar (lambda (s) ! (if (eq (nth 4 entry) ! (nth 3 s)) ! s nil)) ! char-to-type )) ! 2))) ! ! (gnus-score-kill-help-buffer) ! (unless (setq type (nth 1 (assq (downcase tchar) char-to-type))) ! (if mimic (error "%c %c" prefix hchar) (error ""))) ! ! (when (/= (downcase tchar) tchar) ;; It was a majuscle, so we end reading and the the default. (if mimic (message "%c %c %c" prefix hchar tchar) (message "")) ! (setq pchar (or pchar ?p))) ! ;; We continue reading. ! (while (not pchar) ! (if mimic ! (progn ! (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) ! (message "%s permanence (%s?): " (if increase "Increase" "Lower") ! (mapconcat (lambda (s) (char-to-string (car s))) ! char-to-perm ""))) ! (setq pchar (read-char)) ! (when (or (= pchar ??) (= pchar ?\C-h)) ! (setq pchar nil) ! (gnus-score-insert-help "Match permanence" char-to-perm 2))) ! ! (gnus-score-kill-help-buffer) ! (if mimic (message "%c %c %c" prefix hchar tchar pchar) ! (message "")) ! (unless (setq temporary (cadr (assq pchar char-to-perm))) ! (if mimic ! (error "%c %c %c %c" prefix hchar tchar pchar) ! (error "")))) ! ;; Always kill the score help buffer. ! (gnus-score-kill-help-buffer)) ;; 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 ! ((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))) ! ! (gnus-summary-score-entry ! (nth 1 entry) ; Header ! match ; Match ! type ; Type ! (if (eq 's score) nil score) ; Score ! (if (eq 'perm temporary) ; Temp ! nil ! temporary) ! (not (nth 3 entry))) ; Prompt ! )) (defun gnus-score-insert-help (string alist idx) *************** used as score." *** 299,304 **** (setq list (cdr list))) (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end ! (setq n (/ (window-width) max)) ; items per line ! (setq width (/ (window-width) n)) ; width of each item ;; insert `n' items, each in a field of width `width' (while alist --- 466,471 ---- (setq list (cdr list))) (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' (while alist *************** used as score." *** 310,321 **** (setq pad (- width 3)) (setq format (concat "%c: %-" (int-to-string pad) "s")) ! (insert (format format (car (car alist)) (nth idx (car alist)))) (setq alist (cdr alist)) (setq i (1+ i)))) ;; display ourselves in a small window at the bottom ! (appt-select-lowest-window) (split-window) (pop-to-buffer "*Score Help*") ! (shrink-window-if-larger-than-buffer) (select-window (get-buffer-window gnus-summary-buffer)))) --- 477,489 ---- (setq pad (- width 3)) (setq format (concat "%c: %-" (int-to-string pad) "s")) ! (insert (format format (caar alist) (nth idx (car alist)))) (setq alist (cdr alist)) (setq i (1+ i)))) ;; display ourselves in a small window at the bottom ! (gnus-appt-select-lowest-window) (split-window) (pop-to-buffer "*Score Help*") ! (let ((window-min-height 1)) ! (shrink-window-if-larger-than-buffer)) (select-window (get-buffer-window gnus-summary-buffer)))) *************** used as score." *** 325,329 **** headers) (if article ! (if (and (setq headers (gnus-get-header-by-number article)) (vectorp headers)) (aref headers (nth 1 (assoc header gnus-header-index))) --- 493,497 ---- headers) (if article ! (if (and (setq headers (gnus-summary-article-header article)) (vectorp headers)) (aref headers (nth 1 (assoc header gnus-header-index))) *************** used as score." *** 335,338 **** --- 503,523 ---- nil)))) + (defun gnus-newsgroup-score-alist () + (or + (let ((param-file (gnus-group-get-parameter + gnus-newsgroup-name 'score-file))) + (when param-file + (gnus-score-load param-file))) + (gnus-score-load + (gnus-score-file-name gnus-newsgroup-name))) + gnus-score-alist) + + (defsubst gnus-score-get (symbol &optional alist) + ;; Get SYMBOL's definition in ALIST. + (cdr (assoc symbol + (or alist + gnus-score-alist + (gnus-newsgroup-score-alist))))) + (defun gnus-summary-score-entry (header match type score date &optional prompt silent) *************** If optional argument `SILENT' is nil, sh *** 367,371 **** (setq match (gnus-simplify-subject-fuzzy match)))) (let ((score (gnus-score-default score)) ! (header (downcase header))) (and prompt (setq match (read-string (format "Match %s on %s, %s: " --- 552,557 ---- (setq match (gnus-simplify-subject-fuzzy match)))) (let ((score (gnus-score-default score)) ! (header (format "%s" (downcase header))) ! new) (and prompt (setq match (read-string (format "Match %s on %s, %s: " *************** If optional argument `SILENT' is nil, sh *** 380,387 **** (int-to-string match) match)))) ! (and (>= (nth 1 (assoc header gnus-header-index)) 0) ! (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-string) ! (not silent) ! (gnus-summary-score-effect header match type score)) ;; If this is an integer comparison, we transform from string to int. --- 566,572 ---- (int-to-string match) match)))) ! ! ;; Get rid of string props. ! (setq match (format "%s" match)) ;; If this is an integer comparison, we transform from string to int. *************** If optional argument `SILENT' is nil, sh *** 389,407 **** (setq match (string-to-int match))) ! (if (eq date 'now) ! () ! (and (= score gnus-score-interactive-default-score) (setq score nil)) ! (let ((new (cond ! (type ! (list match score (and date (gnus-day-number date)) type)) ! (date ! (list match score (gnus-day-number date))) ! (score ! (list match score)) ! (t ! (list match)))) ! (old (gnus-score-get header)) elem) ;; We see whether we can collapse some score entries. ;; This isn't quite correct, because there may be more elements --- 574,589 ---- (setq match (string-to-int match))) ! (unless (eq date 'now) ! ;; Add the score entry to the score file. ! (when (= score gnus-score-interactive-default-score) (setq score nil)) ! (let ((old (gnus-score-get header)) elem) + (setq new + (cond + (type (list match score (and date (gnus-day-number date)) type)) + (date (list match score (gnus-day-number date))) + (score (list match score)) + (t (list match)))) ;; We see whether we can collapse some score entries. ;; This isn't quite correct, because there may be more elements *************** If optional argument `SILENT' is nil, sh *** 418,423 **** gnus-score-interactive-default-score))) ;; Nope, we have to add a new elem. ! (gnus-score-set header (if old (cons new old) (list new))))) ! (gnus-score-set 'touched '(t))))) (defun gnus-summary-score-effect (header match type score) --- 600,616 ---- gnus-score-interactive-default-score))) ;; Nope, we have to add a new elem. ! (gnus-score-set header (if old (cons new old) (list new)))) ! (gnus-score-set 'touched '(t)))) ! ! ;; Score the current buffer. ! (unless silent ! (if (and (>= (nth 1 (assoc header gnus-header-index)) 0) ! (eq (nth 2 (assoc header gnus-header-index)) ! 'gnus-score-string)) ! (gnus-summary-score-effect header match type score) ! (gnus-summary-rescore))) ! ! ;; Return the new scoring rule. ! new)) (defun gnus-summary-score-effect (header match type score) *************** SCORE is the score to add." *** 440,445 **** (let ((regexp (cond ((eq type 'f) (gnus-simplify-subject-fuzzy match)) ! (type match) ! (t (concat "\\`.*" (regexp-quote match) ".*\\'"))))) (while (not (eobp)) (let ((content (gnus-summary-header header 'noerr)) --- 633,642 ---- (let ((regexp (cond ((eq type 'f) (gnus-simplify-subject-fuzzy match)) ! ((eq type 'r) ! match) ! ((eq type 'e) ! (concat "\\`" (regexp-quote match) "\\'")) ! (t ! (regexp-quote match))))) (while (not (eobp)) (let ((content (gnus-summary-header header 'noerr)) *************** SCORE is the score to add." *** 487,491 **** (gnus-score-set 'touched '(t)) (setq gnus-summary-mark-below score) ! (gnus-summary-update-lines)) (defun gnus-score-set-expunge-below (score) --- 684,711 ---- (gnus-score-set 'touched '(t)) (setq gnus-summary-mark-below score) ! (gnus-score-update-lines)) ! ! (defun gnus-score-update-lines () ! "Update all lines in the summary buffer." ! (save-excursion ! (goto-char (point-min)) ! (while (not (eobp)) ! (gnus-summary-update-line) ! (forward-line 1)))) ! ! (defun gnus-score-update-all-lines () ! "Update all lines in the summary buffer, even the hidden ones." ! (save-excursion ! (goto-char (point-min)) ! (let (hidden) ! (while (not (eobp)) ! (when (gnus-summary-show-thread) ! (push (point) hidden)) ! (gnus-summary-update-line) ! (forward-line 1)) ! ;; Re-hide the hidden threads. ! (while hidden ! (goto-char (pop hidden)) ! (gnus-summary-hide-thread))))) (defun gnus-score-set-expunge-below (score) *************** SCORE is the score to add." *** 498,501 **** --- 718,751 ---- (gnus-score-set 'touched '(t))) + (defun gnus-score-followup-article (&optional score) + "Add SCORE to all followups to the article in the current buffer." + (interactive "P") + (setq score (gnus-score-default score)) + (when (gnus-buffer-live-p gnus-summary-buffer) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let ((id (mail-fetch-field "message-id"))) + (when id + (set-buffer gnus-summary-buffer) + (gnus-summary-score-entry + "references" (concat id "[ \t]*$") 'r + score (current-time-string) nil t))))))) + + (defun gnus-score-followup-thread (&optional score) + "Add SCORE to all later articles in the thread the current buffer is part of." + (interactive "P") + (setq score (gnus-score-default score)) + (when (gnus-buffer-live-p gnus-summary-buffer) + (save-excursion + (save-restriction + (goto-char (point-min)) + (let ((id (mail-fetch-field "message-id"))) + (when id + (set-buffer gnus-summary-buffer) + (gnus-summary-score-entry + "references" id 's + score (current-time-string)))))))) + (defun gnus-score-set (symbol value &optional alist) ;; Set SYMBOL to VALUE in ALIST. *************** SCORE is the score to add." *** 503,509 **** (or alist gnus-score-alist ! (progn ! (gnus-score-load (gnus-score-file-name gnus-newsgroup-name)) ! gnus-score-alist))) (entry (assoc symbol alist))) (cond ((gnus-score-get 'read-only alist) --- 753,757 ---- (or alist gnus-score-alist ! (gnus-newsgroup-score-alist))) (entry (assoc symbol alist))) (cond ((gnus-score-get 'read-only alist) *************** SCORE is the score to add." *** 518,551 **** (cons (cons symbol value) (cdr alist))))))) ! (defun gnus-score-get (symbol &optional alist) ! ;; Get SYMBOL's definition in ALIST. ! (cdr (assoc symbol ! (or alist ! gnus-score-alist ! (progn ! (gnus-score-load ! (gnus-score-file-name gnus-newsgroup-name)) ! gnus-score-alist))))) (defun gnus-score-change-score-file (file) "Change current score alist." (interactive ! (list (read-file-name "Edit score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) ! (defun gnus-score-edit-alist (file) "Edit the current score alist." (interactive (list gnus-current-score-file)) (let ((winconf (current-window-configuration))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message 4 (substitute-command-keys ! "\\\\[gnus-score-edit-done] to save edits"))) (defun gnus-score-edit-file (file) --- 766,824 ---- (cons (cons symbol value) (cdr alist))))))) ! (defun gnus-summary-raise-score (n) ! "Raise the score of the current article by N." ! (interactive "p") ! (gnus-set-global-variables) ! (gnus-summary-set-score (+ (gnus-summary-article-score) ! (or n gnus-score-interactive-default-score )))) ! ! (defun gnus-summary-set-score (n) ! "Set the score of the current article to N." ! (interactive "p") ! (gnus-set-global-variables) ! (save-excursion ! (gnus-summary-show-thread) ! (let ((buffer-read-only nil)) ! ;; Set score. ! (gnus-summary-update-mark ! (if (= n (or gnus-summary-default-score 0)) ? ! (if (< n (or gnus-summary-default-score 0)) ! gnus-score-below-mark gnus-score-over-mark)) 'score)) ! (let* ((article (gnus-summary-article-number)) ! (score (assq article gnus-newsgroup-scored))) ! (if score (setcdr score n) ! (setq gnus-newsgroup-scored ! (cons (cons article n) gnus-newsgroup-scored)))) ! (gnus-summary-update-line))) ! ! (defun gnus-summary-current-score () ! "Return the score of the current article." ! (interactive) ! (gnus-set-global-variables) ! (gnus-message 1 "%s" (gnus-summary-article-score))) (defun gnus-score-change-score-file (file) "Change current score alist." (interactive ! (list (read-file-name "Change to score file: " gnus-kill-files-directory))) (gnus-score-load-file file) (gnus-set-mode-line 'summary)) ! (defvar gnus-score-edit-exit-function) ! (defun gnus-score-edit-current-scores (file) "Edit the current score alist." (interactive (list gnus-current-score-file)) (let ((winconf (current-window-configuration))) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) + (gnus-make-directory (file-name-directory file)) (setq gnus-score-edit-buffer (find-file-noselect file)) (gnus-configure-windows 'edit-score) (gnus-score-mode) + (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-score-edit-exit] to save edits"))) (defun gnus-score-edit-file (file) *************** SCORE is the score to add." *** 553,556 **** --- 826,830 ---- (interactive (list (read-file-name "Edit score file: " gnus-kill-files-directory))) + (gnus-make-directory (file-name-directory file)) (and (buffer-name gnus-summary-buffer) (gnus-score-save)) (let ((winconf (current-window-configuration))) *************** SCORE is the score to add." *** 558,570 **** (gnus-configure-windows 'edit-score) (gnus-score-mode) (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf)) (gnus-message 4 (substitute-command-keys ! "\\\\[gnus-score-edit-done] to save edits"))) (defun gnus-score-load-file (file) ;; Load score file FILE. Returns a list a retrieved score-alists. - (setq gnus-kill-files-directory (or gnus-kill-files-directory "~/News/")) (let* ((file (expand-file-name (or (and (string-match --- 832,844 ---- (gnus-configure-windows 'edit-score) (gnus-score-mode) + (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-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 (or (and (string-match *************** SCORE is the score to add." *** 573,577 **** (expand-file-name file)) file) ! (concat gnus-kill-files-directory file)))) (cached (assoc file gnus-score-cache)) (global (member file gnus-internal-global-score-files)) --- 847,852 ---- (expand-file-name file)) file) ! (concat (file-name-as-directory gnus-kill-files-directory) ! file)))) (cached (assoc file gnus-score-cache)) (global (member file gnus-internal-global-score-files)) *************** SCORE is the score to add." *** 590,600 **** (not (assq 'read-only alist)) (setq alist (cons (list 'read-only t) alist))) - ;; Update cache. (setq gnus-score-cache (cons (cons file alist) gnus-score-cache))) ! ;; If there are actual scores in the alist, we add it to the ! ;; return value of this function. ! (if (memq t (mapcar (lambda (e) (stringp (car e))) alist)) ! (setq lists (list alist))) ;; Treat the other possible atoms in the score alist. (let ((mark (car (gnus-score-get 'mark alist))) --- 865,882 ---- (not (assq 'read-only alist)) (setq alist (cons (list 'read-only t) alist))) (setq gnus-score-cache (cons (cons file alist) gnus-score-cache))) ! (let ((a alist) ! found) ! (while a ! ;; Downcase all header names. ! (when (stringp (caar a)) ! (setcar (car a) (downcase (caar a))) ! (setq found t)) ! (pop a)) ! ;; If there are actual scores in the alist, we add it to the ! ;; return value of this function. ! (when found ! (setq lists (list alist)))) ;; Treat the other possible atoms in the score alist. (let ((mark (car (gnus-score-get 'mark alist))) *************** SCORE is the score to add." *** 605,608 **** --- 887,893 ---- (orphan (car (gnus-score-get 'orphan alist))) (adapt (gnus-score-get 'adapt alist)) + (thread-mark-and-expunge + (car (gnus-score-get 'thread-mark-and-expunge alist))) + (adapt-file (car (gnus-score-get 'adapt-file alist))) (local (gnus-score-get 'local alist)) (eval (car (gnus-score-get 'eval alist)))) *************** SCORE is the score to add." *** 613,617 **** (mapcar (lambda (file) (gnus-score-load-file file)) ! files)))) (and eval (not global) (eval eval)) ;; We then expand any exclude-file directives. --- 898,903 ---- (mapcar (lambda (file) (gnus-score-load-file file)) ! (if adapt-file (cons adapt-file files) ! files))))) (and eval (not global) (eval eval)) ;; We then expand any exclude-file directives. *************** SCORE is the score to add." *** 628,635 **** (while local (and (consp (car local)) ! (symbolp (car (car local))) (progn ! (make-local-variable (car (car local))) ! (set (car (car local)) (nth 1 (car local))))) (setq local (cdr local))))) (if orphan (setq gnus-orphan-score orphan)) --- 914,921 ---- (while local (and (consp (car local)) ! (symbolp (caar local)) (progn ! (make-local-variable (caar local)) ! (set (caar local) (nth 1 (car local))))) (setq local (cdr local))))) (if orphan (setq gnus-orphan-score orphan)) *************** SCORE is the score to add." *** 646,653 **** ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) (setq gnus-summary-expunge-below ! (or expunge mark-and-expunge gnus-summary-expunge-below))) (setq gnus-current-score-file file) (setq gnus-score-alist alist) --- 932,943 ---- ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) gnus-default-adaptive-score-alist))) + (setq gnus-thread-expunge-below + (or thread-mark-and-expunge gnus-thread-expunge-below)) (setq gnus-summary-mark-below (or mark mark-and-expunge gnus-summary-mark-below)) (setq gnus-summary-expunge-below ! (or expunge mark-and-expunge gnus-summary-expunge-below)) ! (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) *************** SCORE is the score to add." *** 672,700 **** (defun gnus-score-load-score-alist (file) (let (alist) ! (if (file-readable-p file) ! (progn ! (save-excursion ! (gnus-set-work-buffer) ! (insert-file-contents file) ! (goto-char (point-min)) ! ;; Only do the loading if the score file isn't empty. ! (if (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) ! (setq alist ! (condition-case () ! (read (current-buffer)) ! (error ! (progn ! (gnus-message 3 "Problem with score file %s" file) ! (ding) ! (sit-for 2) ! nil)))))) ! (if (eq (car alist) 'setq) ! (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) ! (setq gnus-score-alist alist)) ! (setq gnus-score-alist ! (gnus-score-check-syntax gnus-score-alist file))) ! (setq gnus-score-alist nil)))) (defun gnus-score-check-syntax (alist file) (cond ((null alist) --- 962,992 ---- (defun gnus-score-load-score-alist (file) (let (alist) ! (if (not (file-readable-p file)) ! (setq gnus-score-alist nil) ! (save-excursion ! (gnus-set-work-buffer) ! (insert-file-contents file) ! (goto-char (point-min)) ! ;; Only do the loading if the score file isn't empty. ! (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) ! (setq alist ! (condition-case () ! (read (current-buffer)) ! (error ! (progn ! (gnus-message 3 "Problem with score file %s" file) ! (ding) ! (sit-for 2) ! nil)))))) ! (if (eq (car alist) 'setq) ! ;; This is an old-style score file. ! (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) ! (setq gnus-score-alist alist)) ! ;; Check the syntax of the score file. ! (setq gnus-score-alist ! (gnus-score-check-syntax gnus-score-alist file))))) (defun gnus-score-check-syntax (alist file) + "Check the syntax of the score ALIST." (cond ((null alist) *************** SCORE is the score to add." *** 706,723 **** (t (let ((a alist) ! err) (while (and a (not err)) ! (cond ((not (listp (car a))) ! (gnus-message 3 "Illegal score element %s in %s" (car a) file) ! (setq err t)) ! ((and (stringp (car (car a))) ! (not (listp (nth 1 (car a))))) ! (gnus-message 3 "Illegal header match %s in %s" (nth 1 (car a)) file) ! (setq err t)) ! (t ! (setq a (cdr a))))) (if err (progn (ding) nil) alist))))) --- 998,1036 ---- (t (let ((a alist) ! sr err s type) (while (and a (not err)) ! (setq ! err ! (cond ! ((not (listp (car a))) ! (format "Illegal score element %s in %s" (car a) file)) ! ((stringp (caar a)) ! (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 ! err ! (cond ! ((if (member (downcase type) '("lines" "chars")) ! (not (numberp (car s))) ! (not (stringp (car s)))) ! (format "Illegal match %s in %s" (car s) file)) ! ((and (cadr s) (not (integerp (cadr s)))) ! (format "Non-integer score %s in %s" (cadr s) file)) ! ((and (caddr s) (not (integerp (caddr s)))) ! (format "Non-integer date %s in %s" (caddr s) file)) ! ((and (cadddr s) (not (symbolp (cadddr s)))) ! (format "Non-symbol match type %s in %s" (cadddr s) file))))) ! err))))) ! (setq a (cdr a))) (if err (progn (ding) + (gnus-message 3 err) + (sit-for 2) nil) alist))))) *************** SCORE is the score to add." *** 735,739 **** (while scor (setcar scor ! (list (car (car scor)) (nth 2 (car scor)) (and (nth 3 (car scor)) (gnus-day-number (nth 3 (car scor)))) --- 1048,1052 ---- (while scor (setcar scor ! (list (caar scor) (nth 2 (car scor)) (and (nth 3 (car scor)) (gnus-day-number (nth 3 (car scor)))) *************** SCORE is the score to add." *** 768,776 **** (erase-buffer) (let (emacs-lisp-mode-hook) ! (if (string-match (concat gnus-adaptive-file-suffix "$") file) ;; This is an adaptive score file, so we do not run ;; it through `pp'. These files can get huge, and ;; are not meant to be edited by human hands. ! (insert (format "%S" score)) ;; This is a normal score file, so we print it very ;; prettily. --- 1081,1091 ---- (erase-buffer) (let (emacs-lisp-mode-hook) ! (if (string-match ! (concat (regexp-quote gnus-adaptive-file-suffix) ! "$") file) ;; This is an adaptive score file, so we do not run ;; it through `pp'. These files can get huge, and ;; are not meant to be edited by human hands. ! (prin1 score (current-buffer)) ;; This is a normal score file, so we print it very ;; prettily. *************** SCORE is the score to add." *** 782,793 **** (delete-file file) ;; There are scores, so we write the file. ! (and (file-writable-p file) ! (write-region (point-min) (point-max) ! file nil 'silent))))))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) ;; Score `gnus-newsgroup-headers'. ! (let (scores) ;; PLM: probably this is not the best place to clear orphan-score (setq gnus-orphan-score nil) --- 1097,1112 ---- (delete-file file) ;; There are scores, so we write the file. ! (when (file-writable-p file) ! (write-region (point-min) (point-max) file nil 'silent) ! (and gnus-score-after-write-file-function ! (funcall gnus-score-after-write-file-function file))))) ! (and gnus-score-uncacheable-files ! (string-match gnus-score-uncacheable-files file) ! (gnus-score-remove-from-cache file))))) (kill-buffer (current-buffer))))) (defun gnus-score-headers (score-files &optional trace) ;; Score `gnus-newsgroup-headers'. ! (let (scores news) ;; PLM: probably this is not the best place to clear orphan-score (setq gnus-orphan-score nil) *************** SCORE is the score to add." *** 805,810 **** (setq score-files (cdr score-files))) ;; Prune the score files that are to be excluded, if any. ! (if (not gnus-scores-exclude-files) ! () (let ((s scores) c) --- 1124,1128 ---- (setq score-files (cdr score-files))) ;; Prune the score files that are to be excluded, if any. ! (when gnus-scores-exclude-files (let ((s scores) c) *************** SCORE is the score to add." *** 814,878 **** (setq scores (delq (car s) scores))) (setq s (cdr s))))) ! (if (not (and gnus-summary-default-score ! scores ! (> (length gnus-newsgroup-headers) ! (length gnus-newsgroup-scored)))) ! () ! (let* ((entries gnus-header-index) ! (now (gnus-day-number (current-time-string))) ! (expire (- now gnus-score-expiry-days)) ! (headers gnus-newsgroup-headers) ! (current-score-file gnus-current-score-file) ! entry header) ! (gnus-message 5 "Scoring...") ! ;; Create articles, an alist of the form `(HEADER . SCORE)'. ! (while headers ! (setq header (car headers) ! headers (cdr headers)) ! ;; WARNING: The assq makes the function O(N*S) while it could ! ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) ! ;; and S is (length gnus-newsgroup-scored). ! (or (assq (mail-header-number header) gnus-newsgroup-scored) ! (setq gnus-scores-articles ;Total of 2 * N cons-cells used. ! (cons (cons header (or gnus-summary-default-score 0)) ! gnus-scores-articles)))) ! (save-excursion ! (set-buffer (get-buffer-create "*Headers*")) ! (buffer-disable-undo (current-buffer)) ! ;; Set the global variant of this variable. ! (setq gnus-current-score-file current-score-file) ! ;; score orphans ! (if gnus-orphan-score ! (progn ! (setq gnus-score-index ! (nth 1 (assoc "references" gnus-header-index))) ! (gnus-score-orphans gnus-orphan-score))) ! ;; Run each header through the score process. ! (while entries ! (setq entry (car entries) ! header (nth 0 entry) ! entries (cdr entries)) ! (setq gnus-score-index (nth 1 (assoc header gnus-header-index))) ! (if (< 0 (apply 'max (mapcar ! (lambda (score) ! (length (gnus-score-get header score))) ! scores))) ! (funcall (nth 2 entry) scores header now expire trace))) ! ;; Remove the buffer. ! (kill-buffer (current-buffer))) ! ! ;; Add articles to `gnus-newsgroup-scored'. ! (while gnus-scores-articles ! (or (= gnus-summary-default-score (cdr (car gnus-scores-articles))) ! (setq gnus-newsgroup-scored ! (cons (cons (mail-header-number ! (car (car gnus-scores-articles))) ! (cdr (car gnus-scores-articles))) ! gnus-newsgroup-scored))) ! (setq gnus-scores-articles (cdr gnus-scores-articles))) ! (gnus-message 5 "Scoring...done"))))) --- 1132,1198 ---- (setq scores (delq (car s) scores))) (setq s (cdr s))))) ! (setq news scores) ! ;; Do the scoring. ! (while news ! (setq scores news ! news nil) ! (when (and gnus-summary-default-score ! scores) ! (let* ((entries gnus-header-index) ! (now (gnus-day-number (current-time-string))) ! (expire (and gnus-score-expiry-days ! (- now gnus-score-expiry-days))) ! (headers gnus-newsgroup-headers) ! (current-score-file gnus-current-score-file) ! entry header new) ! (gnus-message 5 "Scoring...") ! ;; Create articles, an alist of the form `(HEADER . SCORE)'. ! (while (setq header (pop headers)) ! ;; WARNING: The assq makes the function O(N*S) while it could ! ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) ! ;; and S is (length gnus-newsgroup-scored). ! (or (assq (mail-header-number header) gnus-newsgroup-scored) ! (setq gnus-scores-articles ;Total of 2 * N cons-cells used. ! (cons (cons header (or gnus-summary-default-score 0)) ! gnus-scores-articles)))) ! (save-excursion ! (set-buffer (get-buffer-create "*Headers*")) ! (buffer-disable-undo (current-buffer)) ! ;; 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 ! (nth 1 (assoc "references" gnus-header-index))) ! (gnus-score-orphans gnus-orphan-score)) ! ;; Run each header through the score process. ! (while entries ! (setq entry (pop entries) ! header (nth 0 entry) ! gnus-score-index (nth 1 (assoc header gnus-header-index))) ! (when (< 0 (apply 'max (mapcar ! (lambda (score) ! (length (gnus-score-get header score))) ! scores))) ! ;; Call the scoring function for this type of "header". ! (when (setq new (funcall (nth 2 entry) scores header ! now expire trace)) ! (push new news)))) ! ;; Remove the buffer. ! (kill-buffer (current-buffer))) ! ! ;; Add articles to `gnus-newsgroup-scored'. ! (while gnus-scores-articles ! (or (= gnus-summary-default-score (cdar gnus-scores-articles)) ! (setq gnus-newsgroup-scored ! (cons (cons (mail-header-number ! (caar gnus-scores-articles)) ! (cdar gnus-scores-articles)) ! gnus-newsgroup-scored))) ! (setq gnus-scores-articles (cdr gnus-scores-articles))) ! (gnus-message 5 "Scoring...done")))))) *************** SCORE is the score to add." *** 976,998 **** (while articles (and (funcall match-func ! (or (aref (car (car articles)) gnus-score-index) 0) match) (progn (and trace (setq gnus-score-trace ! (cons (cons (car (car articles)) kill) ! gnus-score-trace))) (setq found t) ! (setcdr (car articles) (+ score (cdr (car articles)))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) ! (setq entries rest)))))) (defun gnus-score-date (scores header now expire &optional trace) --- 1296,1322 ---- (while articles (and (funcall match-func ! (or (aref (caar articles) gnus-score-index) 0) match) (progn (and trace (setq gnus-score-trace ! (cons ! (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))) (setq found t) ! (setcdr (car articles) (+ score (cdar articles))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) ! (setq entries rest))))) ! nil) (defun gnus-score-date (scores header now expire &optional trace) *************** SCORE is the score to add." *** 1027,1143 **** (while articles (and ! (setq l (aref (car (car articles)) gnus-score-index)) (funcall match-func match (timezone-make-date-sortable l)) (progn (and trace (setq gnus-score-trace ! (cons (cons (car (car articles)) kill) ! gnus-score-trace))) (setq found t) ! (setcdr (car articles) (+ score (cdr (car articles)))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) ! (setq entries rest)))))) (defun gnus-score-body (scores header now expire &optional trace) (save-excursion (set-buffer nntp-server-buffer) (save-restriction (let* ((buffer-read-only nil) (articles gnus-scores-articles) - (last (mail-header-number (car (car gnus-scores-articles)))) (all-scores scores) ! (request-func (cond ((string= "head" (downcase header)) 'gnus-request-head) ! ((string= "body" (downcase header)) 'gnus-request-body) (t 'gnus-request-article))) ! entries alist ofunc article) ! ;; Not all backends support partial fetching. In that case, ! ;; we just fetch the entire article. ! (or (gnus-check-backend-function ! (and (string-match "^gnus-" (symbol-name request-func)) ! (intern (substring (symbol-name request-func) ! (match-end 0)))) ! gnus-newsgroup-name) ! (progn ! (setq ofunc request-func) ! (setq request-func 'gnus-request-article))) ! (while articles ! (setq article (mail-header-number (car (car articles)))) ! (gnus-message 7 "Scoring on article %s of %s..." article last) ! (if (not (funcall request-func article gnus-newsgroup-name)) ! () ! (widen) ! (goto-char (point-min)) ! ;; If just parts of the article is to be searched, but the ! ;; backend didn't support partial fetching, we just narrow ! ;; to the relevant parts. ! (if ofunc ! (if (eq ofunc 'gnus-request-head) (narrow-to-region ! (point) ! (or (search-forward "\n\n" nil t) (point-max))) ! (narrow-to-region ! (or (search-forward "\n\n" nil t) (point)) ! (point-max)))) ! (setq scores all-scores) ! ;; Find matches. ! (while scores ! (setq alist (car scores) ! scores (cdr scores) ! entries (assoc header alist)) ! (while (cdr entries) ;First entry is the header index. ! (let* ((rest (cdr entries)) ! (kill (car rest)) ! (match (nth 0 kill)) ! (type (or (nth 3 kill) 's)) ! (score (or (nth 1 kill) ! gnus-score-interactive-default-score)) ! (date (nth 2 kill)) ! (found nil) ! (case-fold-search ! (not (or (eq type 'R) (eq type 'S) ! (eq type 'Regexp) (eq type 'String)))) ! (search-func ! (cond ((or (eq type 'r) (eq type 'R) ! (eq type 'regexp) (eq type 'Regexp)) ! 're-search-forward) ! ((or (eq type 's) (eq type 'S) ! (eq type 'string) (eq type 'String)) ! 'search-forward) ! (t ! (error "Illegal match type: %s" type))))) ! (goto-char (point-min)) ! (if (funcall search-func match nil t) ! ;; Found a match, update scores. ! (progn ! (setcdr (car articles) (+ score (cdr (car articles)))) ! (setq found t) ! (and trace (setq gnus-score-trace ! (cons (cons (car (car articles)) kill) ! gnus-score-trace))))) ! ;; Update expire date ! (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))) ! (setq entries rest))))) ! (setq articles (cdr articles))))))) ! ! ! (defun gnus-score-followup (scores header now expire &optional trace) ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) --- 1351,1483 ---- (while articles (and ! (setq l (aref (caar articles) gnus-score-index)) (funcall match-func match (timezone-make-date-sortable l)) (progn (and trace (setq gnus-score-trace ! (cons ! (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))) (setq found t) ! (setcdr (car articles) (+ score (cdar articles))))) (setq articles (cdr articles))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) (setq rest entries))) ! (setq entries rest))))) ! nil) (defun gnus-score-body (scores header now expire &optional trace) (save-excursion (set-buffer nntp-server-buffer) + (setq gnus-scores-articles + (sort gnus-scores-articles + (lambda (a1 a2) + (< (mail-header-number (car a1)) + (mail-header-number (car a2)))))) (save-restriction (let* ((buffer-read-only nil) (articles gnus-scores-articles) (all-scores scores) ! (request-func (cond ((string= "head" header) 'gnus-request-head) ! ((string= "body" header) 'gnus-request-body) (t 'gnus-request-article))) ! entries alist ofunc article last) ! (when articles ! (while (cdr articles) ! (setq articles (cdr articles))) ! (setq last (mail-header-number (caar articles))) ! (setq articles gnus-scores-articles) ! ;; Not all backends support partial fetching. In that case, ! ;; we just fetch the entire article. ! (or (gnus-check-backend-function ! (and (string-match "^gnus-" (symbol-name request-func)) ! (intern (substring (symbol-name request-func) ! (match-end 0)))) ! gnus-newsgroup-name) ! (progn ! (setq ofunc request-func) ! (setq request-func 'gnus-request-article))) ! (while articles ! (setq article (mail-header-number (caar articles))) ! (gnus-message 7 "Scoring on article %s of %s..." article last) ! (when (funcall request-func article gnus-newsgroup-name) ! (widen) ! (goto-char (point-min)) ! ;; If just parts of the article is to be searched, but the ! ;; backend didn't support partial fetching, we just narrow ! ;; to the relevant parts. ! (if ofunc ! (if (eq ofunc 'gnus-request-head) ! (narrow-to-region ! (point) ! (or (search-forward "\n\n" nil t) (point-max))) (narrow-to-region ! (or (search-forward "\n\n" nil t) (point)) ! (point-max)))) ! (setq scores all-scores) ! ;; Find matches. ! (while scores ! (setq alist (car scores) ! scores (cdr scores) ! entries (assoc header alist)) ! (while (cdr entries) ;First entry is the header index. ! (let* ((rest (cdr entries)) ! (kill (car rest)) ! (match (nth 0 kill)) ! (type (or (nth 3 kill) 's)) ! (score (or (nth 1 kill) ! gnus-score-interactive-default-score)) ! (date (nth 2 kill)) ! (found nil) ! (case-fold-search ! (not (or (eq type 'R) (eq type 'S) ! (eq type 'Regexp) (eq type 'String)))) ! (search-func ! (cond ((or (eq type 'r) (eq type 'R) ! (eq type 'regexp) (eq type 'Regexp)) ! 're-search-forward) ! ((or (eq type 's) (eq type 'S) ! (eq type 'string) (eq type 'String)) ! 'search-forward) ! (t ! (error "Illegal match type: %s" type))))) ! (goto-char (point-min)) ! (if (funcall search-func match nil t) ! ;; Found a match, update scores. ! (progn ! (setcdr (car articles) (+ score (cdar articles))) ! (setq found t) ! (and trace (setq gnus-score-trace ! (cons ! (cons ! (car-safe ! (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))))) ! ;; Update expire date ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))) ! (setq entries rest))))) ! (setq articles (cdr articles))))))) ! nil) ! (defun gnus-score-followup (scores header now expire &optional trace thread) ;; Insert the unique article headers in the buffer. (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) *************** SCORE is the score to add." *** 1145,1154 **** (all-scores scores) ;; gnus-score-index is used as a free variable. ! alike last this art entries alist articles) ;; Change score file to the adaptive score file. All entries that ;; this function makes will be put into this file. ! (gnus-score-load-file (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) --- 1485,1499 ---- (all-scores scores) ;; gnus-score-index is used as a free variable. ! alike last this art entries alist articles ! new news) ;; Change score file to the adaptive score file. All entries that ;; this function makes will be put into this file. ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-score-load-file ! (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)))) (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) *************** SCORE is the score to add." *** 1210,1228 **** arts (cdr arts)) (gnus-score-add-followups ! (car art) score all-scores))))) (while (funcall search-func match nil t) (end-of-line) (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 (car art) score all-scores)))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) --- 1555,1574 ---- arts (cdr arts)) (gnus-score-add-followups ! (car art) score all-scores thread)))) ! (end-of-line)) (while (funcall search-func match nil t) (end-of-line) (setq found (setq arts (get-text-property (point) 'articles))) ;; Found a match, update scores. ! (while (setq art (pop arts)) ! (when (setq new (gnus-score-add-followups ! (car art) score all-scores thread)) ! (push new news))))) ;; Update expire date (cond ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. (gnus-score-set 'touched '(t) alist) (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. (gnus-score-set 'touched '(t) alist) (setcdr entries (cdr rest)) *************** SCORE is the score to add." *** 1230,1236 **** (setq entries rest)))) ;; We change the score file back to the previous one. ! (gnus-score-load-file current-score-file))) ! (defun gnus-score-add-followups (header score scores) (save-excursion (set-buffer gnus-summary-buffer) --- 1576,1586 ---- (setq entries rest)))) ;; We change the score file back to the previous one. ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-score-load-file current-score-file)) ! (list (cons "references" news)))) ! (defun gnus-score-add-followups (header score scores &optional thread) ! "Add a score entry to the adapt file." (save-excursion (set-buffer gnus-summary-buffer) *************** SCORE is the score to add." *** 1239,1255 **** entry dont) ;; Don't enter a score if there already is one. ! (while scores ! (setq entry (car scores)) (and (equal "references" (car entry)) ! (or (null (nth 3 (car (cdr entry)))) ! (eq 's (nth 3 (car (cdr entry))))) ! (progn ! (if (assoc id entry) ! (setq dont t)))) ! (setq scores (cdr scores))) ! (or dont ! (gnus-summary-score-entry ! "references" id 's score (current-time-string) nil t))))) ! (defun gnus-score-string (score-list header now expire &optional trace) --- 1589,1602 ---- entry dont) ;; Don't enter a score if there already is one. ! (while (setq entry (pop scores)) (and (equal "references" (car entry)) ! (or (null (nth 3 (cadr entry))) ! (eq 's (nth 3 (cadr entry)))) ! (assoc id entry) ! (setq dont t))) ! (unless dont ! (gnus-summary-score-entry ! (if thread "thread" "references") ! id 's score (current-time-string) nil t))))) (defun gnus-score-string (score-list header now expire &optional trace) *************** SCORE is the score to add." *** 1294,1298 **** (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) ! ;; Find ordinary matches. (setq scores score-list) --- 1641,1645 ---- (insert last ?\n) (put-text-property (1- (point)) (point) 'articles alike))) ! ;; Find ordinary matches. (setq scores score-list) *************** SCORE is the score to add." *** 1320,1325 **** --- 1667,1674 ---- (if (= dmt ?f) (setq fuzzy t) + ;; Do non-fuzzy matching. (goto-char (point-min)) (if (= dmt ?e) + ;; Do exact matching. (while (and (not (eobp)) (funcall search-func match nil t)) *************** SCORE is the score to add." *** 1337,1344 **** arts (cdr arts)) (setcdr art (+ score (cdr art))) ! (setq gnus-score-trace ! (cons (cons (mail-header-number ! (car art)) kill) ! gnus-score-trace))) (while arts (setq art (car arts) --- 1686,1696 ---- arts (cdr arts)) (setcdr art (+ score (cdr art))) ! (setq gnus-score-trace ! (cons ! (cons ! (car-safe ! (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace))) (while arts (setq art (car arts) *************** SCORE is the score to add." *** 1346,1349 **** --- 1698,1702 ---- (setcdr art (+ score (cdr art))))))) (forward-line 1)) + ;; Do regexp and substring matching. (and (string= match "") (setq match "\n")) (while (and (not (eobp)) *************** SCORE is the score to add." *** 1355,1441 **** (if trace (while arts ! (setq art (car arts) ! arts (cdr arts)) (setcdr art (+ score (cdr art))) ! (setq gnus-score-trace ! (cons (cons (mail-header-number (car art)) kill) ! gnus-score-trace))) (while arts ! (setq art (car arts) ! arts (cdr arts)) (setcdr art (+ score (cdr art))))) (forward-line 1))) ;; Update expire date ! (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries)))) (setq entries rest)))) ! ;; Find fuzzy matches. ! (setq scores (and fuzzy score-list)) ! (if fuzzy (gnus-simplify-buffer-fuzzy)) ! (while scores ! (setq alist (car scores) ! scores (cdr scores) ! entries (assoc header alist)) ! (while (cdr entries) ;First entry is the header index. ! (let* ((rest (cdr entries)) ! (kill (car rest)) ! (match (nth 0 kill)) ! (type (or (nth 3 kill) 's)) ! (score (or (nth 1 kill) gnus-score-interactive-default-score)) ! (date (nth 2 kill)) ! (found nil) ! (mt (aref (symbol-name type) 0)) ! (case-fold-search ! (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) ! (dmt (downcase mt)) ! (search-func ! (cond ((= dmt ?r) 're-search-forward) ! ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) ! (t (error "Illegal match type: %s" type)))) ! arts art) ! (if (/= dmt ?f) ! () ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (funcall search-func match nil t)) ! (and (= (progn (beginning-of-line) (point)) ! (match-beginning 0)) ! (= (progn (end-of-line) (point)) ! (match-end 0)) ! (progn ! (setq found (setq arts (get-text-property ! (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art))) ! (setq gnus-score-trace ! (cons (cons (mail-header-number ! (car art)) kill) ! gnus-score-trace))) ! (while arts ! (setq art (car arts) ! arts (cdr arts)) ! (setcdr art (+ score (cdr art))))))) ! (forward-line 1)) ! ;; Update expire date ! (cond ((null date)) ;Permanent entry. ! (found ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((< date expire) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries)))) ! (setq entries rest)))))) (defun gnus-score-string< (a1 a2) --- 1708,1789 ---- (if trace (while arts ! (setq art (pop arts)) (setcdr art (+ score (cdr art))) ! (push (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace)) (while arts ! (setq art (pop arts)) (setcdr art (+ score (cdr art))))) (forward-line 1))) ;; Update expire date ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries)))) (setq entries rest)))) ! ;; Find fuzzy matches. ! (when fuzzy ! (setq scores score-list) ! (gnus-simplify-buffer-fuzzy) ! (while scores ! (setq alist (car scores) ! scores (cdr scores) ! entries (assoc header alist)) ! (while (cdr entries) ;First entry is the header index. ! (let* ((rest (cdr entries)) ! (kill (car rest)) ! (match (nth 0 kill)) ! (type (or (nth 3 kill) 's)) ! (score (or (nth 1 kill) gnus-score-interactive-default-score)) ! (date (nth 2 kill)) ! (found nil) ! (mt (aref (symbol-name type) 0)) ! (case-fold-search (not (= mt ?F))) ! (dmt (downcase mt)) ! arts art) ! (when (= dmt ?f) ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (search-forward match nil t)) ! (when (and (= (progn (beginning-of-line) (point)) ! (match-beginning 0)) ! (= (progn (end-of-line) (point)) ! (match-end 0))) ! (setq found (setq arts (get-text-property ! (point) 'articles))) ! ;; Found a match, update scores. ! (if trace ! (while arts ! (setq art (pop arts)) ! (setcdr art (+ score (cdr art))) ! (push (cons ! (car-safe (rassq alist gnus-score-cache)) ! kill) ! gnus-score-trace)) ! (while arts ! (setq art (pop arts)) ! (setcdr art (+ score (cdr art)))))) ! (forward-line 1)) ! ;; Update expire date ! (unless trace ! (cond ! ((null date)) ;Permanent entry. ! ((and found gnus-update-score-entry-dates) ;Match, update date. ! (gnus-score-set 'touched '(t) alist) ! (setcar (nthcdr 2 kill) now)) ! ((and expire (< date expire)) ;Old entry, remove. ! (gnus-score-set 'touched '(t) alist) ! (setcdr entries (cdr rest)) ! (setq rest entries))))) ! (setq entries rest)))))) ! nil) (defun gnus-score-string< (a1 a2) *************** SCORE is the score to add." *** 1449,1468 **** (cons (mail-header-number (car article)) (cdr article))) - (defconst gnus-header-index - ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) - ("head" -1 gnus-score-body) - ("body" -1 gnus-score-body) - ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup))) - (defun gnus-current-score-file-nondirectory (&optional score-file) (let ((score-file (or score-file gnus-current-score-file))) --- 1797,1800 ---- *************** SCORE is the score to add." *** 1476,1479 **** --- 1808,1812 ---- (alist malist) (date (current-time-string)) + (data gnus-newsgroup-data) elem headers match) ;; First we transform the adaptive rule alist into something *************** SCORE is the score to add." *** 1486,1643 **** (while elem (setcdr (car elem) ! (cons (symbol-name (car (car elem))) (cdr (car elem)))) (setcar (car elem) ! (intern ! (concat "gnus-header-" ! (downcase (symbol-name (car (car elem))))))) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; We change the score file to the adaptive score file. ! (gnus-score-load-file (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)) ! ;; The we score away. ! (goto-char (point-min)) ! (while (not (eobp)) ! (setq elem (cdr (assq (gnus-summary-article-mark) alist))) ! (if (or (not elem) ! (get-text-property (point) 'gnus-pseudo)) ! () ! (setq headers (gnus-get-header-by-number ! (gnus-summary-article-number))) ! (while (and elem headers) ! (setq match (funcall (car (car elem)) headers)) ! (gnus-summary-score-entry ! (nth 1 (car elem)) match ! (cond ! ((numberp match) ! '=) ! ((equal (nth 1 (car elem)) "date") ! 'a) ! (t ! ;; Whether we use substring or exact matches are controlled ! ;; here. ! (if (or (not gnus-score-exact-adapt-limit) ! (< (length match) gnus-score-exact-adapt-limit)) ! 'e ! (if (equal (nth 1 (car elem)) "subject") ! 'f 's)))) ! (nth 2 (car elem)) date nil t) ! (setq elem (cdr elem)))) ! (forward-line 1))))) ! ! (defun gnus-score-remove-lines-adaptive (marks) ! (save-excursion ! (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) ! (alist malist) ! (date (current-time-string)) ! (cur-score gnus-current-score-file) ! elem headers match) ! ;; First we transform the adaptive rule alist into something ! ;; that's faster to process. ! (while malist ! (setq elem (car malist)) ! (if (symbolp (car elem)) ! (setcar elem (symbol-value (car elem)))) ! (setq elem (cdr elem)) ! (while elem ! (setcdr (car elem) ! (cons (symbol-name (car (car elem))) (cdr (car elem)))) ! (setcar (car elem) ! (intern ! (concat "gnus-header-" ! (downcase (symbol-name (car (car elem))))))) ! (setq elem (cdr elem))) ! (setq malist (cdr malist))) ;; The we score away. ! (goto-char (point-min)) ! ;; We change the score file to the adaptive score file. ! (gnus-score-load-file (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)) ! (while (re-search-forward marks nil t) ! (beginning-of-line) ! (setq elem (cdr (assq (gnus-summary-article-mark) alist))) (if (or (not elem) ! (get-text-property (gnus-point-at-bol) 'gnus-pseudo)) () ! (setq headers (gnus-get-header-by-number ! (gnus-summary-article-number))) ! (while elem ! (setq match (funcall (car (car elem)) headers)) ! (gnus-summary-score-entry ! (nth 1 (car elem)) match ! (if (or (not gnus-score-exact-adapt-limit) ! (< (length match) gnus-score-exact-adapt-limit)) ! 'e 's) ! (nth 2 (car elem)) date nil t) ! (setq elem (cdr elem)))) ! (delete-region (point) (progn (forward-line 1) (point)))) ! ;; Switch back to the old score file. ! (gnus-score-load-file cur-score)))) ! ! ;;; ! ;;; Score mode. ! ;;; ! ! (defvar gnus-score-mode-map nil) ! (defvar gnus-score-mode-hook nil) ! ! (if gnus-score-mode-map ! () ! (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) ! (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-done) ! (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)) ! ! (defun gnus-score-mode () ! "Mode for editing score files. ! This mode is an extended emacs-lisp mode. ! ! \\{gnus-score-mode-map}" ! (interactive) ! (kill-all-local-variables) ! (use-local-map gnus-score-mode-map) ! (set-syntax-table emacs-lisp-mode-syntax-table) ! (setq major-mode 'gnus-score-mode) ! (setq mode-name "Score") ! (lisp-mode-variables nil) ! (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) ! ! (defun gnus-score-edit-insert-date () ! "Insert date in numerical format." ! (interactive) ! (insert (int-to-string (gnus-day-number (current-time-string))))) (defun gnus-score-edit-done () - "Save the score file and return to the summary buffer." - (interactive) (let ((bufnam (buffer-file-name (current-buffer))) (winconf gnus-prev-winconf)) ! (gnus-make-directory (file-name-directory (buffer-file-name))) ! (save-buffer) ! (kill-buffer (current-buffer)) (gnus-score-remove-from-cache bufnam) ! (gnus-score-load-file bufnam) ! (and winconf (set-window-configuration winconf)))) (defun gnus-score-find-trace () ! "Find all score rules applied to this article." (interactive) (let ((gnus-newsgroup-headers ! (list (gnus-get-header-by-number (gnus-summary-article-number)))) (gnus-newsgroup-scored nil) (buf (current-buffer)) trace) (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) ! (or (setq trace gnus-score-trace) ! (error "No score rules apply to the current article.")) ! (pop-to-buffer "*Gnus Scores*") ! (gnus-add-current-to-buffer-list) ! (erase-buffer) ! (while trace ! (insert (format "%S\n" (cdr (car trace)))) ! (setq trace (cdr trace))) ! (goto-char (point-min)) ! (pop-to-buffer buf))) (provide 'gnus-score) --- 1819,2256 ---- (while elem (setcdr (car elem) ! (cons (if (eq (caar elem) 'followup) ! "references" ! (symbol-name (caar elem))) ! (cdar elem))) (setcar (car elem) ! `(lambda (h) ! (,(intern ! (concat "mail-header-" ! (if (eq (caar elem) 'followup) ! "message-id" ! (downcase (symbol-name (caar elem)))))) ! h))) (setq elem (cdr elem))) (setq malist (cdr malist))) ;; We change the score file to the adaptive score file. ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-score-load-file ! (or gnus-newsgroup-adaptive-score-file ! (gnus-score-file-name ! gnus-newsgroup-name gnus-adaptive-file-suffix)))) ;; The we score away. ! (while data ! (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) (if (or (not elem) ! (gnus-data-pseudo-p (car data))) () ! (when (setq headers (gnus-data-header (car data))) ! (while elem ! (setq match (funcall (caar elem) headers)) ! (gnus-summary-score-entry ! (nth 1 (car elem)) match ! (cond ! ((numberp match) ! '=) ! ((equal (nth 1 (car elem)) "date") ! 'a) ! (t ! ;; Whether we use substring or exact matches are controlled ! ;; here. ! (if (or (not gnus-score-exact-adapt-limit) ! (< (length match) gnus-score-exact-adapt-limit)) ! 'e ! (if (equal (nth 1 (car elem)) "subject") ! 'f 's)))) ! (nth 2 (car elem)) date nil t) ! (setq elem (cdr elem))))) ! (setq data (cdr data)))))) (defun gnus-score-edit-done () (let ((bufnam (buffer-file-name (current-buffer))) (winconf gnus-prev-winconf)) ! (and winconf (set-window-configuration winconf)) (gnus-score-remove-from-cache bufnam) ! (gnus-score-load-file bufnam))) (defun gnus-score-find-trace () ! "Find all score rules that applies to the current article." (interactive) (let ((gnus-newsgroup-headers ! (list (gnus-summary-article-header))) (gnus-newsgroup-scored nil) (buf (current-buffer)) trace) + (when (get-buffer "*Gnus Scores*") + (save-excursion + (set-buffer "*Gnus Scores*") + (erase-buffer))) (setq gnus-score-trace nil) (gnus-possibly-score-headers 'trace) ! (if (not (setq trace gnus-score-trace)) ! (gnus-error 1 "No score rules apply to the current article.") ! (pop-to-buffer "*Gnus Scores*") ! (gnus-add-current-to-buffer-list) ! (erase-buffer) ! (while trace ! (insert (format "%S -> %s\n" (cdar trace) ! (file-name-nondirectory (caar trace)))) ! (setq trace (cdr trace))) ! (goto-char (point-min)) ! (pop-to-buffer buf)))) ! ! (defun gnus-summary-rescore () ! "Redo the entire scoring process in the current summary." ! (interactive) ! (gnus-score-save) ! (setq gnus-score-cache nil) ! (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) + (gnus-score-save) + (setq gnus-score-cache nil + gnus-score-alist nil + gnus-short-name-score-file-cache nil) + (gnus-message 6 "The score cache is now flushed")) + + (gnus-add-shutdown 'gnus-score-close 'gnus) + + (defvar gnus-score-file-alist-cache nil) + + (defun gnus-score-close () + "Clear all internal score variables." + (setq gnus-score-cache nil + gnus-internal-global-score-files nil + gnus-score-file-list nil + gnus-score-file-alist-cache nil)) + + ;; Summary score marking commands. + + (defun gnus-summary-raise-same-subject-and-select (score) + "Raise articles which has the same subject with SCORE and select the next." + (interactive "p") + (let ((subject (gnus-summary-article-subject))) + (gnus-summary-raise-score score) + (while (gnus-summary-find-subject subject) + (gnus-summary-raise-score score)) + (gnus-summary-next-article t))) + + (defun gnus-summary-raise-same-subject (score) + "Raise articles which has the same subject with SCORE." + (interactive "p") + (let ((subject (gnus-summary-article-subject))) + (gnus-summary-raise-score score) + (while (gnus-summary-find-subject subject) + (gnus-summary-raise-score score)) + (gnus-summary-next-subject 1 t))) + + (defun gnus-score-default (level) + (if level (prefix-numeric-value level) + gnus-score-interactive-default-score)) + + (defun gnus-summary-raise-thread (&optional score) + "Raise the score of the articles in the current thread with SCORE." + (interactive "P") + (setq score (gnus-score-default score)) + (let (e) + (save-excursion + (let ((articles (gnus-summary-articles-in-thread))) + (while articles + (gnus-summary-goto-subject (car articles)) + (gnus-summary-raise-score score) + (setq articles (cdr articles)))) + (setq e (point))) + (let ((gnus-summary-check-current t)) + (or (zerop (gnus-summary-next-subject 1 t)) + (goto-char e)))) + (gnus-summary-recenter) + (gnus-summary-position-point) + (gnus-set-mode-line 'summary)) + + (defun gnus-summary-lower-same-subject-and-select (score) + "Raise articles which has the same subject with SCORE and select the next." + (interactive "p") + (gnus-summary-raise-same-subject-and-select (- score))) + + (defun gnus-summary-lower-same-subject (score) + "Raise articles which has the same subject with SCORE." + (interactive "p") + (gnus-summary-raise-same-subject (- score))) + + (defun gnus-summary-lower-thread (&optional score) + "Lower score of articles in the current thread with SCORE." + (interactive "P") + (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) + + ;;; Finding score files. + + (defun gnus-score-score-files (group) + "Return a list of all possible score files." + ;; Search and set any global score files. + (and gnus-global-score-files + (or 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 + (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 + (or gnus-short-name-score-file-cache + (prog2 + (gnus-message 6 "Finding all score files...") + (setq gnus-short-name-score-file-cache + (gnus-score-score-files-1 + gnus-kill-files-directory)) + (gnus-message 6 "Finding all score files...done"))))) + ;; We want long file names. + (when (or (not gnus-score-file-list) + (not (car gnus-score-file-list)) + (gnus-file-newer-than gnus-kill-files-directory + (car 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 + (gnus-score-file-regexp))))))) + (cdr gnus-score-file-list))) + + (defun gnus-score-score-files-1 (dir) + "Return all possible score files under DIR." + (let ((files (directory-files (expand-file-name dir) t nil t)) + (regexp (gnus-score-file-regexp)) + out file) + (while (setq file (pop files)) + (cond + ;; Ignore "." and "..". + ((member (file-name-nondirectory file) '("." "..")) + nil) + ;; Recurse down directories. + ((file-directory-p file) + (setq out (nconc (gnus-score-score-files-1 file) out))) + ;; Add files to the list of score files. + ((string-match regexp file) + (push file out)))) + (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 + (expand-file-name gnus-kill-files-directory))) + (klen (length kill-dir)) + (score-regexp (gnus-score-file-regexp)) + (trans (cdr (assq ?: nnheader-file-name-translation-alist))) + ofiles not-match regexp) + (save-excursion + (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. + (while sfiles + (erase-buffer) + (insert (car sfiles)) + (goto-char (point-min)) + ;; First remove the suffix itself. + (when (re-search-forward (concat "." score-regexp) nil t) + (replace-match "" t t) + (goto-char (point-min)) + (if (looking-at (regexp-quote kill-dir)) + ;; If the file name was just "SCORE", `klen' is one character + ;; too much. + (delete-char (min (1- (point-max)) klen)) + (goto-char (point-max)) + (search-backward "/") + (delete-region (1+ (point)) (point-min))) + ;; If short file names were used, we have to translate slashes. + (goto-char (point-min)) + (let ((regexp (concat + "[/:" (if trans (char-to-string trans) "") "]"))) + (while (re-search-forward regexp nil t) + (replace-match "." t t))) + ;; Cludge to get rid of "nntp+" problems. + (goto-char (point-min)) + (and (looking-at "nn[a-z]+\\+") + (progn + (search-forward "+") + (forward-char -1) + (insert "\\"))) + ;; Kludge to deal with "++". + (goto-char (point-min)) + (while (search-forward "++" nil t) + (replace-match "\\+\\+" t t)) + ;; Translate "all" to ".*". + (goto-char (point-min)) + (while (search-forward "all" nil t) + (replace-match ".*" t t)) + (goto-char (point-min)) + ;; Deal with "not."s. + (if (looking-at "not.") + (progn + (setq not-match t) + (setq regexp (buffer-substring 5 (point-max)))) + (setq regexp (buffer-substring 1 (point-max))) + (setq not-match nil)) + ;; Finally - if this resulting regexp matches the group name, + ;; we add this score file to the list of score files + ;; applicable to this group. + (if (or (and not-match + (not (string-match regexp group))) + (and (not not-match) + (string-match regexp group))) + (setq ofiles (cons (car sfiles) ofiles)))) + (setq sfiles (cdr sfiles))) + (kill-buffer (current-buffer)) + ;; Slight kludge here - the last score file returned should be + ;; the local score file, whether it exists or not. This is so + ;; that any score commands the user enters will go to the right + ;; file, and not end up in some global score file. + (let ((localscore (gnus-score-file-name group))) + (setq ofiles (cons localscore (delete localscore ofiles)))) + (nreverse ofiles)))) + + (defun gnus-score-find-single (group) + "Return list containing the score file for GROUP." + (list (or gnus-newsgroup-adaptive-score-file + (gnus-score-file-name group gnus-adaptive-file-suffix)) + (gnus-score-file-name group))) + + (defun gnus-score-find-hierarchical (group) + "Return list of score files for GROUP. + This includes the score file for the group and all its parents." + (let ((all (copy-sequence '(nil))) + (start 0)) + (while (string-match "\\." group (1+ start)) + (setq start (match-beginning 0)) + (setq all (cons (substring group 0 start) all))) + (setq all (cons group all)) + (nconc + (mapcar (lambda (newsgroup) + (gnus-score-file-name newsgroup gnus-adaptive-file-suffix)) + (setq all (nreverse all))) + (mapcar 'gnus-score-file-name all)))) + + (defun gnus-score-find-alist (group) + "Return list of score files for GROUP. + The list is determined from the variable gnus-score-file-alist." + (let ((alist gnus-score-file-multiple-match-alist) + score-files) + ;; if this group has been seen before, return the cached entry + (if (setq score-files (assoc group gnus-score-file-alist-cache)) + (cdr score-files) ;ensures caching groups with no matches + ;; handle the multiple match alist + (while alist + (and (string-match (caar alist) group) + (setq score-files + (nconc score-files (copy-sequence (cdar alist))))) + (setq alist (cdr alist))) + (setq alist gnus-score-file-single-match-alist) + ;; handle the single match alist + (while alist + (and (string-match (caar alist) group) + ;; 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 + (progn + (setq score-files + (nconc score-files (copy-sequence (cdar alist)))) + (setq alist nil))) + (setq alist (cdr alist))) + ;; cache the score files + (setq gnus-score-file-alist-cache + (cons (cons group score-files) gnus-score-file-alist-cache)) + score-files))) + + (defun gnus-possibly-score-headers (&optional trace) + (let ((funcs gnus-score-find-score-files-function) + score-files) + ;; Make sure funcs is a list. + (and funcs + (not (listp funcs)) + (setq funcs (list funcs))) + ;; Get the initial score files for this group. + (when funcs + (setq score-files (gnus-score-find-alist gnus-newsgroup-name))) + ;; Go through all the functions for finding score files (or actual + ;; scores) and add them to a list. + (while funcs + (when (gnus-functionp (car funcs)) + (setq score-files + (nconc score-files (funcall (car funcs) gnus-newsgroup-name)))) + (setq funcs (cdr funcs))) + ;; Check whether there is a `score-file' group parameter. + (let ((param-file (gnus-group-get-parameter + gnus-newsgroup-name 'score-file))) + (when param-file + (push param-file score-files))) + ;; Do the scoring if there are any score files for this group. + (when score-files + (gnus-score-headers score-files trace)))) + + (defun gnus-score-file-name (newsgroup &optional suffix) + "Return the name of a score file for NEWSGROUP." + (let ((suffix (or suffix gnus-score-file-suffix))) + (nnheader-translate-file-chars + (cond + ((or (null newsgroup) + (string-equal newsgroup "")) + ;; The global score file is placed at top of the directory. + (expand-file-name + suffix gnus-kill-files-directory)) + ((gnus-use-long-file-name 'not-score) + ;; Append ".SCORE" to newsgroup name. + (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) + "." suffix) + gnus-kill-files-directory)) + (t + ;; Place "SCORE" under the hierarchical directory. + (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) + "/" suffix) + gnus-kill-files-directory)))))) + + (defun gnus-score-search-global-directories (files) + "Scan all global score directories for score files." + ;; Set the variable `gnus-internal-global-score-files' to all + ;; available global score files. + (interactive (list gnus-global-score-files)) + (let (out) + (while files + (if (string-match "/$" (car files)) + (setq out (nconc (directory-files + (car files) t + (concat (gnus-score-file-regexp) "$")))) + (setq out (cons (car files) out))) + (setq files (cdr files))) + (setq gnus-internal-global-score-files out))) + + (defun gnus-score-default-fold-toggle () + "Toggle folding for new score file entries." + (interactive) + (setq gnus-score-default-fold (not gnus-score-default-fold)) + (if gnus-score-default-fold + (gnus-message 1 "New score file entries will be case insensitive.") + (gnus-message 1 "New score file entries will be case sensitive."))) (provide 'gnus-score) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-setup.el emacs-19.32/lisp/gnus-setup.el *** emacs-19.31/lisp/gnus-setup.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-setup.el Tue Jun 25 18:30:33 1996 *************** *** 0 **** --- 1,210 ---- + ;;; gnus-setup.el --- Initialization & Setup for Gnus 5 + ;; Copyright (C) 1995, 96 Free Software Foundation, Inc. + + ;; Author: Steven L. Baur + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + ;; My head is starting to spin with all the different mail/news packages. + ;; Stop The Madness! + + ;; Given that Emacs Lisp byte codes may be diverging, it is probably best + ;; not to byte compile this, and just arrange to have the .el loaded out + ;; of .emacs. + + ;;; Code: + + (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) + + (defvar gnus-emacs-lisp-directory (if running-xemacs + "/usr/local/lib/xemacs/" + "/usr/local/share/emacs/") + "Directory where Emacs site lisp is located.") + + (defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory + "gnus-5.0.15/lisp/") + "Directory where Gnus Emacs lisp is found.") + + (defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory + "sgnus/lisp/") + "Directory where September Gnus Emacs lisp is found.") + + (defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory + "site-lisp/") + "Directory where TM Emacs lisp is found.") + + (defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory + "site-lisp/mailcrypt-3.4/") + "Directory where Mailcrypt Emacs Lisp is found.") + + (defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory + "site-lisp/bbdb-1.50/") + "Directory where Big Brother Database is found.") + + (defvar gnus-use-tm t + "Set this if you want MIME support for Gnus") + (defvar gnus-use-mhe nil + "Set this if you want to use MH-E for mail reading") + (defvar gnus-use-rmail nil + "Set this if you want to use RMAIL for mail reading") + (defvar gnus-use-sendmail t + "Set this if you want to use SENDMAIL for mail reading") + (defvar gnus-use-vm nil + "Set this if you want to use the VM package for mail reading") + (defvar gnus-use-sc t + "Set this if you want to use Supercite") + (defvar gnus-use-mailcrypt t + "Set this if you want to use Mailcrypt for dealing with PGP messages") + (defvar gnus-use-bbdb nil + "Set this if you want to use the Big Brother DataBase") + (defvar gnus-use-september nil + "Set this if you are using the experimental September Gnus") + + (let ((gnus-directory (if gnus-use-september + gnus-sgnus-lisp-directory + gnus-gnus-lisp-directory))) + (if (null (member gnus-directory load-path)) + (setq load-path (cons gnus-directory load-path)))) + + ;;; Tools for MIME by + ;;; UMEDA Masanobu + ;;; MORIOKA Tomohiko + + (if gnus-use-tm + (progn + (if (null (member gnus-tm-lisp-directory load-path)) + (setq load-path (cons gnus-tm-lisp-directory load-path))) + (load "mime-setup"))) + + ;;; Mailcrypt by + ;;; Jin Choi + ;;; Patrick LoPresti + + (if gnus-use-mailcrypt + (progn + (if (null (member gnus-mailcrypt-lisp-directory load-path)) + (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) + (autoload 'mc-install-write-mode "mailcrypt" nil t) + (autoload 'mc-install-read-mode "mailcrypt" nil t) + (add-hook 'message-mode-hook 'mc-install-write-mode) + (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) + (if gnus-use-mhe + (progn + (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) + (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))))) + + ;;; BBDB by + ;;; Jamie Zawinski + + (if gnus-use-bbdb + (progn + (if (null (member gnus-bbdb-lisp-directory load-path)) + (setq load-path (cons gnus-bbdb-lisp-directory load-path))) + (autoload 'bbdb "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-name "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-company "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-net "bbdb-com" + "Insidious Big Brother Database" t) + (autoload 'bbdb-notes "bbdb-com" + "Insidious Big Brother Database" t) + + (if gnus-use-vm + (progn + (autoload 'bbdb-insinuate-vm "bbdb-vm" + "Hook BBDB into VM" t))) + + (if gnus-use-rmail + (progn + (autoload 'bbdb-insinuate-rmail "bbdb-rmail" + "Hook BBDB into RMAIL" t) + (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))) + + (if gnus-use-mhe + (progn + (autoload 'bbdb-insinuate-mh "bbdb-mh" + "Hook BBDB into MH-E" t) + (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))) + + (autoload 'bbdb-insinuate-gnus "bbdb-gnus" + "Hook BBDB into Gnus" t) + (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) + + (if gnus-use-sendmail + (progn + (autoload 'bbdb-insinuate-sendmail "bbdb" + "Insidious Big Brother Database" t) + (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) + (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))))) + + (if gnus-use-sc + (progn + (add-hook 'mail-citation-hook 'sc-cite-original) + (setq message-cite-function 'sc-cite-original) + (autoload 'sc-cite-original "supercite"))) + + ;;;### (autoloads (gnus-batch-score gnus-fetch-group gnus gnus-slave gnus-no-server gnus-update-format) "gnus" "lisp/gnus.el" (12473 2137)) + ;;; Generated autoloads from lisp/gnus.el + + (autoload 'gnus-update-format "gnus" "\ + Update the format specification near point." t nil) + + (autoload 'gnus-slave-no-server "gnus" "\ + Read network news as a slave without connecting to local server." t nil) + + (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. + 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) + + (autoload 'gnus-slave "gnus" "\ + Read news as a slave." t nil) + + (autoload 'gnus "gnus" "\ + Read network news. + If ARG is non-nil and a positive number, Gnus will use that as the + startup level. If ARG is non-nil and not a positive number, Gnus will + prompt the user for the name of an NNTP server to use." t nil) + + (autoload 'gnus-fetch-group "gnus" "\ + Start Gnus if necessary and enter GROUP. + Returns whether the fetching was successful or not." t nil) + + (defalias 'gnus-batch-kill 'gnus-batch-score) + + (autoload 'gnus-batch-score "gnus" "\ + Run batched scoring. + Usage: emacs -batch -l gnus -f gnus-batch-score ... + Newsgroups is a list of strings in Bnews format. If you want to score + the comp hierarchy, you'd say \"comp.all\". If you would not like to + score the alt hierarchy, you'd say \"!alt.all\"." t nil) + + ;;;*** + + (provide 'gnus-setup) + + (run-hooks 'gnus-setup-load-hook) + + ;;; gnus-setup.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-soup.el emacs-19.32/lisp/gnus-soup.el *** emacs-19.31/lisp/gnus-soup.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-soup.el Tue Jun 25 18:30:37 1996 *************** *** 0 **** --- 1,563 ---- + ;;; gnus-soup.el --- SOUP packet writing support for Gnus + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Per Abrahamsen + ;; Lars Magne Ingebrigtsen + ;; Keywords: news, mail + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus-msg) + (require 'gnus) + (eval-when-compile (require 'cl)) + + ;;; User Variables: + + (defvar gnus-soup-directory "~/SoupBrew/" + "*Directory containing an unpacked SOUP packet.") + + (defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/") + "*Directory where Gnus will do processing of replies.") + + (defvar gnus-soup-prefix-file "gnus-prefix" + "*Name of the file where Gnus stores the last used prefix.") + + (defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz" + "Format string command for packing a SOUP packet. + The SOUP files will be inserted where the %s is in the string. + This string MUST contain both %s and %d. The file number will be + inserted where %d appears.") + + (defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -" + "*Format string command for unpacking a SOUP packet. + The SOUP packet file name will be inserted at the %s.") + + (defvar gnus-soup-packet-directory "~/" + "*Where gnus-soup will look for REPLIES packets.") + + (defvar gnus-soup-packet-regexp "Soupin" + "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.") + + (defvar gnus-soup-ignored-headers "^Xref:" + "*Regexp to match headers to be removed when brewing SOUP packets.") + + ;;; Internal Variables: + + (defvar gnus-soup-encoding-type ?n + "*Soup encoding type. + `n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox + format.") + + (defvar gnus-soup-index-type ?c + "*Soup index type. + `n' means no index file and `c' means standard Cnews overview + format.") + + (defvar gnus-soup-areas nil) + (defvar gnus-soup-last-prefix nil) + (defvar gnus-soup-prev-prefix nil) + (defvar gnus-soup-buffers nil) + + ;;; Access macros: + + (defmacro gnus-soup-area-prefix (area) + `(aref ,area 0)) + (defmacro gnus-soup-set-area-prefix (area prefix) + `(aset ,area 0 ,prefix)) + (defmacro gnus-soup-area-name (area) + `(aref ,area 1)) + (defmacro gnus-soup-area-encoding (area) + `(aref ,area 2)) + (defmacro gnus-soup-area-description (area) + `(aref ,area 3)) + (defmacro gnus-soup-area-number (area) + `(aref ,area 4)) + (defmacro gnus-soup-area-set-number (area value) + `(aset ,area 4 ,value)) + + (defmacro gnus-soup-encoding-format (encoding) + `(aref ,encoding 0)) + (defmacro gnus-soup-encoding-index (encoding) + `(aref ,encoding 1)) + (defmacro gnus-soup-encoding-kind (encoding) + `(aref ,encoding 2)) + + (defmacro gnus-soup-reply-prefix (reply) + `(aref ,reply 0)) + (defmacro gnus-soup-reply-kind (reply) + `(aref ,reply 1)) + (defmacro gnus-soup-reply-encoding (reply) + `(aref ,reply 2)) + + ;;; Commands: + + (defun gnus-soup-send-replies () + "Unpack and send all replies in the reply packet." + (interactive) + (let ((packets (directory-files + gnus-soup-packet-directory t gnus-soup-packet-regexp))) + (while packets + (and (gnus-soup-send-packet (car packets)) + (delete-file (car packets))) + (setq packets (cdr packets))))) + + (defun gnus-soup-add-article (n) + "Add the current article to SOUP packet. + If N is a positive number, add the N next articles. + If N is a negative number, add the N previous articles. + If N is nil and any articles have been marked with the process mark, + move those articles instead." + (interactive "P") + (gnus-set-global-variables) + (let* ((articles (gnus-summary-work-articles n)) + (tmp-buf (get-buffer-create "*soup work*")) + (area (gnus-soup-area gnus-newsgroup-name)) + (prefix (gnus-soup-area-prefix area)) + headers) + (buffer-disable-undo tmp-buf) + (save-excursion + (while articles + ;; Find the header of the article. + (set-buffer gnus-summary-buffer) + (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 + (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-index-type) + (gnus-soup-area-set-number + area (1+ (or (gnus-soup-area-number area) 0))))) + ;; 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) + (setq articles (cdr articles))) + (kill-buffer tmp-buf)) + (gnus-soup-save-areas))) + + (defun gnus-soup-pack-packet () + "Make a SOUP packet from the SOUP areas." + (interactive) + (gnus-soup-read-areas) + (gnus-soup-pack gnus-soup-directory gnus-soup-packer)) + + (defun gnus-group-brew-soup (n) + "Make a soup packet from the current group. + Uses the process/prefix convention." + (interactive "P") + (let ((groups (gnus-group-process-prefix n))) + (while groups + (gnus-group-remove-mark (car groups)) + (gnus-soup-group-brew (car groups) t) + (setq groups (cdr groups))) + (gnus-soup-save-areas))) + + (defun gnus-brew-soup (&optional level) + "Go through all groups on LEVEL or less and make a soup packet." + (interactive "P") + (let ((level (or level gnus-level-subscribed)) + (newsrc (cdr gnus-newsrc-alist))) + (while newsrc + (and (<= (nth 1 (car newsrc)) level) + (gnus-soup-group-brew (caar newsrc) t)) + (setq newsrc (cdr newsrc))) + (gnus-soup-save-areas))) + + ;;;###autoload + (defun gnus-batch-brew-soup () + "Brew a SOUP packet from groups mention on the command line. + Will use the remaining command line arguments as regular expressions + for matching on group names. + + For instance, if you want to brew on all the nnml groups, as well as + groups with \"emacs\" in the name, you could say something like: + + $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" + (interactive) + ) + + ;;; Internal Functions: + + ;; Store the current buffer. + (defun gnus-soup-store (directory prefix headers format index) + ;; Create the directory, if needed. + (or (file-directory-p directory) + (gnus-make-directory directory)) + (let* ((msg-buf (find-file-noselect + (concat directory prefix ".MSG"))) + (idx-buf (if (= index ?n) + nil + (find-file-noselect + (concat directory prefix ".IDX")))) + (article-buf (current-buffer)) + from head-line beg type) + (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) + (buffer-disable-undo msg-buf) + (and idx-buf + (progn + (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers)) + (buffer-disable-undo idx-buf))) + (save-excursion + ;; Make sure the last char in the buffer is a newline. + (goto-char (point-max)) + (or (= (current-column) 0) + (insert "\n")) + ;; Find the "from". + (goto-char (point-min)) + (setq from + (gnus-mail-strip-quoted-names + (or (mail-fetch-field "from") + (mail-fetch-field "really-from") + (mail-fetch-field "sender")))) + (goto-char (point-min)) + ;; Depending on what encoding is supposed to be used, we make + ;; a soup header. + (setq head-line + (cond + ((= gnus-soup-encoding-type ?n) + (format "#! rnews %d\n" (buffer-size))) + ((= gnus-soup-encoding-type ?m) + (while (search-forward "\nFrom " nil t) + (replace-match "\n>From " t t)) + (concat "From " (or from "unknown") + " " (current-time-string) "\n")) + ((= gnus-soup-encoding-type ?M) + "\^a\^a\^a\^a\n") + (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) + ;; Insert the soup header and the article in the MSG buf. + (set-buffer msg-buf) + (goto-char (point-max)) + (insert head-line) + (setq beg (point)) + (insert-buffer-substring article-buf) + ;; Insert the index in the IDX buf. + (cond ((= index ?c) + (set-buffer idx-buf) + (gnus-soup-insert-idx beg headers)) + ((/= index ?n) + (error "Unknown index type: %c" type))) + ;; Return the MSG buf. + msg-buf))) + + (defun gnus-soup-group-brew (group &optional not-all) + "Enter GROUP and add all articles to a SOUP package. + If NOT-ALL, don't pack ticked articles." + (let ((gnus-expert-user t) + (gnus-large-newsgroup nil) + (entry (gnus-gethash group gnus-newsrc-hashtb))) + (when (or (null entry) + (eq (car entry) t) + (and (car entry) + (> (car entry) 0)) + (and (not not-all) + (gnus-range-length (cdr (assq 'tick (gnus-info-marks + (nth 2 entry))))))) + (when (gnus-summary-read-group group nil t) + (setq gnus-newsgroup-processable + (reverse + (if (not not-all) + (append gnus-newsgroup-marked gnus-newsgroup-unreads) + gnus-newsgroup-unreads))) + (gnus-soup-add-article nil) + (gnus-summary-exit))))) + + (defun gnus-soup-insert-idx (offset header) + ;; [number subject from date id references chars lines xref] + (goto-char (point-max)) + (insert + (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n" + offset + (or (mail-header-subject header) "(none)") + (or (mail-header-from header) "(nobody)") + (or (mail-header-date header) "") + (or (mail-header-id header) + (concat "soup-dummy-id-" + (mapconcat + (lambda (time) (int-to-string time)) + (current-time) "-"))) + (or (mail-header-references header) "") + (or (mail-header-chars header) 0) + (or (mail-header-lines header) "0")))) + + (defun gnus-soup-save-areas () + (gnus-soup-write-areas) + (save-excursion + (let (buf) + (while gnus-soup-buffers + (setq buf (car gnus-soup-buffers) + gnus-soup-buffers (cdr gnus-soup-buffers)) + (if (not (buffer-name buf)) + () + (set-buffer buf) + (and (buffer-modified-p) (save-buffer)) + (kill-buffer (current-buffer))))) + (gnus-soup-write-prefixes))) + + (defun gnus-soup-write-prefixes () + (let ((prefix gnus-soup-last-prefix)) + (save-excursion + (while prefix + (gnus-set-work-buffer) + (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix))) + (gnus-make-directory (caar prefix)) + (write-region (point-min) (point-max) + (concat (caar prefix) gnus-soup-prefix-file) + nil 'nomesg) + (setq prefix (cdr prefix)))))) + + (defun gnus-soup-pack (dir packer) + (let* ((files (mapconcat 'identity + '("AREAS" "*.MSG" "*.IDX" "INFO" + "LIST" "REPLIES" "COMMANDS" "ERRORS") + " ")) + (packer (if (< (string-match "%s" packer) + (string-match "%d" packer)) + (format packer files + (string-to-int (gnus-soup-unique-prefix dir))) + (format packer + (string-to-int (gnus-soup-unique-prefix dir)) + files))) + (dir (expand-file-name dir))) + (or (file-directory-p dir) + (gnus-make-directory dir)) + (setq gnus-soup-areas nil) + (gnus-message 4 "Packing %s..." packer) + (if (zerop (call-process shell-file-name + nil nil nil shell-command-switch + (concat "cd " dir " ; " packer))) + (progn + (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.")))) + + (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, + [prefix name encoding description number] + though the two last may be nil if they are missing." + (let (areas) + (save-excursion + (set-buffer (find-file-noselect file 'force)) + (buffer-disable-undo (current-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (setq areas + (cons (vector (gnus-soup-field) + (gnus-soup-field) + (gnus-soup-field) + (and (eq (preceding-char) ?\t) + (gnus-soup-field)) + (and (eq (preceding-char) ?\t) + (string-to-int (gnus-soup-field)))) + areas)) + (if (eq (preceding-char) ?\t) + (beginning-of-line 2))) + (kill-buffer (current-buffer))) + areas)) + + (defun gnus-soup-parse-replies (file) + "Parse soup REPLIES file FILE. + The result is a of vectors, each containing one entry from the REPLIES + file. The vector contain three strings, [prefix name encoding]." + (let (replies) + (save-excursion + (set-buffer (find-file-noselect file)) + (buffer-disable-undo (current-buffer)) + (goto-char (point-min)) + (while (not (eobp)) + (setq replies + (cons (vector (gnus-soup-field) (gnus-soup-field) + (gnus-soup-field)) + replies)) + (if (eq (preceding-char) ?\t) + (beginning-of-line 2))) + (kill-buffer (current-buffer))) + replies)) + + (defun gnus-soup-field () + (prog1 + (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) + (forward-char 1))) + + (defun gnus-soup-read-areas () + (or gnus-soup-areas + (setq gnus-soup-areas + (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) + + (defun gnus-soup-write-areas () + "Write the AREAS file." + (interactive) + (when gnus-soup-areas + (nnheader-temp-write (concat gnus-soup-directory "AREAS") + (let ((areas gnus-soup-areas) + area) + (while (setq area (pop areas)) + (insert + (format + "%s\t%s\t%s%s\n" + (gnus-soup-area-prefix area) + (gnus-soup-area-name area) + (gnus-soup-area-encoding area) + (if (or (gnus-soup-area-description area) + (gnus-soup-area-number area)) + (concat "\t" (or (gnus-soup-area-description + area) "") + (if (gnus-soup-area-number area) + (concat "\t" (int-to-string + (gnus-soup-area-number area))) + "")) "")))))))) + + (defun gnus-soup-write-replies (dir areas) + "Write a REPLIES file in DIR containing AREAS." + (nnheader-temp-write (concat dir "REPLIES") + (let (area) + (while (setq area (pop areas)) + (insert (format "%s\t%s\t%s\n" + (gnus-soup-reply-prefix area) + (gnus-soup-reply-kind area) + (gnus-soup-reply-encoding area))))))) + + (defun gnus-soup-area (group) + (gnus-soup-read-areas) + (let ((areas gnus-soup-areas) + (real-group (gnus-group-real-name group)) + area result) + (while areas + (setq area (car areas) + areas (cdr areas)) + (if (equal (gnus-soup-area-name area) real-group) + (setq result area))) + (or result + (setq result + (vector (gnus-soup-unique-prefix) + real-group + (format "%c%c%c" + gnus-soup-encoding-type + gnus-soup-index-type + (if (gnus-member-of-valid 'mail group) ?m ?n)) + nil nil) + gnus-soup-areas (cons result gnus-soup-areas))) + result)) + + (defun gnus-soup-unique-prefix (&optional dir) + (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) + (entry (assoc dir gnus-soup-last-prefix)) + gnus-soup-prev-prefix) + (if entry + () + (and (file-exists-p (concat dir gnus-soup-prefix-file)) + (condition-case nil + (load (concat dir gnus-soup-prefix-file) nil t t) + (error nil))) + (setq gnus-soup-last-prefix + (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0))) + gnus-soup-last-prefix))) + (setcdr entry (1+ (cdr entry))) + (gnus-soup-write-prefixes) + (int-to-string (cdr entry)))) + + (defun gnus-soup-unpack-packet (dir unpacker packet) + "Unpack PACKET into DIR using UNPACKER. + Return whether the unpacking was successful." + (gnus-make-directory dir) + (gnus-message 4 "Unpacking: %s" (format unpacker packet)) + (prog1 + (zerop (call-process + shell-file-name nil nil nil shell-command-switch + (format "cd %s ; %s" (expand-file-name dir) + (format unpacker packet)))) + (gnus-message 4 "Unpacking...done"))) + + (defun gnus-soup-send-packet (packet) + (gnus-soup-unpack-packet + gnus-soup-replies-directory gnus-soup-unpacker packet) + (let ((replies (gnus-soup-parse-replies + (concat gnus-soup-replies-directory "REPLIES")))) + (save-excursion + (while replies + (let* ((msg-file (concat gnus-soup-replies-directory + (gnus-soup-reply-prefix (car replies)) + ".MSG")) + (msg-buf (and (file-exists-p msg-file) + (find-file-noselect msg-file))) + (tmp-buf (get-buffer-create " *soup send*")) + beg end) + (cond + ((/= (gnus-soup-encoding-format + (gnus-soup-reply-encoding (car replies))) ?n) + (error "Unsupported encoding")) + ((null msg-buf) + t) + (t + (buffer-disable-undo msg-buf) + (buffer-disable-undo tmp-buf) + (set-buffer msg-buf) + (goto-char (point-min)) + (while (not (eobp)) + (or (looking-at "#! *rnews +\\([0-9]+\\)") + (error "Bad header.")) + (forward-line 1) + (setq beg (point) + end (+ (point) (string-to-int + (buffer-substring + (match-beginning 1) (match-end 1))))) + (switch-to-buffer tmp-buf) + (erase-buffer) + (insert-buffer-substring msg-buf beg end) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (insert mail-header-separator) + (setq message-newsreader (setq message-mailer + (gnus-extended-version))) + (cond + ((string= (gnus-soup-reply-kind (car replies)) "news") + (gnus-message 5 "Sending news message to %s..." + (mail-fetch-field "newsgroups")) + (sit-for 1) + (funcall message-send-news-function)) + ((string= (gnus-soup-reply-kind (car replies)) "mail") + (gnus-message 5 "Sending mail to %s..." + (mail-fetch-field "to")) + (sit-for 1) + (message-send-mail)) + (t + (error "Unknown reply kind"))) + (set-buffer msg-buf) + (goto-char end)) + (delete-file (buffer-file-name)) + (kill-buffer msg-buf) + (kill-buffer tmp-buf) + (gnus-message 4 "Sent packet")))) + (setq replies (cdr replies))) + t))) + + (provide 'gnus-soup) + + ;;; gnus-soup.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-srvr.el emacs-19.32/lisp/gnus-srvr.el *** emacs-19.31/lisp/gnus-srvr.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-srvr.el Tue Jun 25 18:30:42 1996 *************** *** 0 **** --- 1,708 ---- + ;;; gnus-srvr.el --- virtual server support for Gnus + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (eval-when-compile (require 'cl)) + + (defvar gnus-server-mode-hook nil + "Hook run in `gnus-server-mode' buffers.") + + (defconst gnus-server-line-format " {%(%h:%w%)} %s\n" + "Format of server lines. + It works along the same lines as a normal formatting string, + with some simple extensions.") + + (defvar gnus-server-mode-line-format "Gnus List of servers" + "The format specification for the server mode line.") + + (defvar gnus-server-exit-hook nil + "*Hook run when exiting the server buffer.") + + ;;; Internal variables. + + (defvar gnus-inserted-opened-servers nil) + + (defvar gnus-server-line-format-alist + `((?h how ?s) + (?n name ?s) + (?w where ?s) + (?s status ?s))) + + (defvar gnus-server-mode-line-format-alist + `((?S news-server ?s) + (?M news-method ?s) + (?u user-defined ?s))) + + (defvar gnus-server-line-format-spec nil) + (defvar gnus-server-mode-line-format-spec nil) + (defvar gnus-server-killed-servers nil) + + (defvar gnus-server-mode-map) + + (defvar gnus-server-menu-hook nil + "*Hook run after the creation of the server mode menu.") + + (defun gnus-server-make-menu-bar () + (gnus-visual-turn-off-edit-menu 'server) + (unless (boundp 'gnus-server-server-menu) + (easy-menu-define + gnus-server-server-menu gnus-server-mode-map "" + '("Server" + ["Add" gnus-server-add-server t] + ["Browse" gnus-server-read-server t] + ["List" gnus-server-list-servers t] + ["Kill" gnus-server-kill-server t] + ["Yank" gnus-server-yank-server t] + ["Copy" gnus-server-copy-server t] + ["Edit" gnus-server-edit-server t] + ["Exit" gnus-server-exit t] + )) + + (easy-menu-define + gnus-server-connections-menu gnus-server-mode-map "" + '("Connections" + ["Open" gnus-server-open-server t] + ["Close" gnus-server-close-server t] + ["Deny" gnus-server-deny-server t] + ["Reset" gnus-server-remove-denials t] + )) + + (run-hooks 'gnus-server-menu-hook))) + + (defvar gnus-server-mode-map nil) + (put 'gnus-server-mode 'mode-class 'special) + + (unless gnus-server-mode-map + (setq gnus-server-mode-map (make-sparse-keymap)) + (suppress-keymap gnus-server-mode-map) + + (gnus-define-keys + gnus-server-mode-map + " " gnus-server-read-server + "\r" gnus-server-read-server + gnus-mouse-2 gnus-server-pick-server + "q" gnus-server-exit + "l" gnus-server-list-servers + "k" gnus-server-kill-server + "y" gnus-server-yank-server + "c" gnus-server-copy-server + "a" gnus-server-add-server + "e" gnus-server-edit-server + + "O" gnus-server-open-server + "C" gnus-server-close-server + "D" gnus-server-deny-server + "R" gnus-server-remove-denials + + "\C-c\C-i" gnus-info-find-node)) + + (defun gnus-server-mode () + "Major mode for listing and editing servers. + + All normal editing commands are switched off. + \\ + For more in-depth information on this mode, read the manual + (`\\[gnus-info-find-node]'). + + The following commands are available: + + \\{gnus-server-mode-map}" + (interactive) + (when (and menu-bar-mode + (gnus-visual-p 'server-menu 'menu)) + (gnus-server-make-menu-bar)) + (kill-all-local-variables) + (gnus-simplify-mode-line) + (setq major-mode 'gnus-server-mode) + (setq mode-name "Server") + ; (gnus-group-set-mode-line) + (setq mode-line-process nil) + (use-local-map gnus-server-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (run-hooks 'gnus-server-mode-hook)) + + (defun gnus-server-insert-server-line (name method) + (let* ((how (car method)) + (where (nth 1 method)) + (elem (assoc method gnus-opened-servers)) + (status (cond ((eq (nth 1 elem) 'denied) + "(denied)") + ((or (gnus-server-opened method) + (eq (nth 1 elem) 'ok)) + "(opened)") + (t + "(closed)")))) + (beginning-of-line) + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + ;; Insert the text. + (eval gnus-server-line-format-spec)) + (list 'gnus-server (intern name))))) + + (defun gnus-enter-server-buffer () + "Set up the server buffer." + (gnus-server-setup-buffer) + (gnus-configure-windows 'server) + (gnus-server-prepare)) + + (defun gnus-server-setup-buffer () + "Initialize the server buffer." + (unless (get-buffer gnus-server-buffer) + (save-excursion + (set-buffer (get-buffer-create gnus-server-buffer)) + (gnus-server-mode) + (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 + gnus-server-mode-line-format-alist)) + (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) + (opened gnus-opened-servers) + done server op-ser) + (erase-buffer) + (setq gnus-inserted-opened-servers nil) + ;; First we do the real list of servers. + (while alist + (push (cdr (setq server (pop alist))) done) + (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 + (unless (member (caar opened) done) + (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)) + (setq opened (cdr opened)))) + (goto-char (point-min)) + (gnus-server-position-point)) + + (defun gnus-server-server-name () + (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) + (and server (symbol-name server)))) + + (defalias 'gnus-server-position-point 'gnus-goto-colon) + + (defconst gnus-server-edit-buffer "*Gnus edit server*") + + (defun gnus-server-update-server (server) + (save-excursion + (set-buffer gnus-server-buffer) + (let* ((buffer-read-only nil) + (entry (assoc server gnus-server-alist)) + (oentry (assoc (gnus-server-to-method server) + gnus-opened-servers))) + (when entry + (gnus-dribble-enter + (concat "(gnus-server-set-info \"" server "\" '" + (prin1-to-string (cdr entry)) ")"))) + (when (or entry oentry) + ;; Buffer may be narrowed. + (save-restriction + (widen) + (when (gnus-server-goto-server server) + (gnus-delete-line)) + (if entry + (gnus-server-insert-server-line (car entry) (cdr entry)) + (gnus-server-insert-server-line + (format "%s:%s" (caar oentry) (nth 1 (car oentry))) + (car oentry))) + (gnus-server-position-point)))))) + + (defun gnus-server-set-info (server info) + ;; Enter a select method into the virtual server alist. + (when (and server info) + (gnus-dribble-enter + (concat "(gnus-server-set-info \"" server "\" '" + (prin1-to-string info) ")")) + (let* ((server (nth 1 info)) + (entry (assoc server gnus-server-alist))) + (if entry (setcdr entry info) + (setq gnus-server-alist + (nconc gnus-server-alist (list (cons server info)))))))) + + ;;; Interactive server functions. + + (defun gnus-server-kill-server (server) + "Kill the server on the current line." + (interactive (list (gnus-server-server-name))) + (unless (gnus-server-goto-server server) + (if server (error "No such server: %s" server) + (error "No server on the current line"))) + (unless (assoc server gnus-server-alist) + (error "Read-only server %s" server)) + (gnus-dribble-enter "") + (let ((buffer-read-only nil)) + (gnus-delete-line)) + (setq gnus-server-killed-servers + (cons (assoc server gnus-server-alist) gnus-server-killed-servers)) + (setq gnus-server-alist (delq (car gnus-server-killed-servers) + gnus-server-alist)) + (gnus-server-position-point)) + + (defun gnus-server-yank-server () + "Yank the previously killed server." + (interactive) + (or gnus-server-killed-servers + (error "No killed servers to be yanked")) + (let ((alist gnus-server-alist) + (server (gnus-server-server-name)) + (killed (car gnus-server-killed-servers))) + (if (not server) + (setq gnus-server-alist (nconc gnus-server-alist (list killed))) + (if (string= server (caar gnus-server-alist)) + (setq gnus-server-alist (cons killed gnus-server-alist)) + (while (and (cdr alist) + (not (string= server (caadr alist)))) + (setq alist (cdr alist))) + (if alist + (setcdr alist (cons killed (cdr alist))) + (setq gnus-server-alist (list killed))))) + (gnus-server-update-server (car killed)) + (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) + (gnus-server-position-point))) + + (defun gnus-server-exit () + "Return to the group buffer." + (interactive) + (kill-buffer (current-buffer)) + (switch-to-buffer gnus-group-buffer) + (run-hooks 'gnus-server-exit-hook)) + + (defun gnus-server-list-servers () + "List all available servers." + (interactive) + (let ((cur (gnus-server-server-name))) + (gnus-server-prepare) + (if cur (gnus-server-goto-server cur) + (goto-char (point-max)) + (forward-line -1)) + (gnus-server-position-point))) + + (defun gnus-server-set-status (method status) + "Make METHOD have STATUS." + (let ((entry (assoc method gnus-opened-servers))) + (if entry + (setcar (cdr entry) status) + (push (list method status) gnus-opened-servers)))) + + (defun gnus-opened-servers-remove (method) + "Remove METHOD from the list of opened servers." + (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) + gnus-opened-servers))) + + (defun gnus-server-open-server (server) + "Force an open of SERVER." + (interactive (list (gnus-server-server-name))) + (let ((method (gnus-server-to-method server))) + (or method (error "No such server: %s" server)) + (gnus-server-set-status method 'ok) + (prog1 + (or (gnus-open-server method) + (progn (message "Couldn't open %s" server) nil)) + (gnus-server-update-server server) + (gnus-server-position-point)))) + + (defun gnus-server-close-server (server) + "Close SERVER." + (interactive (list (gnus-server-server-name))) + (let ((method (gnus-server-to-method server))) + (or method (error "No such server: %s" server)) + (gnus-server-set-status method 'closed) + (prog1 + (gnus-close-server method) + (gnus-server-update-server server) + (gnus-server-position-point)))) + + (defun gnus-server-deny-server (server) + "Make sure SERVER will never be attempted opened." + (interactive (list (gnus-server-server-name))) + (let ((method (gnus-server-to-method server))) + (or method (error "No such server: %s" server)) + (gnus-server-set-status method 'denied)) + (gnus-server-update-server server) + (gnus-server-position-point) + t) + + (defun gnus-server-remove-denials () + "Make all denied servers into closed servers." + (interactive) + (let ((servers gnus-opened-servers)) + (while servers + (when (eq (nth 1 (car servers)) 'denied) + (setcar (nthcdr 1 (car servers)) 'closed)) + (setq servers (cdr servers)))) + (gnus-server-list-servers)) + + (defun gnus-server-copy-server (from to) + (interactive + (list + (or (gnus-server-server-name) + (error "No server on the current line")) + (read-string "Copy to: "))) + (or from (error "No server on current line")) + (or (and to (not (string= to ""))) (error "No name to copy to")) + (and (assoc to gnus-server-alist) (error "%s already exists" to)) + (or (assoc from gnus-server-alist) + (error "%s: no such server" from)) + (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist)))) + (setcar to-entry to) + (setcar (nthcdr 2 to-entry) to) + (setq gnus-server-killed-servers + (cons to-entry gnus-server-killed-servers)) + (gnus-server-yank-server))) + + (defun gnus-server-add-server (how where) + (interactive + (list (intern (completing-read "Server method: " + gnus-valid-select-methods nil t)) + (read-string "Server name: "))) + (setq gnus-server-killed-servers + (cons (list where how where) gnus-server-killed-servers)) + (gnus-server-yank-server)) + + (defun gnus-server-goto-server (server) + "Jump to a server line." + (interactive + (list (completing-read "Goto server: " gnus-server-alist nil t))) + (let ((to (text-property-any (point-min) (point-max) + 'gnus-server (intern server)))) + (and to + (progn + (goto-char to) + (gnus-server-position-point))))) + + (defun gnus-server-edit-server (server) + "Edit the server on the current line." + (interactive (list (gnus-server-server-name))) + (unless server + (error "No server on current line")) + (unless (assoc server gnus-server-alist) + (error "This server can't be edited")) + (let ((winconf (current-window-configuration)) + (info (cdr (assoc server gnus-server-alist)))) + (gnus-close-server info) + (get-buffer-create gnus-server-edit-buffer) + (gnus-configure-windows 'edit-server) + (gnus-add-current-to-buffer-list) + (emacs-lisp-mode) + (make-local-variable 'gnus-prev-winconf) + (setq gnus-prev-winconf winconf) + (use-local-map (copy-keymap (current-local-map))) + (let ((done-func '(lambda () + "Exit editing mode and update the information." + (interactive) + (gnus-server-edit-server-done 'group)))) + (setcar (cdr (nth 4 done-func)) server) + (local-set-key "\C-c\C-c" done-func)) + (erase-buffer) + (insert ";; Type `C-c C-c' after you have edited the server.\n\n") + (insert (pp-to-string info)))) + + (defun gnus-server-edit-server-done (server) + (interactive) + (set-buffer (get-buffer-create gnus-server-edit-buffer)) + (goto-char (point-min)) + (let ((form (read (current-buffer))) + (winconf gnus-prev-winconf)) + (gnus-server-set-info server form) + (kill-buffer (current-buffer)) + (and winconf (set-window-configuration winconf)) + (set-buffer gnus-server-buffer) + (gnus-server-update-server server) + (gnus-server-list-servers) + (gnus-server-position-point))) + + (defun gnus-server-read-server (server) + "Browse a server." + (interactive (list (gnus-server-server-name))) + (let ((buf (current-buffer))) + (prog1 + (gnus-browse-foreign-server (gnus-server-to-method server) buf) + (save-excursion + (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) + (gnus-server-read-server (gnus-server-server-name))) + + + ;;; + ;;; Browse Server Mode + ;;; + + (defvar gnus-browse-menu-hook nil + "*Hook run after the creation of the browse mode menu.") + + (defvar gnus-browse-mode-hook nil) + (defvar gnus-browse-mode-map nil) + (put 'gnus-browse-mode 'mode-class 'special) + + (unless gnus-browse-mode-map + (setq gnus-browse-mode-map (make-keymap)) + (suppress-keymap gnus-browse-mode-map) + + (gnus-define-keys + gnus-browse-mode-map + " " gnus-browse-read-group + "=" gnus-browse-select-group + "n" gnus-browse-next-group + "p" gnus-browse-prev-group + "\177" gnus-browse-prev-group + "N" gnus-browse-next-group + "P" gnus-browse-prev-group + "\M-n" gnus-browse-next-group + "\M-p" gnus-browse-prev-group + "\r" gnus-browse-select-group + "u" gnus-browse-unsubscribe-current-group + "l" gnus-browse-exit + "L" gnus-browse-exit + "q" gnus-browse-exit + "Q" gnus-browse-exit + "\C-c\C-c" gnus-browse-exit + "?" gnus-browse-describe-briefly + + "\C-c\C-i" gnus-info-find-node)) + + (defun gnus-browse-make-menu-bar () + (gnus-visual-turn-off-edit-menu 'browse) + (or + (boundp 'gnus-browse-menu) + (progn + (easy-menu-define + gnus-browse-menu gnus-browse-mode-map "" + '("Browse" + ["Subscribe" gnus-browse-unsubscribe-current-group t] + ["Read" gnus-browse-read-group t] + ["Select" gnus-browse-read-group t] + ["Next" gnus-browse-next-group t] + ["Prev" gnus-browse-next-group t] + ["Exit" gnus-browse-exit t] + )) + (run-hooks 'gnus-browse-menu-hook)))) + + (defvar gnus-browse-current-method nil) + (defvar gnus-browse-return-buffer nil) + + (defvar gnus-browse-buffer "*Gnus Browse Server*") + + (defun gnus-browse-foreign-server (method &optional return-buffer) + "Browse the server METHOD." + (setq gnus-browse-current-method method) + (setq gnus-browse-return-buffer return-buffer) + (let ((gnus-select-method method) + groups group) + (gnus-message 5 "Connecting to %s..." (nth 1 method)) + (cond + ((not (gnus-check-server method)) + (gnus-message + 1 "Unable to contact server: %s" (gnus-status-message method)) + nil) + ((not (gnus-request-list method)) + (gnus-message + 1 "Couldn't request list: %s" (gnus-status-message method)) + nil) + (t + (get-buffer-create gnus-browse-buffer) + (gnus-add-current-to-buffer-list) + (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) + (gnus-configure-windows 'browse) + (buffer-disable-undo (current-buffer)) + (let ((buffer-read-only nil)) + (erase-buffer)) + (gnus-browse-mode) + (setq mode-line-buffer-identification + (list + (format + "Gnus: %%b {%s:%s}" (car method) (cadr method)))) + (save-excursion + (set-buffer nntp-server-buffer) + (let ((cur (current-buffer))) + (goto-char (point-min)) + (or (string= gnus-ignored-newsgroups "") + (delete-matching-lines gnus-ignored-newsgroups)) + (while (re-search-forward + "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) + (goto-char (match-end 1)) + (setq groups (cons (cons (match-string 1) + (max 0 (- (1+ (read cur)) (read cur)))) + groups))))) + (setq groups (sort groups + (lambda (l1 l2) + (string< (car l1) (car l2))))) + (let ((buffer-read-only nil)) + (while groups + (setq group (car groups)) + (insert + (format "K%7d: %s\n" (cdr group) (car group))) + (setq groups (cdr groups)))) + (switch-to-buffer (current-buffer)) + (goto-char (point-min)) + (gnus-group-position-point) + (gnus-message 5 "Connecting to %s...done" (nth 1 method)) + t)))) + + (defun gnus-browse-mode () + "Major mode for browsing a foreign server. + + All normal editing commands are switched off. + + \\ + The only things you can do in this buffer is + + 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. + The group will be inserted into the group buffer upon exit from this + buffer. + + 2) `\\[gnus-browse-read-group]' to read a group ephemerally. + + 3) `\\[gnus-browse-exit]' to return to the group buffer." + (interactive) + (kill-all-local-variables) + (when (and menu-bar-mode + (gnus-visual-p 'browse-menu 'menu)) + (gnus-browse-make-menu-bar)) + (gnus-simplify-mode-line) + (setq major-mode 'gnus-browse-mode) + (setq mode-name "Browse Server") + (setq mode-line-process nil) + (use-local-map gnus-browse-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (run-hooks 'gnus-browse-mode-hook)) + + (defun gnus-browse-read-group (&optional no-article) + "Enter the group at the current line." + (interactive) + (let ((group (gnus-browse-group-name))) + (or (gnus-group-read-ephemeral-group + group gnus-browse-current-method nil + (cons (current-buffer) 'browse)) + (error "Couldn't enter %s" group)))) + + (defun gnus-browse-select-group () + "Select the current group." + (interactive) + (gnus-browse-read-group 'no)) + + (defun gnus-browse-next-group (n) + "Go to the next group." + (interactive "p") + (prog1 + (forward-line n) + (gnus-group-position-point))) + + (defun gnus-browse-prev-group (n) + "Go to the next group." + (interactive "p") + (gnus-browse-next-group (- n))) + + (defun gnus-browse-unsubscribe-current-group (arg) + "(Un)subscribe to the next ARG groups." + (interactive "p") + (when (eobp) + (error "No group at current line.")) + (let ((ward (if (< arg 0) -1 1)) + (arg (abs arg))) + (while (and (> arg 0) + (not (eobp)) + (gnus-browse-unsubscribe-group) + (zerop (gnus-browse-next-group ward))) + (decf arg)) + (gnus-group-position-point) + (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) + arg)) + + (defun gnus-browse-group-name () + (save-excursion + (beginning-of-line) + (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) + (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method)))) + + (defun gnus-browse-unsubscribe-group () + "Toggle subscription of the current group in the browse buffer." + (let ((sub nil) + (buffer-read-only nil) + group) + (save-excursion + (beginning-of-line) + ;; If this group it killed, then we want to subscribe it. + (if (= (following-char) ?K) (setq sub t)) + (setq group (gnus-browse-group-name)) + (delete-char 1) + (if sub + (progn + (gnus-group-change-level + (list t group gnus-level-default-subscribed + nil nil gnus-browse-current-method) + gnus-level-default-subscribed gnus-level-killed + (and (car (nth 1 gnus-newsrc-alist)) + (gnus-gethash (car (nth 1 gnus-newsrc-alist)) + gnus-newsrc-hashtb)) + t) + (insert ? )) + (gnus-group-change-level + group gnus-level-killed gnus-level-default-subscribed) + (insert ?K))) + t)) + + (defun gnus-browse-exit () + "Quit browsing and return to the group buffer." + (interactive) + (when (eq major-mode 'gnus-browse-mode) + (kill-buffer (current-buffer))) + ;; Insert the newly subscribed groups in the group buffer. + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-list-groups nil)) + (if gnus-browse-return-buffer + (gnus-configure-windows 'server 'force) + (gnus-configure-windows 'group 'force))) + + (defun gnus-browse-describe-briefly () + "Give a one line description of the group mode commands." + (interactive) + (gnus-message 6 + (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) + + (provide 'gnus-srvr) + + ;;; gnus-srvr.el ends here. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-topic.el emacs-19.32/lisp/gnus-topic.el *** emacs-19.31/lisp/gnus-topic.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/gnus-topic.el Tue Jun 25 18:30:49 1996 *************** *** 0 **** --- 1,1057 ---- + ;;; gnus-topic.el --- a folding minor mode for Gnus group buffers + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Ilja Weis + ;; Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'gnus) + (eval-when-compile (require 'cl)) + + (defvar gnus-topic-mode nil + "Minor mode for Gnus group buffers.") + + (defvar gnus-topic-mode-hook nil + "Hook run in topic mode buffers.") + + (defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" + "Format of topic lines. + It works along the same lines as a normal formatting string, + with some simple extensions. + + %i Indentation based on topic level. + %n Topic name. + %v Nothing if the topic is visible, \"...\" otherwise. + %g Number of groups in the topic. + %a Number of unread articles in the groups in the topic. + %A Number of unread articles in the groups in the topic and its subtopics. + ") + + (defvar gnus-topic-indent-level 2 + "*How much each subtopic should be indented.") + + ;; Internal variables. + + (defvar gnus-topic-active-topology nil) + (defvar gnus-topic-active-alist nil) + + (defvar gnus-topology-checked-p nil + "Whether the topology has been checked in this session.") + + (defvar gnus-topic-killed-topics nil) + (defvar gnus-topic-inhibit-change-level nil) + (defvar gnus-topic-tallied-groups nil) + + (defconst gnus-topic-line-format-alist + `((?n name ?s) + (?v visible ?s) + (?i indentation ?s) + (?g number-of-groups ?d) + (?a (gnus-topic-articles-in-topic entries) ?d) + (?A total-number-of-articles ?d) + (?l level ?d))) + + (defvar gnus-topic-line-format-spec nil) + + ;; Functions. + + (defun gnus-group-topic-name () + "The name of the topic on the current line." + (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) + (and topic (symbol-name topic)))) + + (defun gnus-group-topic-level () + "The level of the topic on the current line." + (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) + + (defun gnus-group-topic-unread () + "The number of unread articles in topic on the current line." + (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) + + (defun gnus-topic-unread (topic) + "Return the number of unread articles in TOPIC." + (or (save-excursion + (and (gnus-topic-goto-topic topic) + (gnus-group-topic-unread))) + 0)) + + (defun gnus-topic-init-alist () + "Initialize the topic structures." + (setq gnus-topic-topology + (cons (list "Gnus" 'visible) + (mapcar (lambda (topic) + (list (list (car topic) 'visible))) + '(("misc"))))) + (setq gnus-topic-alist + (list (cons "misc" + (mapcar (lambda (info) (gnus-info-group info)) + (cdr gnus-newsrc-alist))) + (list "Gnus"))) + (gnus-topic-enter-dribble)) + + (defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) + "List all newsgroups with unread articles of level LEVEL or lower, and + use the `gnus-group-topics' to sort the groups. + If ALL is non-nil, list groups that have no unread articles. + If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." + (set-buffer gnus-group-buffer) + (let ((buffer-read-only nil) + (lowest (or lowest 1))) + + (setq gnus-topic-tallied-groups nil) + + (when (or (not gnus-topic-alist) + (not gnus-topology-checked-p)) + (gnus-topic-check-topology)) + + (unless list-topic + (erase-buffer)) + + ;; List dead groups? + (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) + (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 + (setq gnus-killed-list (sort gnus-killed-list 'string<)) + gnus-level-killed ?K + regexp)) + + ;; Use topics. + (when (< lowest gnus-level-zombie) + (if list-topic + (let ((top (gnus-topic-find-topology list-topic))) + (gnus-topic-prepare-topic (cdr top) (car top) + (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)) + + (defun gnus-topic-prepare-topic (topicl level &optional list-level all silent) + "Insert TOPIC into the group buffer. + If SILENT, don't insert anything. Return the number of unread + articles in the topic and its subtopics." + (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 + (make-string (* gnus-topic-indent-level level) ? )) + (beg (progn (beginning-of-line) (point))) + (topicl (reverse topicl)) + (all-entries entries) + (unread 0) + (topic (car type)) + info entry end active) + ;; Insert any sub-topics. + (while topicl + (incf unread + (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 + (if (stringp entry) + ;; Dead groups. + (gnus-group-insert-group-line + entry (if (member entry gnus-zombie-list) 8 9) + nil (- (1+ (cdr (setq active (gnus-active entry)))) + (car active)) nil) + ;; Living groups. + (when (setq info (nth 2 entry)) + (gnus-group-insert-group-line + (gnus-info-group info) + (gnus-info-level info) (gnus-info-marks info) + (car entry) (gnus-info-method info))))) + (when (and (listp entry) + (numberp (car entry)) + (not (member (gnus-info-group (setq info (nth 2 entry))) + gnus-topic-tallied-groups))) + (push (gnus-info-group info) gnus-topic-tallied-groups) + (incf unread (car entry)))) + (goto-char beg) + ;; Insert the topic line. + (unless silent + (gnus-extent-start-open (point)) + (gnus-topic-insert-topic-line + (car type) visiblep + (not (eq (nth 2 type) 'hidden)) + level all-entries unread)) + (goto-char end) + unread)) + + (defun gnus-topic-find-groups (topic &optional level all) + "Return entries for all visible groups in TOPIC." + (let ((groups (cdr (assoc topic gnus-topic-alist))) + info clevel unread group lowest params visible-groups entry active) + (setq lowest (or lowest 1)) + (setq level (or level 7)) + ;; We go through the newsrc to look for matches. + (while groups + (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb) + info (nth 2 entry) + params (gnus-info-params info) + active (gnus-active group) + unread (or (car entry) + (and (not (equal group "dummy.group")) + active + (- (1+ (cdr active)) (car active)))) + clevel (or (gnus-info-level info) + (if (member group gnus-zombie-list) 8 9))) + (and + unread ; nil means that the group is dead. + (<= clevel level) + (>= clevel lowest) ; Is inside the level we want. + (or all + (if (eq unread t) + gnus-group-list-inactive-groups + (> unread 0)) + (and gnus-list-groups-with-ticked-articles + (cdr (assq 'tick (gnus-info-marks info)))) + ; Has right readedness. + ;; Check for permanent visibility. + (and gnus-permanently-visible-groups + (string-match gnus-permanently-visible-groups group)) + (memq 'visible params) + (cdr (assq 'visible params))) + ;; Add this group to the list of visible groups. + (push (or entry group) visible-groups))) + (nreverse visible-groups))) + + (defun gnus-topic-remove-topic (&optional insert total-remove hide in-level) + "Remove the current topic." + (let ((topic (gnus-group-topic-name)) + (level (gnus-group-topic-level)) + (beg (progn (beginning-of-line) (point))) + buffer-read-only) + (when topic + (while (and (zerop (forward-line 1)) + (> (or (gnus-group-topic-level) (1+ level)) level))) + (delete-region beg (point)) + (setcar (cdadr (gnus-topic-find-topology topic)) + (if insert 'visible 'invisible)) + (when hide + (setcdr (cdadr (gnus-topic-find-topology topic)) + (list hide))) + (unless total-remove + (gnus-topic-insert-topic topic in-level))))) + + (defun gnus-topic-insert-topic (topic &optional level) + "Insert TOPIC." + (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))) + (when topic + (save-excursion + (if (not (gnus-group-active-topic-p)) + (gnus-topic-remove-topic + (or insert (not (gnus-topic-visible-p)))) + (let ((gnus-topic-topology gnus-topic-active-topology) + (gnus-topic-alist gnus-topic-active-alist) + (gnus-group-list-mode (cons 5 t))) + (gnus-topic-remove-topic + (or insert (not (gnus-topic-visible-p))) nil nil 9))))))) + + (defun gnus-group-topic-p () + "Return non-nil if the current line is a topic." + (gnus-group-topic-name)) + + (defun gnus-topic-visible-p () + "Return non-nil if the current topic is visible." + (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) + + (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) ? )) + (total-number-of-articles unread) + (number-of-groups (length entries)) + (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) + (beginning-of-line) + ;; Insert the text. + (gnus-add-text-properties + (point) + (prog1 (1+ (point)) + (eval gnus-topic-line-format-spec) + (gnus-topic-remove-excess-properties)1) + (list 'gnus-topic (intern name) + 'gnus-topic-level level + 'gnus-topic-unread unread + 'gnus-active active-topic + 'gnus-topic-visible visiblep)))) + + (defun gnus-topic-previous-topic (topic) + "Return the previous topic on the same level as TOPIC." + (let ((top (cddr (gnus-topic-find-topology + (gnus-topic-parent-topic topic))))) + (unless (equal topic (caaar top)) + (while (and top (not (equal (caaadr top) topic))) + (setq top (cdr top))) + (caaar top)))) + + (defun gnus-topic-parent-topic (topic &optional topology) + "Return the parent of TOPIC." + (unless topology + (setq topology gnus-topic-topology)) + (let ((parent (car (pop topology))) + result found) + (while (and topology + (not (setq found (equal (caaar topology) 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 ((topology gnus-topic-topology) + (parentt (cddr (gnus-topic-find-topology + (gnus-topic-parent-topic topic)))) + prev) + (while (and parentt + (not (equal (caaar parentt) topic))) + (setq prev (caaar parentt) + parentt (cdr parentt))) + (if previous + prev + (caaadr parentt)))) + + (defun gnus-topic-find-topology (topic &optional topology level remove) + "Return the topology of TOPIC." + (unless topology + (setq topology gnus-topic-topology) + (setq level 0)) + (let ((top topology) + result) + (if (equal (caar topology) topic) + (progn + (when remove + (delq topology remove)) + (cons level topology)) + (setq topology (cdr topology)) + (while (and topology + (not (setq result (gnus-topic-find-topology + topic (car topology) (1+ level) + (and remove top))))) + (setq topology (cdr topology))) + result))) + + (gnus-add-shutdown 'gnus-topic-close 'gnus) + + (defun gnus-topic-close () + (setq gnus-topic-active-topology nil + gnus-topic-active-alist nil + gnus-topic-killed-topics nil + gnus-topic-tallied-groups nil + gnus-topology-checked-p nil)) + + (defun gnus-topic-check-topology () + ;; The first time we set the topology to whatever we have + ;; gotten here, which can be rather random. + (unless gnus-topic-alist + (gnus-topic-init-alist)) + + (setq gnus-topology-checked-p t) + (let ((topics (gnus-topic-list)) + (alist gnus-topic-alist) + changed) + (while alist + (unless (member (caar alist) topics) + (nconc gnus-topic-topology + (list (list (list (caar alist) 'visible)))) + (setq changed t)) + (setq alist (cdr alist))) + (when changed + (gnus-topic-enter-dribble))) + (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) + gnus-topic-alist))) + (entry (assoc (caar gnus-topic-topology) gnus-topic-alist)) + (newsrc gnus-newsrc-alist) + group) + (while newsrc + (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) + (setcdr entry (cons group (cdr entry))))))) + + (defvar gnus-tmp-topics nil) + (defun gnus-topic-list (&optional topology) + (unless topology + (setq topology gnus-topic-topology + gnus-tmp-topics nil)) + (push (caar topology) gnus-tmp-topics) + (mapcar 'gnus-topic-list (cdr topology)) + gnus-tmp-topics) + + (defun gnus-topic-enter-dribble () + (gnus-dribble-enter + (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) + + (defun gnus-topic-articles-in-topic (entries) + (let ((total 0) + number) + (while entries + (when (numberp (setq number (car (pop entries)))) + (incf total number))) + total)) + + (defun gnus-group-topic (group) + "Return the topic GROUP is a member of." + (let ((alist gnus-topic-alist) + out) + (while alist + (when (member group (cdar alist)) + (setq out (caar alist) + alist nil)) + (setq alist (cdr alist))) + out)) + + (defun gnus-topic-goto-topic (topic) + "Go to TOPIC." + (when topic + (gnus-goto-char (text-property-any (point-min) (point-max) + 'gnus-topic (intern topic))))) + + (defun gnus-group-parent-topic () + "Return the name of the current topic." + (let ((result + (or (get-text-property (point) 'gnus-topic) + (save-excursion + (and (gnus-goto-char (previous-single-property-change + (point) 'gnus-topic)) + (get-text-property (max (1- (point)) (point-min)) + 'gnus-topic)))))) + (when result + (symbol-name result)))) + + (defun gnus-topic-update-topic () + "Update all parent topics to the current group." + (when (and (eq major-mode 'gnus-group-mode) + gnus-topic-mode) + (let ((group (gnus-group-group-name)) + (buffer-read-only nil)) + (when (and group (gnus-get-info group) + (gnus-topic-goto-topic (gnus-group-parent-topic))) + (gnus-topic-update-topic-line (gnus-group-topic-name)) + (gnus-group-goto-group group) + (gnus-group-position-point))))) + + (defun gnus-topic-goto-missing-group (group) + "Place point where GROUP is supposed to be inserted." + (let* ((topic (gnus-group-topic group)) + (groups (cdr (assoc topic gnus-topic-alist))) + (g (cdr (member group groups))) + (unfound t)) + (while (and g unfound) + (when (gnus-group-goto-group (pop g)) + (beginning-of-line) + (setq unfound nil))) + (when unfound + (setq g (cdr (member group (reverse groups)))) + (while (and g unfound) + (when (gnus-group-goto-group (pop g)) + (forward-line 1) + (setq unfound nil))) + (when unfound + (gnus-topic-goto-topic topic) + (forward-line 1))))) + + (defun gnus-topic-update-topic-line (topic-name &optional reads) + (let* ((top (gnus-topic-find-topology topic-name)) + (type (cadr top)) + (children (cddr top)) + (entries (gnus-topic-find-groups + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode))) + (parent (gnus-topic-parent-topic topic-name)) + (all-entries entries) + (unread 0) + old-unread entry) + (when (gnus-topic-goto-topic (car type)) + ;; Tally all the groups that belong in this topic. + (if reads + (setq unread (- (gnus-group-topic-unread) reads)) + (while children + (incf unread (gnus-topic-unread (caar (pop children))))) + (while (setq entry (pop entries)) + (when (numberp (car entry)) + (incf unread (car entry))))) + (setq old-unread (gnus-group-topic-unread)) + ;; Insert the 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) + (gnus-delete-line)) + (when parent + (forward-line -1) + (gnus-topic-update-topic-line + parent (- old-unread (gnus-group-topic-unread)))) + unread)) + + (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. + (when (or force + (not gnus-topic-active-alist)) + (let (groups) + ;; Get a list of all groups available. + (mapatoms (lambda (g) (when (symbol-value g) + (push (symbol-name g) groups))) + gnus-active-hashtb) + (setq groups (sort groups 'string<)) + ;; Init the variables. + (setq gnus-topic-active-topology (list (list "" 'visible))) + (setq gnus-topic-active-alist nil) + ;; Descend the top-level hierarchy. + (gnus-topic-grok-active-1 gnus-topic-active-topology groups) + ;; Set the top-level topic names to something nice. + (setcar (car gnus-topic-active-topology) "Gnus active") + (setcar (car gnus-topic-active-alist) "Gnus active")))) + + (defun gnus-topic-grok-active-1 (topology groups) + (let* ((name (caar topology)) + (prefix (concat "^" (regexp-quote name))) + tgroups ntopology group) + (while (and groups + (string-match prefix (setq group (car groups)))) + (if (not (string-match "\\." group (match-end 0))) + ;; There are no further hierarchies here, so we just + ;; enter this group into the list belonging to this + ;; topic. + (push (pop groups) tgroups) + ;; New sub-hierarchy, so we add it to the topology. + (nconc topology (list (setq ntopology + (list (list (substring + group 0 (match-end 0)) + 'invisible))))) + ;; Descend the hierarchy. + (setq groups (gnus-topic-grok-active-1 ntopology groups)))) + ;; We remove the trailing "." from the topic name. + (setq name + (if (string-match "\\.$" name) + (substring name 0 (match-beginning 0)) + name)) + ;; Add this topic and its groups to the topic alist. + (push (cons name (nreverse tgroups)) gnus-topic-active-alist) + (setcar (car topology) name) + ;; We return the rest of the groups that didn't belong + ;; to this topic. + groups)) + + (defun gnus-group-active-topic-p () + "Return whether the current active comes from the active topics." + (save-excursion + (beginning-of-line) + (get-text-property (point) 'gnus-active))) + + ;;; Topic mode, commands and keymap. + + (defvar gnus-topic-mode-map nil) + (defvar gnus-group-topic-map nil) + + (unless gnus-topic-mode-map + (setq gnus-topic-mode-map (make-sparse-keymap)) + + ;; Override certain group mode keys. + (gnus-define-keys + gnus-topic-mode-map + "=" gnus-topic-select-group + "\r" gnus-topic-select-group + " " gnus-topic-read-group + "\C-k" gnus-topic-kill-group + "\C-y" gnus-topic-yank-group + "\M-g" gnus-topic-get-new-news-this-topic + "AT" gnus-topic-list-active + gnus-mouse-2 gnus-mouse-pick-topic) + + ;; Define a new submap. + (gnus-define-keys + (gnus-group-topic-map "T" gnus-group-mode-map) + "#" gnus-topic-mark-topic + "\M-#" gnus-topic-unmark-topic + "n" gnus-topic-create-topic + "m" gnus-topic-move-group + "D" gnus-topic-remove-group + "c" gnus-topic-copy-group + "h" gnus-topic-hide-topic + "s" gnus-topic-show-topic + "M" gnus-topic-move-matching + "C" gnus-topic-copy-matching + "\C-i" gnus-topic-indent + [tab] gnus-topic-indent + "r" gnus-topic-rename + "\177" gnus-topic-delete)) + + (defun gnus-topic-make-menu-bar () + (unless (boundp 'gnus-topic-menu) + (easy-menu-define + gnus-topic-menu gnus-topic-mode-map "" + '("Topics" + ["Toggle topics" gnus-topic-mode t] + ("Groups" + ["Copy" gnus-topic-copy-group t] + ["Move" gnus-topic-move-group t] + ["Remove" gnus-topic-remove-group t] + ["Copy matching" gnus-topic-copy-matching t] + ["Move matching" gnus-topic-move-matching t]) + ("Topics" + ["Show" gnus-topic-show-topic t] + ["Hide" gnus-topic-hide-topic t] + ["Delete" gnus-topic-delete t] + ["Rename" gnus-topic-rename t] + ["Create" gnus-topic-create-topic t] + ["Mark" gnus-topic-mark-topic t] + ["Indent" gnus-topic-indent t]) + ["List active" gnus-topic-list-active t])))) + + (defun gnus-topic-mode (&optional arg redisplay) + "Minor mode for topicsifying Gnus group buffers." + (interactive (list current-prefix-arg t)) + (when (eq major-mode 'gnus-group-mode) + (make-local-variable '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 (and menu-bar-mode + (gnus-visual-p 'topic-menu 'menu)) + (gnus-topic-make-menu-bar)) + (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)) + (unless (assq 'gnus-topic-mode minor-mode-map-alist) + (push (cons 'gnus-topic-mode gnus-topic-mode-map) + minor-mode-map-alist)) + (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) + (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) + (add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic) + (make-local-variable 'gnus-group-prepare-function) + (setq gnus-group-prepare-function 'gnus-group-prepare-topics) + (make-local-variable 'gnus-group-goto-next-group-function) + (setq gnus-group-goto-next-group-function + 'gnus-topic-goto-next-group) + (setq gnus-group-change-level-function 'gnus-topic-change-level) + (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) + (make-local-variable 'gnus-group-indentation-function) + (setq gnus-group-indentation-function + 'gnus-topic-group-indentation) + (setq gnus-topology-checked-p nil) + ;; We check the topology. + (when gnus-newsrc-alist + (gnus-topic-check-topology)) + (run-hooks 'gnus-topic-mode-hook)) + ;; Remove topic infestation. + (unless gnus-topic-mode + (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) + (remove-hook 'gnus-group-change-level-function + 'gnus-topic-change-level) + (setq gnus-group-prepare-function 'gnus-group-prepare-flat)) + (when redisplay + (gnus-group-list-groups)))) + + (defun gnus-topic-select-group (&optional all) + "Select this newsgroup. + No article is selected automatically. + If ALL is non-nil, already read articles become readable. + If ALL is a number, fetch this number of articles." + (interactive "P") + (if (gnus-group-topic-p) + (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))) + + (defun gnus-mouse-pick-topic (e) + "Select the group or topic under the mouse pointer." + (interactive "e") + (mouse-set-point e) + (gnus-topic-read-group nil)) + + (defun gnus-topic-read-group (&optional all no-article group) + "Read news in this newsgroup. + If the prefix argument ALL is non-nil, already read articles become + readable. IF ALL is a number, fetch this number of articles. If the + optional argument NO-ARTICLE is non-nil, no article will be + auto-selected upon group entry. If GROUP is non-nil, fetch that + group." + (interactive "P") + (if (gnus-group-topic-p) + (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 + (list + (read-string "New topic: ") + (gnus-group-parent-topic))) + ;; Check whether this topic already exists. + (when (gnus-topic-find-topology topic) + (error "Topic aleady exists")) + (unless parent + (setq parent (caar gnus-topic-topology))) + (let ((top (cdr (gnus-topic-find-topology parent))) + (full-topic (or full-topic `((,topic visible))))) + (unless top + (error "No such parent topic: %s" parent)) + (if previous + (progn + (while (and (cdr top) + (not (equal (caaadr top) previous))) + (setq top (cdr top))) + (setcdr top (cons full-topic (cdr top)))) + (nconc top (list full-topic))) + (unless (assoc topic gnus-topic-alist) + (push (list topic) gnus-topic-alist))) + (gnus-topic-enter-dribble) + (gnus-group-list-groups) + (gnus-topic-goto-topic topic)) + + (defun gnus-topic-move-group (n topic &optional copyp) + "Move the next N groups to TOPIC. + If COPYP, copy the groups instead." + (interactive + (list current-prefix-arg + (completing-read "Move to topic: " gnus-topic-alist nil t))) + (let ((groups (gnus-group-process-prefix n)) + (topicl (assoc topic gnus-topic-alist)) + entry) + (mapcar (lambda (g) + (gnus-group-remove-mark g) + (when (and + (setq entry (assoc (gnus-group-parent-topic) + gnus-topic-alist)) + (not copyp)) + (setcdr entry (gnus-delete-first g (cdr entry)))) + (nconc topicl (list g))) + groups) + (gnus-group-position-point)) + (gnus-topic-enter-dribble) + (gnus-group-list-groups)) + + (defun gnus-topic-remove-group () + "Remove the current group from the topic." + (interactive) + (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist)) + (group (gnus-group-group-name)) + (buffer-read-only nil)) + (when (and topicl group) + (gnus-delete-line) + (gnus-delete-first group topicl)) + (gnus-group-position-point))) + + (defun gnus-topic-copy-group (n topic) + "Copy the current group to a topic." + (interactive + (list current-prefix-arg + (completing-read "Copy to topic: " gnus-topic-alist nil t))) + (gnus-topic-move-group n topic t)) + + (defun gnus-topic-group-indentation () + (make-string + (* gnus-topic-indent-level + (or (save-excursion + (gnus-topic-goto-topic (gnus-group-parent-topic)) + (gnus-group-topic-level)) 0)) ? )) + + (defun gnus-topic-change-level (group level oldlevel) + "Run when changing levels to enter/remove groups from topics." + (save-excursion + (set-buffer gnus-group-buffer) + (when (and gnus-topic-mode + gnus-topic-alist + (not gnus-topic-inhibit-change-level)) + ;; Remove the group from the topics. + (when (and (< oldlevel gnus-level-zombie) + (>= level gnus-level-zombie)) + (let (alist) + (forward-line -1) + (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist)) + (setcdr alist (gnus-delete-first group (cdr alist)))))) + ;; If the group is subscribed. then we enter it into the topics. + (when (and (< level gnus-level-zombie) + (>= oldlevel gnus-level-zombie)) + (let* ((prev (gnus-group-group-name)) + (gnus-topic-inhibit-change-level t) + (gnus-group-indentation + (make-string + (* gnus-topic-indent-level + (or (save-excursion + (gnus-topic-goto-topic (gnus-group-parent-topic)) + (gnus-group-topic-level)) 0)) ? )) + (yanked (list group)) + alist talist end) + ;; Then we enter the yanked groups into the topics they belong + ;; to. + (when (setq alist (assoc (save-excursion + (forward-line -1) + (or + (gnus-group-parent-topic) + (caar gnus-topic-topology))) + gnus-topic-alist)) + (setq talist alist) + (when (stringp yanked) + (setq yanked (list yanked))) + (if (not prev) + (nconc alist yanked) + (if (not (cdr alist)) + (setcdr alist (nconc yanked (cdr alist))) + (while (and (not end) (cdr alist)) + (when (equal (cadr alist) prev) + (setcdr alist (nconc yanked (cdr alist))) + (setq end t)) + (setq alist (cdr alist))) + (unless end + (nconc talist yanked)))))) + (gnus-topic-update-topic))))) + + (defun gnus-topic-goto-next-group (group props) + "Go to group or the next group after group." + (if (null group) + (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))) + (if (gnus-group-goto-group group) + t + ;; The group is no longer visible. + (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist)) + (after (cdr (member group (cdr list))))) + ;; First try to put point on a group after the current one. + (while (and after + (not (gnus-group-goto-group (car after)))) + (setq after (cdr after))) + ;; Then try to put point on a group before point. + (unless after + (setq after (cdr (member group (reverse (cdr list))))) + (while (and after + (not (gnus-group-goto-group (car after)))) + (setq after (cdr after)))) + ;; Finally, just put point on the topic. + (unless after + (gnus-topic-goto-topic (car list)) + (setq after nil)) + t)))) + + (defun gnus-topic-kill-group (&optional n discard) + "Kill the next N groups." + (interactive "P") + (if (gnus-group-topic-p) + (let ((topic (gnus-group-topic-name))) + (gnus-topic-remove-topic nil t) + (push (gnus-topic-find-topology topic nil nil gnus-topic-topology) + gnus-topic-killed-topics)) + (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 + (or (gnus-group-topic-name) + (gnus-topic-next-topic (gnus-group-parent-topic)))) + (item (cdr (pop gnus-topic-killed-topics)))) + (gnus-topic-create-topic + (caar item) (gnus-topic-parent-topic previous) previous + item) + (gnus-topic-goto-topic (caar item))) + (let* ((prev (gnus-group-group-name)) + (gnus-topic-inhibit-change-level t) + (gnus-group-indentation + (make-string + (* gnus-topic-indent-level + (or (save-excursion + (gnus-topic-goto-topic (gnus-group-parent-topic)) + (gnus-group-topic-level)) 0)) ? )) + yanked alist) + ;; 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. + (setq alist (assoc (save-excursion + (forward-line -1) + (gnus-group-parent-topic)) + gnus-topic-alist)) + (when (stringp yanked) + (setq yanked (list yanked))) + (if (not prev) + (nconc alist yanked) + (if (not (cdr alist)) + (setcdr alist (nconc yanked (cdr alist))) + (while (cdr alist) + (when (equal (cadr alist) prev) + (setcdr alist (nconc yanked (cdr alist))) + (setq alist nil)) + (setq alist (cdr alist)))))) + (gnus-topic-update-topic))) + + (defun gnus-topic-hide-topic () + "Hide all subtopics under the current topic." + (interactive) + (when (gnus-group-parent-topic) + (gnus-topic-goto-topic (gnus-group-parent-topic)) + (gnus-topic-remove-topic nil nil 'hidden))) + + (defun gnus-topic-show-topic () + "Show the hidden topic." + (interactive) + (when (gnus-group-topic-p) + (gnus-topic-remove-topic t nil 'shown))) + + (defun gnus-topic-mark-topic (topic &optional unmark) + "Mark all groups in the topic with the process mark." + (interactive (list (gnus-group-parent-topic))) + (save-excursion + (let ((groups (gnus-topic-find-groups topic 9 t))) + (while groups + (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) + (gnus-info-group (nth 2 (pop groups)))))))) + + (defun gnus-topic-unmark-topic (topic &optional unmark) + "Remove the process mark from all groups in the topic." + (interactive (list (gnus-group-parent-topic))) + (gnus-topic-mark-topic topic t)) + + (defun gnus-topic-get-new-news-this-topic (&optional n) + "Check for new news in the current topic." + (interactive "P") + (if (not (gnus-group-topic-p)) + (gnus-group-get-new-news-this-group n) + (gnus-topic-mark-topic (gnus-group-topic-name)) + (gnus-group-get-new-news-this-group))) + + (defun gnus-topic-move-matching (regexp topic &optional copyp) + "Move all groups that match REGEXP to some topic." + (interactive + (let (topic) + (nreverse + (list + (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) + (read-string (format "Move to %s (regexp): " topic)))))) + (gnus-group-mark-regexp regexp) + (gnus-topic-move-group nil topic copyp)) + + (defun gnus-topic-copy-matching (regexp topic &optional copyp) + "Copy all groups that match REGEXP to some topic." + (interactive + (let (topic) + (nreverse + (list + (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) + (read-string (format "Copy to %s (regexp): " topic)))))) + (gnus-topic-move-matching regexp topic t)) + + (defun gnus-topic-delete (topic) + "Delete a topic." + (interactive (list (gnus-group-topic-name))) + (unless topic + (error "No topic to be deleted")) + (let ((entry (assoc topic gnus-topic-alist)) + (buffer-read-only nil)) + (when (cdr entry) + (error "Topic not empty")) + ;; Delete if visible. + (when (gnus-topic-goto-topic topic) + (gnus-delete-line)) + ;; Remove from alist. + (setq gnus-topic-alist (delq entry gnus-topic-alist)) + ;; Remove from topology. + (gnus-topic-find-topology topic nil nil 'delete))) + + (defun gnus-topic-rename (old-name new-name) + "Rename a topic." + (interactive + (let ((topic (gnus-group-parent-topic))) + (list topic + (read-string (format "Rename %s to: " topic))))) + (let ((top (gnus-topic-find-topology old-name)) + (entry (assoc old-name gnus-topic-alist))) + (when top + (setcar (cadr top) new-name)) + (when entry + (setcar entry new-name)) + (gnus-group-list-groups))) + + (defun gnus-topic-indent (&optional unindent) + "Indent a topic -- make it a sub-topic of the previous topic. + If UNINDENT, remove an indentation." + (interactive "P") + (if unindent + (gnus-topic-unindent) + (let* ((topic (gnus-group-parent-topic)) + (parent (gnus-topic-previous-topic topic))) + (unless parent + (error "Nothing to indent %s into" topic)) + (when topic + (gnus-topic-goto-topic topic) + (gnus-topic-kill-group) + (gnus-topic-create-topic + topic parent nil (cdr (pop gnus-topic-killed-topics))) + (or (gnus-topic-goto-topic topic) + (gnus-topic-goto-topic parent)))))) + + (defun gnus-topic-unindent () + "Unindent a topic." + (interactive) + (let* ((topic (gnus-group-parent-topic)) + (parent (gnus-topic-parent-topic topic)) + (grandparent (gnus-topic-parent-topic parent))) + (unless grandparent + (error "Nothing to indent %s into" topic)) + (when topic + (gnus-topic-goto-topic topic) + (gnus-topic-kill-group) + (gnus-topic-create-topic + topic grandparent (gnus-topic-next-topic parent) + (cdr (pop gnus-topic-killed-topics))) + (gnus-topic-goto-topic topic)))) + + (defun gnus-topic-list-active (&optional force) + "List all groups that Gnus knows about in a topicsified fashion. + If FORCE, always re-read the active file." + (interactive "P") + (when force + (gnus-get-killed-groups)) + (gnus-topic-grok-active force) + (let ((gnus-topic-topology gnus-topic-active-topology) + (gnus-topic-alist gnus-topic-active-alist) + gnus-killed-list gnus-zombie-list) + (gnus-group-list-groups 9 nil 1))) + + (provide 'gnus-topic) + + ;;; gnus-topic.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-uu.el emacs-19.32/lisp/gnus-uu.el *** emacs-19.31/lisp/gnus-uu.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-uu.el Tue Jun 25 18:06:24 1996 *************** *** 1,9 **** ;;; gnus-uu.el --- extract (uu)encoded files in Gnus ! ! ;; Copyright (C) 1985,86,87,93,94,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 - ;; Version: v3.0 ;; Keyword: news --- 1,7 ---- ;;; gnus-uu.el --- extract (uu)encoded files in Gnus ! ;; Copyright (C) 1985,86,87,93,94,95,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Created: 2 Oct 1993 ;; Keyword: news *************** *** 31,34 **** --- 29,33 ---- (require 'gnus) (require 'gnus-msg) + (eval-when-compile (require 'cl)) ;; Default viewing action rules *************** *** 43,46 **** --- 42,46 ---- "sox -v .5 %s -t .au -u - > /dev/audio") ("\\.au$" "cat %s > /dev/audio") + ("\\.midi?$" "playmidi -f") ("\\.mod$" "str32") ("\\.ps$" "ghostview") *************** Default is \"/tmp/\".") *** 186,198 **** Default is nil.") - (defvar gnus-uu-view-and-save nil - "*Non-nil means that the user will always be asked to save a file after viewing it. - If the variable is nil, the user will only be asked to save if the - viewing is unsuccessful. Default is nil.") - (defvar gnus-uu-ignore-default-view-rules nil "*Non-nil means that gnus-uu will ignore the default viewing rules. Only the user viewing rules will be consulted. Default is nil.") (defvar gnus-uu-ignore-default-archive-rules nil "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. --- 186,199 ---- Default is nil.") (defvar gnus-uu-ignore-default-view-rules nil "*Non-nil means that gnus-uu will ignore the default viewing rules. Only the user viewing rules will be consulted. Default is nil.") + (defvar 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' + and `gnus-uu-grab-move'.") + (defvar gnus-uu-ignore-default-archive-rules nil "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. *************** The headers will be included in the sequ *** 260,321 **** (defvar gnus-uu-binhex-article-name nil) - (defvar gnus-uu-generated-file-list nil) (defvar gnus-uu-work-dir nil) (defconst gnus-uu-output-buffer-name " *Gnus UU Output*") ! (defvar gnus-uu-default-dir default-directory) ;; Keymaps ! (defvar gnus-uu-extract-map nil) ! (defvar gnus-uu-extract-view-map nil) ! (defvar gnus-uu-mark-map nil) ! ! (define-prefix-command 'gnus-uu-mark-map) ! (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) ! (define-key gnus-uu-mark-map "p" 'gnus-summary-mark-as-processable) ! (define-key gnus-uu-mark-map "u" 'gnus-summary-unmark-as-processable) ! (define-key gnus-uu-mark-map "U" 'gnus-summary-unmark-all-processable) ! (define-key gnus-uu-mark-map "s" 'gnus-uu-mark-series) ! (define-key gnus-uu-mark-map "r" 'gnus-uu-mark-region) ! (define-key gnus-uu-mark-map "R" 'gnus-uu-mark-by-regexp) ! (define-key gnus-uu-mark-map "t" 'gnus-uu-mark-thread) ! (define-key gnus-uu-mark-map "a" 'gnus-uu-mark-all) ! (define-key gnus-uu-mark-map "S" 'gnus-uu-mark-sparse) ! ! (define-prefix-command 'gnus-uu-extract-map) ! (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) ! ;;(define-key gnus-uu-extract-map "x" 'gnus-uu-extract-any) ! ;;(define-key gnus-uu-extract-map "m" 'gnus-uu-extract-mime) ! (define-key gnus-uu-extract-map "u" 'gnus-uu-decode-uu) ! (define-key gnus-uu-extract-map "U" 'gnus-uu-decode-uu-and-save) ! (define-key gnus-uu-extract-map "s" 'gnus-uu-decode-unshar) ! (define-key gnus-uu-extract-map "S" 'gnus-uu-decode-unshar-and-save) ! (define-key gnus-uu-extract-map "o" 'gnus-uu-decode-save) ! (define-key gnus-uu-extract-map "O" 'gnus-uu-decode-save) ! (define-key gnus-uu-extract-map "b" 'gnus-uu-decode-binhex) ! (define-key gnus-uu-extract-map "B" 'gnus-uu-decode-binhex) ! (define-key gnus-uu-extract-map "p" 'gnus-uu-decode-postscript) ! (define-key gnus-uu-extract-map "P" 'gnus-uu-decode-postscript-and-save) ! ! (define-prefix-command 'gnus-uu-extract-view-map) ! (define-key gnus-uu-extract-map "v" 'gnus-uu-extract-view-map) ! (define-key gnus-uu-extract-view-map "u" 'gnus-uu-decode-uu-view) ! (define-key gnus-uu-extract-view-map "U" 'gnus-uu-decode-uu-and-save-view) ! (define-key gnus-uu-extract-view-map "s" 'gnus-uu-decode-unshar-view) ! (define-key gnus-uu-extract-view-map "S" 'gnus-uu-decode-unshar-and-save-view) ! (define-key gnus-uu-extract-view-map "o" 'gnus-uu-decode-save-view) ! (define-key gnus-uu-extract-view-map "O" 'gnus-uu-decode-save-view) ! (define-key gnus-uu-extract-view-map "b" 'gnus-uu-decode-binhex-view) ! (define-key gnus-uu-extract-view-map "B" 'gnus-uu-decode-binhex-view) ! (define-key gnus-uu-extract-view-map "p" 'gnus-uu-decode-postscript-view) ! (define-key gnus-uu-extract-view-map "P" 'gnus-uu-decode-postscript-and-save-view) ! ;; Commands. ! (defun gnus-uu-decode-uu (n) "Uudecodes the current article." (interactive "P") --- 261,320 ---- (defvar gnus-uu-binhex-article-name nil) (defvar gnus-uu-work-dir nil) (defconst gnus-uu-output-buffer-name " *Gnus UU Output*") ! (defvar gnus-uu-default-dir gnus-article-save-directory) ! (defvar gnus-uu-digest-from-subject nil) ;; Keymaps ! (gnus-define-keys ! (gnus-uu-mark-map "P" gnus-summary-mark-map) ! "p" gnus-summary-mark-as-processable ! "u" gnus-summary-unmark-as-processable ! "U" gnus-summary-unmark-all-processable ! "v" gnus-uu-mark-over ! "s" gnus-uu-mark-series ! "r" gnus-uu-mark-region ! "R" gnus-uu-mark-by-regexp ! "t" gnus-uu-mark-thread ! "T" gnus-uu-unmark-thread ! "a" gnus-uu-mark-all ! "b" gnus-uu-mark-buffer ! "S" gnus-uu-mark-sparse) ! ! (gnus-define-keys ! (gnus-uu-extract-map "X" gnus-summary-mode-map) ! ;;"x" gnus-uu-extract-any ! ;;"m" gnus-uu-extract-mime ! "u" gnus-uu-decode-uu ! "U" gnus-uu-decode-uu-and-save ! "s" gnus-uu-decode-unshar ! "S" gnus-uu-decode-unshar-and-save ! "o" gnus-uu-decode-save ! "O" gnus-uu-decode-save ! "b" gnus-uu-decode-binhex ! "B" gnus-uu-decode-binhex ! "p" gnus-uu-decode-postscript ! "P" gnus-uu-decode-postscript-and-save) ! ! (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 ! "s" gnus-uu-decode-unshar-view ! "S" gnus-uu-decode-unshar-and-save-view ! "o" gnus-uu-decode-save-view ! "O" gnus-uu-decode-save-view ! "b" gnus-uu-decode-binhex-view ! "B" gnus-uu-decode-binhex-view ! "p" gnus-uu-decode-postscript-view ! "P" gnus-uu-decode-postscript-and-save-view) ;; Commands. ! (defun gnus-uu-decode-uu (&optional n) "Uudecodes the current article." (interactive "P") *************** The headers will be included in the sequ *** 330,339 **** gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir)) ! (defun gnus-uu-decode-unshar (n) "Unshars the current article." (interactive "P") ! (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan)) (defun gnus-uu-decode-unshar-and-save (n dir) --- 329,338 ---- gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) ! (defun gnus-uu-decode-unshar (&optional n) "Unshars the current article." (interactive "P") ! (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) (defun gnus-uu-decode-unshar-and-save (n dir) *************** The headers will be included in the sequ *** 345,349 **** gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan)) (defun gnus-uu-decode-save (n file) --- 344,348 ---- gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) (defun gnus-uu-decode-save (n file) *************** The headers will be included in the sequ *** 358,364 **** gnus-uu-default-dir))) (setq gnus-uu-saved-article-name file) ! (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t) ! (setq gnus-uu-generated-file-list ! (delete file gnus-uu-generated-file-list))) (defun gnus-uu-decode-binhex (n dir) --- 357,361 ---- gnus-uu-default-dir))) (setq gnus-uu-saved-article-name file) ! (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) (defun gnus-uu-decode-binhex (n dir) *************** The headers will be included in the sequ *** 374,378 **** (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) ! (defun gnus-uu-decode-uu-view (n) "Uudecodes and views the current article." (interactive "P") --- 371,375 ---- (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." (interactive "P") *************** The headers will be included in the sequ *** 390,394 **** (gnus-uu-decode-uu-and-save n dir))) ! (defun gnus-uu-decode-unshar-view (n) "Unshars and views the current article." (interactive "P") --- 387,391 ---- (gnus-uu-decode-uu-and-save n dir))) ! (defun gnus-uu-decode-unshar-view (&optional n) "Unshars and views the current article." (interactive "P") *************** The headers will be included in the sequ *** 431,442 **** ;; Digest and forward articles ! (defun gnus-uu-digest-mail-forward (n &optional post) "Digests and forwards all articles in this series." (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (concat gnus-uu-tmp-dir "forward"))) ! buf) (gnus-uu-decode-save n file) - (gnus-uu-add-file file) (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) (gnus-add-current-to-buffer-list) --- 428,439 ---- ;; Digest and forward articles ! (defun gnus-uu-digest-mail-forward (&optional n post) "Digests and forwards all articles in this series." (interactive "P") (let ((gnus-uu-save-in-digest t) (file (make-temp-name (concat gnus-uu-tmp-dir "forward"))) ! buf subject from) ! (setq gnus-uu-digest-from-subject nil) (gnus-uu-decode-save n file) (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) (gnus-add-current-to-buffer-list) *************** The headers will be included in the sequ *** 444,464 **** (delete-other-windows) (insert-file file) (goto-char (point-min)) (and (re-search-forward "^Subject: ") (progn (delete-region (point) (gnus-point-at-eol)) ! (insert "Digested Articles"))) (goto-char (point-min)) (and (re-search-forward "^From: ") (progn (delete-region (point) (gnus-point-at-eol)) ! (insert "Various"))) ! (if post ! (gnus-forward-using-post) ! (funcall gnus-mail-forward-method)) (delete-file file) ! (kill-buffer buf))) ! (defun gnus-uu-digest-post-forward (n) "Digest and forward to a newsgroup." (interactive "P") --- 441,477 ---- (delete-other-windows) (insert-file file) + (let ((fs gnus-uu-digest-from-subject)) + (if (not fs) + () + (setq from (caar fs) + subject (gnus-simplify-subject-fuzzy (cdar fs)) + fs (cdr fs)) + (while (and fs (or from subject)) + (and from + (or (string= from (caar fs)) + (setq from nil))) + (and subject + (or (string= (gnus-simplify-subject-fuzzy (cdar fs)) + subject) + (setq subject nil))) + (setq fs (cdr fs)))) + (or subject (setq subject "Digested Articles")) + (or from (setq from "Various"))) (goto-char (point-min)) (and (re-search-forward "^Subject: ") (progn (delete-region (point) (gnus-point-at-eol)) ! (insert subject))) (goto-char (point-min)) (and (re-search-forward "^From: ") (progn (delete-region (point) (gnus-point-at-eol)) ! (insert from))) ! (message-forward post) (delete-file file) ! (kill-buffer buf) ! (setq gnus-uu-digest-from-subject nil))) ! (defun gnus-uu-digest-post-forward (&optional n) "Digest and forward to a newsgroup." (interactive "P") *************** The headers will be included in the sequ *** 467,471 **** ;; Process marking. ! (defun gnus-uu-mark-by-regexp (regexp) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) --- 480,484 ---- ;; Process marking. ! (defun gnus-uu-mark-by-regexp (regexp &optional unmark) "Ask for a regular expression and set the process mark on all articles that match." (interactive (list (read-from-minibuffer "Mark (regexp): "))) *************** The headers will be included in the sequ *** 473,480 **** (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles ! (gnus-summary-set-process-mark (car articles)) ! (setq articles (cdr articles))) (message "")) ! (gnus-summary-position-cursor)) (defun gnus-uu-mark-series () --- 486,499 ---- (let ((articles (gnus-uu-find-articles-matching regexp))) (while articles ! (if unmark ! (gnus-summary-remove-process-mark (pop articles)) ! (gnus-summary-set-process-mark (pop articles)))) (message "")) ! (gnus-summary-position-point)) ! ! (defun gnus-uu-unmark-by-regexp (regexp &optional unmark) ! "Ask for a regular expression and remove the process mark on all articles that match." ! (interactive (list (read-from-minibuffer "Mark (regexp): "))) ! (gnus-uu-mark-by-regexp regexp t)) (defun gnus-uu-mark-series () *************** The headers will be included in the sequ *** 487,494 **** (setq articles (cdr articles))) (message "")) ! (gnus-summary-position-cursor)) ! (defun gnus-uu-mark-region (beg end) ! "Marks all articles between point and mark." (interactive "r") (gnus-set-global-variables) --- 506,513 ---- (setq articles (cdr articles))) (message "")) ! (gnus-summary-position-point)) ! (defun gnus-uu-mark-region (beg end &optional unmark) ! "Set the process mark on all articles between point and mark." (interactive "r") (gnus-set-global-variables) *************** The headers will be included in the sequ *** 496,502 **** (goto-char beg) (while (< (point) end) ! (gnus-summary-set-process-mark (gnus-summary-article-number)) (forward-line 1))) ! (gnus-summary-position-cursor)) (defun gnus-uu-mark-thread () --- 515,538 ---- (goto-char beg) (while (< (point) end) ! (if unmark ! (gnus-summary-remove-process-mark (gnus-summary-article-number)) ! (gnus-summary-set-process-mark (gnus-summary-article-number))) (forward-line 1))) ! (gnus-summary-position-point)) ! ! (defun gnus-uu-unmark-region (beg end) ! "Remove the process mark from all articles between point and mark." ! (interactive "r") ! (gnus-uu-mark-region beg end t)) ! ! (defun gnus-uu-mark-buffer () ! "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 () *************** The headers will be included in the sequ *** 508,512 **** (zerop (gnus-summary-next-subject 1)) (> (gnus-summary-thread-level) level)))) ! (gnus-summary-position-cursor)) (defun gnus-uu-mark-sparse () --- 544,574 ---- (zerop (gnus-summary-next-subject 1)) (> (gnus-summary-thread-level) level)))) ! (gnus-summary-position-point)) ! ! (defun gnus-uu-unmark-thread () ! "Unmarks all articles downwards in this thread." ! (interactive) ! (gnus-set-global-variables) ! (let ((level (gnus-summary-thread-level))) ! (while (and (gnus-summary-remove-process-mark ! (gnus-summary-article-number)) ! (zerop (gnus-summary-next-subject 1)) ! (> (gnus-summary-thread-level) level)))) ! (gnus-summary-position-point)) ! ! (defun gnus-uu-mark-over (&optional score) ! "Mark all articles with a score over SCORE (the prefix.)" ! (interactive "P") ! (let ((score (gnus-score-default score)) ! (data gnus-newsgroup-data)) ! (save-excursion ! (while data ! (when (> (or (cdr (assq (gnus-data-number (caar data)) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! score) ! (gnus-summary-set-process-mark (caar data))) ! (setq data (cdr data)))) ! (gnus-summary-position-point))) (defun gnus-uu-mark-sparse () *************** The headers will be included in the sequ *** 520,524 **** (save-excursion (while marked ! (and (setq headers (gnus-get-header-by-number (car marked))) (setq subject (mail-header-subject headers) articles (gnus-uu-find-articles-matching --- 582,587 ---- (save-excursion (while marked ! (and (vectorp (setq headers ! (gnus-summary-article-header (car marked)))) (setq subject (mail-header-subject headers) articles (gnus-uu-find-articles-matching *************** The headers will be included in the sequ *** 531,535 **** (setq marked (cdr marked))) (setq gnus-newsgroup-processable (nreverse total))) ! (gnus-summary-position-cursor))) (defun gnus-uu-mark-all () --- 594,598 ---- (setq marked (cdr marked))) (setq gnus-newsgroup-processable (nreverse total))) ! (gnus-summary-position-point))) (defun gnus-uu-mark-all () *************** The headers will be included in the sequ *** 539,559 **** (setq gnus-newsgroup-processable nil) (save-excursion ! (goto-char (point-min)) ! (let (number) ! (while (and (not (eobp)) ! (setq number (gnus-summary-article-number))) ! (if (not (memq number gnus-newsgroup-processable)) ! (save-excursion (gnus-uu-mark-series))) ! (forward-line 1)))) ! (gnus-summary-position-cursor)) ;; All PostScript functions written by Erik Selberg . ! (defun gnus-uu-decode-postscript (n) "Gets postscript of the current article." (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) ! (defun gnus-uu-decode-postscript-view (n) "Gets and views the current article." (interactive "P") --- 602,624 ---- (setq gnus-newsgroup-processable nil) (save-excursion ! (let ((data gnus-newsgroup-data) ! number) ! (while data ! (when (and (not (memq (setq number (gnus-data-number (car data))) ! gnus-newsgroup-processable)) ! (vectorp (gnus-data-header (car data)))) ! (gnus-summary-goto-subject number) ! (gnus-uu-mark-series)) ! (setq data (cdr data))))) ! (gnus-summary-position-point)) ;; All PostScript functions written by Erik Selberg . ! (defun gnus-uu-decode-postscript (&optional n) "Gets postscript of the current article." (interactive "P") (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) ! (defun gnus-uu-decode-postscript-view (&optional n) "Gets and views the current article." (interactive "P") *************** The headers will be included in the sequ *** 569,574 **** gnus-uu-default-dir gnus-uu-default-dir t)))) ! (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n dir)) ! (defun gnus-uu-decode-postscript-and-save-view (n dir) --- 634,639 ---- gnus-uu-default-dir gnus-uu-default-dir t)))) ! (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) *************** The headers will be included in the sequ *** 585,591 **** ;; Internal functions. ! (defun gnus-uu-decode-with-method (method n &optional save not-insert scan) (gnus-uu-initialize scan) (if save (setq gnus-uu-default-dir save)) (let ((articles (gnus-uu-get-list-of-articles n)) files) --- 650,661 ---- ;; Internal functions. ! (defun gnus-uu-decode-with-method (method n &optional save not-insert ! scan cdir) (gnus-uu-initialize scan) (if save (setq gnus-uu-default-dir save)) + ;; Create the directory we save to. + (when (and scan cdir save + (not (file-exists-p save))) + (make-directory save t)) (let ((articles (gnus-uu-get-list-of-articles n)) files) *************** The headers will be included in the sequ *** 594,634 **** (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) (and save (gnus-uu-save-files files save)) ! (setq files (gnus-uu-unpack-files files)) ! (gnus-uu-add-file (mapcar (lambda (file) (cdr (assq 'name file))) files)) (setq files (nreverse (gnus-uu-get-actions files))) ! (or not-insert (gnus-summary-insert-pseudos files save)))) ! ;; Return a list of files in dir. ! (defun gnus-uu-scan-directory (dir) (let ((files (directory-files dir t)) ! dirs out) ! (while files ! (cond ((string-match "/\\.\\.?$" (car files))) ! ((file-directory-p (car files)) ! (setq dirs (cons (car files) dirs))) ! (t (setq out (cons (list (cons 'name (car files)) ! (cons 'article gnus-current-article)) ! out)))) ! (setq files (cdr files))) ! (apply 'nconc out (mapcar (lambda (d) (gnus-uu-scan-directory d)) ! dirs)))) (defun gnus-uu-save-files (files dir) (let ((len (length files)) ! to-file file) ! (while files ! (and ! (setq file (cdr (assq 'name (car files)))) ! (file-exists-p file) ! (progn ! (setq to-file (if (file-directory-p dir) ! (concat dir (file-name-nondirectory file)) ! dir)) ! (and (or (not (file-exists-p to-file)) ! (gnus-y-or-n-p (format "%s exists; overwrite? " ! to-file))) ! (copy-file file to-file t t)))) ! (setq files (cdr files))) ! (message "Saved %d file%s" len (if (> len 1) "s" "")))) ;; Functions for saving and possibly digesting articles without --- 664,705 ---- (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) (and save (gnus-uu-save-files files save)) ! (if (eq gnus-uu-do-not-unpack-archives nil) ! (setq files (gnus-uu-unpack-files files))) (setq files (nreverse (gnus-uu-get-actions files))) ! (or not-insert (not gnus-insert-pseudo-articles) ! (gnus-summary-insert-pseudos files save)))) ! (defun gnus-uu-scan-directory (dir &optional rec) ! "Return a list of all files under DIR." (let ((files (directory-files dir t)) ! out file) ! (while (setq file (pop files)) ! (unless (member (file-name-nondirectory file) '("." "..")) ! (push (list (cons 'name file) ! (cons 'article gnus-current-article)) ! out) ! (when (file-directory-p file) ! (setq out (nconc (gnus-uu-scan-directory file t) out))))) ! (if rec ! out ! (nreverse out)))) (defun gnus-uu-save-files (files dir) + "Save FILES in DIR." (let ((len (length files)) ! (reg (concat "^" (regexp-quote gnus-uu-work-dir))) ! to-file file fromdir) ! (while (setq file (cdr (assq 'name (pop files)))) ! (when (file-exists-p file) ! (string-match reg file) ! (setq fromdir (substring file (match-end 0))) ! (if (file-directory-p file) ! (unless (file-exists-p (concat dir fromdir)) ! (make-directory (concat dir fromdir) t)) ! (setq to-file (concat dir fromdir)) ! (when (or (not (file-exists-p to-file)) ! (gnus-y-or-n-p (format "%s exists; overwrite? " to-file))) ! (copy-file file to-file t t))))) ! (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) ;; Functions for saving and possibly digesting articles without *************** The headers will be included in the sequ *** 658,662 **** --- 729,739 ---- (t (list 'middle))))) (t + (let ((header (gnus-summary-article-header))) + (setq gnus-uu-digest-from-subject + (cons (cons (mail-header-from header) + (mail-header-subject header)) + gnus-uu-digest-from-subject))) (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) + (delim (concat "^" (make-string 30 ?-) "$")) beg subj headers headline sorthead body end-string state) (if (or (eq in-state 'first) *************** The headers will be included in the sequ *** 681,685 **** (set-buffer buffer) (let (buffer-read-only) ! (set-text-properties (point-min) (point-max) nil) ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) --- 758,762 ---- (set-buffer buffer) (let (buffer-read-only) ! (gnus-set-text-properties (point-min) (point-max) nil) ;; These two are necessary for XEmacs 19.12 fascism. (put-text-property (point-min) (point-max) 'invisible nil) *************** The headers will be included in the sequ *** 687,692 **** (goto-char (point-min)) (re-search-forward "\n\n") (setq body (buffer-substring (1- (point)) (point-max))) ! (narrow-to-region 1 (point)) (if (not (setq headers gnus-uu-digest-headers)) (setq sorthead (buffer-substring (point-min) (point-max))) --- 764,775 ---- (goto-char (point-min)) (re-search-forward "\n\n") + ;; Quote all 30-dash lines. + (save-excursion + (while (re-search-forward delim nil t) + (beginning-of-line) + (delete-char 1) + (insert " "))) (setq body (buffer-substring (1- (point)) (point-max))) ! (narrow-to-region (point-min) (point)) (if (not (setq headers gnus-uu-digest-headers)) (setq sorthead (buffer-substring (point-min) (point-max))) *************** The headers will be included in the sequ *** 695,709 **** (setq headers (cdr headers)) (goto-char (point-min)) ! (if (re-search-forward headline nil t) ! (setq sorthead ! (concat sorthead ! (buffer-substring ! (match-beginning 0) ! (or (and (re-search-forward "^[^ \t]" nil t) ! (1- (point))) ! (progn (forward-line 1) (point))))))))) (widen))) ! (insert sorthead)(goto-char (point-max)) ! (insert body)(goto-char (point-max)) (insert (concat "\n" (make-string 30 ?-) "\n\n")) (goto-char beg) --- 778,792 ---- (setq headers (cdr headers)) (goto-char (point-min)) ! (while (re-search-forward headline nil t) ! (setq sorthead ! (concat sorthead ! (buffer-substring ! (match-beginning 0) ! (or (and (re-search-forward "^[^ \t]" nil t) ! (1- (point))) ! (progn (forward-line 1) (point))))))))) (widen))) ! (insert sorthead) (goto-char (point-max)) ! (insert body) (goto-char (point-max)) (insert (concat "\n" (make-string 30 ?-) "\n\n")) (goto-char beg) *************** The headers will be included in the sequ *** 796,805 **** (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (insert-buffer-substring process-buffer start-char end-char) ! (setq file-name (concat gnus-uu-work-dir (cdr gnus-article-current) ".ps")) (write-region (point-min) (point-max) file-name) ! (setq state (list file-name'begin 'end)) ! ! )) ! ) state)) --- 879,886 ---- (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) (insert-buffer-substring process-buffer start-char end-char) ! (setq file-name (concat gnus-uu-work-dir ! (cdr gnus-article-current) ".ps")) (write-region (point-min) (point-max) file-name) ! (setq state (list file-name 'begin 'end))))) state)) *************** The headers will be included in the sequ *** 817,823 **** (cons 'action "file") (cons 'action action)) ! (cons 'execute (if (string-match "%" action) ! (format action name) ! (concat action " " name)))) (car files)))) (setq files (cdr files))) --- 898,903 ---- (cons 'action "file") (cons 'action action)) ! (cons 'execute (gnus-uu-command ! action name))) (car files)))) (setq files (cdr files))) *************** The headers will be included in the sequ *** 927,931 **** ;; non-nil, article names are not equalized before sorting. (let ((subject (or subject ! (gnus-uu-reginize-string (gnus-summary-subject-string)))) list-of-subjects) (save-excursion --- 1007,1011 ---- ;; non-nil, article names are not equalized before sorting. (let ((subject (or subject ! (gnus-uu-reginize-string (gnus-summary-article-subject)))) list-of-subjects) (save-excursion *************** The headers will be included in the sequ *** 934,951 **** ;; Collect all subjects matching subject. (let ((case-fold-search t) ! subj mark) ! (goto-char (point-min)) ! (while (not (eobp)) ! (and (setq subj (gnus-summary-subject-string)) ! (string-match subject subj) (or (not only-unread) ! (= (setq mark (gnus-summary-article-mark)) gnus-unread-mark) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (setq list-of-subjects ! (cons (cons subj (gnus-summary-article-number)) ! list-of-subjects))) ! (forward-line 1))) ;; Expand numbers, sort, and return the list of article --- 1014,1032 ---- ;; Collect all subjects matching subject. (let ((case-fold-search t) ! (data gnus-newsgroup-data) ! subj mark d) ! (while data ! (setq d (pop data)) ! (and (not (gnus-data-pseudo-p d)) (or (not only-unread) ! (= (setq mark (gnus-data-mark d)) gnus-unread-mark) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) + (setq subj (mail-header-subject (gnus-data-header d))) + (string-match subject subj) (setq list-of-subjects ! (cons (cons subj (gnus-data-number d)) ! list-of-subjects))))) ;; Expand numbers, sort, and return the list of article *************** The headers will be included in the sequ *** 970,974 **** (while string-list (erase-buffer) ! (insert (car (car string-list))) ;; Translate multiple spaces to one space. (goto-char (point-min)) --- 1051,1055 ---- (while string-list (erase-buffer) ! (insert (caar string-list)) ;; Translate multiple spaces to one space. (goto-char (point-min)) *************** The headers will be included in the sequ *** 1039,1055 **** ;; 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 &optional sloppy limit no-errors) (let ((state 'first) ! has-been-begin article result-file result-files process-state ! article-buffer) - (if (not (gnus-server-opened gnus-current-select-method)) - (progn - (gnus-start-news-server) - (gnus-request-group gnus-newsgroup-name))) - - (setq gnus-uu-has-been-grabbed nil) - (while (and articles (not (memq 'error process-state)) --- 1120,1131 ---- ;; 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 ! &optional sloppy limit no-errors) (let ((state 'first) ! has-been-begin article result-file result-files process-state ! gnus-summary-display-article-function ! gnus-article-display-hook gnus-article-prepare-hook ! article-series files) (while (and articles (not (memq 'error process-state)) *************** The headers will be included in the sequ *** 1057,1123 **** (not (memq 'end process-state)))) ! (setq article (car articles)) ! (setq articles (cdr articles)) ! (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) ! ! (if (eq articles ()) ! (if (eq state 'first) ! (setq state 'first-and-last) ! (setq state 'last))) ! ! (message "Getting article %d, %s" article (gnus-uu-part-number article)) ! ! (if (not (= (or gnus-current-article 0) article)) ! (let ((nntp-async-number nil)) ! (gnus-request-article article gnus-newsgroup-name ! nntp-server-buffer) ! (setq gnus-last-article gnus-current-article) ! (setq gnus-current-article article) ! (setq gnus-article-current (cons gnus-newsgroup-name article)) ! (if (stringp nntp-server-buffer) ! (setq article-buffer nntp-server-buffer) ! (setq article-buffer (buffer-name nntp-server-buffer)))) ! (gnus-summary-stop-page-breaking) ! (setq article-buffer gnus-article-buffer)) ! ! (buffer-disable-undo article-buffer) ! ;; Mark article as read. ! (and (memq article gnus-newsgroup-processable) ! (gnus-summary-remove-process-mark article)) ! (run-hooks 'gnus-mark-article-hook) ! ! (setq process-state (funcall process-function article-buffer state)) ! ! (if (or (memq 'begin process-state) ! (and (or (eq state 'first) (eq state 'first-and-last)) ! (memq 'ok process-state))) ! (progn ! (if has-been-begin ! (if (and result-file (file-exists-p result-file)) ! (delete-file result-file))) ! (if (memq 'begin process-state) ! (setq result-file (car process-state))) ! (setq has-been-begin t))) ! (if (memq 'end process-state) ! (progn ! (setq gnus-uu-has-been-grabbed nil) ! (setq result-files (cons (list (cons 'name result-file) ! (cons 'article article)) ! result-files)) ! (setq has-been-begin nil) ! (and limit (= (length result-files) limit) ! (setq articles nil)))) ! ! (if (and (or (eq state 'last) (eq state 'first-and-last)) ! (not (memq 'end process-state))) ! (if (and result-file (file-exists-p result-file)) (delete-file result-file))) ! (if (not (memq 'wrong-type process-state)) ! () ! (if gnus-uu-unmark-articles-not-decoded ! (gnus-summary-tick-article article t))) ! (if (and (not has-been-begin) (not sloppy) --- 1133,1216 ---- (not (memq 'end process-state)))) ! (setq article (pop articles)) ! (push article article-series) ! (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..." ! 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 ! (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 ! ;; on to a list. ! (when (or (memq 'begin process-state) ! (and (or (eq state 'first) ! (eq state 'first-and-last)) ! (memq 'ok process-state))) ! (if 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 ! (file-exists-p result-file)) (delete-file result-file))) + (when (memq 'begin process-state) + (setq result-file (car process-state))) + (setq has-been-begin t)) + + ;; Check whether we have decoded one complete file. + (when (memq 'end process-state) + (setq article-series nil) + (setq has-been-begin nil) + (if (stringp result-file) + (setq files (list result-file)) + (setq files result-file)) + (setq result-file (car files)) + (while files + (push (list (cons 'name (pop files)) + (cons 'article article)) + result-files)) + ;; Allow user-defined functions to be run on this file. + (when gnus-uu-grabbed-file-functions + (let ((funcs gnus-uu-grabbed-file-functions)) + (unless (listp funcs) + (setq funcs (list funcs))) + (while funcs + (funcall (pop funcs) result-file)))) + ;; Check whether we have decoded enough articles. + (and limit (= (length result-files) limit) + (setq articles nil))) + + ;; If this is the last article to be decoded, and + ;; we still haven't reached the end, then we delete + ;; the partially decoded file. + (and (or (eq state 'last) (eq state 'first-and-last)) + (not (memq 'end process-state)) + result-file + (file-exists-p result-file) + (delete-file result-file)) + + ;; 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) + (gnus-summary-tick-article article t)) ! ;; Set the new series state. (if (and (not has-been-begin) (not sloppy) *************** The headers will be included in the sequ *** 1126,1168 **** (progn (setq process-state (list 'error)) ! (message "No begin part at the beginning") (sleep-for 2)) (setq state 'middle))) ! ;; Make sure the last article is put in the article buffer & fix ! ;; windows etc. ! ! (if (not (string= article-buffer gnus-article-buffer)) ! (save-excursion ! (set-buffer (get-buffer-create gnus-article-buffer)) ! (let ((buffer-read-only nil)) ! (widen) ! (erase-buffer) ! (insert-buffer-substring article-buffer) ! (gnus-set-mode-line 'article) ! (goto-char (point-min))))) ! ! (gnus-set-mode-line 'summary) ! (if result-files ! () ! (if (not has-been-begin) ! (if (not no-errors) (message "Wrong type file")) ! (if (memq 'error process-state) ! (setq result-files nil) ! (if (not (or (memq 'ok process-state) ! (memq 'end process-state))) ! (progn ! (if (not no-errors) ! (message "End of articles reached before end of file")) ! (setq result-files nil)) ! (gnus-uu-unmark-list-of-grabbed))))) result-files)) (defun gnus-uu-part-number (article) ! (let ((subject (mail-header-subject (gnus-get-header-by-number article)))) ! (if (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" ! subject) ! (substring subject (match-beginning 0) (match-end 0)) ""))) --- 1219,1268 ---- (progn (setq process-state (list 'error)) ! (gnus-message 2 "No begin part at the beginning") (sleep-for 2)) (setq state 'middle))) ! ;; When there are no result-files, then something must be wrong. (if result-files ! (message "") ! (cond ! ((not has-been-begin) ! (gnus-message 2 "Wrong type file")) ! ((memq 'error process-state) ! (gnus-message 2 "An error occurred during decoding")) ! ((not (or (memq 'ok process-state) ! (memq 'end process-state))) ! (gnus-message 2 "End of articles reached before end of file"))) ! ;; Make unsuccessfully decoded articles unread. ! (when gnus-uu-unmark-articles-not-decoded ! (while article-series ! (gnus-summary-tick-article (pop article-series) t)))) ! result-files)) + (defun gnus-uu-grab-view (file) + "View FILE using the gnus-uu methods." + (let ((action (gnus-uu-get-action file))) + (gnus-execute-command + (if (string-match "%" action) + (format action file) + (concat action " " file)) + (eq gnus-view-pseudos 'not-confirm)))) + + (defun gnus-uu-grab-move (file) + "Move FILE to somewhere." + (when gnus-uu-default-dir + (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) + (file-name-nondirectory file)))) + (rename-file file to-file) + (unless (file-exists-p file) + (make-symbolic-link to-file file))))) + (defun gnus-uu-part-number (article) ! (let* ((header (gnus-summary-article-header article)) ! (subject (and header (mail-header-subject header)))) ! (if (and subject ! (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) ! (match-string 0 subject) ""))) *************** The headers will be included in the sequ *** 1172,1286 **** (defun gnus-uu-uustrip-article (process-buffer in-state) ;; Uudecodes a file asynchronously. ! (let ((state (list 'ok)) ! (process-connection-type nil) ! start-char pst name-beg name-end) ! (save-excursion ! (set-buffer process-buffer) ! (let ((case-fold-search nil) ! (buffer-read-only nil)) ! (goto-char (point-min)) ! (if gnus-uu-kill-carriage-return ! (progn ! (while (search-forward "\r" nil t) ! (delete-backward-char 1)) ! (goto-char (point-min)))) ! ! (if (not (re-search-forward gnus-uu-begin-string nil t)) ! (if (not (re-search-forward gnus-uu-body-line nil t)) ! (setq state (list 'wrong-type)))) ! ! (if (memq 'wrong-type state) ! () ! (beginning-of-line) ! (setq start-char (point)) ! (if (looking-at gnus-uu-begin-string) ! (progn ! (setq name-end (match-end 1) ! name-beg (match-beginning 1)) ! ;; Remove any non gnus-uu-body-line right after start. ! (forward-line 1) ! (or (looking-at gnus-uu-body-line) ! (gnus-delete-line)) ! ! ; Replace any slashes and spaces in file names before decoding ! (goto-char name-beg) ! (while (re-search-forward "/" name-end t) ! (replace-match ",")) ! (goto-char name-beg) ! (while (re-search-forward " " name-end t) ! (replace-match "_")) ! (goto-char name-beg) ! (if (re-search-forward "_*$" name-end t) ! (replace-match "")) ! ! (setq gnus-uu-file-name (buffer-substring name-beg name-end)) ! (and gnus-uu-uudecode-process ! (setq pst (process-status ! (or gnus-uu-uudecode-process "nevair"))) ! (if (or (eq pst 'stop) (eq pst 'run)) ! (progn ! (delete-process gnus-uu-uudecode-process) ! (gnus-uu-unmark-list-of-grabbed t)))) ! (if (get-process "*uudecode*") ! (delete-process "*uudecode*")) ! (setq gnus-uu-uudecode-process ! (start-process ! "*uudecode*" ! (get-buffer-create gnus-uu-output-buffer-name) ! "sh" "-c" ! (format "cd %s ; uudecode" gnus-uu-work-dir))) ! (set-process-sentinel ! gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) ! (setq state (list 'begin)) ! (gnus-uu-add-file (concat gnus-uu-work-dir gnus-uu-file-name))) ! (setq state (list 'middle))) (goto-char (point-max)) ! (re-search-backward ! (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) ! (beginning-of-line) ! ! (if (looking-at gnus-uu-end-string) ! (setq state (cons 'end state))) ! (forward-line 1) ! (and gnus-uu-uudecode-process ! (setq pst (process-status ! (or gnus-uu-uudecode-process "nevair"))) ! (if (or (eq pst 'run) (eq pst 'stop)) ! (progn ! (if gnus-uu-correct-stripped-uucode ! (progn ! (gnus-uu-check-correct-stripped-uucode ! start-char (point)) ! (goto-char (point-max)) ! (re-search-backward ! (concat gnus-uu-body-line "\\|" ! gnus-uu-end-string) ! nil t) ! (forward-line 1))) ! ! (condition-case nil ! (process-send-region gnus-uu-uudecode-process ! start-char (point)) ! (error ! (progn ! (delete-process gnus-uu-uudecode-process) ! (message "gnus-uu: Couldn't uudecode") ! ; (sleep-for 2) ! (setq state (list 'wrong-type))))) ! ! (if (memq 'end state) ! (accept-process-output gnus-uu-uudecode-process))) ! (setq state (list 'wrong-type)))) ! (if (not gnus-uu-uudecode-process) ! (setq state (list 'wrong-type))))) (if (memq 'begin state) ! (cons (concat gnus-uu-work-dir gnus-uu-file-name) state) state)))) --- 1272,1369 ---- (defun gnus-uu-uustrip-article (process-buffer in-state) ;; Uudecodes a file asynchronously. ! (save-excursion ! (set-buffer process-buffer) ! (let ((state (list 'wrong-type)) ! process-connection-type case-fold-search buffer-read-only ! files start-char) ! (goto-char (point-min)) ! ;; Deal with ^M at the end of the lines. ! (when gnus-uu-kill-carriage-return ! (save-excursion ! (while (search-forward "\r" nil t) ! (delete-backward-char 1)))) ! (while (or (re-search-forward gnus-uu-begin-string nil t) ! (re-search-forward gnus-uu-body-line nil t)) ! (setq state (list 'ok)) ! ;; Ok, we are at the first uucoded line. ! (beginning-of-line) ! (setq start-char (point)) ! (if (not (looking-at gnus-uu-begin-string)) ! (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 ! (let ((nnheader-file-name-translation-alist ! '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) ! (nnheader-translate-file-chars (match-string 1)))) ! ! ;; Remove any non gnus-uu-body-line right after start. ! (forward-line 1) ! (while (and (not (eobp)) ! (not (looking-at gnus-uu-body-line))) ! (gnus-delete-line)) ! ! ;; If a process is running, we kill it. ! (when (and gnus-uu-uudecode-process ! (memq (process-status gnus-uu-uudecode-process) ! '(run stop))) ! (delete-process gnus-uu-uudecode-process) ! (gnus-uu-unmark-list-of-grabbed t)) ! ! ;; Start a new uudecoding process. ! (setq gnus-uu-uudecode-process ! (start-process ! "*uudecode*" ! (get-buffer-create gnus-uu-output-buffer-name) ! shell-file-name shell-command-switch ! (format "cd %s ; uudecode" gnus-uu-work-dir))) ! (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) + (setq state (cons 'end state)) (goto-char (point-max)) + (re-search-backward gnus-uu-body-line nil t)) + + (forward-line 1) ! (when gnus-uu-uudecode-process ! (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) ! ;; Try to correct mishandled uucode. ! (when gnus-uu-correct-stripped-uucode ! (gnus-uu-check-correct-stripped-uucode start-char (point))) ! ! ;; Send the text to the process. ! (condition-case nil ! (process-send-region ! gnus-uu-uudecode-process start-char (point)) ! (error ! (progn ! (delete-process gnus-uu-uudecode-process) ! (gnus-message 2 "gnus-uu: Couldn't uudecode") ! (setq state (list 'wrong-type))))) ! (if (memq 'end state) ! (progn ! ;; Send an EOF, just in case. ! (condition-case () ! (process-send-eof gnus-uu-uudecode-process) ! (error nil)) ! (while (memq (process-status gnus-uu-uudecode-process) ! '(open run)) ! (accept-process-output gnus-uu-uudecode-process 1))) ! (when (or (not gnus-uu-uudecode-process) ! (not (memq (process-status gnus-uu-uudecode-process) ! '(run stop)))) ! (setq state (list 'wrong-type))))))) (if (memq 'begin state) ! (cons (if (= (length files) 1) (car files) files) state) state)))) *************** The headers will be included in the sequ *** 1298,1304 **** (setq start-char (point)) (call-process-region ! start-char (point-max) "sh" nil (get-buffer-create gnus-uu-output-buffer-name) nil ! "-c" (concat "cd " gnus-uu-work-dir " ; sh")))) state)) --- 1381,1387 ---- (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 " ; sh")))) state)) *************** The headers will be included in the sequ *** 1335,1339 **** (setq action-list (cdr action-list)) (if (string-match (car rule) file-name) ! (setq action (car (cdr rule)))))) action)) --- 1418,1422 ---- (setq action-list (cdr action-list)) (if (string-match (car rule) file-name) ! (setq action (cadr rule))))) action)) *************** The headers will be included in the sequ *** 1362,1372 **** (erase-buffer)) ! (message "Unpacking: %s..." (gnus-uu-command action file-path)) ! (if (= 0 (call-process "sh" nil (get-buffer-create gnus-uu-output-buffer-name) ! nil "-c" command)) (message "") ! (message "Error during unpacking of archive") (setq did-unpack nil)) --- 1445,1455 ---- (erase-buffer)) ! (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) ! (if (= 0 (call-process shell-file-name nil (get-buffer-create gnus-uu-output-buffer-name) ! nil shell-command-switch command)) (message "") ! (gnus-message 2 "Error during unpacking of archive") (setq did-unpack nil)) *************** The headers will be included in the sequ *** 1390,1397 **** (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) (ofiles files) ! file did-unpack file-entry) ! (gnus-uu-add-file totfiles) (while files ! (setq file (cdr (setq file-entry (assq 'name (car files))))) (if (and (not (member file ignore)) (equal (gnus-uu-get-action (file-name-nondirectory file)) --- 1473,1479 ---- (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) (ofiles files) ! file did-unpack) (while files ! (setq file (cdr (assq 'name (car files)))) (if (and (not (member file ignore)) (equal (gnus-uu-get-action (file-name-nondirectory file)) *************** The headers will be included in the sequ *** 1400,1407 **** (setq did-unpack (cons file did-unpack)) (or (gnus-uu-treat-archive file) ! (message "Error during unpacking of %s" file)) (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) (nfiles newfiles)) - (gnus-uu-add-file newfiles) (while nfiles (or (member (car nfiles) totfiles) --- 1482,1488 ---- (setq did-unpack (cons file did-unpack)) (or (gnus-uu-treat-archive file) ! (gnus-message 2 "Error during unpacking of %s" file)) (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) (nfiles newfiles)) (while nfiles (or (member (car nfiles) totfiles) *************** The headers will be included in the sequ *** 1435,1439 **** (setq file (car files)) (setq files (cdr files)) ! (or (string-match "/\\.\\.?$" file) (setq out (cons file out)))) (setq out (nreverse out)) --- 1516,1520 ---- (setq file (car files)) (setq files (cdr files)) ! (or (member (file-name-nondirectory file) '("." "..")) (setq out (cons file out)))) (setq out (nreverse out)) *************** The headers will be included in the sequ *** 1441,1474 **** (defun gnus-uu-check-correct-stripped-uucode (start end) ! (let (found beg length) ! (if (not gnus-uu-correct-stripped-uucode) ! () ! (goto-char start) ! (if (re-search-forward " \\|`" end t) ! (progn ! (goto-char start) ! (while (not (eobp)) ! (progn ! (if (looking-at "\n") (replace-match "")) ! (forward-line 1)))) ! ! (while (not (eobp)) ! (if (looking-at (concat gnus-uu-begin-string "\\|" ! gnus-uu-end-string)) ! () ! (if (not found) (progn ! (beginning-of-line) ! (setq beg (point)) ! (end-of-line) ! (setq length (- (point) beg)))) ! (setq found t) ! (beginning-of-line) ! (setq beg (point)) ! (end-of-line) ! (if (not (= length (- (point) beg))) ! (insert (make-string (- length (- (point) beg)) ? )))) ! (forward-line 1)))))) (defvar gnus-uu-tmp-alist nil) --- 1522,1556 ---- (defun gnus-uu-check-correct-stripped-uucode (start end) ! (save-excursion ! (let (found beg length) ! (if (not gnus-uu-correct-stripped-uucode) ! () ! (goto-char start) ! (if (re-search-forward " \\|`" end t) ! (progn ! (goto-char start) ! (while (not (eobp)) (progn ! (if (looking-at "\n") (replace-match "")) ! (forward-line 1)))) ! ! (while (not (eobp)) ! (if (looking-at (concat gnus-uu-begin-string "\\|" ! gnus-uu-end-string)) ! () ! (if (not found) ! (progn ! (beginning-of-line) ! (setq beg (point)) ! (end-of-line) ! (setq length (- (point) beg)))) ! (setq found t) ! (beginning-of-line) ! (setq beg (point)) ! (end-of-line) ! (if (not (= length (- (point) beg))) ! (insert (make-string (- length (- (point) beg)) ? )))) ! (forward-line 1))))))) (defvar gnus-uu-tmp-alist nil) *************** The headers will be included in the sequ *** 1493,1497 **** (setq gnus-uu-work-dir (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) - (gnus-uu-add-file gnus-uu-work-dir) (if (not (file-directory-p gnus-uu-work-dir)) (gnus-make-directory gnus-uu-work-dir)) --- 1575,1578 ---- *************** The headers will be included in the sequ *** 1506,1547 **** (let (buf pst) (and gnus-uu-uudecode-process ! (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) ! (if (or (eq pst 'stop) (eq pst 'run)) ! (delete-process gnus-uu-uudecode-process))) (and (setq buf (get-buffer gnus-uu-output-buffer-name)) (kill-buffer buf)))) - ;; `gnus-uu-check-for-generated-files' deletes any generated files that - ;; hasn't been deleted, if, for instance, the user terminated decoding - ;; with `C-g'. - (defun gnus-uu-check-for-generated-files () - (let (file dirs) - (while gnus-uu-generated-file-list - (setq file (car gnus-uu-generated-file-list)) - (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list)) - (if (not (string-match "/\\.[\\.]?$" file)) - (progn - (if (file-directory-p file) - (setq dirs (cons file dirs)) - (if (file-exists-p file) - (delete-file file)))))) - (setq dirs (nreverse dirs)) - (while dirs - (setq file (car dirs)) - (setq dirs (cdr dirs)) - (if (file-directory-p file) - (if (string-match "/$" file) - (delete-directory (substring file 0 (match-beginning 0))) - (delete-directory file)))))) - - ;; Add a file (or a list of files) to be checked (and deleted if it/they - ;; still exists upon exiting the newsgroup). - (defun gnus-uu-add-file (file) - (if (stringp file) - (setq gnus-uu-generated-file-list - (cons file gnus-uu-generated-file-list)) - (setq gnus-uu-generated-file-list - (append file gnus-uu-generated-file-list)))) - ;; Inputs an action and a file and returns a full command, putting ;; quotes round the file name and escaping any quotes in the file name. --- 1587,1596 ---- (let (buf pst) (and gnus-uu-uudecode-process ! (memq (process-status (or gnus-uu-uudecode-process "nevair")) ! '(stop run)) ! (delete-process gnus-uu-uudecode-process)) (and (setq buf (get-buffer gnus-uu-output-buffer-name)) (kill-buffer buf)))) ;; Inputs an action and a file and returns a full command, putting ;; quotes round the file name and escaping any quotes in the file name. *************** The headers will be included in the sequ *** 1559,1567 **** (concat action " " ofile)))) ;; Initializing (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) ! (add-hook 'gnus-exit-group-hook 'gnus-uu-check-for-generated-files) --- 1608,1633 ---- (concat action " " ofile)))) + (defun gnus-uu-delete-work-dir (&optional dir) + "Delete recursively all files and directories under `gnus-uu-work-dir'." + (if dir + (gnus-message 7 "Deleting directory %s..." dir) + (setq dir gnus-uu-work-dir)) + (when (and dir + (file-exists-p dir)) + (let ((files (directory-files dir t nil t)) + file) + (while (setq file (pop files)) + (unless (member (file-name-nondirectory file) '("." "..")) + (if (file-directory-p file) + (gnus-uu-delete-work-dir file) + (gnus-message 9 "Deleting file %s..." file) + (delete-file file)))) + (delete-directory dir))) + (gnus-message 7 "")) ;; Initializing (add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) ! (add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) *************** The headers will be included in the sequ *** 1571,1577 **** ;;; - (require 'sendmail) - (require 'rnews) - ;; Any function that is to be used as and encoding method will take two ;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" --- 1637,1640 ---- *************** is t.") *** 1637,1642 **** The user will be asked for a file name." (interactive) - (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) - (error "Not in post-news buffer")) (save-excursion (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) --- 1700,1703 ---- *************** The user will be asked for a file name." *** 1674,1678 **** (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction ! (set-buffer gnus-post-news-buffer) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) --- 1735,1739 ---- (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) (save-restriction ! (set-buffer gnus-message-buffer) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) *************** The user will be asked for a file name." *** 1688,1692 **** ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) ! (= 0 (call-process "sh" nil t nil "-c" (format "%s %s %s" command path file-name)))) --- 1749,1753 ---- ;; current buffer. (defun gnus-uu-post-encode-file (command path file-name) ! (= 0 (call-process shell-file-name nil t nil shell-command-switch (format "%s %s %s" command path file-name)))) *************** The user will be asked for a file name." *** 1695,1700 **** If no file has been included, the user will be asked for a file." (interactive) - (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) - (error "Not in post news buffer")) (let (file-name) --- 1756,1759 ---- *************** If no file has been included, the user w *** 1705,1712 **** (if gnus-uu-post-threaded ! (let ((gnus-required-headers ! (if (memq 'Message-ID gnus-required-headers) ! gnus-required-headers ! (cons 'Message-ID gnus-required-headers))) gnus-inews-article-hook) --- 1764,1771 ---- (if gnus-uu-post-threaded ! (let ((message-required-news-headers ! (if (memq 'Message-ID message-required-news-headers) ! message-required-news-headers ! (cons 'Message-ID message-required-news-headers))) gnus-inews-article-hook) *************** If no file has been included, the user w *** 1757,1761 **** (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) ! (insert-buffer uubuf) (error "Encoding unsuccessful")) (kill-buffer uubuf)) --- 1816,1820 ---- (erase-buffer) (funcall gnus-uu-post-encode-method file-path file-name)) ! (insert-buffer-substring uubuf) (error "Encoding unsuccessful")) (kill-buffer uubuf)) *************** If no file has been included, the user w *** 1812,1816 **** (end-of-line) (insert (format " (0/%d)" parts)))) ! (gnus-inews-news)) (save-excursion --- 1871,1875 ---- (end-of-line) (insert (format " (0/%d)" parts)))) ! (message-send)) (save-excursion *************** If no file has been included, the user w *** 1875,1879 **** (insert beg-line) (insert "\n") ! (gnus-inews-news))) (and (setq buf (get-buffer send-buffer-name)) --- 1934,1939 ---- (insert beg-line) (insert "\n") ! (let (message-sent-message-via) ! (message-send)))) (and (setq buf (get-buffer send-buffer-name)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-vis.el emacs-19.32/lisp/gnus-vis.el *** emacs-19.31/lisp/gnus-vis.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-vis.el Tue Jun 25 18:07:14 1996 *************** *** 1,5 **** ;;; gnus-vis.el --- display-oriented parts of Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; gnus-vis.el --- display-oriented parts of Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 32,35 **** --- 31,37 ---- (require 'easymenu) (require 'custom) + (require 'browse-url) + (require 'gnus-score) + (eval-when-compile (require 'cl)) (defvar gnus-group-menu-hook nil *************** *** 42,51 **** "*Hook run after the creation of the article mode menu.") - (defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") - - (defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") - ;;; Summary highlights. --- 44,47 ---- *************** *** 213,227 **** ; "Face used for signature.") (defvar gnus-button-alist ! '(("in\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 ! (assq (count-lines (point-min) (match-end 0)) ! gnus-cite-attribution-alist) gnus-button-message-id 3) ;; This is how URLs _should_ be embedded in text... ! ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ! ("\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]" 0 t gnus-button-url 0)) ! "Alist of regexps matching buttons in an article. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where --- 209,227 ---- ; "Face used for signature.") + (defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]" + "*Regular expression that matches URLs.") + (defvar gnus-button-alist ! `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 ! t gnus-button-message-id 3) ! ("\\(\n\t ]*\\)>?\\)" 1 t gnus-button-message-id 3) + ("\\( \n\t]+\\)>?" 0 t gnus-button-reply 2) ;; This is how URLs _should_ be embedded in text... ! ("]*\\)>" 0 t gnus-button-url 1) ;; Next regexp stolen from highlight-headers.el. ;; Modified by Vladimir Alexiev. ! (,gnus-button-url-regexp 0 t gnus-button-url 0)) ! "Alist of regexps matching buttons in article bodies. Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where *************** CALLBACK can also be a variable, in that *** 236,258 **** variable it the real callback function.") ;see gnus-cus.el ;(eval-when-compile ; (defvar browse-url-browser-function)) ;see gnus-cus.el ! ;(defvar gnus-button-url ! ; (cond ((boundp 'browse-url-browser-function) browse-url-browser-function) ! ; ((fboundp 'w3-fetch) 'w3-fetch) ! ; ((eq window-system 'x) 'gnus-netscape-open-url)) ! ; "*Function to fetch URL. ! ;The function will be called with one argument, the URL to fetch. ! ;Useful values of this function are: ! ! ;w3-fetch: ! ; defined in the w3 emacs package by William M. Perry. ! ;gnus-netscape-open-url: ! ; open url in existing netscape, start netscape if none found. ! ;gnus-netscape-start-url: ! ; start new netscape with url.") --- 236,286 ---- variable it the real callback function.") + (defvar gnus-header-button-alist + `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" + 0 t gnus-button-message-id 0) + ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0) + ("^\\(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) + ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t + gnus-button-message-id 3)) + "Alist of headers and regexps to match buttons in article heads. + + This alist is very similar to `gnus-button-alist', except that each + alist has an additional HEADER element first in each entry: + + \(HEADER REGEXP BUTTON FORM CALLBACK PAR) + + HEADER is a regexp to match a header. For a fuller explanation, see + `gnus-button-alist'.") + ;see gnus-cus.el ;(eval-when-compile ; (defvar browse-url-browser-function)) + ;;; Group mode highlighting. + ;see gnus-cus.el ! ;(defvar gnus-group-highlight nil ! ; "Group lines are highlighted with the FACE for the first FORM which ! ;evaluate to a non-nil value. ! ; ! ;Point will be at the beginning of the line when FORM is evaluated. ! ;Variables bound when these forms are evaluated include: ! ; ! ;group: The group name. ! ;unread: The number of unread articles. ! ;method: The select method. ! ;mailp: Whether the select method is a mail method. ! ;level: The level of the group. ! ;score: The score of the group. ! ;ticked: The number of ticked articles in the group. ! ;") ! ! ! ;;; Internal variables. ! ! (defvar gnus-button-marker-list nil) *************** variable it the real callback function." *** 278,324 **** (progn (easy-menu-define ! gnus-group-reading-menu ! gnus-group-mode-map ! "" '("Group" ! ["Read" gnus-group-read-group t] ! ["Select" gnus-group-select-group t] ! ["See old articles" gnus-group-select-group-all t] ! ["Catch up" gnus-group-catchup-current t] ! ["Catch up all articles" gnus-group-catchup-current-all t] ! ["Check for new articles" gnus-group-get-new-news-this-group t] ! ["Toggle subscription" gnus-group-unsubscribe-current-group t] ! ["Kill" gnus-group-kill-group t] ! ["Yank" gnus-group-yank-group t] ! ["Describe" gnus-group-describe-group t] ! ["Fetch FAQ" gnus-group-fetch-faq t] ! ["Edit kill file" gnus-group-edit-local-kill t] ! ["Expire articles" gnus-group-expire-articles t] ! ["Set group level" gnus-group-set-current-level t] )) (easy-menu-define ! gnus-group-group-menu ! gnus-group-mode-map ! "" '("Groups" ("Listing" ! ["List subscribed groups" gnus-group-list-groups t] ! ["List all groups" gnus-group-list-all-groups t] ! ["List groups matching..." gnus-group-list-matching t] ! ["List killed groups" gnus-group-list-killed t] ! ["List zombie groups" gnus-group-list-zombies t] ["Describe all groups" gnus-group-describe-all-groups t] ! ["Group apropos" gnus-group-apropos t] ! ["Group and description apropos" gnus-group-description-apropos t] ! ["List groups matching..." gnus-group-list-matching t]) ("Mark" ! ["Mark group" gnus-group-mark-group t] ! ["Unmark group" gnus-group-unmark-group t] ! ["Mark region" gnus-group-mark-region t]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ! ["Kill all zombie groups" gnus-group-kill-all-zombies t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] --- 306,389 ---- (progn (easy-menu-define ! gnus-group-reading-menu gnus-group-mode-map "" '("Group" ! ["Read" gnus-group-read-group (gnus-group-group-name)] ! ["Select" gnus-group-select-group (gnus-group-group-name)] ! ["See old articles" (gnus-group-select-group 'all) ! :keys "C-u SPC" :active (gnus-group-group-name)] ! ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] ! ["Catch up all articles" gnus-group-catchup-current-all ! (gnus-group-group-name)] ! ["Check for new articles" gnus-group-get-new-news-this-group ! (gnus-group-group-name)] ! ["Toggle subscription" gnus-group-unsubscribe-current-group ! (gnus-group-group-name)] ! ["Kill" gnus-group-kill-group (gnus-group-group-name)] ! ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] ! ["Describe" gnus-group-describe-group (gnus-group-group-name)] ! ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] ! ["Edit kill file" gnus-group-edit-local-kill ! (gnus-group-group-name)] ! ;; Actually one should check, if any of the marked groups gives t for ! ;; (gnus-check-backend-function 'request-expire-articles ...) ! ["Expire articles" gnus-group-expire-articles ! (or (and (gnus-group-group-name) ! (gnus-check-backend-function ! 'request-expire-articles ! (gnus-group-group-name))) gnus-group-marked)] ! ["Set group level" gnus-group-set-current-level ! (gnus-group-group-name)] ! ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] )) (easy-menu-define ! gnus-group-group-menu gnus-group-mode-map "" '("Groups" ("Listing" ! ["List unread subscribed groups" gnus-group-list-groups t] ! ["List (un)subscribed groups" gnus-group-list-all-groups t] ! ["List killed groups" gnus-group-list-killed gnus-killed-list] ! ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] ! ["List level..." gnus-group-list-level t] ["Describe all groups" gnus-group-describe-all-groups t] ! ["Group apropos..." gnus-group-apropos t] ! ["Group and description apropos..." gnus-group-description-apropos t] ! ["List groups matching..." gnus-group-list-matching t] ! ["List all groups matching..." gnus-group-list-all-matching t] ! ["List active file" gnus-group-list-active t]) ! ("Sort" ! ["Default sort" gnus-group-sort-groups ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ! ["Sort by method" gnus-group-sort-groups-by-method ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ! ["Sort by rank" gnus-group-sort-groups-by-rank ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ! ["Sort by score" gnus-group-sort-groups-by-score ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ! ["Sort by level" gnus-group-sort-groups-by-level ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ! ["Sort by unread" gnus-group-sort-groups-by-unread ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] ! ["Sort by name" gnus-group-sort-groups-by-alphabet ! (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) ("Mark" ! ["Mark group" gnus-group-mark-group ! (and (gnus-group-group-name) ! (not (memq (gnus-group-group-name) gnus-group-marked)))] ! ["Unmark group" gnus-group-unmark-group ! (and (gnus-group-group-name) ! (memq (gnus-group-group-name) gnus-group-marked))] ! ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] ! ["Mark regexp..." gnus-group-mark-regexp t] ! ["Mark region" gnus-group-mark-region t] ! ["Mark buffer" gnus-group-mark-buffer t] ! ["Execute command" gnus-group-universal-argument ! (or gnus-group-marked (gnus-group-group-name))]) ("Subscribe" ["Subscribe to random group" gnus-group-unsubscribe-group t] ["Kill all newsgroups in region" gnus-group-kill-region t] ! ["Kill all zombie groups" gnus-group-kill-all-zombies ! gnus-zombie-list] ! ["Kill all groups on level..." gnus-group-kill-level t]) ("Foreign groups" ["Make a foreign group" gnus-group-make-group t] *************** variable it the real callback function." *** 329,353 **** ["Make a kiboze group" gnus-group-make-kiboze-group t] ["Make a virtual group" gnus-group-make-empty-virtual t] ! ["Add a group to a virtual" gnus-group-add-to-virtual t]) ("Editing groups" ! ["Parameters" gnus-group-edit-group-parameters t] ! ["Select method" gnus-group-edit-group-method t] ! ["Info" gnus-group-edit-group t]) ! ["Read a directory as a group" gnus-group-enter-directory t] ! ["Jump to group" gnus-group-jump-to-group t] ! ["Best unread group" gnus-group-best-unread-group t] )) (easy-menu-define ! gnus-group-misc-menu ! gnus-group-mode-map ! "" '("Misc" ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ! ["Post an article" gnus-group-post-news t] ! ["Customize score file" gnus-score-customize ! (not (string-match "XEmacs" emacs-version)) ] ["Check for new news" gnus-group-get-new-news t] ["Delete bogus groups" gnus-group-check-bogus-groups t] ["Find new newsgroups" gnus-find-new-newsgroups t] --- 394,438 ---- ["Make a kiboze group" gnus-group-make-kiboze-group t] ["Make a virtual group" gnus-group-make-empty-virtual t] ! ["Add a group to a virtual" gnus-group-add-to-virtual t] ! ["Rename group" gnus-group-rename-group ! (gnus-check-backend-function ! 'request-rename-group (gnus-group-group-name))] ! ["Delete group" gnus-group-delete-group ! (gnus-check-backend-function ! 'request-delete-group (gnus-group-group-name))]) ("Editing groups" ! ["Parameters" gnus-group-edit-group-parameters ! (gnus-group-group-name)] ! ["Select method" gnus-group-edit-group-method ! (gnus-group-group-name)] ! ["Info" gnus-group-edit-group (gnus-group-group-name)]) ! ("Score file" ! ["Flush cache" gnus-score-flush-cache ! (or gnus-score-cache gnus-short-name-score-file-cache)]) ! ("Move" ! ["Next" gnus-group-next-group t] ! ["Previous" gnus-group-prev-group t] ! ["Next unread" gnus-group-next-unread-group t] ! ["Previous unread" gnus-group-prev-unread-group t] ! ["Next unread same level" gnus-group-next-unread-group-same-level t] ! ["Previous unread same level" ! gnus-group-previous-unread-group-same-level t] ! ["Jump to group" gnus-group-jump-to-group t] ! ["First unread group" gnus-group-first-unread-group t] ! ["Best unread group" gnus-group-best-unread-group t]) ! ["Transpose" gnus-group-transpose-groups ! (gnus-group-group-name)] ! ["Read a directory as a group..." gnus-group-enter-directory t] )) (easy-menu-define ! gnus-group-misc-menu gnus-group-mode-map "" '("Misc" ["Send a bug report" gnus-bug t] ["Send a mail" gnus-group-mail t] ! ["Post an article..." gnus-group-post-news t] ! ["Customize score file" gnus-score-customize t] ["Check for new news" gnus-group-get-new-news t] + ["Activate all groups" gnus-activate-all-groups t] ["Delete bogus groups" gnus-group-check-bogus-groups t] ["Find new newsgroups" gnus-find-new-newsgroups t] *************** variable it the real callback function." *** 356,360 **** ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ! ["Expire expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] --- 441,445 ---- ["Browse foreign server" gnus-group-browse-foreign-server t] ["Enter server buffer" gnus-group-enter-server-mode t] ! ["Expire all expirable articles" gnus-group-expire-all-groups t] ["Generate any kiboze groups" nnkiboze-generate-groups t] ["Gnus version" gnus-version t] *************** variable it the real callback function." *** 365,794 **** ["Exit without saving" gnus-group-quit t] ["Edit global kill file" gnus-group-edit-global-kill t] ! ["Sort group buffer" gnus-group-sort-groups t] )) (run-hooks 'gnus-group-menu-hook) ))) - ;; Server mode - (defun gnus-server-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'server) - (or - (boundp 'gnus-server-menu) - (progn - (easy-menu-define - gnus-server-menu - gnus-server-mode-map - "" - '("Server" - ["Add" gnus-server-add-server t] - ["Browse" gnus-server-read-server t] - ["List" gnus-server-list-servers t] - ["Kill" gnus-server-kill-server t] - ["Yank" gnus-server-yank-server t] - ["Copy" gnus-server-copy-server t] - ["Edit" gnus-server-edit-server t] - ["Exit" gnus-server-exit t] - )) - (run-hooks 'gnus-server-menu-hook) - ))) - - ;; Browse mode - (defun gnus-browse-make-menu-bar () - (gnus-visual-turn-off-edit-menu 'browse) - (or - (boundp 'gnus-browse-menu) - (progn - (easy-menu-define - gnus-browse-menu - gnus-browse-mode-map - "" - '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] - ["Read" gnus-group-read-group t] - ["Exit" gnus-browse-exit t] - )) - (run-hooks 'gnus-browse-menu-hook) - ))) - - ;; Summary buffer (defun gnus-summary-make-menu-bar () (gnus-visual-turn-off-edit-menu 'summary) ! (or ! (boundp 'gnus-summary-misc-menu) ! (progn ! (easy-menu-define ! gnus-summary-misc-menu ! gnus-summary-mode-map ! "" ! '("Misc" ! ("Mark" ! ("Read" ! ["Mark as read" gnus-summary-mark-as-read-forward t] ! ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ! ["Mark same subject" gnus-summary-kill-same-subject t] ! ["Catchup" gnus-summary-catchup t] ! ["Catchup all" gnus-summary-catchup-all t] ! ["Catchup to here" gnus-summary-catchup-to-here t] ! ["Catchup region" gnus-summary-mark-region-as-read t]) ! ("Various" ! ["Tick" gnus-summary-tick-article-forward t] ! ["Mark as dormant" gnus-summary-mark-as-dormant t] ! ["Remove marks" gnus-summary-clear-mark-forward t] ! ["Set expirable mark" gnus-summary-mark-as-expirable t] ! ["Set bookmark" gnus-summary-set-bookmark t] ! ["Remove bookmark" gnus-summary-remove-bookmark t]) ! ("Display" ! ["Remove lines marked as read" gnus-summary-remove-lines-marked-as-read t] ! ["Remove lines marked with..." gnus-summary-remove-lines-marked-with t] ! ["Show dormant articles" gnus-summary-show-all-dormant t] ! ["Hide dormant articles" gnus-summary-hide-all-dormant t] ! ["Show expunged articles" gnus-summary-show-all-expunged t]) ! ("Process mark" ! ["Set mark" gnus-summary-mark-as-processable t] ! ["Remove mark" gnus-summary-unmark-as-processable t] ! ["Remove all marks" gnus-summary-unmark-all-processable t] ! ["Mark series" gnus-uu-mark-series t] ! ["Mark region" gnus-uu-mark-region t] ! ["Mark by regexp" gnus-uu-mark-by-regexp t] ! ["Mark all" gnus-uu-mark-all t] ! ["Mark sparse" gnus-uu-mark-sparse t] ! ["Mark thread" gnus-uu-mark-thread t])) ! ("Move" ! ["Scroll article forwards" gnus-summary-next-page t] ! ["Next unread article" gnus-summary-next-unread-article t] ! ["Previous unread article" gnus-summary-prev-unread-article t] ! ["Next article" gnus-summary-next-article t] ! ["Previous article" gnus-summary-prev-article t] ! ["Next article same subject" gnus-summary-next-same-subject t] ! ["Previous article same subject" gnus-summary-prev-same-subject t] ! ["First unread article" gnus-summary-first-unread-article t] ! ["Go to subject number..." gnus-summary-goto-subject t] ! ["Go to the last article" gnus-summary-goto-last-article t] ! ["Pop article off history" gnus-summary-pop-article t]) ! ("Sort" ! ["Sort by number" gnus-summary-sort-by-number t] ! ["Sort by author" gnus-summary-sort-by-author t] ! ["Sort by subject" gnus-summary-sort-by-subject t] ! ["Sort by date" gnus-summary-sort-by-date t] ! ["Sort by score" gnus-summary-sort-by-score t]) ! ("Exit" ! ["Catchup and exit" gnus-summary-catchup-and-exit t] ! ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ! ["Exit group" gnus-summary-exit t] ! ["Exit group without updating" gnus-summary-exit-no-update t] ! ["Reselect group" gnus-summary-reselect-current-group t] ! ["Rescan group" gnus-summary-rescan-group t]) ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Filter articles" gnus-summary-execute-command t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] - ["Expire expirable articles" gnus-summary-expire-articles t] ["Describe group" gnus-summary-describe-group t] ! ["Edit local kill file" gnus-summary-edit-local-kill t] ! )) ! ! (easy-menu-define ! gnus-summary-kill-menu ! gnus-summary-mode-map ! "" ! (cons ! "Score" ! (nconc ! (list ! ["Enter score" gnus-summary-score-entry t]) ! (gnus-visual-score-map 'increase) ! (gnus-visual-score-map 'lower) ! '(["Current score" gnus-summary-current-score t] ! ["Set score" gnus-summary-set-score t] ! ["Customize score file" gnus-score-customize t] ! ["Switch current score file" gnus-score-change-score-file t] ! ["Set mark below" gnus-score-set-mark-below t] ! ["Set expunge below" gnus-score-set-expunge-below t] ! ["Edit current score file" gnus-score-edit-alist t] ! ["Edit score file" gnus-score-edit-file t] ! ["Trace score" gnus-score-find-trace t] ! ["Increase score" gnus-summary-increase-score t] ! ["Lower score" gnus-summary-lower-score t])))) ! ! (and nil ! '(("Default header" ! ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) ! :style radio ! :selected (null gnus-score-default-header)] ! ["From" (gnus-score-set-default 'gnus-score-default-header 'a) ! :style radio ! :selected (eq gnus-score-default-header 'a )] ! ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) ! :style radio ! :selected (eq gnus-score-default-header 's )] ! ["Article body" ! (gnus-score-set-default 'gnus-score-default-header 'b) ! :style radio ! :selected (eq gnus-score-default-header 'b )] ! ["All headers" ! (gnus-score-set-default 'gnus-score-default-header 'h) ! :style radio ! :selected (eq gnus-score-default-header 'h )] ! ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) ! :style radio ! :selected (eq gnus-score-default-header 'i )] ! ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) ! :style radio ! :selected (eq gnus-score-default-header 't )] ! ["Crossposting" ! (gnus-score-set-default 'gnus-score-default-header 'x) ! :style radio ! :selected (eq gnus-score-default-header 'x )] ! ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) ! :style radio ! :selected (eq gnus-score-default-header 'l )] ! ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) ! :style radio ! :selected (eq gnus-score-default-header 'd )] ! ["Followups to author" ! (gnus-score-set-default 'gnus-score-default-header 'f) ! :style radio ! :selected (eq gnus-score-default-header 'f )]) ! ("Default type" ! ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) ! :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. ! ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) ! :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) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'r)] ! ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) ! :style radio ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '=)] ! ["Greater than number" ! (gnus-score-set-default 'gnus-score-default-type '>) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '>)]) ! ["Default fold" gnus-score-default-fold-toggle ! :style toggle ! :selected gnus-score-default-fold] ! ("Default duration" ! ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) ! :style radio ! :selected (null gnus-score-default-duration)] ! ["Permanent" ! (gnus-score-set-default 'gnus-score-default-duration 'p) ! :style radio ! :selected (eq gnus-score-default-duration 'p)] ! ["Temporary" ! (gnus-score-set-default 'gnus-score-default-duration 't) ! :style radio ! :selected (eq gnus-score-default-duration 't)] ! ["Immediate" ! (gnus-score-set-default 'gnus-score-default-duration 'i) ! :style radio ! :selected (eq gnus-score-default-duration 'i)]) ! )) ! ! (easy-menu-define ! gnus-summary-article-menu ! gnus-summary-mode-map ! "" ! '("Article" ! ("Hide" ! ["All" gnus-article-hide t] ! ["Headers" gnus-article-hide-headers t] ! ["Signature" gnus-article-hide-signature t] ! ["Citation" gnus-article-hide-citation t]) ! ("Highlight" ! ["All" gnus-article-highlight t] ! ["Headers" gnus-article-highlight-headers t] ! ["Signature" gnus-article-highlight-signature t] ! ["Citation" gnus-article-highlight-citation t]) ! ("Date" ! ["Local" gnus-article-date-local t] ! ["UT" gnus-article-date-ut t] ! ["Lapsed" gnus-article-date-lapsed t]) ! ("Filter" ! ["Overstrike" gnus-article-treat-overstrike t] ! ["Word wrap" gnus-article-word-wrap t] ! ["CR" gnus-article-remove-cr t] ! ["Show X-Face" gnus-article-display-x-face t] ! ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ! ["Rot 13" gnus-summary-caesar-message t] ! ["Add buttons" gnus-article-add-buttons t] ! ["Stop page breaking" gnus-summary-stop-page-breaking t] ! ["Toggle MIME" gnus-summary-toggle-mime t] ! ["Toggle header" gnus-summary-toggle-header t]) ! ("Output" ! ["Save in default format" gnus-summary-save-article t] ! ["Save in file" gnus-summary-save-article-file t] ! ["Save in Unix mail format" gnus-summary-save-article-mail t] ! ["Save in MH folder" gnus-summary-save-article-folder t] ! ["Save in VM folder" gnus-summary-save-article-vm t] ! ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] ! ["Pipe through a filter" gnus-summary-pipe-output t]) ! ("Backend" ! ["Respool article" gnus-summary-respool-article t] ! ["Move article" gnus-summary-move-article t] ! ["Copy article" gnus-summary-copy-article t] ! ["Import file" gnus-summary-import-article t] ! ["Edit article" gnus-summary-edit-article t] ! ["Delete article" gnus-summary-delete-article t]) ! ("Extract" ! ["Uudecode" gnus-uu-decode-uu t] ! ["Uudecode and save" gnus-uu-decode-uu-and-save t] ! ["Unshar" gnus-uu-decode-unshar t] ! ["Unshar and save" gnus-uu-decode-unshar-and-save t] ! ["Save" gnus-uu-decode-save t] ! ["Binhex" gnus-uu-decode-binhex t]) ! ["Enter digest buffer" gnus-summary-enter-digest-group t] ! ["Isearch article" gnus-summary-isearch-article t] ! ["Search all articles" gnus-summary-search-article-forward t] ! ["Beginning of the article" gnus-summary-beginning-of-article t] ! ["End of the article" gnus-summary-end-of-article t] ! ["Fetch parent of article" gnus-summary-refer-parent-article t] ! ["Fetch article with id..." gnus-summary-refer-article t] ! ["Redisplay" gnus-summary-show-article t])) ! ! ! ! (easy-menu-define ! gnus-summary-thread-menu ! gnus-summary-mode-map ! "" ! '("Threads" ! ["Toggle threading" gnus-summary-toggle-threads t] ! ["Display hidden thread" gnus-summary-show-thread t] ! ["Hide thread" gnus-summary-hide-thread t] ! ["Go to next thread" gnus-summary-next-thread t] ! ["Go to previous thread" gnus-summary-prev-thread t] ! ["Go down thread" gnus-summary-down-thread t] ! ["Go up thread" gnus-summary-up-thread t] ! ["Mark thread as read" gnus-summary-kill-thread t] ! ["Lower thread score" gnus-summary-lower-thread t] ! ["Raise thread score" gnus-summary-raise-thread t] ! )) ! (easy-menu-define ! gnus-summary-post-menu ! gnus-summary-mode-map ! "" ! '("Post" ! ["Post an article" gnus-summary-post-news t] ! ["Followup" gnus-summary-followup t] ! ["Followup and yank" gnus-summary-followup-with-original t] ! ["Supersede article" gnus-summary-supersede-article t] ! ["Cancel article" gnus-summary-cancel-article t] ! ["Reply" gnus-summary-reply t] ! ["Reply and yank" gnus-summary-reply-with-original t] ! ["Mail forward" gnus-summary-mail-forward t] ! ["Post forward" gnus-summary-post-forward t] ! ["Digest and mail" gnus-uu-digest-mail-forward t] ! ["Digest and post" gnus-uu-digest-post-forward t] ! ["Send a mail" gnus-summary-mail-other-window t] ! ["Reply & followup" gnus-summary-followup-and-reply t] ! ["Reply & followup and yank" gnus-summary-followup-and-reply-with-original t] ! ["Uuencode and post" gnus-uu-post-news t] ! )) ! (run-hooks 'gnus-summary-menu-hook) ! ))) (defun gnus-score-set-default (var value) ! ;; A version of set that updates the GNU Emacs menu-bar. (set var value) ;; It is the message that forces the active status to be updated. (message "")) - (defvar gnus-score-default-header nil - "Default header when entering new scores. - - Should be one of the following symbols. - - a: from - s: subject - b: body - h: head - i: message-id - t: references - x: xref - l: lines - d: date - f: followup - - If nil, the user will be asked for a header.") - - (defvar gnus-score-default-type nil - "Default match type when entering new scores. - - Should be one of the following symbols. - - s: substring - e: exact string - f: fuzzy string - r: regexp string - b: before date - a: at date - n: this date - <: less than number - >: greater than number - =: equal to number - - If nil, the user will be asked for a match type.") - - (defvar gnus-score-default-fold nil - "Use case folding for new score file entries iff not nil.") - - - (defun gnus-score-default-fold-toggle () - "Toggle folding for new score file entries." - (interactive) - (setq gnus-score-default-fold (not gnus-score-default-fold)) - (if gnus-score-default-fold - (message "New score file entries will be case insensitive.") - (message "New score file entries will be case sensitive."))) - - (defvar gnus-score-default-duration nil - "Default duration of effect when entering new scores. - - Should be one of the following symbols. - - t: temporary - p: permanent - i: immediate - - If nil, the user will be asked for a duration.") - (defun gnus-visual-score-map (type) (if t --- 450,843 ---- ["Exit without saving" gnus-group-quit t] ["Edit global kill file" gnus-group-edit-global-kill t] ! ["Read manual" gnus-info-find-node t] ! ["Toggle topics" gnus-topic-mode t] ! ("SOUP" ! ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] ! ["Send replies" gnus-soup-send-replies ! (fboundp 'gnus-soup-pack-packet)] ! ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] ! ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] ! ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) )) (run-hooks 'gnus-group-menu-hook) ))) ;; Summary buffer (defun gnus-summary-make-menu-bar () (gnus-visual-turn-off-edit-menu 'summary) ! (unless (boundp 'gnus-summary-misc-menu) ! (easy-menu-define ! gnus-summary-misc-menu gnus-summary-mode-map "" ! '("Misc" ! ("Mark" ! ("Read" ! ["Mark as read" gnus-summary-mark-as-read-forward t] ! ["Mark same subject and select" ! gnus-summary-kill-same-subject-and-select t] ! ["Mark same subject" gnus-summary-kill-same-subject t] ! ["Catchup" gnus-summary-catchup t] ! ["Catchup all" gnus-summary-catchup-all t] ! ["Catchup to here" gnus-summary-catchup-to-here t] ! ["Catchup region" gnus-summary-mark-region-as-read t] ! ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) ! ("Various" ! ["Tick" gnus-summary-tick-article-forward t] ! ["Mark as dormant" gnus-summary-mark-as-dormant t] ! ["Remove marks" gnus-summary-clear-mark-forward t] ! ["Set expirable mark" gnus-summary-mark-as-expirable t] ! ["Set bookmark" gnus-summary-set-bookmark t] ! ["Remove bookmark" gnus-summary-remove-bookmark t]) ! ("Limit" ! ["Marks..." gnus-summary-limit-to-marks t] ! ["Subject..." gnus-summary-limit-to-subject t] ! ["Author..." gnus-summary-limit-to-author t] ! ["Score" gnus-summary-limit-to-score t] ! ["Unread" gnus-summary-limit-to-unread t] ! ["Non-dormant" gnus-summary-limit-exclude-dormant t] ! ["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" ! gnus-summary-limit-exclude-childless-dormant t] ! ;;["Hide thread" gnus-summary-limit-exclude-thread t] ! ["Show expunged" gnus-summary-show-all-expunged t]) ! ("Process mark" ! ["Set mark" gnus-summary-mark-as-processable t] ! ["Remove mark" gnus-summary-unmark-as-processable t] ! ["Remove all marks" gnus-summary-unmark-all-processable t] ! ["Mark above" gnus-uu-mark-over t] ! ["Mark series" gnus-uu-mark-series t] ! ["Mark region" gnus-uu-mark-region t] ! ["Mark by regexp..." gnus-uu-mark-by-regexp t] ! ["Mark all" gnus-uu-mark-all t] ! ["Mark buffer" gnus-uu-mark-buffer t] ! ["Mark sparse" gnus-uu-mark-sparse t] ! ["Mark thread" gnus-uu-mark-thread t] ! ["Unmark thread" gnus-uu-unmark-thread t])) ! ("Scroll article" ! ["Page forward" gnus-summary-next-page t] ! ["Page backward" gnus-summary-prev-page t] ! ["Line forward" gnus-summary-scroll-up t]) ! ("Move" ! ["Next unread article" gnus-summary-next-unread-article t] ! ["Previous unread article" gnus-summary-prev-unread-article t] ! ["Next article" gnus-summary-next-article t] ! ["Previous article" gnus-summary-prev-article t] ! ["Next unread subject" gnus-summary-next-unread-subject t] ! ["Previous unread subject" gnus-summary-prev-unread-subject t] ! ["Next article same subject" gnus-summary-next-same-subject t] ! ["Previous article same subject" gnus-summary-prev-same-subject t] ! ["First unread article" gnus-summary-first-unread-article t] ! ["Best unread article" gnus-summary-best-unread-article t] ! ["Go to subject number..." gnus-summary-goto-subject t] ! ["Go to article number..." gnus-summary-goto-article t] ! ["Go to the last article" gnus-summary-goto-last-article t] ! ["Pop article off history" gnus-summary-pop-article t]) ! ("Sort" ! ["Sort by number" gnus-summary-sort-by-number t] ! ["Sort by author" gnus-summary-sort-by-author t] ! ["Sort by subject" gnus-summary-sort-by-subject t] ! ["Sort by date" gnus-summary-sort-by-date t] ! ["Sort by score" gnus-summary-sort-by-score t]) ! ("Exit" ! ["Catchup and exit" gnus-summary-catchup-and-exit t] ! ["Catchup all and exit" gnus-summary-catchup-and-exit t] ! ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ! ["Exit group" gnus-summary-exit t] ! ["Exit group without updating" gnus-summary-exit-no-update t] ! ["Exit and goto next group" gnus-summary-next-group t] ! ["Exit and goto prev group" gnus-summary-prev-group t] ! ["Reselect group" gnus-summary-reselect-current-group t] ! ["Rescan group" gnus-summary-rescan-group t]) ! ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] ! ["Read manual" gnus-info-find-node t]) ! ("Cache" ! ["Enter article" gnus-cache-enter-article t] ! ["Remove article" gnus-cache-remove-article t]) ! ("Modes" ! ["Pick and read" gnus-pick-mode t] ! ["Binary" gnus-binary-mode t]) ! ["Filter articles..." gnus-summary-execute-command t] ! ["Run command on subjects..." gnus-summary-universal-argument t] ! ["Toggle line truncation" gnus-summary-toggle-truncation t] ! ["Expand window" gnus-summary-expand-window t] ! ["Expire expirable articles" gnus-summary-expire-articles ! (gnus-check-backend-function ! 'request-expire-articles gnus-newsgroup-name)] ! ["Edit local kill file" gnus-summary-edit-local-kill t] ! ["Edit main kill file" gnus-summary-edit-global-kill t] ! )) ! ! (easy-menu-define ! gnus-summary-kill-menu gnus-summary-mode-map "" ! (cons ! "Score" ! (nconc ! (list ! ["Enter score..." gnus-summary-score-entry t]) ! (gnus-visual-score-map 'increase) ! (gnus-visual-score-map 'lower) ! '(("Mark" ! ["Kill below" gnus-summary-kill-below t] ! ["Mark above" gnus-summary-mark-above t] ! ["Tick above" gnus-summary-tick-above t] ! ["Clear above" gnus-summary-clear-above t]) ! ["Current score" gnus-summary-current-score t] ! ["Set score" gnus-summary-set-score t] ! ["Customize score file" gnus-score-customize t] ! ["Switch current score file..." gnus-score-change-score-file t] ! ["Set mark below..." gnus-score-set-mark-below t] ! ["Set expunge below..." gnus-score-set-expunge-below t] ! ["Edit current score file" gnus-score-edit-current-scores t] ! ["Edit score file" gnus-score-edit-file t] ! ["Trace score" gnus-score-find-trace t] ! ["Rescore buffer" gnus-summary-rescore t] ! ["Increase score..." gnus-summary-increase-score t] ! ["Lower score..." gnus-summary-lower-score t])))) ! ! '(("Default header" ! ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) ! :style radio ! :selected (null gnus-score-default-header)] ! ["From" (gnus-score-set-default 'gnus-score-default-header 'a) ! :style radio ! :selected (eq gnus-score-default-header 'a)] ! ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) ! :style radio ! :selected (eq gnus-score-default-header 's)] ! ["Article body" ! (gnus-score-set-default 'gnus-score-default-header 'b) ! :style radio ! :selected (eq gnus-score-default-header 'b )] ! ["All headers" ! (gnus-score-set-default 'gnus-score-default-header 'h) ! :style radio ! :selected (eq gnus-score-default-header 'h )] ! ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i) ! :style radio ! :selected (eq gnus-score-default-header 'i )] ! ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) ! :style radio ! :selected (eq gnus-score-default-header 't )] ! ["Crossposting" ! (gnus-score-set-default 'gnus-score-default-header 'x) ! :style radio ! :selected (eq gnus-score-default-header 'x )] ! ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) ! :style radio ! :selected (eq gnus-score-default-header 'l )] ! ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) ! :style radio ! :selected (eq gnus-score-default-header 'd )] ! ["Followups to author" ! (gnus-score-set-default 'gnus-score-default-header 'f) ! :style radio ! :selected (eq gnus-score-default-header 'f )]) ! ("Default type" ! ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) ! :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. ! ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) ! :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) ! :style radio ! ;; :active (not (memq gnus-score-default-header '(l d))) ! :selected (eq gnus-score-default-type 'r)] ! ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) ! :style radio ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :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 ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '=)] ! ["Greater than number" ! (gnus-score-set-default 'gnus-score-default-type '>) ! :style radio ! ;; :active (eq (gnus-score-default-header 'l)) ! :selected (eq gnus-score-default-type '>)]) ! ["Default fold" gnus-score-default-fold-toggle ! :style toggle ! :selected gnus-score-default-fold] ! ("Default duration" ! ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) ! :style radio ! :selected (null gnus-score-default-duration)] ! ["Permanent" ! (gnus-score-set-default 'gnus-score-default-duration 'p) ! :style radio ! :selected (eq gnus-score-default-duration 'p)] ! ["Temporary" ! (gnus-score-set-default 'gnus-score-default-duration 't) ! :style radio ! :selected (eq gnus-score-default-duration 't)] ! ["Immediate" ! (gnus-score-set-default 'gnus-score-default-duration 'i) ! :style radio ! :selected (eq gnus-score-default-duration 'i)])) ! ! (easy-menu-define ! gnus-summary-article-menu gnus-summary-mode-map "" ! '("Article" ! ("Hide" ! ["All" gnus-article-hide t] ! ["Headers" gnus-article-hide-headers t] ! ["Signature" gnus-article-hide-signature t] ! ["Citation" gnus-article-hide-citation t] ! ["PGP" gnus-article-hide-pgp t] ! ["Boring headers" gnus-article-hide-boring-headers t]) ! ("Highlight" ! ["All" gnus-article-highlight t] ! ["Headers" gnus-article-highlight-headers t] ! ["Signature" gnus-article-highlight-signature t] ! ["Citation" gnus-article-highlight-citation t]) ! ("Date" ! ["Local" gnus-article-date-local t] ! ["UT" gnus-article-date-ut t] ! ["Original" gnus-article-date-original t] ! ["Lapsed" gnus-article-date-lapsed t]) ! ("Filter" ! ["Overstrike" gnus-article-treat-overstrike t] ! ["Word wrap" gnus-article-fill-cited-article t] ! ["CR" gnus-article-remove-cr t] ! ["Trailing blank lines" gnus-article-remove-trailing-blank-lines t] ! ["Show X-Face" gnus-article-display-x-face t] ! ["Quoted-Printable" gnus-article-de-quoted-unreadable t] ! ["Rot 13" gnus-summary-caesar-message t] ! ["Add buttons" gnus-article-add-buttons t] ! ["Add buttons to head" gnus-article-add-buttons-to-head t] ! ["Stop page breaking" gnus-summary-stop-page-breaking t] ! ["Toggle MIME" gnus-summary-toggle-mime t] ! ["Verbose header" gnus-summary-verbose-headers t] ! ["Toggle header" gnus-summary-toggle-header t]) ! ("Output" ! ["Save in default format" gnus-summary-save-article t] ! ["Save in file" gnus-summary-save-article-file t] ! ["Save in Unix mail format" gnus-summary-save-article-mail t] ! ["Save in MH folder" gnus-summary-save-article-folder t] ! ["Save in VM folder" gnus-summary-save-article-vm t] ! ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] ! ["Save body in file" gnus-summary-save-article-body-file t] ! ["Pipe through a filter" gnus-summary-pipe-output t] ! ["Add to SOUP packet" gnus-soup-add-article t]) ! ("Backend" ! ["Respool article..." gnus-summary-respool-article t] ! ["Move article..." gnus-summary-move-article ! (gnus-check-backend-function ! 'request-move-article gnus-newsgroup-name)] ! ["Copy article..." gnus-summary-copy-article t] ! ["Crosspost article..." gnus-summary-crosspost-article ! (gnus-check-backend-function ! 'request-replace-article gnus-newsgroup-name)] ! ["Import file..." gnus-summary-import-article t] ! ["Edit article" gnus-summary-edit-article ! (not (gnus-group-read-only-p))] ! ["Delete article" gnus-summary-delete-article ! (gnus-check-backend-function ! 'request-expire-articles gnus-newsgroup-name)] ! ["Query respool" gnus-summary-respool-query t] ! ["Delete expirable articles" gnus-summary-expire-articles-now ! (gnus-check-backend-function ! 'request-expire-articles gnus-newsgroup-name)]) ! ("Extract" ! ["Uudecode" gnus-uu-decode-uu t] ! ["Uudecode and save" gnus-uu-decode-uu-and-save t] ! ["Unshar" gnus-uu-decode-unshar t] ! ["Unshar and save" gnus-uu-decode-unshar-and-save t] ! ["Save" gnus-uu-decode-save t] ! ["Binhex" gnus-uu-decode-binhex t] ! ["Postscript" gnus-uu-decode-postscript t]) ! ["Enter digest buffer" gnus-summary-enter-digest-group t] ! ["Isearch article..." gnus-summary-isearch-article t] ! ["Search articles forward..." gnus-summary-search-article-forward t] ! ["Search articles backward..." gnus-summary-search-article-backward t] ! ["Beginning of the article" gnus-summary-beginning-of-article t] ! ["End of the article" gnus-summary-end-of-article t] ! ["Fetch parent of article" gnus-summary-refer-parent-article t] ! ["Fetch referenced articles" gnus-summary-refer-references t] ! ["Fetch article with id..." gnus-summary-refer-article t] ! ["Redisplay" gnus-summary-show-article t])) ! ! (easy-menu-define ! gnus-summary-thread-menu gnus-summary-mode-map "" ! '("Threads" ! ["Toggle threading" gnus-summary-toggle-threads t] ! ["Hide threads" gnus-summary-hide-all-threads t] ! ["Show threads" gnus-summary-show-all-threads t] ! ["Hide thread" gnus-summary-hide-thread t] ! ["Show thread" gnus-summary-show-thread t] ! ["Go to next thread" gnus-summary-next-thread t] ! ["Go to previous thread" gnus-summary-prev-thread t] ! ["Go down thread" gnus-summary-down-thread t] ! ["Go up thread" gnus-summary-up-thread t] ! ["Top of thread" gnus-summary-top-thread t] ! ["Mark thread as read" gnus-summary-kill-thread t] ! ["Lower thread score" gnus-summary-lower-thread t] ! ["Raise thread score" gnus-summary-raise-thread t] ! ["Rethread current" gnus-summary-rethread-current t] ! )) ! ! (easy-menu-define ! gnus-summary-post-menu gnus-summary-mode-map "" ! '("Post" ! ["Post an article" gnus-summary-post-news t] ! ["Followup" gnus-summary-followup t] ! ["Followup and yank" gnus-summary-followup-with-original t] ! ["Supersede article" gnus-summary-supersede-article t] ! ["Cancel article" gnus-summary-cancel-article t] ! ["Reply" gnus-summary-reply t] ! ["Reply and yank" gnus-summary-reply-with-original t] ! ["Mail forward" gnus-summary-mail-forward t] ! ["Post forward" gnus-summary-post-forward t] ! ["Digest and mail" gnus-uu-digest-mail-forward t] ! ["Digest and post" gnus-uu-digest-post-forward t] ! ["Resend message" gnus-summary-resend-message t] ! ["Send bounced mail" gnus-summary-resend-bounced-mail t] ! ["Send a mail" gnus-summary-mail-other-window t] ! ["Uuencode and post" gnus-uu-post-news t] ! ;;("Draft" ! ;;["Send" gnus-summary-send-draft t] ! ;;["Send bounced" gnus-resend-bounced-mail t]) ! )) ! (run-hooks 'gnus-summary-menu-hook) ! )) (defun gnus-score-set-default (var value) ! "A version of set that updates the GNU Emacs menu-bar." (set var value) ;; It is the message that forces the active status to be updated. (message "")) (defun gnus-visual-score-map (type) (if t *************** If nil, the user will be asked for a dur *** 834,838 **** (apply 'nconc ! (list (car (car ts))) (let ((ps perms) outp) --- 883,887 ---- (apply 'nconc ! (list (caar ts)) (let ((ps perms) outp) *************** If nil, the user will be asked for a dur *** 841,845 **** (cons (vector ! (car (car ps)) (list 'gnus-summary-score-entry --- 890,894 ---- (cons (vector ! (caar ps) (list 'gnus-summary-score-entry *************** If nil, the user will be asked for a dur *** 874,883 **** (progn (easy-menu-define ! gnus-article-article-menu ! gnus-article-mode-map ! "" '("Article" ! ["Scroll forwards" gnus-article-next-page t] ! ["Scroll backwards" gnus-article-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] --- 923,930 ---- (progn (easy-menu-define ! gnus-article-article-menu gnus-article-mode-map "" '("Article" ! ["Scroll forwards" gnus-article-goto-next-page t] ! ["Scroll backwards" gnus-article-goto-prev-page t] ["Show summary" gnus-article-show-summary t] ["Fetch Message-ID at point" gnus-article-refer-article t] *************** If nil, the user will be asked for a dur *** 886,892 **** (easy-menu-define ! gnus-article-treatment-menu ! gnus-article-mode-map ! "" '("Treatment" ["Hide headers" gnus-article-hide-headers t] --- 933,937 ---- (easy-menu-define ! gnus-article-treatment-menu gnus-article-mode-map "" '("Treatment" ["Hide headers" gnus-article-hide-headers t] *************** If nil, the user will be asked for a dur *** 897,902 **** ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] )) ! (run-hooks 'gnus-article-menu-hook) ! ))) ;;; --- 942,946 ---- ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t] )) ! (run-hooks 'gnus-article-menu-hook)))) ;;; *************** If nil, the user will be asked for a dur *** 912,922 **** (end (progn (end-of-line) (point))) ;; Fix by Mike Dugan . ! (from (if (get-text-property beg 'mouse-face) beg (1+ (or (next-single-property-change ! beg 'mouse-face nil end) beg)))) (to (1- (or (next-single-property-change ! from 'mouse-face nil end) end)))) ;; If no mouse-face prop on line (e.g. xemacs) we --- 956,966 ---- (end (progn (end-of-line) (point))) ;; Fix by Mike Dugan . ! (from (if (get-text-property beg gnus-mouse-face-prop) beg (1+ (or (next-single-property-change ! beg gnus-mouse-face-prop nil end) beg)))) (to (1- (or (next-single-property-change ! from gnus-mouse-face-prop nil end) end)))) ;; If no mouse-face prop on line (e.g. xemacs) we *************** If nil, the user will be asked for a dur *** 942,959 **** ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) ! (score (or (cdr (assq (or (get-text-property beg 'gnus-number) ! gnus-current-article) gnus-newsgroup-scored)) gnus-summary-default-score 0)) ! (default gnus-summary-default-score) ! (mark (get-text-property beg 'gnus-mark)) (inhibit-read-only t)) ! (while (and list (not (eval (car (car list))))) (setq list (cdr list))) ! (let ((face (and list (cdr (car list))))) ! (or (eobp) ! (eq face (get-text-property beg 'face)) ! (put-text-property beg end 'face ! (if (boundp face) (symbol-value face) face)))) (goto-char p))) --- 986,1039 ---- ;; now find out where the line starts and leave point there. (beg (progn (beginning-of-line) (point))) ! (article (gnus-summary-article-number)) ! (score (or (cdr (assq (or article gnus-current-article) gnus-newsgroup-scored)) gnus-summary-default-score 0)) ! (mark (or (gnus-summary-article-mark) gnus-unread-mark)) ! (inhibit-read-only t)) ! ;; Eval the cars of the lists until we find a match. ! (let ((default gnus-summary-default-score)) ! (while (and list ! (not (eval (caar list)))) ! (setq list (cdr list)))) ! (let ((face (cdar list))) ! (unless (eq face (get-text-property beg '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)))) ! (goto-char p))) ! ! (defun gnus-group-highlight-line () ! "Highlight the current line according to `gnus-group-highlight'." ! (let* ((list gnus-group-highlight) ! (p (point)) ! (end (progn (end-of-line) (point))) ! ;; now find out where the line starts and leave point there. ! (beg (progn (beginning-of-line) (point))) ! (group (gnus-group-group-name)) ! (entry (gnus-group-entry group)) ! (unread (if (numberp (car entry)) (car entry) 0)) ! (info (nth 2 entry)) ! (method (gnus-server-get-method group (gnus-info-method info))) ! (marked (gnus-info-marks info)) ! (mailp (memq 'mail (assoc (symbol-name ! (car (or method gnus-select-method))) ! gnus-valid-select-methods))) ! (level (or (gnus-info-level info) 9)) ! (score (or (gnus-info-score info) 0)) ! (ticked (gnus-range-length (cdr (assq 'tick marked)))) (inhibit-read-only t)) ! ;; Eval the cars of the lists until we find a match. ! (while (and list ! (not (eval (caar list)))) (setq list (cdr list))) ! (let ((face (cdar list))) ! (unless (eq face (get-text-property beg '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))) *************** The following commands are available: *** 1099,1112 **** buttons (cdr buttons)) (if (stringp button) ! (set-text-properties (point) (prog2 (insert button) (point) (insert " ")) (list 'face gnus-carpal-header-face)) ! (set-text-properties (point) (prog2 (insert (car button)) (point) (insert " ")) (list 'gnus-callback (cdr button) 'face gnus-carpal-button-face ! 'mouse-face 'highlight)))) (let ((fill-column (- (window-width) 2))) (fill-region (point-min) (point-max))) --- 1179,1192 ---- buttons (cdr buttons)) (if (stringp button) ! (gnus-set-text-properties (point) (prog2 (insert button) (point) (insert " ")) (list 'face gnus-carpal-header-face)) ! (gnus-set-text-properties (point) (prog2 (insert (car button)) (point) (insert " ")) (list 'gnus-callback (cdr button) 'face gnus-carpal-button-face ! gnus-mouse-face-prop 'highlight)))) (let ((fill-column (- (window-width) 2))) (fill-region (point-min) (point-max))) *************** call it with the value of the `gnus-data *** 1165,1182 **** (if fun (funcall fun data)))) ! ;; Suggested by Arne Elofsson ! (defun gnus-article-next-button () ! "Move point to next button." ! (interactive) ! (if (get-text-property (point) 'gnus-callback) ! (goto-char (next-single-property-change (point) 'gnus-callback ! nil (point-max)))) ! (let ((pos (next-single-property-change (point) 'gnus-callback))) ! (if pos ! (goto-char pos) ! (setq pos (next-single-property-change (point-min) 'gnus-callback)) ! (if pos ! (goto-char pos) ! (error "No buttons found"))))) (defun gnus-article-highlight (&optional force) --- 1245,1281 ---- (if fun (funcall fun data)))) ! (defun gnus-article-prev-button (n) ! "Move point to N buttons backward. ! If N is negative, move forward instead." ! (interactive "p") ! (gnus-article-next-button (- n))) ! ! (defun gnus-article-next-button (n) ! "Move point to N buttons forward. ! If N is negative, move backward instead." ! (interactive "p") ! (let ((function (if (< n 0) 'previous-single-property-change ! 'next-single-property-change)) ! (inhibit-point-motion-hooks t) ! (backward (< n 0)) ! (limit (if (< n 0) (point-min) (point-max)))) ! (setq n (abs n)) ! (while (and (not (= limit (point))) ! (> n 0)) ! ;; Skip past the current button. ! (when (get-text-property (point) 'gnus-callback) ! (goto-char (funcall function (point) 'gnus-callback nil limit))) ! ;; Go to the next (or previous) button. ! (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) ! ;; Put point at the start of the button. ! (when (and backward (not (get-text-property (point) 'gnus-callback))) ! (goto-char (funcall function (point) 'gnus-callback nil limit))) ! ;; Skip past intangible buttons. ! (when (get-text-property (point) 'intangible) ! (incf n)) ! (decf n)) ! (unless (zerop n) ! (gnus-message 5 "No more buttons")) ! n)) (defun gnus-article-highlight (&optional force) *************** do the highlighting. See the documentat *** 1190,1194 **** (gnus-article-highlight-citation force) (gnus-article-highlight-signature) ! (gnus-article-add-buttons force)) (defun gnus-article-highlight-some (&optional force) --- 1289,1294 ---- (gnus-article-highlight-citation force) (gnus-article-highlight-signature) ! (gnus-article-add-buttons force) ! (gnus-article-add-buttons-to-head)) (defun gnus-article-highlight-some (&optional force) *************** do the highlighting. See the documentat *** 1202,1215 **** (gnus-article-add-buttons)) - (defun gnus-article-hide (&optional force) - "Hide current article. - This function calls `gnus-article-hide-headers', - `gnus-article-hide-citation-maybe', and `gnus-article-hide-signature' - to do the hiding. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-hide-headers) - (gnus-article-hide-citation-maybe force) - (gnus-article-hide-signature)) - (defun gnus-article-highlight-headers () "Highlight article headers as specified by `gnus-header-face-alist'." --- 1302,1305 ---- *************** to do the hiding. See the documentation *** 1217,1258 **** (save-excursion (set-buffer gnus-article-buffer) ! (goto-char (point-min)) ! (if (not (search-forward "\n\n" nil t)) ! () ! (beginning-of-line 0) ! (while (not (bobp)) ! (let ((alist gnus-header-face-alist) ! (buffer-read-only nil) ! (case-fold-search t) ! (end (point)) ! (inhibit-point-motion-hooks t) ! begin entry regexp header-face field-face ! header-found field-found) ! (re-search-backward "^[^ \t]" nil t) ! (setq begin (point)) ! (while alist ! (setq entry (car alist) ! regexp (nth 0 entry) header-face (nth 1 entry) ! field-face (nth 2 entry) ! alist (cdr alist)) ! (if (looking-at regexp) ! (let ((from (point))) ! (skip-chars-forward "^:\n") ! (and (not header-found) ! header-face ! (progn ! (put-text-property from (point) 'face header-face) ! (setq header-found t))) ! (and (not field-found) ! field-face ! (progn ! (skip-chars-forward ": \t") ! (let ((from (point))) ! (goto-char end) ! (skip-chars-backward " \t") ! (put-text-property from (point) 'face field-face) ! (setq field-found t)))))) ! (goto-char begin))))))) (defun gnus-article-highlight-signature () --- 1307,1345 ---- (save-excursion (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((alist gnus-header-face-alist) ! (buffer-read-only nil) ! (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)) ! (or (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 () *************** It does this by highlighting everything *** 1265,1338 **** (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) ! (goto-char (point-max)) ! (and (re-search-backward gnus-signature-separator nil t) ! gnus-signature-face ! (let ((start (match-beginning 0)) ! (end (match-end 0))) ! (gnus-article-add-button start end 'gnus-signature-toggle end) ! (gnus-overlay-put (gnus-make-overlay end (point-max)) ! 'face gnus-signature-face)))))) ! ! (defun gnus-article-hide-signature () ! "Hide the signature in an article. ! It does this by making everything after `gnus-signature-separator' invisible." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (goto-char (point-max)) ! (and (re-search-backward gnus-signature-separator nil t) ! gnus-signature-face ! (add-text-properties (match-end 0) (point-max) ! gnus-hidden-properties))))) (defun gnus-article-add-buttons (&optional force) ! "Find external references in article and make them to buttons. ! ! External references are things like message-ids and URLs, as specified by ! `gnus-button-alist'." (interactive (list 'force)) - (if (eq gnus-button-last gnus-button-alist) - () - (setq gnus-button-regexp (mapconcat 'car gnus-button-alist "\\|") - gnus-button-last gnus-button-alist)) (save-excursion (set-buffer gnus-article-buffer) ! (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) ! (case-fold-search t)) (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) ! (goto-char (point-max))) ! (while (re-search-forward gnus-button-regexp nil t) ! (goto-char (match-beginning 0)) ! (let* ((from (point)) ! (entry (gnus-button-entry)) ! (start (and entry (match-beginning (nth 1 entry)))) ! (end (and entry (match-end (nth 1 entry)))) ! (form (nth 2 entry))) ! (if (not entry) ! () ! (goto-char (match-end 0)) ! (if (eval form) ! (gnus-article-add-button start end 'gnus-button-push ! (set-marker (make-marker) ! from))))))))) ! (defun gnus-netscape-open-url (url) ! "Open URL in netscape, or start new scape with URL." ! (let ((process (start-process (concat "netscape " url) ! nil ! "netscape" ! "-remote" ! (concat "openUrl(" url ")'")))) ! (set-process-sentinel process ! (` (lambda (process change) ! (or (eq (process-exit-status process) 0) ! (gnus-netscape-start-url (, url)))))))) ! ! (defun gnus-netscape-start-url (url) ! "Start netscape with URL." ! (start-process (concat "netscape" url) nil "netscape" url)) ;;; External functions: --- 1352,1442 ---- (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) ! (save-restriction ! (when (and gnus-signature-face ! (gnus-narrow-to-signature)) ! (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) ! 'face gnus-signature-face) ! (widen) ! (re-search-backward gnus-signature-separator nil t) ! (let ((start (match-beginning 0)) ! (end (set-marker (make-marker) (1+ (match-end 0))))) ! (gnus-article-add-button start (1- end) 'gnus-signature-toggle ! end))))))) (defun gnus-article-add-buttons (&optional force) ! "Find external references in the article and make buttons of them. ! \"External references\" are things like Message-IDs and URLs, as ! specified by `gnus-button-alist'." (interactive (list 'force)) (save-excursion (set-buffer gnus-article-buffer) ! ;; Remove all old markers. ! (while gnus-button-marker-list ! (set-marker (pop gnus-button-marker-list) nil)) (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) ! (case-fold-search t) ! (alist gnus-button-alist) ! beg entry regexp) (goto-char (point-min)) ! ;; We skip the headers. ! (unless (search-forward "\n\n" nil t) ! (goto-char (point-max))) ! (setq beg (point)) ! (while (setq entry (pop alist)) ! (setq regexp (car entry)) ! (goto-char beg) ! (while (re-search-forward regexp nil t) ! (let* ((start (and entry (match-beginning (nth 1 entry)))) ! (end (and entry (match-end (nth 1 entry)))) ! (from (match-beginning 0))) ! (when (or (eq t (nth 1 entry)) ! (eval (nth 1 entry))) ! ;; That optional form returned non-nil, so we add the ! ;; button. ! (gnus-article-add-button ! start end 'gnus-button-push ! (car (push (set-marker (make-marker) from) ! gnus-button-marker-list)))))))))) ! ! ;; Add buttons to the head of an article. ! (defun gnus-article-add-buttons-to-head () ! "Add buttons to the head of the article." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (case-fold-search t) ! (alist gnus-header-button-alist) ! entry beg end) ! (nnheader-narrow-to-headers) ! (while alist ! ;; Each alist entry. ! (setq entry (car alist) ! alist (cdr alist)) ! (goto-char (point-min)) ! (while (re-search-forward (car entry) nil t) ! ;; Each header matching the entry. ! (setq beg (match-beginning 0)) ! (setq end (or (and (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0)) ! (point-max))) ! (goto-char beg) ! (while (re-search-forward (nth 1 entry) end t) ! ;; Each match within a header. ! (let* ((from (match-beginning 0)) ! (entry (cdr entry)) ! (start (match-beginning (nth 1 entry))) ! (end (match-end (nth 1 entry))) ! (form (nth 2 entry))) ! (goto-char (match-end 0)) ! (and (eval form) ! (gnus-article-add-button ! start end (nth 3 entry) ! (buffer-substring (match-beginning (nth 4 entry)) ! (match-end (nth 4 entry))))))) ! (goto-char end)))) ! (widen))) ;;; External functions: *************** External references are things like mess *** 1343,1351 **** (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (add-text-properties from to ! (append (and gnus-article-mouse-face ! (list 'mouse-face gnus-article-mouse-face)) ! (list 'gnus-callback fun) ! (and data (list 'gnus-data data))))) ;;; Internal functions: --- 1447,1456 ---- (gnus-overlay-put (gnus-make-overlay from to) 'face gnus-article-button-face)) ! (gnus-add-text-properties ! from to ! (nconc (and gnus-article-mouse-face ! (list gnus-mouse-face-prop gnus-article-mouse-face)) ! (list 'gnus-callback fun) ! (and data (list 'gnus-data data))))) ;;; Internal functions: *************** External references are things like mess *** 1354,1368 **** (save-excursion (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) (if (get-text-property end 'invisible) ! (remove-text-properties end (point-max) gnus-hidden-properties) ! (add-text-properties end (point-max) gnus-hidden-properties))))) ! ! ;see gnus-cus.el ! ;(defun gnus-make-face (color) ! ; ;; Create entry for face with COLOR. ! ; (if gnus-make-foreground ! ; (custom-face-lookup color nil nil nil nil nil) ! ; (custom-face-lookup nil color nil nil nil nil))) (defun gnus-button-entry () --- 1459,1467 ---- (save-excursion (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (inhibit-point-motion-hooks t)) (if (get-text-property end 'invisible) ! (gnus-unhide-text end (point-max)) ! (gnus-hide-text end (point-max) gnus-hidden-properties))))) (defun gnus-button-entry () *************** External references are things like mess *** 1371,1376 **** (entry nil)) (while alist ! (setq entry (car alist) ! alist (cdr alist)) (if (looking-at (car entry)) (setq alist nil) --- 1470,1474 ---- (entry nil)) (while alist ! (setq entry (pop alist)) (if (looking-at (car entry)) (setq alist nil) *************** External references are things like mess *** 1390,1410 **** (match-beginning group) (match-end group)))) ! (set-text-properties 0 (length string) nil string) string)) (nthcdr 4 entry)))) ! (cond ((fboundp fun) ! (apply fun args)) ! ((and (boundp fun) ! (fboundp (symbol-value fun))) ! (apply (symbol-value fun) args)) ! (t ! (message "You must define `%S' to use this button" (cons fun args))))))) (defun gnus-button-message-id (message-id) ! ;; Push on MESSAGE-ID. (save-excursion (set-buffer gnus-summary-buffer) (gnus-summary-refer-article message-id))) ;;; Compatibility Functions: --- 1488,1587 ---- (match-beginning group) (match-end group)))) ! (gnus-set-text-properties ! 0 (length string) nil string) string)) (nthcdr 4 entry)))) ! (cond ! ((fboundp fun) ! (apply fun args)) ! ((and (boundp fun) ! (fboundp (symbol-value fun))) ! (apply (symbol-value fun) args)) ! (t ! (gnus-message 1 "You must define `%S' to use this button" (cons fun args))))))) (defun gnus-button-message-id (message-id) ! "Fetch MESSAGE-ID." (save-excursion (set-buffer gnus-summary-buffer) (gnus-summary-refer-article message-id))) + + (defun gnus-button-mailto (address) + ;; Mail to ADDRESS. + (set-buffer (gnus-copy-article-buffer)) + (message-reply address)) + + (defun gnus-button-reply (address) + ;; Reply to ADDRESS. + (message-reply address)) + + (defun gnus-button-url (address) + "Browse ADDRESS." + (funcall browse-url-browser-function address)) + + ;;; Next/prev buttons in the article buffer. + + (defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") + (defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") + + (defvar gnus-prev-page-map nil) + (unless gnus-prev-page-map + (setq gnus-prev-page-map (make-sparse-keymap)) + (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) + (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) + + (defun gnus-insert-prev-page-button () + (let ((buffer-read-only nil)) + (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)))) + + (defvar gnus-next-page-map nil) + (unless gnus-next-page-map + (setq gnus-next-page-map (make-keymap)) + (suppress-keymap gnus-prev-page-map) + (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) + (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) + + (defun gnus-button-next-page () + "Go to the next page." + (interactive) + (let ((win (selected-window))) + (select-window (get-buffer-window gnus-article-buffer t)) + (gnus-article-next-page) + (select-window win))) + + (defun gnus-button-prev-page () + "Go to the prev page." + (interactive) + (let ((win (selected-window))) + (select-window (get-buffer-window gnus-article-buffer t)) + (gnus-article-prev-page) + (select-window win))) + + (defun gnus-insert-next-page-button () + (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-article-button-next-page)))) + + (defun gnus-article-button-next-page (arg) + "Go to the next page." + (interactive "P") + (let ((win (selected-window))) + (select-window (get-buffer-window gnus-article-buffer t)) + (gnus-article-next-page) + (select-window win))) + + (defun gnus-article-button-prev-page (arg) + "Go to the prev page." + (interactive "P") + (let ((win (selected-window))) + (select-window (get-buffer-window gnus-article-buffer t)) + (gnus-article-prev-page) + (select-window win))) ;;; Compatibility Functions: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus-vm.el emacs-19.32/lisp/gnus-vm.el *** emacs-19.31/lisp/gnus-vm.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/gnus-vm.el Tue Jun 25 18:08:09 1996 *************** *** 1,5 **** ;;; gnus-vm.el --- vm interface for Gnus ! ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Per Persson --- 1,4 ---- ;;; gnus-vm.el --- vm interface for Gnus ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Per Persson *************** *** 33,36 **** --- 32,36 ---- (require 'sendmail) + (require 'message) (require 'gnus) (require 'gnus-msg) *************** save those articles instead." *** 91,107 **** (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail))) - (or folder - (setq folder - (read-file-name - (concat "Save article in VM folder: (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name))) (setq folder ! (expand-file-name folder ! (and default-name ! (file-name-directory default-name)))) (gnus-make-directory (file-name-directory folder)) ! (set-buffer gnus-article-buffer) (save-excursion (save-restriction --- 91,101 ---- (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail))) (setq folder ! (cond ((eq folder 'default) default-name) ! (folder folder) ! (t (gnus-read-save-file-name ! "Save article in VM folder:" default-name)))) (gnus-make-directory (file-name-directory folder)) ! (set-buffer gnus-original-article-buffer) (save-excursion (save-restriction *************** save those articles instead." *** 112,261 **** ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-mail folder))) - - (defun gnus-mail-forward-using-vm (&optional buffer) - "Forward the current message to another user using vm." - (let* ((gnus-buffer (or buffer (current-buffer))) - (subject (gnus-forward-make-subject gnus-buffer))) - (or (featurep 'win-vm) - (if gnus-use-full-window - (pop-to-buffer gnus-article-buffer) - (switch-to-buffer gnus-article-buffer))) - (gnus-copy-article-buffer) - (set-buffer gnus-article-copy) - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder)) - (vm-forward-message-hook - (append (symbol-value 'vm-forward-message-hook) - '((lambda () - (save-excursion - (mail-position-on-field "Subject") - (beginning-of-line) - (looking-at "^\\(Subject: \\).*$") - (replace-match (concat "\\1" subject)))))))) - (vm-forward-message) - (gnus-vm-init-reply-buffer gnus-buffer) - (run-hooks 'gnus-mail-hook) - (kill-buffer vm-folder)))))) - - (defun gnus-vm-init-reply-buffer (buffer) - (make-local-variable 'gnus-summary-buffer) - (setq gnus-summary-buffer buffer) - (set 'vm-mail-buffer nil) - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-y" 'gnus-yank-article)) - - (defun gnus-mail-reply-using-vm (&optional yank) - "Compose reply mail using vm. - Optional argument YANK means yank original article. - The command \\[vm-yank-message] yank the original message into current buffer." - (let ((gnus-buffer (current-buffer))) - (gnus-copy-article-buffer) - (set-buffer gnus-article-copy) - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder gnus-article-copy))) - (vm-reply 1) - (gnus-vm-init-reply-buffer gnus-buffer) - (setq gnus-buffer (current-buffer)) - (and yank - ;; nil will (magically :-)) yank the current article - (gnus-yank-article nil)) - (kill-buffer vm-folder)))) - (if (featurep 'win-vm) nil - (pop-to-buffer gnus-buffer)) - (run-hooks 'gnus-mail-hook))) - - (defun gnus-mail-other-window-using-vm () - "Compose mail in the other window using VM." - (interactive) - (let ((gnus-buffer (current-buffer))) - (vm-mail) - (gnus-vm-init-reply-buffer gnus-buffer)) - (run-hooks 'gnus-mail-hook)) - - (defun gnus-yank-article (article &optional prefix) - ;; Based on vm-yank-message by Kyle Jones. - "Yank article number N into the current buffer at point. - When called interactively N is read from the minibuffer. - - This command is meant to be used in GNUS created Mail mode buffers; - the yanked article comes from the newsgroup containing the article - you are replying to or forwarding. - - All article headers are yanked along with the text. Point is left - before the inserted text, the mark after. Any hook functions bound to - `mail-citation-hook' are run, after inserting the text and setting - point and mark. - - Prefix arg means to ignore `mail-citation-hook', don't set the mark, - prepend the value of `vm-included-text-prefix' to every yanked line. - For backwards compatibility, if `mail-citation-hook' is set to nil, - `mail-yank-hooks' is run instead. If that is also nil, a default - action is taken." - (interactive - (list - (let ((result 0) - default prompt) - (setq default (and gnus-summary-buffer - (save-excursion - (set-buffer gnus-summary-buffer) - (and gnus-current-article - (int-to-string gnus-current-article)))) - prompt (if default - (format "Yank article number: (default %s) " default) - "Yank article number: ")) - (while (and (not (stringp result)) (zerop result)) - (setq result (read-string prompt)) - (and (string= result "") default (setq result default)) - (or (string-match "^<.*>$" result) - (setq result (string-to-int result)))) - result) - current-prefix-arg)) - (if gnus-summary-buffer - (save-excursion - (let ((message (current-buffer)) - (start (point)) end - (tmp (generate-new-buffer " *tmp-yank*"))) - (set-buffer gnus-summary-buffer) - ;; Make sure the connection to the server is alive. - (or (gnus-server-opened (gnus-find-method-for-group - gnus-newsgroup-name)) - (progn - (gnus-check-server - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t))) - (and (stringp article) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article))) - (gnus-request-article (or article - gnus-current-article) - gnus-newsgroup-name tmp) - (set-buffer tmp) - (run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (if (and gnus-show-mime - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method)) - ;; Perform the article display hooks. - (let ((buffer-read-only nil)) - (run-hooks 'gnus-article-display-hook)) - (append-to-buffer message (point-min) (point-max)) - (kill-buffer tmp) - (set-buffer message) - (setq end (point)) - (goto-char start) - (if (or prefix - (not (or mail-citation-hook mail-yank-hooks))) - (save-excursion - (while (< (point) end) - (insert (symbol-value 'vm-included-text-prefix)) - (forward-line 1))) - (push-mark end) - (cond - (mail-citation-hook (run-hooks 'mail-citation-hook)) - (mail-yank-hooks (run-hooks 'mail-yank-hooks)))))))) (provide 'gnus-vm) --- 106,109 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gnus.el emacs-19.32/lisp/gnus.el *** emacs-19.31/lisp/gnus.el Thu Apr 18 15:36:06 1996 --- emacs-19.32/lisp/gnus.el Sun Jul 14 11:05:02 1996 *************** *** 1,4 **** ;;; gnus.el --- a newsreader for GNU Emacs - ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. --- 1,3 ---- *************** *** 16,20 **** ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. --- 15,19 ---- ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ! ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. *************** *** 26,37 **** ;;; Commentary: - ;; Although Gnus looks suspiciously like GNUS, it isn't quite the same - ;; beast. Most internal structures have been changed. If you have - ;; written packages that depend on any of the hash tables, - ;; `gnus-newsrc-alist', `gnus-killed-assoc', marked lists, the .newsrc - ;; buffer, or internal knowledge of the `nntp-header-' macros, or - ;; dependence on the buffers having a certain format, your code will - ;; fail. - ;;; Code: --- 25,28 ---- *************** *** 41,46 **** (require 'timezone) (require 'nnheader) ! ;; Site dependent variables. These variables should be defined in ;; paths.el. --- 32,45 ---- (require 'timezone) (require 'nnheader) + (require 'nnmail) + (require 'backquote) + (require 'nnoo) + + (eval-when-compile (require 'cl)) + + (defvar gnus-directory (or (getenv "SAVEDIR") "~/News/") + "*Directory variable from which all other Gnus file variables are derived.") ! ;; Site dependent variables. These variables should be defined in ;; paths.el. *************** If you want to change servers, you shoul *** 52,56 **** See the documentation to that variable.") ! (defconst gnus-backup-default-subscribed-newsgroups '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") "Default default new newsgroups the first time Gnus is run. --- 51,55 ---- See the documentation to that variable.") ! (defvar gnus-backup-default-subscribed-newsgroups '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") "Default default new newsgroups the first time Gnus is run. *************** no need to set this variable.") *** 67,71 **** 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. --- 66,70 ---- 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. *************** variable, or returned by the function) i *** 74,88 **** this file will be used as the organization.") - (defvar gnus-use-generic-from nil - "If nil, the full host name will be the system name prepended to the domain name. - If this is a string, the full host name will be this string. - If this is non-nil, non-string, the domain name will be used as the - full host name.") - - (defvar gnus-use-generic-path nil - "If nil, use the NNTP server name in the Path header. - If stringp, use this; if non-nil, use no host name (user name only).") - - ;; Customization variables --- 73,76 ---- *************** If stringp, use this; if non-nil, use no *** 90,94 **** (defvar gnus-nntp-service "nntp" "*NNTP service name (\"nntp\" or 119). ! This is an obsolete variable, which is scarcely used. If you use an nntp server for your newsgroup and want to change the port number used to 899, you would say something along these lines: --- 78,82 ---- (defvar gnus-nntp-service "nntp" "*NNTP service name (\"nntp\" or 119). ! This is an obsolete variable, which is scarcely used. If you use an nntp server for your newsgroup and want to change the port number used to 899, you would say something along these lines: *************** used to 899, you would say something alo *** 96,102 **** (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") ! (defvar gnus-select-method (nconc ! (list 'nntp (or (getenv "NNTPSERVER") (if (and gnus-default-nntp-server (not (string= gnus-default-nntp-server ""))) --- 84,112 ---- (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") ! (defvar gnus-nntpserver-file "/etc/nntpserver" ! "*A file with only the name of the nntp server in it.") ! ! ;; This function is used to check both the environment variable ! ;; NNTPSERVER and the /etc/nntpserver file to see whether one can find ! ;; an nntp server name default. ! (defun gnus-getenv-nntpserver () ! (or (getenv "NNTPSERVER") ! (and (file-readable-p gnus-nntpserver-file) ! (save-excursion ! (set-buffer (get-buffer-create " *gnus nntp*")) ! (buffer-disable-undo (current-buffer)) ! (insert-file-contents gnus-nntpserver-file) ! (let ((name (buffer-string))) ! (prog1 ! (if (string-match "^[ \t\n]*$" name) ! nil ! name) ! (kill-buffer (current-buffer)))))))) ! ! (defvar gnus-select-method (nconc ! (list 'nntp (or (condition-case () ! (gnus-getenv-nntpserver) ! (error nil)) (if (and gnus-default-nntp-server (not (string= gnus-default-nntp-server ""))) *************** used to 899, you would say something alo *** 105,113 **** (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) ! nil (list gnus-nntp-service))) "*Default method for selecting a newsgroup. This variable should be a list, where the first element is how the ! news is to be fetched, the second is the address. For instance, if you want to get your news via NNTP from --- 115,123 ---- (if (or (null gnus-nntp-service) (equal gnus-nntp-service "nntp")) ! nil (list gnus-nntp-service))) "*Default method for selecting a newsgroup. This variable should be a list, where the first element is how the ! news is to be fetched, the second is the address. For instance, if you want to get your news via NNTP from *************** There is a lot more to know about select *** 125,152 **** see the manual for details.") ! ;; Added by Sudish Joseph . ! (defvar gnus-post-method nil ! "*Preferred method for posting USENET news. ! If this variable is nil, Gnus will use the current method to decide ! which method to use when posting. If it is non-nil, it will override ! the current method. This method will not be used in mail groups and ! the like, only in \"real\" newsgroups. ! ! The value must be a valid method as discussed in the documentation of ! `gnus-select-method'.") (defvar gnus-refer-article-method nil "*Preferred method for fetching an article by Message-ID. If you are reading news from the local spool (with nnspool), fetching ! articles by Message-ID is painfully slow. By setting this method to an nntp method, you might get acceptable results. The value of this variable must be a valid select method as discussed ! in the documentation of `gnus-select-method'") (defvar gnus-secondary-select-methods nil "*A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see ! `gnus-select-method'). If, for instance, you want to read your mail with the nnml backend, --- 135,179 ---- see the manual for details.") ! (defvar gnus-message-archive-method ! `(nnfolder ! "archive" ! (nnfolder-directory ,(nnheader-concat message-directory "archive")) ! (nnfolder-active-file ! ,(nnheader-concat message-directory "archive/active")) ! (nnfolder-get-new-mail nil) ! (nnfolder-inhibit-expiry t)) ! "*Method used for archiving messages you've sent. ! This should be a mail method. ! ! It's probably not a very effective to change this variable once you've ! run Gnus once. After doing that, you must edit this server from the ! server buffer.") ! ! (defvar 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 ! 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. ! ! Normally the group names returned by this variable should be ! unprefixed -- which implictly means \"store on the archive server\". ! However, you may wish to store the message on some other server. In ! that case, just return a fully prefixed name of the group -- ! \"nnml+private:mail.misc\", for instance.") (defvar gnus-refer-article-method nil "*Preferred method for fetching an article by Message-ID. If you are reading news from the local spool (with nnspool), fetching ! articles by Message-ID is painfully slow. By setting this method to an nntp method, you might get acceptable results. The value of this variable must be a valid select method as discussed ! in the documentation of `gnus-select-method'.") (defvar gnus-secondary-select-methods nil "*A list of secondary methods that will be used for reading news. This is a list where each element is a complete select method (see ! `gnus-select-method'). If, for instance, you want to read your mail with the nnml backend, *************** non-numeric prefix - `C-u M-x gnus', in *** 162,166 **** (defvar gnus-nntp-server nil "*The name of the host running the NNTP server. ! This variable is semi-obsolete. Use the `gnus-select-method' variable instead.") --- 189,193 ---- (defvar gnus-nntp-server nil "*The name of the host running the NNTP server. ! This variable is semi-obsolete. Use the `gnus-select-method' variable instead.") *************** variable instead.") *** 172,183 **** "*Your Gnus elisp startup file. If a file with the .el or .elc suffixes exist, it will be read ! instead.") (defvar gnus-group-faq-directory ! "/ftp@mirrors.aol.com:/pub/rtfm/usenet/" "*Directory where the group FAQs are stored. This will most commonly be on a remote machine, and the file will be fetched by ange-ftp. Note that Gnus uses an aol machine as the default directory. If this feels fundamentally unclean, just think of it as a way to finally get --- 199,224 ---- "*Your Gnus elisp startup file. If a file with the .el or .elc suffixes exist, it will be read ! instead.") (defvar gnus-group-faq-directory ! '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" ! "/ftp@sunsite.auc.dk:/pub/usenet/" ! "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" ! "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" ! "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" ! "/ftp@rtfm.mit.edu:/pub/usenet/" ! "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" ! "/ftp@ftp.sunet.se:/pub/usenet/" ! "/ftp@nctuccca.edu.tw:/USENET/FAQ/" ! "/ftp@hwarang.postech.ac.kr:/pub/usenet/" ! "/ftp@ftp.hk.super.net:/mirror/faqs/") "*Directory where the group FAQs are stored. This will most commonly be on a remote machine, and the file will be fetched by ange-ftp. + This variable can also be a list of directories. In that case, the + first element in the list will be used by default. The others can + be used when being prompted for a site. + Note that Gnus uses an aol machine as the default directory. If this feels fundamentally unclean, just think of it as a way to finally get *************** something of value back from them. *** 186,202 **** If the default site is too slow, try one of these: ! North America: ftp.uu.net /usenet/news.answers ! mirrors.aol.com /pub/rtfm/usenet ! ftp.seas.gwu.edu /pub/rtfm ! rtfm.mit.edu /pub/usenet/news.answers ! Europe: ftp.uni-paderborn.de /pub/FAQ ! ftp.Germany.EU.net /pub/newsarchive/news.answers ! ftp.sunet.se /pub/usenet ! Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet/news.answers ! ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory ! "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives.") --- 227,243 ---- If the default site is too slow, try one of these: ! North America: mirrors.aol.com /pub/rtfm/usenet ! ftp.seas.gwu.edu /pub/rtfm ! rtfm.mit.edu /pub/usenet ! Europe: ftp.uni-paderborn.de /pub/FAQ ! src.doc.ic.ac.uk /usenet/news-FAQS ! ftp.sunet.se /pub/usenet ! sunsite.auc.dk /pub/usenet ! Asia: nctuccca.edu.tw /USENET/FAQ ! hwarang.postech.ac.kr /pub/usenet ! ftp.hk.super.net /mirror/faqs") (defvar gnus-group-archive-directory ! "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" "*The address of the (ding) archives.") *************** started; it'll just use the normal newsg *** 214,219 **** "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in ! subscribed newsgroups. If neither t nor nil, mark as read in all ! newsgroups.") (defvar gnus-use-dribble-file t --- 255,264 ---- "*Non-nil means that cross referenced articles will be marked as read. If nil, ignore cross references. If t, mark articles as read in ! subscribed newsgroups. If neither t nor nil, mark as read in all ! newsgroups.") ! ! (defvar gnus-single-article-buffer t ! "*If non-nil, display all articles in the same buffer. ! If nil, each group will get its own article buffer.") (defvar gnus-use-dribble-file t *************** If Emacs should crash without saving the *** 222,285 **** information can be restored from the dribble file.") (defvar gnus-asynchronous nil "*If non-nil, Gnus will supply backends with data needed for async article fetching.") ! (defvar gnus-asynchronous-article-function nil ! "*Function for picking articles to pre-fetch, possibly.") ! ! (defvar gnus-score-file-single-match-alist nil ! "*Alist mapping regexps to lists of score files. ! Each element of this alist should be of the form ! (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) ! ! If the name of a group is matched by REGEXP, the corresponding scorefiles ! will be used for that group. ! The first match found is used, subsequent matching entries are ignored (to ! use multiple matches, see gnus-score-file-multiple-match-alist). ! ! These score files are loaded in addition to any files returned by ! gnus-score-find-score-files-function (which see).") ! ! (defvar gnus-score-file-multiple-match-alist nil ! "*Alist mapping regexps to lists of score files. ! Each element of this alist should be of the form ! (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) ! ! If the name of a group is matched by REGEXP, the corresponding scorefiles ! will be used for that group. ! If multiple REGEXPs match a group, the score files corresponding to each ! match will be used (for only one match to be used, see ! gnus-score-file-single-match-alist). ! ! These score files are loaded in addition to any files returned by ! gnus-score-find-score-files-function (which see).") ! ! ! (defvar gnus-score-file-suffix "SCORE" ! "*Suffix of the score files.") ! ! (defvar gnus-adaptive-file-suffix "ADAPT" ! "*Suffix of the adaptive score files.") ! ! (defvar gnus-score-find-score-files-function 'gnus-score-find-bnews ! "*Function used to find score files. ! The function will be called with the group name as the argument, and ! should return a list of score files to apply to that group. The score ! files do not actually have to exist. ! ! Predefined values are: ! ! gnus-score-find-single: Only apply the group's own score file. ! gnus-score-find-hierarchical: Also apply score files from parent groups. ! gnus-score-find-bnews: Apply score files whose names matches. ! ! See the documentation to these functions for more information. ! ! This variable can also be a list of functions to be called. Each ! function should either return a list of score files, or a list of ! score alists.") ! ! (defvar gnus-score-interactive-default-score 1000 ! "*Scoring commands will raise/lower the score with this number as the default.") (defvar gnus-large-newsgroup 200 --- 267,282 ---- information can be restored from the dribble file.") + (defvar gnus-dribble-directory nil + "*The directory where dribble files will be saved. + If this variable is nil, the directory where the .newsrc files are + saved will be used.") + (defvar gnus-asynchronous nil "*If non-nil, Gnus will supply backends with data needed for async article fetching.") ! (defvar gnus-kill-summary-on-exit t ! "*If non-nil, kill the summary buffer when you exit from it. ! If nil, the summary will become a \"*Dead Summary*\" buffer, and ! it will be killed sometime later.") (defvar gnus-large-newsgroup 200 *************** If this variable is a list, and the list *** 300,312 **** contains the element `not-save', long file names will not be used for saving; and if it contains the element `not-kill', long file names ! will not be used for kill files.") ! (defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/") ! "*Name of the directory articles will be saved in (default \"~/News\"). ! Initialized from the SAVEDIR environment variable.") ! ! (defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/") ! "*Name of the directory where kill files will be stored (default \"~/News\"). ! Initialized from the SAVEDIR environment variable.") (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail --- 297,311 ---- contains the element `not-save', long file names will not be used for saving; and if it contains the element `not-kill', long file names ! will not be used for kill files. ! ! Note that the default for this variable varies according to what system ! type you're using. On `usg-unix-v' and `xenix' this variable defaults ! to nil while on all other systems it defaults to t.") ! (defvar gnus-article-save-directory gnus-directory ! "*Name of the directory articles will be saved in (default \"~/News\").") ! ! (defvar gnus-kill-files-directory gnus-directory ! "*Name of the directory where kill files will be stored (default \"~/News\").") (defvar gnus-default-article-saver 'gnus-summary-save-in-rmail *************** Gnus provides the following functions: *** 323,326 **** --- 322,334 ---- * gnus-summary-save-in-vm (use VM's folder format).") + (defvar gnus-prompt-before-saving 'always + "*This variable says how much prompting is to be done when saving articles. + If it is nil, no prompting will be done, and the articles will be + saved to the default files. If this variable is `always', each and + every article that is saved will be preceded by a prompt, even when + saving large batches of articles. If this variable is neither nil not + `always', there the user will be prompted once for a file name for + each invocation of the saving commands.") + (defvar gnus-rmail-save-name (function gnus-plain-save-name) "*A function generating a file name to save articles in Rmail format. *************** The function is called with NEWSGROUP, H *** 340,347 **** LAST-FILE.") ! (defvar gnus-split-methods nil "*Variable used to suggest where articles are to be saved. - The syntax of this variable is the same as `nnmail-split-methods'. - For instance, if you would like to save articles related to Gnus in the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", --- 348,354 ---- LAST-FILE.") ! (defvar gnus-split-methods ! '((gnus-article-archive-name)) "*Variable used to suggest where articles are to be saved. For instance, if you would like to save articles related to Gnus in the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", *************** you could set this variable to something *** 349,353 **** '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") ! (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))") (defvar gnus-save-score nil --- 356,376 ---- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") ! (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) ! ! This variable is an alist where the where the key is the match and the ! value is a list of possible files to save in if the match is non-nil. ! ! If the match is a string, it is used as a regexp match on the ! article. If the match is a symbol, that symbol will be funcalled ! from the buffer of the article to be saved with the newsgroup as the ! parameter. If it is a list, it will be evaled in the same buffer. ! ! If this form or function returns a string, this string will be used as ! a possible file name; and if it returns a non-nil list, that list will ! be used as possible file names.") ! ! (defvar gnus-move-split-methods nil ! "*Variable used to suggest where articles are to be moved to. ! It uses the same syntax as the `gnus-split-methods' variable.") (defvar gnus-save-score nil *************** you could set this variable to something *** 357,366 **** "*If non-nil, use some adaptive scoring scheme.") ! (defvar gnus-use-cache nil ! "*If non-nil, Gnus will cache (some) articles locally.") (defvar gnus-use-scoring t "*If non-nil, enable scoring.") (defvar gnus-fetch-old-headers nil "*Non-nil means that Gnus will try to build threads by grabbing old headers. --- 380,413 ---- "*If non-nil, use some adaptive scoring scheme.") ! (defvar gnus-use-cache 'passive ! "*If nil, Gnus will ignore the article cache. ! If `passive', it will allow entering (and reading) articles ! explicitly entered into the cache. If anything else, use the ! cache to the full extent of the law.") ! ! (defvar gnus-use-trees nil ! "*If non-nil, display a thread tree buffer.") ! ! (defvar gnus-use-grouplens nil ! "*If non-nil, use GroupLens ratings.") ! ! (defvar gnus-keep-backlog nil ! "*If non-nil, Gnus will keep read articles for later re-retrieval. ! If it is a number N, then Gnus will only keep the last N articles ! read. If it is neither nil nor a number, Gnus will keep all read ! articles. This is not a good idea.") ! ! (defvar gnus-use-nocem nil ! "*If non-nil, Gnus will read NoCeM cancel messages.") ! ! (defvar gnus-use-demon nil ! "If non-nil, Gnus might use some demons.") (defvar gnus-use-scoring t "*If non-nil, enable scoring.") + (defvar gnus-use-picons nil + "*If non-nil, display picons.") + (defvar gnus-fetch-old-headers nil "*Non-nil means that Gnus will try to build threads by grabbing old headers. *************** just marked as read) article, the old ar *** 369,376 **** displayed in the Summary buffer. If this variable is non-nil, Gnus will attempt to grab the headers to the old articles, and thereby ! build complete threads. If it has the value `some', only enough headers to connect otherwise loose threads will be displayed. ! The server has to support XOVER for any of this to work.") ;see gnus-cus.el --- 416,425 ---- displayed in the Summary buffer. If this variable is non-nil, Gnus will attempt to grab the headers to the old articles, and thereby ! build complete threads. If it has the value `some', only enough headers to connect otherwise loose threads will be displayed. + This variable can also be a number. In that case, no more than that + number of old headers will be fetched. ! The server has to support NOV for any of this to work.") ;see gnus-cus.el *************** jabbering all the time.") *** 400,406 **** "*Non-nil means that the next newsgroup after the current will be on the same level. When you type, for instance, `n' after reading the last article in the ! current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group ! buffer. If this variable is non-nil, Gnus will either put you in the next newsgroup with the same level, or, if no such newsgroup is --- 449,455 ---- "*Non-nil means that the next newsgroup after the current will be on the same level. When you type, for instance, `n' after reading the last article in the ! current newsgroup, you will go to the next newsgroup. If this variable is nil, the next newsgroup will be the next from the group ! buffer. If this variable is non-nil, Gnus will either put you in the next newsgroup with the same level, or, if no such newsgroup is *************** with the best level.") *** 414,419 **** If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been ! lost. Instead of having many small sub-threads from this original thread ! scattered all over the summary buffer, Gnus can gather them. If non-nil, Gnus will try to gather all loose sub-threads from an --- 463,468 ---- If the root of a thread has expired or been read in a previous session, the information necessary to build a complete thread has been ! lost. Instead of having many small sub-threads from this original thread ! scattered all over the summary buffer, Gnus can gather them. If non-nil, Gnus will try to gather all loose sub-threads from an *************** If this variable is `adopt', Gnus will m *** 430,436 **** the parent and mark all the step-children as such. If this variable is `empty', the \"children\" are printed with empty ! subject fields. (Or rather, they will be printed with a string given by the `gnus-summary-same-subject' variable.)") (defvar gnus-summary-gather-subject-limit nil "*Maximum length of subject comparisons when gathering loose threads. --- 479,491 ---- the parent and mark all the step-children as such. If this variable is `empty', the \"children\" are printed with empty ! subject fields. (Or rather, they will be printed with a string given by the `gnus-summary-same-subject' variable.)") + (defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" + "*A regexp to match subjects to be excluded from loose thread gathering. + As loose thread gathering is done on subjects only, that means that + there can be many false gatherings performed. By rooting out certain + common subjects, gathering might become saner.") + (defvar gnus-summary-gather-subject-limit nil "*Maximum length of subject comparisons when gathering loose threads. *************** If this variable is `fuzzy', Gnus will u *** 444,447 **** --- 499,518 ---- comparing subjects.") + (defvar gnus-simplify-ignored-prefixes nil + "*Regexp, matches for which are removed from subject lines when simplifying.") + + (defvar gnus-build-sparse-threads nil + "*If non-nil, fill in the gaps in threads. + If `some', only fill in the gaps that are needed to tie loose threads + together. If `more', fill in all leaf nodes that Gnus can find. If + non-nil and non-`some', fill in all gaps that Gnus manages to guess.") + + (defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject + "Function used for gathering loose threads. + There are two pre-defined functions: `gnus-gather-threads-by-subject', + which only takes Subjects into consideration; and + `gnus-gather-threads-by-references', which compared the References + headers of the articles to find matches.") + ;; Added by Per Abrahamsen . (defvar gnus-summary-same-subject "" *************** This variable will only be used if the v *** 451,473 **** (defvar gnus-summary-goto-unread t ! "*If non-nil, marking commands will go to the next unread article.") (defvar gnus-group-goto-unread t "*If non-nil, movement commands will go to the next unread and subscribed group.") (defvar gnus-check-new-newsgroups t "*Non-nil means that Gnus will add new newsgroups at startup. If this variable is `ask-server', Gnus will ask the server for new ! groups since the last time it checked. This means that the killed list is no longer necessary, so you could set `gnus-save-killed-list' to ! nil. ! A variant is to have this variable be a list of select methods. Gnus will then use the `ask-server' method on all these select methods to query for new groups from all those servers. Eg. ! (setq gnus-check-new-newsgroups ! '((nntp \"some.server\") (nntp \"other.server\"))) If this variable is nil, then you have to tell Gnus explicitly to --- 522,549 ---- (defvar gnus-summary-goto-unread t ! "*If non-nil, marking commands will go to the next unread article. ! If `never', \\\\[gnus-summary-next-page] will go to the next article, ! whether it is read or not.") (defvar gnus-group-goto-unread t "*If non-nil, movement commands will go to the next unread and subscribed group.") + (defvar gnus-goto-next-group-when-activating t + "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group.") + (defvar gnus-check-new-newsgroups t "*Non-nil means that Gnus will add new newsgroups at startup. If this variable is `ask-server', Gnus will ask the server for new ! groups since the last time it checked. This means that the killed list is no longer necessary, so you could set `gnus-save-killed-list' to ! nil. ! A variant is to have this variable be a list of select methods. Gnus will then use the `ask-server' method on all these select methods to query for new groups from all those servers. Eg. ! (setq gnus-check-new-newsgroups ! '((nntp \"some.server\") (nntp \"other.server\"))) If this variable is nil, then you have to tell Gnus explicitly to *************** less than this variable, are subscribed. *** 514,527 **** "*New unsubscribed groups will be unsubscribed at this level.") (defvar gnus-activate-foreign-newsgroups 4 "*If nil, Gnus will not check foreign newsgroups at startup. ! If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be ! activated on startup. For instance, if you want to active all ! subscribed newsgroups, but not the rest, you'd set this variable to `gnus-level-subscribed'. If you subscribe to lots of newsgroups from different servers, startup ! might take a while. By setting this variable to nil, you'll save time, but you won't be told how many unread articles there are in the groups.") --- 590,608 ---- "*New unsubscribed groups will be unsubscribed at this level.") + (defvar gnus-activate-level (1+ gnus-level-subscribed) + "*Groups higher than this level won't be activated on startup. + Setting this variable to something log might save lots of time when + you have many groups that you aren't interested in.") + (defvar gnus-activate-foreign-newsgroups 4 "*If nil, Gnus will not check foreign newsgroups at startup. ! If it is non-nil, it should be a number between one and nine. Foreign newsgroups that have a level lower or equal to this number will be ! activated on startup. For instance, if you want to active all ! subscribed newsgroups, but not the rest, you'd set this variable to `gnus-level-subscribed'. If you subscribe to lots of newsgroups from different servers, startup ! might take a while. By setting this variable to nil, you'll save time, but you won't be told how many unread articles there are in the groups.") *************** exit.") *** 537,553 **** (defvar gnus-save-killed-list t "*If non-nil, save the list of killed groups to the startup file. ! This will save both time (when starting and quitting) and space (both ! memory and disk), but it will also mean that Gnus has no record of ! which groups are new and which are old, so the automatic new ! newsgroups subscription methods become meaningless. You should always ! set `gnus-check-new-newsgroups' to `ask-server' or nil if you set this ! variable to nil.") (defvar gnus-interactive-catchup t "*If non-nil, require your confirmation when catching up a group.") - (defvar gnus-interactive-post t - "*If non-nil, group name will be asked for when posting.") - (defvar gnus-interactive-exit t "*If non-nil, require your confirmation when exiting Gnus.") --- 618,632 ---- (defvar gnus-save-killed-list t "*If non-nil, save the list of killed groups to the startup file. ! If you set this variable to nil, you'll save both time (when starting ! and quitting) and space (both memory and disk), but it will also mean ! that Gnus has no record of which groups are new and which are old, so ! the automatic new newsgroups subscription methods become meaningless. ! ! You should always set `gnus-check-new-newsgroups' to `ask-server' or ! nil if you set this variable to nil.") (defvar gnus-interactive-catchup t "*If non-nil, require your confirmation when catching up a group.") (defvar gnus-interactive-exit t "*If non-nil, require your confirmation when exiting Gnus.") *************** will not be marked.") *** 576,584 **** (defvar gnus-simplify-subject-fuzzy-regexp nil ! "*Regular expression that will be removed from subject strings if ! fuzzy subject simplification is selected.") (defvar gnus-group-default-list-level gnus-level-subscribed ! "*Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil.") --- 655,674 ---- (defvar gnus-simplify-subject-fuzzy-regexp nil ! "*Strings to be removed when doing fuzzy matches. ! This can either be a regular expression or list of regular expressions ! that will be removed from subject strings if fuzzy subject ! simplification is selected.") ! ! (defvar gnus-permanently-visible-groups nil ! "*Regexp to match groups that should always be listed in the group buffer. ! This means that they will still be listed when there are no unread ! articles in the groups.") ! ! (defvar gnus-list-groups-with-ticked-articles t ! "*If non-nil, list groups that have only ticked articles. ! If nil, only list groups that have unread articles.") (defvar gnus-group-default-list-level gnus-level-subscribed ! "*Default listing level. Ignored if `gnus-group-use-permanent-levels' is non-nil.") *************** Ignored if `gnus-group-use-permanent-lev *** 586,589 **** --- 676,682 ---- "*If non-nil, once you set a level, Gnus will use this level.") + (defvar gnus-group-list-inactive-groups t + "*If non-nil, inactive groups will be listed.") + (defvar gnus-show-mime nil "*If non-nil, do mime processing of articles. *************** The articles will simply be fed to the f *** 592,601 **** (defvar gnus-strict-mime t ! "*If nil, decode MIME header even if there is not Mime-Version field.") ! ! (defvar gnus-show-mime-method (function metamail-buffer) "*Function to process a MIME message. The function is called from the article buffer.") (defvar gnus-show-threads t "*If non-nil, display threads in summary mode.") --- 685,698 ---- (defvar gnus-strict-mime t ! "*If nil, MIME-decode even if there is no Mime-Version header in the article.") ! ! (defvar gnus-show-mime-method 'metamail-buffer "*Function to process a MIME message. The function is called from the article buffer.") + (defvar gnus-decode-encoded-word-method (lambda ()) + "*Function to decode a MIME encoded-words. + The function is called from the article buffer.") + (defvar gnus-show-threads t "*If non-nil, display threads in summary mode.") *************** If nil, which is the default, articles t *** 615,628 **** from their parents will start separate threads.") (defvar gnus-thread-indent-level 4 "*Number that says how much each sub-thread should be indented.") ! (defvar gnus-ignored-newsgroups (purecopy (mapconcat 'identity ! '("^to\\." ; not "real" groups ! "^[0-9. \t]+ " ; all digits in name ! "[][\"#'()]" ; bogus characters ! ) ! "\\|")) "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are --- 712,735 ---- from their parents will start separate threads.") + (defvar gnus-thread-operation-ignore-subject t + "*If non-nil, subjects will be ignored when doing thread commands. + This affects commands like `gnus-summary-kill-thread' and + `gnus-summary-lower-thread'. + + If this variable is nil, articles in the same thread with different + subjects will not be included in the operation in question. If this + variable is `fuzzy', only articles that have subjects that are fuzzily + equal will be included.") + (defvar gnus-thread-indent-level 4 "*Number that says how much each sub-thread should be indented.") ! (defvar gnus-ignored-newsgroups (purecopy (mapconcat 'identity ! '("^to\\." ; not "real" groups ! "^[0-9. \t]+ " ; all digits in name ! "[][\"#'()]" ; bogus characters ! ) ! "\\|")) "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are *************** thus making them effectively non-existen *** 633,644 **** "^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:" "*All headers that match this regexp will be hidden. If `gnus-visible-headers' is non-nil, this variable will be ignored.") ! (defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:" "*All headers that do not match this regexp will be hidden. If this variable is non-nil, `gnus-ignored-headers' will be ignored.") (defvar gnus-sorted-header-list ! '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" "^Cc:" "^Date:" "^Organization:") "*This variable is a list of regular expressions. --- 740,753 ---- "^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:" "*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.") ! (defvar 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-" "*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. If this variable is non-nil, `gnus-ignored-headers' will be ignored.") (defvar gnus-sorted-header-list ! '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:" "^Cc:" "^Date:" "^Organization:") "*This variable is a list of regular expressions. *************** be placed first in the article buffer in *** 647,650 **** --- 756,765 ---- this list.") + (defvar gnus-boring-article-headers + '(empty followup-to reply-to) + "*Headers that are only to be displayed if they have interesting data. + Possible values in this list are `empty', `newsgroups', `followup-to', + `reply-to', and `date'.") + (defvar gnus-show-all-headers nil "*If non-nil, don't hide any headers.") *************** this list.") *** 653,656 **** --- 768,777 ---- "*If non-nil, don't remove any headers before saving.") + (defvar gnus-saved-headers gnus-visible-headers + "*Headers to keep if `gnus-save-all-headers' is nil. + If `gnus-save-all-headers' is non-nil, this variable will be ignored. + If that variable is nil, however, all headers that match this regexp + will be kept while the rest will be deleted before saving.") + (defvar gnus-inhibit-startup-message nil "*If non-nil, the startup message will not be displayed.") *************** this list.") *** 659,678 **** "Regexp matching signature separator.") (defvar gnus-auto-extend-newsgroup t "*If non-nil, extend newsgroup forward and backward when requested.") (defvar gnus-auto-select-first t ! "*If non-nil, select the first unread article when entering a group. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in ! `gnus-select-group-hook'.") (defvar gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit ! summary mode and go back to group mode. If the value is neither nil ! nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread ! newsgroup will be selected without any confirmations.") (defvar gnus-auto-select-same nil --- 780,815 ---- "Regexp matching signature separator.") + (defvar gnus-signature-limit nil + "Provide a limit to what is considered a signature. + If it is a number, no signature may not be longer (in characters) than + that number. If it is a function, the function will be called without + any parameters, and if it returns nil, there is no signature in the + buffer. If it is a string, it will be used as a regexp. If it + matches, the text in question is not a signature.") + (defvar gnus-auto-extend-newsgroup t "*If non-nil, extend newsgroup forward and backward when requested.") (defvar gnus-auto-select-first t ! "*If nil, don't select the first unread article when entering a group. ! If this variable is `best', select the highest-scored unread article ! in the group. If neither nil nor `best', select the first unread ! article. ! If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in ! `gnus-select-group-hook'.") (defvar gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit ! summary mode and go back to group mode. If the value is neither nil ! nor t, Gnus will select the following unread newsgroup. In particular, if the value is the symbol `quietly', the next unread ! newsgroup will be selected without any confirmation, and if it is ! `almost-quietly', the next group will be selected without any ! confirmation if you are located on the last article in the group. ! Finally, if this variable is `slightly-quietly', the `Z n' command ! will go to the next group without confirmation.") (defvar gnus-auto-select-same nil *************** current article is unread.") *** 685,689 **** (defvar gnus-auto-center-summary t ! "*If non-nil, always center the current summary buffer.") (defvar gnus-break-pages t --- 822,828 ---- (defvar gnus-auto-center-summary t ! "*If non-nil, always center the current summary buffer. ! In particular, if `vertical' do only vertical recentering. If non-nil ! and non-`vertical', do both horizontal and vertical recentering.") (defvar gnus-break-pages t *************** beginning of a line.") *** 703,746 **** "Obsolete variable. See `gnus-buffer-configuration'.") (defvar gnus-buffer-configuration ! '((group ([group 1.0 point] ! (if gnus-carpal [group-carpal 4]))) ! (summary ([summary 1.0 point] ! (if gnus-carpal [summary-carpal 4]))) ! (article ([summary 0.25 point] ! (if gnus-carpal [summary-carpal 4]) ! [article 1.0])) ! (pipe ([summary 0.25 point] ! (if gnus-carpal [summary-carpal 4]) ! [pipe 1.0])) ! (server ([server 1.0 point] ! (if gnus-carpal [server-carpal 2]))) ! (browse ([browse 1.0 point] ! (if gnus-carpal [browse-carpal 2]))) ! (group-mail ([mail 1.0 point])) ! (summary-mail ([mail 1.0 point])) ! (summary-reply ([article 0.5] ! [mail 1.0 point])) ! (info ([nil 1.0 point])) ! (summary-faq ([summary 0.25] ! [faq 1.0 point])) ! (edit-group ([group 0.5] ! [edit-group 1.0 point])) ! (edit-server ([server 0.5] ! [edit-server 1.0 point])) ! (edit-score ([summary 0.25] ! [edit-score 1.0 point])) ! (post ([post 1.0 point])) ! (reply ([article 0.5] ! [mail 1.0 point])) ! (mail-forward ([mail 1.0 point])) ! (post-forward ([post 1.0 point])) ! (reply-yank ([mail 1.0 point])) ! (followup ([article 0.5] ! [post 1.0 point])) ! (followup-yank ([post 1.0 point]))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and ! a RULE. The NAMEs are common-sense names like `group', which names a rule used when displaying the group buffer; `summary', which names a rule for what happens when you enter a group and do not display an --- 842,951 ---- "Obsolete variable. See `gnus-buffer-configuration'.") + (defvar gnus-window-min-width 2 + "*Minimum width of Gnus buffers.") + + (defvar gnus-window-min-height 1 + "*Minimum height of Gnus buffers.") + (defvar gnus-buffer-configuration ! '((group ! (vertical 1.0 ! (group 1.0 point) ! (if gnus-carpal '(group-carpal 4)))) ! (summary ! (vertical 1.0 ! (summary 1.0 point) ! (if gnus-carpal '(summary-carpal 4)))) ! (article ! (cond ! (gnus-use-picons ! '(frame 1.0 ! (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ! (article 1.0)) ! (vertical ((height . 5) (width . 15) ! (user-position . t) ! (left . -1) (top . 1)) ! (picons 1.0)))) ! (gnus-use-trees ! '(vertical 1.0 ! (summary 0.25 point) ! (tree 0.25) ! (article 1.0))) ! (t ! '(vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ! (article 1.0))))) ! (server ! (vertical 1.0 ! (server 1.0 point) ! (if gnus-carpal '(server-carpal 2)))) ! (browse ! (vertical 1.0 ! (browse 1.0 point) ! (if gnus-carpal '(browse-carpal 2)))) ! (message ! (vertical 1.0 ! (message 1.0 point))) ! (pick ! (vertical 1.0 ! (article 1.0 point))) ! (info ! (vertical 1.0 ! (info 1.0 point))) ! (summary-faq ! (vertical 1.0 ! (summary 0.25) ! (faq 1.0 point))) ! (edit-group ! (vertical 1.0 ! (group 0.5) ! (edit-group 1.0 point))) ! (edit-server ! (vertical 1.0 ! (server 0.5) ! (edit-server 1.0 point))) ! (edit-score ! (vertical 1.0 ! (summary 0.25) ! (edit-score 1.0 point))) ! (post ! (vertical 1.0 ! (post 1.0 point))) ! (reply ! (vertical 1.0 ! (article-copy 0.5) ! (message 1.0 point))) ! (forward ! (vertical 1.0 ! (message 1.0 point))) ! (reply-yank ! (vertical 1.0 ! (message 1.0 point))) ! (mail-bounce ! (vertical 1.0 ! (article 0.5) ! (message 1.0 point))) ! (draft ! (vertical 1.0 ! (draft 1.0 point))) ! (pipe ! (vertical 1.0 ! (summary 0.25 point) ! (if gnus-carpal '(summary-carpal 4)) ! ("*Shell Command Output*" 1.0))) ! (bug ! (vertical 1.0 ! ("*Gnus Help Bug*" 0.5) ! ("*Gnus Bug*" 1.0 point))) ! (compose-bounce ! (vertical 1.0 ! (article 0.5) ! (message 1.0 point)))) "Window configuration for all possible Gnus buffers. This variable is a list of lists. Each of these lists has a NAME and ! a RULE. The NAMEs are commonsense names like `group', which names a rule used when displaying the group buffer; `summary', which names a rule for what happens when you enter a group and do not display an *************** article buffer; and so on. See the valu *** 748,752 **** complete list of NAMEs. ! Each RULE is a list of vectors. The first element in this vector is the name of the buffer to be displayed; the second element is the percentage of the screen this buffer is to occupy (a number in the --- 953,957 ---- complete list of NAMEs. ! Each RULE is a list of vectors. The first element in this vector is the name of the buffer to be displayed; the second element is the percentage of the screen this buffer is to occupy (a number in the *************** buffer configuration.") *** 761,765 **** (server . gnus-server-buffer) (browse . "*Gnus Browse Server*") - (pipe . "*Shell Command Output*") (edit-group . gnus-group-edit-buffer) (edit-server . gnus-server-edit-buffer) --- 966,969 ---- *************** buffer configuration.") *** 769,775 **** (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) ! (mail . gnus-mail-buffer) ! (post . gnus-post-news-buffer) ! (faq . gnus-faq-buffer)) "Mapping from short symbols to buffer names or buffer variables.") --- 973,985 ---- (browse-carpal . gnus-carpal-browse-buffer) (edit-score . gnus-score-edit-buffer) ! (message . gnus-message-buffer) ! (mail . gnus-message-buffer) ! (post-news . gnus-message-buffer) ! (faq . gnus-faq-buffer) ! (picons . "*Picons*") ! (tree . gnus-tree-buffer) ! (info . gnus-info-buffer) ! (article-copy . gnus-article-copy) ! (draft . gnus-draft-buffer)) "Mapping from short symbols to buffer names or buffer variables.") *************** inserts new groups at the beginning of t *** 784,791 **** alphabetic order; `gnus-subscribe-hierarchically' inserts new groups in hierarchical newsgroup order; `gnus-subscribe-interactively' asks ! for your decision.") ;; Suggested by a bug report by Hallvard B Furuseth. ! ;; . (defvar gnus-subscribe-options-newsgroup-method (function gnus-subscribe-alphabetically) --- 994,1002 ---- alphabetic order; `gnus-subscribe-hierarchically' inserts new groups in hierarchical newsgroup order; `gnus-subscribe-interactively' asks ! for your decision; `gnus-subscribe-killed' kills all new groups; ! `gnus-subscribe-zombies' will make all new groups into zombies.") ;; Suggested by a bug report by Hallvard B Furuseth. ! ;; . (defvar gnus-subscribe-options-newsgroup-method (function gnus-subscribe-alphabetically) *************** hierarchy in its entirety.") *** 814,822 **** This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include ! `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread' and ! `gnus-group-sort-by-level'") ;; Mark variables suggested by Thomas Michanek ! ;; . (defvar gnus-unread-mark ? "*Mark used for unread articles.") --- 1025,1038 ---- This function will be called with group info entries as the arguments for the groups to be sorted. Pre-made functions include ! `gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread', ! `gnus-group-sort-by-level', `gnus-group-sort-by-score', and ! `gnus-group-sort-by-rank'. ! ! This variable can also be a list of sorting functions. In that case, ! the most significant sort function should be the last function in the ! list.") ;; Mark variables suggested by Thomas Michanek ! ;; . (defvar gnus-unread-mark ? "*Mark used for unread articles.") *************** for the groups to be sorted. Pre-made f *** 833,836 **** --- 1049,1054 ---- (defvar gnus-killed-mark ?K "*Mark used for killed articles.") + (defvar gnus-souped-mark ?F + "*Mark used for killed articles.") (defvar gnus-kill-file-mark ?X "*Mark used for articles killed by kill files.") *************** for the groups to be sorted. Pre-made f *** 841,848 **** (defvar gnus-replied-mark ?A "*Mark used for articles that have been replied to.") ! (defvar gnus-process-mark ?# "*Process mark.") (defvar gnus-ancient-mark ?O "*Mark used for ancient articles.") (defvar gnus-canceled-mark ?G "*Mark used for canceled articles.") --- 1059,1072 ---- (defvar gnus-replied-mark ?A "*Mark used for articles that have been replied to.") ! (defvar gnus-cached-mark ?* ! "*Mark used for articles that are in the cache.") ! (defvar gnus-saved-mark ?S ! "*Mark used for articles that have been saved to.") ! (defvar gnus-process-mark ?# "*Process mark.") (defvar gnus-ancient-mark ?O "*Mark used for ancient articles.") + (defvar gnus-sparse-mark ?Q + "*Mark used for sparsely reffed articles.") (defvar gnus-canceled-mark ?G "*Mark used for canceled articles.") *************** for the groups to be sorted. Pre-made f *** 855,860 **** (defvar gnus-not-empty-thread-mark ?= "*There is a thread under the article.") - (defvar gnus-dummy-mark ?Z - "*This is a dummy article.") (defvar gnus-view-pseudo-asynchronously nil --- 1079,1082 ---- *************** If nil, all files that use the same view *** 871,875 **** list of parameters to that command.") ! (defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n" "*Format of group lines. It works along the same lines as a normal formatting string, --- 1093,1100 ---- list of parameters to that command.") ! (defvar gnus-insert-pseudo-articles t ! "*If non-nil, insert pseudo-articles when decoding articles.") ! ! (defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n" "*Format of group lines. It works along the same lines as a normal formatting string, *************** with some simple extensions. *** 893,902 **** %p Process mark (char) %O Moderated group (string, \"(m)\" or \"\") %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used ! %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, ! where X is the letter following %u. The function will be passed the ! current header as argument. The function should return a string, which will be inserted into the buffer just like information from any other group specifier. --- 1118,1129 ---- %p Process mark (char) %O Moderated group (string, \"(m)\" or \"\") + %P Topic indentation (string) + %l Whether there are GroupLens predictions for this group (string) %n Select from where (string) %z A string that look like `<%s:%n>' if a foreign select method is used ! %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, ! where X is the letter following %u. The function will be passed the ! current header as argument. The function should return a string, which will be inserted into the buffer just like information from any other group specifier. *************** Text between %( and %) will be highlight *** 905,911 **** the mouse point move inside the area. There can only be one such area. ! Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification ! is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. --- 1132,1138 ---- the mouse point move inside the area. There can only be one such area. ! Note that this format specification is not always respected. For reasons of efficiency, when listing killed groups, this specification ! is ignored altogether. If the spec is changed considerably, your output may end up looking strange when listing both alive and killed groups. *************** a bit of extra memory will be used. %D w *** 915,919 **** Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into ! effect.") (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" --- 1142,1146 ---- Also note that if you change the format specification to include any of these specs, you must probably re-start Gnus to see them go into ! effect.") (defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n" *************** with some simple extensions. *** 950,977 **** %t Number of articles under the current thread (number). %e Whether the thread is empty or not (character). ! %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, ! where X is the letter following %u. The function will be passed the ! current header as argument. The function should return a string, which will be inserted into the summary just like information from any other summary specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' ! when the mouse point is placed inside the area. There can only be one such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled ! with care. For reasons of efficiency, Gnus will compute what column ! these characters will end up in, and \"hard-code\" that. This means that ! it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. The smart choice is to have these specs as for to the left as ! possible. This restriction may disappear in later versions of Gnus.") ! (defvar gnus-summary-dummy-line-format "* : : %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, --- 1177,1206 ---- %t Number of articles under the current thread (number). %e Whether the thread is empty or not (character). ! %l GroupLens score (string). ! %u User defined specifier. The next character in the format string should be a letter. Gnus will call the function gnus-user-format-function-X, ! where X is the letter following %u. The function will be passed the ! current header as argument. The function should return a string, which will be inserted into the summary just like information from any other summary specifier. Text between %( and %) will be highlighted with `gnus-mouse-face' ! when the mouse point is placed inside the area. There can only be one such area. The %U (status), %R (replied) and %z (zcore) specs have to be handled ! with care. For reasons of efficiency, Gnus will compute what column ! these characters will end up in, and \"hard-code\" that. This means that ! it is illegal to have these specs after a variable-length spec. Well, you might not be arrested, but your summary buffer will look strange, which is bad enough. The smart choice is to have these specs as for to the left as ! possible. This restriction may disappear in later versions of Gnus.") ! (defvar gnus-summary-dummy-line-format ! "* %(: :%) %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, *************** with some simple extensions. *** 980,1020 **** %S The subject") ! (defvar gnus-summary-mode-line-format "Gnus: %b [%A] %Z" ! "*The format specification for the summary mode line.") ! (defvar gnus-article-mode-line-format "Gnus: %b %S" ! "*The format specification for the article mode line.") ! (defvar gnus-group-mode-line-format "Gnus: %b {%M:%S} " ! "*The format specification for the group mode line.") (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) ! ("nnspool" post) ! ("nnvirtual" none virtual prompt-address) ! ("nnmbox" mail respool) ! ("nnml" mail respool) ! ("nnmh" mail respool) ! ("nndir" none prompt-address address) ! ("nneething" none prompt-address) ! ("nndigest" none) ! ("nndoc" none prompt-address) ! ("nnbabyl" mail respool) ! ("nnkiboze" post virtual) ! ;;("nnsoup" post) ! ("nnfolder" mail respool)) "An alist of valid select methods. The first element of each list lists should be a string with the name ! of the select method. The other elements may be be the category of this method (ie. `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is ! this variable. I think.") ! (defvar gnus-updated-mode-lines '(group article summary) "*List of buffers that should update their mode lines. ! The list may contain the symbols `group', `article' and `summary'. If the corresponding symbol is present, Gnus will keep that mode line ! updated with information that may be pertinent. If this variable is nil, screen refresh may be quicker.") --- 1209,1273 ---- %S The subject") ! (defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" ! "*The format specification for the summary mode line. ! It works along the same lines as a normal formatting string, ! with some simple extensions: ! ! %G Group name ! %p Unprefixed group name ! %A Current article number ! %V Gnus version ! %U Number of unread articles in the group ! %e Number of unselected articles in the group ! %Z A string with unread/unselected article counts ! %g Shortish group name ! %S Subject of the current article ! %u User-defined spec ! %s Current score file name ! %d Number of dormant articles ! %r Number of articles that have been marked as read in this session ! %E Number of articles expunged by the score files") ! ! (defvar gnus-article-mode-line-format "Gnus: %%b %S" ! "*The format specification for the article mode line. ! See `gnus-summary-mode-line-format' for a closer description.") ! (defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}" ! "*The format specification for the group mode line. ! It works along the same lines as a normal formatting string, ! with some simple extensions: ! %S The native news server. ! %M The native select method. ! %: \":\" if %S isn't \"\".") (defvar gnus-valid-select-methods '(("nntp" post address prompt-address) ! ("nnspool" post address) ! ("nnvirtual" post-mail virtual prompt-address) ! ("nnmbox" mail respool address) ! ("nnml" mail respool address) ! ("nnmh" mail respool address) ! ("nndir" post-mail prompt-address address) ! ("nneething" none address prompt-address) ! ("nndoc" none address prompt-address) ! ("nnbabyl" mail address respool) ! ("nnkiboze" post virtual) ! ("nnsoup" post-mail address) ! ("nndraft" post-mail) ! ("nnfolder" mail respool address)) "An alist of valid select methods. The first element of each list lists should be a string with the name ! of the select method. The other elements may be be the category of this method (ie. `post', `mail', `none' or whatever) or other properties that this method has (like being respoolable). If you implement a new select method, all you should have to change is ! this variable. I think.") ! (defvar gnus-updated-mode-lines '(group article summary tree) "*List of buffers that should update their mode lines. ! The list may contain the symbols `group', `article' and `summary'. If the corresponding symbol is present, Gnus will keep that mode line ! updated with information that may be pertinent. If this variable is nil, screen refresh may be quicker.") *************** of the modeline intact.") *** 1030,1037 **** ;No mouse highlights will be done if `gnus-visual' is nil.") ! (defvar gnus-summary-mark-below nil "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the ! score file.") (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) --- 1283,1294 ---- ;No mouse highlights will be done if `gnus-visual' is nil.") ! (defvar gnus-summary-mark-below 0 "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the ! score file.") ! ! (defvar gnus-article-sort-functions '(gnus-article-sort-by-number) ! "*List of functions used for sorting articles in the summary buffer. ! This variable is only used when not using a threaded display.") (defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number) *************** By default, threads are sorted by articl *** 1041,1045 **** Each function takes two threads and return non-nil if the first thread should be sorted before the other. If you use more than one function, ! the primary sort function should be the last. Ready-mady functions include `gnus-thread-sort-by-number', --- 1298,1304 ---- Each function takes two threads and return non-nil if the first thread should be sorted before the other. If you use more than one function, ! the primary sort function should be the last. You should probably ! always include `gnus-thread-sort-by-number' in the list of sorting ! functions -- preferably first. Ready-mady functions include `gnus-thread-sort-by-number', *************** subthread and should then return the sco *** 1056,1067 **** Some functions you can use are `+', `max', or `min'.") (defvar gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. ! Note that this variable deals only with new newsgroups. This variable ! does not affect old newsgroups.") (defvar gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. ! Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups.") --- 1315,1348 ---- Some functions you can use are `+', `max', or `min'.") + (defvar gnus-summary-expunge-below nil + "All articles that have a score less than this variable will be expunged.") + + (defvar gnus-thread-expunge-below nil + "All threads that have a total score less than this variable will be expunged. + See `gnus-thread-score-function' for en explanation of what a + \"thread score\" is.") + + (defvar gnus-auto-subscribed-groups + "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" + "*All new groups that match this regexp will be subscribed automatically. + Note that this variable only deals with new groups. It has no effect + whatsoever on old groups. + + New groups that match this regexp will not be handled by + `gnus-subscribe-newsgroup-method'. Instead, they will + be subscribed using `gnus-subscribe-options-newsgroup-method'.") + (defvar gnus-options-subscribe nil "*All new groups matching this regexp will be subscribed unconditionally. ! Note that this variable deals only with new newsgroups. This variable ! does not affect old newsgroups. ! ! New groups that match this regexp will not be handled by ! `gnus-subscribe-newsgroup-method'. Instead, they will ! be subscribed using `gnus-subscribe-options-newsgroup-method'.") (defvar gnus-options-not-subscribe nil "*All new groups matching this regexp will be ignored. ! Note that this variable deals only with new newsgroups. This variable does not affect old (already subscribed) newsgroups.") *************** If non-nil, this should be a regexp that *** 1071,1080 **** which to perform auto-expiry. This only makes sense for mail groups.") (defvar gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text.") (defvar gnus-modtime-botch nil ! "*Non-nil means .newsrc should be deleted prior to save. Its use is ! due to the bogus appearance that .newsrc was modified on disc.") ;; Hooks. --- 1352,1372 ---- which to perform auto-expiry. This only makes sense for mail groups.") + (defvar gnus-total-expirable-newsgroups nil + "*Groups in which to perform expiry of all read articles. + Use with extreme caution. All groups that match this regexp will be + expiring - which means that all read articles will be deleted after + (say) one week. (This only goes for mail groups and the like, of + course.)") + + (defvar gnus-group-uncollapsed-levels 1 + "Number of group name elements to leave alone when making a short group name.") + (defvar gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text.") (defvar gnus-modtime-botch nil ! "*Non-nil means .newsrc should be deleted prior to save. ! Its use is due to the bogus appearance that .newsrc was modified on ! disc.") ;; Hooks. *************** This hook is run before any variables ar *** 1090,1101 **** "*A hook for Gnus article mode.") ! (defun gnus-summary-prepare-exit-hook nil "*A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default.") (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) ! (defun gnus-summary-exit-hook nil "*A hook called on exit from the summary buffer.") (defvar gnus-open-server-hook nil "*A hook called just before opening connection to the news server.") --- 1382,1399 ---- "*A hook for Gnus article mode.") ! (defvar gnus-summary-prepare-exit-hook nil "*A hook called when preparing to exit from the summary buffer. It calls `gnus-summary-expire-articles' by default.") (add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles) ! (defvar gnus-summary-exit-hook nil "*A hook called on exit from the summary buffer.") + (defvar gnus-group-catchup-group-hook nil + "*A hook run when catching up a group from the group buffer.") + + (defvar gnus-group-update-group-hook nil + "*A hook called when updating group lines.") + (defvar gnus-open-server-hook nil "*A hook called just before opening connection to the news server.") *************** This hook is called after Gnus is connec *** 1111,1120 **** "*A hook run just before Gnus checks for new news.") (defvar gnus-group-prepare-function 'gnus-group-prepare-flat "*A function that is called to generate the group buffer. The function is called with three arguments: The first is a number; all group with a level less or equal to that number should be listed, ! if the second is non-nil, empty groups should also be displayed. If ! the third is non-nil, it is a number. No groups with a level lower than this number should be displayed. --- 1409,1421 ---- "*A hook run just before Gnus checks for new news.") + (defvar gnus-after-getting-new-news-hook nil + "*A hook run after Gnus checks for new news.") + (defvar gnus-group-prepare-function 'gnus-group-prepare-flat "*A function that is called to generate the group buffer. The function is called with three arguments: The first is a number; all group with a level less or equal to that number should be listed, ! if the second is non-nil, empty groups should also be displayed. If ! the third is non-nil, it is a number. No groups with a level lower than this number should be displayed. *************** If you want to modify the group buffer, *** 1129,1132 **** --- 1430,1438 ---- If you want to modify the summary buffer, you can use this hook.") + (defvar gnus-summary-generate-hook nil + "*A hook run just before generating the summary buffer. + This hook is commonly used to customize threading variables and the + like.") + (defvar gnus-article-prepare-hook nil "*A hook called after an article has been prepared in the article buffer. *************** If you want to run a special decoding pr *** 1136,1142 **** ; "*A hook called after the article is displayed in the article buffer. ;The hook is designed to change the contents of the article ! ;buffer. Typical functions that this hook may contain are ;`gnus-article-hide-headers' (hide selected headers), ! ;`gnus-article-maybe-highlight' (perform fancy article highlighting), ;`gnus-article-hide-signature' (hide signature) and ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") --- 1442,1448 ---- ; "*A hook called after the article is displayed in the article buffer. ;The hook is designed to change the contents of the article ! ;buffer. Typical functions that this hook may contain are ;`gnus-article-hide-headers' (hide selected headers), ! ;`gnus-article-maybe-highlight' (perform fancy article highlighting), ;`gnus-article-hide-signature' (hide signature) and ;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).") *************** If you want to run a special decoding pr *** 1145,1154 **** ;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight) - (defvar gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "String or function to be executed to display an X-Face header. - If it is a string, the command will be executed in a sub-shell - asynchronously. The compressed face will be piped to this command.") - (defvar gnus-article-x-face-too-ugly nil "Regexp matching posters whose face shouldn't be shown automatically.") --- 1451,1454 ---- *************** following hook: *** 1171,1179 **** gnus-newsgroup-headers))))") ! (defvar gnus-select-article-hook ! '(gnus-summary-show-thread) ! "*A hook called when an article is selected. ! The default hook shows conversation thread subtrees of the selected ! article automatically using `gnus-summary-show-thread'.") (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) --- 1471,1476 ---- gnus-newsgroup-headers))))") ! (defvar gnus-select-article-hook nil ! "*A hook called when an article is selected.") (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) *************** The function `gnus-apply-kill-file' is c *** 1183,1187 **** Since a general kill file is too heavy to use only for a few ! newsgroups, I recommend you to use a lighter hook function. For example, if you'd like to apply a kill file to articles which contains a string `rmgroup' in subject in newsgroup `control', you can use the --- 1480,1484 ---- Since a general kill file is too heavy to use only for a few ! newsgroups, I recommend you to use a lighter hook function. For example, if you'd like to apply a kill file to articles which contains a string `rmgroup' in subject in newsgroup `control', you can use the *************** following hook: *** 1195,1199 **** (gnus-expunge \"X\"))))))") ! (defvar gnus-visual-mark-article-hook (list 'gnus-highlight-selected-summary) "*Hook run after selecting an article in the summary buffer. --- 1492,1496 ---- (gnus-expunge \"X\"))))))") ! (defvar gnus-visual-mark-article-hook (list 'gnus-highlight-selected-summary) "*Hook run after selecting an article in the summary buffer. *************** It is meant to be used for highlighting *** 1201,1206 **** is not run if `gnus-visual' is nil.") ! (defun gnus-parse-headers-hook nil "*A hook called before parsing the headers.") (defvar gnus-exit-group-hook nil --- 1498,1504 ---- is not run if `gnus-visual' is nil.") ! (defvar gnus-parse-headers-hook nil "*A hook called before parsing the headers.") + (add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522) (defvar gnus-exit-group-hook nil *************** is not run if `gnus-visual' is nil.") *** 1213,1220 **** "*A hook called when exiting Gnus.") (defvar gnus-save-newsrc-hook nil ! "*A hook called when saving the newsrc file.") ! (defvar gnus-summary-update-hook (list 'gnus-summary-highlight-line) "*A hook called when a summary line is changed. --- 1511,1529 ---- "*A hook called when exiting Gnus.") + (defvar gnus-after-exiting-gnus-hook nil + "*A hook called after exiting Gnus.") + (defvar gnus-save-newsrc-hook nil ! "*A hook called before saving any of the newsrc files.") ! ! (defvar gnus-save-quick-newsrc-hook nil ! "*A hook called just before saving the quick newsrc file. ! Can be used to turn version control on or off.") ! ! (defvar gnus-save-standard-newsrc-hook nil ! "*A hook called just before saving the standard newsrc file. ! Can be used to turn version control on or off.") ! (defvar gnus-summary-update-hook (list 'gnus-summary-highlight-line) "*A hook called when a summary line is changed. *************** highlight the line according to the `gnu *** 1225,1233 **** variable.") ! (defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read) "*A hook called when an article is selected for the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected.") ;; Remove any hilit infestation. (add-hook 'gnus-startup-hook --- 1534,1554 ---- variable.") ! (defvar gnus-group-update-hook '(gnus-group-highlight-line) ! "*A hook called when a group line is changed. ! The hook will not be called if `gnus-visual' is nil. ! ! The default function `gnus-group-highlight-line' will ! highlight the line according to the `gnus-group-highlight' ! variable.") ! ! (defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) "*A hook called when an article is selected for the first time. The hook is intended to mark an article as read (or unread) automatically when it is selected.") + (defvar gnus-group-change-level-function nil + "Function run when a group level is changed. + It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.") + ;; Remove any hilit infestation. (add-hook 'gnus-startup-hook *************** automatically when it is selected.") *** 1236,1251 **** 'hilit-rehighlight-buffer-quietly) (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) ! (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read)) (remove-hook 'gnus-article-prepare-hook 'hilit-rehighlight-buffer-quietly))) - ;; Internal variables ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) (defvar gnus-newsgroup-selected-overlay nil) (defvar gnus-article-mode-map nil) (defvar gnus-dribble-buffer nil) --- 1557,1616 ---- 'hilit-rehighlight-buffer-quietly) (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks) ! (setq gnus-mark-article-hook ! '(gnus-summary-mark-read-and-unread-as-read)) (remove-hook 'gnus-article-prepare-hook 'hilit-rehighlight-buffer-quietly))) ;; Internal variables + (defvar gnus-tree-buffer "*Tree*" + "Buffer where Gnus thread trees are displayed.") + + ;; Dummy variable. + (defvar gnus-use-generic-from nil) + + (defvar gnus-thread-indent-array nil) + (defvar gnus-thread-indent-array-level gnus-thread-indent-level) + + (defvar gnus-newsrc-file-version nil) + + (defvar gnus-method-history nil) + ;; Variable holding the user answers to all method prompts. + + (defvar gnus-group-history nil) + ;; Variable holding the user answers to all group prompts. + + (defvar gnus-server-alist nil + "List of available servers.") + + (defvar gnus-group-indentation-function nil) + + (defvar gnus-topic-indentation "") ;; Obsolete variable. + + (defvar gnus-goto-missing-group-function nil) + + (defvar gnus-override-subscribe-method nil) + + (defvar gnus-group-goto-next-group-function nil + "Function to override finding the next group after listing groups.") + + (defconst gnus-article-mark-lists + '((marked . tick) (replied . reply) + (expirable . expire) (killed . killed) + (bookmarks . bookmark) (dormant . dormant) + (scored . score) (saved . save) + (cached . cache) + )) + ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) (defvar gnus-newsgroup-selected-overlay nil) + (defvar gnus-inhibit-hiding nil) + (defvar gnus-group-indentation "") + (defvar gnus-inhibit-limiting nil) + (defvar gnus-created-frames nil) + (defvar gnus-article-mode-map nil) (defvar gnus-dribble-buffer nil) *************** automatically when it is selected.") *** 1256,1267 **** (defvar gnus-current-score-file nil) ! (defvar gnus-internal-global-score-files nil) ! (defvar gnus-score-file-list nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-current-move-group nil) (defvar gnus-newsgroup-dependencies nil) - (defvar gnus-newsgroup-threads nil) (defvar gnus-newsgroup-async nil) (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") --- 1621,1634 ---- (defvar gnus-current-score-file nil) ! (defvar gnus-newsgroup-adaptive-score-file nil) (defvar gnus-scores-exclude-files nil) + (defvar gnus-opened-servers nil) + (defvar gnus-current-move-group nil) + (defvar gnus-current-copy-group nil) + (defvar gnus-current-crosspost-group nil) (defvar gnus-newsgroup-dependencies nil) (defvar gnus-newsgroup-async nil) (defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") *************** automatically when it is selected.") *** 1270,1357 **** (defvar gnus-summary-display-table nil) ! (defconst gnus-group-line-format-alist ! (list (list ?M 'marked ?c) ! (list ?S 'subscribed ?c) ! (list ?L 'level ?d) ! (list ?N 'number ?s) ! (list ?I 'number-of-dormant ?d) ! (list ?T 'number-of-ticked ?d) ! (list ?R 'number-of-read ?s) ! (list ?t 'number-total ?d) ! (list ?y 'number-of-unread-unticked ?s) ! (list ?i 'number-of-ticked-and-dormant ?d) ! (list ?g 'group ?s) ! (list ?G 'qualified-group ?s) ! (list ?D 'newsgroup-description ?s) ! (list ?o 'moderated ?c) ! (list ?O 'moderated-string ?s) ! (list ?p 'process-marked ?c) ! (list ?s 'news-server ?s) ! (list ?n 'news-method ?s) ! (list ?z 'news-method-string ?s) ! (list ?u 'user-defined ?s))) ! ! (defconst gnus-summary-line-format-alist ! (list (list ?N 'number ?d) ! (list ?S 'subject ?s) ! (list ?s 'subject-or-nil ?s) ! (list ?n 'name ?s) ! (list ?A '(car (cdr (funcall gnus-extract-address-components from))) ! ?s) ! (list ?a '(or (car (funcall gnus-extract-address-components from)) ! from) ?s) ! (list ?F 'from ?s) ! (list ?x (macroexpand '(mail-header-xref header)) ?s) ! (list ?D (macroexpand '(mail-header-date header)) ?s) ! (list ?d '(gnus-dd-mmm (mail-header-date header)) ?s) ! (list ?M (macroexpand '(mail-header-id header)) ?s) ! (list ?r (macroexpand '(mail-header-references header)) ?s) ! (list ?c '(or (mail-header-chars header) 0) ?d) ! (list ?L 'lines ?d) ! (list ?I 'indentation ?s) ! (list ?T '(if (= level 0) "" (make-string (frame-width) ? )) ?s) ! (list ?R 'replied ?c) ! (list ?\[ 'opening-bracket ?c) ! (list ?\] 'closing-bracket ?c) ! (list ?\> '(make-string level ? ) ?s) ! (list ?\< '(make-string (max 0 (- 20 level)) ? ) ?s) ! (list ?i 'score ?d) ! (list ?z 'score-char ?c) ! (list ?U 'unread ?c) ! (list ?t '(gnus-summary-number-of-articles-in-thread ! (and (boundp 'thread) (car thread))) ! ?d) ! (list ?e '(gnus-summary-number-of-articles-in-thread ! (and (boundp 'thread) (car thread)) t) ! ?c) ! (list ?u 'user-defined ?s)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") ! (defconst gnus-summary-dummy-line-format-alist ! (list (list ?S 'subject ?s) ! (list ?N 'number ?d) ! (list ?u 'user-defined ?s))) ! ! (defconst gnus-summary-mode-line-format-alist ! (list (list ?G 'group-name ?s) ! (list ?g '(gnus-short-group-name group-name) ?s) ! (list ?A 'article-number ?d) ! (list ?Z 'unread-and-unselected ?s) ! (list ?V 'gnus-version ?s) ! (list ?U 'unread ?d) ! (list ?S 'subject ?s) ! (list ?e 'unselected ?d) ! (list ?u 'user-defined ?s) ! (list ?b 'buffer-name ?s) ! (list ?s '(gnus-current-score-file-nondirectory) ?s))) ! ! (defconst gnus-group-mode-line-format-alist ! (list (list ?S 'news-server ?s) ! (list ?M 'news-method ?s) ! (list ?b '(buffer-name) ?s) ! (list ?u 'user-defined ?s))) (defvar gnus-have-read-active-file nil) --- 1637,1747 ---- (defvar gnus-summary-display-table nil) + (defvar gnus-summary-display-article-function nil) ! (defvar gnus-summary-highlight-line-function nil ! "Function called after highlighting a summary line.") ! ! (defvar gnus-group-line-format-alist ! `((?M gnus-tmp-marked-mark ?c) ! (?S gnus-tmp-subscribed ?c) ! (?L gnus-tmp-level ?d) ! (?N (cond ((eq number t) "*" ) ! ((numberp number) ! (int-to-string ! (+ number ! (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ! (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) ! (t number)) ?s) ! (?R gnus-tmp-number-of-read ?s) ! (?t gnus-tmp-number-total ?d) ! (?y gnus-tmp-number-of-unread ?s) ! (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) ! (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) ! (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ! (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) ! (?g gnus-tmp-group ?s) ! (?G gnus-tmp-qualified-group ?s) ! (?c (gnus-short-group-name gnus-tmp-group) ?s) ! (?D gnus-tmp-newsgroup-description ?s) ! (?o gnus-tmp-moderated ?c) ! (?O gnus-tmp-moderated-string ?s) ! (?p gnus-tmp-process-marked ?c) ! (?s gnus-tmp-news-server ?s) ! (?n gnus-tmp-news-method ?s) ! (?P gnus-group-indentation ?s) ! (?l gnus-tmp-grouplens ?s) ! (?z gnus-tmp-news-method-string ?s) ! (?u gnus-tmp-user-defined ?s))) ! ! (defvar gnus-summary-line-format-alist ! `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) ! (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) ! (?s gnus-tmp-subject-or-nil ?s) ! (?n gnus-tmp-name ?s) ! (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) ! ?s) ! (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) ! gnus-tmp-from) ?s) ! (?F gnus-tmp-from ?s) ! (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) ! (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) ! (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) ! (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) ! (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) ! (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) ! (?L gnus-tmp-lines ?d) ! (?I gnus-tmp-indentation ?s) ! (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) ! (?R gnus-tmp-replied ?c) ! (?\[ gnus-tmp-opening-bracket ?c) ! (?\] gnus-tmp-closing-bracket ?c) ! (?\> (make-string gnus-tmp-level ? ) ?s) ! (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) ! (?i gnus-tmp-score ?d) ! (?z gnus-tmp-score-char ?c) ! (?l (bbb-grouplens-score gnus-tmp-header) ?s) ! (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) ! (?U gnus-tmp-unread ?c) ! (?t (gnus-summary-number-of-articles-in-thread ! (and (boundp 'thread) (car thread)) gnus-tmp-level) ! ?d) ! (?e (gnus-summary-number-of-articles-in-thread ! (and (boundp 'thread) (car thread)) gnus-tmp-level t) ! ?c) ! (?u gnus-tmp-user-defined ?s)) "An alist of format specifications that can appear in summary lines, and what variables they correspond with, along with the type of the variable (string, integer, character, etc).") ! (defvar gnus-summary-dummy-line-format-alist ! `((?S gnus-tmp-subject ?s) ! (?N gnus-tmp-number ?d) ! (?u gnus-tmp-user-defined ?s))) ! ! (defvar gnus-summary-mode-line-format-alist ! `((?G gnus-tmp-group-name ?s) ! (?g (gnus-short-group-name gnus-tmp-group-name) ?s) ! (?p (gnus-group-real-name gnus-tmp-group-name) ?s) ! (?A gnus-tmp-article-number ?d) ! (?Z gnus-tmp-unread-and-unselected ?s) ! (?V gnus-version ?s) ! (?U gnus-tmp-unread-and-unticked ?d) ! (?S gnus-tmp-subject ?s) ! (?e gnus-tmp-unselected ?d) ! (?u gnus-tmp-user-defined ?s) ! (?d (length gnus-newsgroup-dormant) ?d) ! (?t (length gnus-newsgroup-marked) ?d) ! (?r (length gnus-newsgroup-reads) ?d) ! (?E gnus-newsgroup-expunged-tally ?d) ! (?s (gnus-current-score-file-nondirectory) ?s))) ! ! (defvar gnus-article-mode-line-format-alist ! gnus-summary-mode-line-format-alist) ! ! (defvar gnus-group-mode-line-format-alist ! `((?S gnus-tmp-news-server ?s) ! (?M gnus-tmp-news-method ?s) ! (?u gnus-tmp-user-defined ?s) ! (?: gnus-tmp-colon ?s))) (defvar gnus-have-read-active-file nil) *************** variable (string, integer, character, et *** 1361,1372 **** "The mail address of the Gnus maintainers.") ! (defconst gnus-version "Gnus v5.1" "Version number for this version of Gnus.") (defvar gnus-info-nodes ! '((gnus-group-mode "(gnus)The Group Buffer") ! (gnus-summary-mode "(gnus)The Summary Buffer") ! (gnus-article-mode "(gnus)The Article Buffer")) ! "Assoc list of major modes and related Info nodes.") (defvar gnus-group-buffer "*Group*") --- 1751,1769 ---- "The mail address of the Gnus maintainers.") ! (defconst gnus-version-number "5.3" "Version number for this version of Gnus.") + (defconst gnus-version (format "Gnus v%s" gnus-version-number) + "Version string for this version of Gnus.") + (defvar gnus-info-nodes ! '((gnus-group-mode "(gnus)The Group Buffer") ! (gnus-summary-mode "(gnus)The Summary Buffer") ! (gnus-article-mode "(gnus)The Article Buffer") ! (gnus-server-mode "(gnus)The Server Buffer") ! (gnus-browse-mode "(gnus)Browse Foreign Server") ! (gnus-tree-mode "(gnus)Tree Display") ! ) ! "Alist of major modes and related Info nodes.") (defvar gnus-group-buffer "*Group*") *************** variable (string, integer, character, et *** 1377,1407 **** (defvar gnus-work-buffer " *gnus work*") (defvar gnus-buffer-list nil "Gnus buffers that should be killed on exit.") ! (defvar gnus-server-alist nil ! "List of available servers.") (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n ! gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist ! gnus-killed-list gnus-zombie-list) "Gnus variables saved in the quick startup file.") - (defvar gnus-overload-functions - '((news-inews gnus-inews-news "rnewspost")) - "Functions overloaded by gnus. - It is a list of `(original overload &optional file)'.") - (defvar gnus-newsrc-options nil "Options line in the .newsrc file.") (defvar gnus-newsrc-options-n nil ! "List of regexps representing groups to be subscribed/ignored unconditionally.") (defvar gnus-newsrc-last-checked-date nil "Date Gnus last asked server for new newsgroups.") (defvar gnus-newsrc-alist nil "Assoc list of read articles. --- 1774,1810 ---- (defvar gnus-work-buffer " *gnus work*") + (defvar gnus-original-article-buffer " *Original Article*") + (defvar gnus-original-article nil) + (defvar gnus-buffer-list nil "Gnus buffers that should be killed on exit.") ! (defvar gnus-slave nil ! "Whether this Gnus is a slave or not.") (defvar gnus-variable-list '(gnus-newsrc-options gnus-newsrc-options-n ! gnus-newsrc-last-checked-date gnus-newsrc-alist gnus-server-alist ! gnus-killed-list gnus-zombie-list ! gnus-topic-topology gnus-topic-alist ! gnus-format-specs) "Gnus variables saved in the quick startup file.") (defvar gnus-newsrc-options nil "Options line in the .newsrc file.") (defvar gnus-newsrc-options-n nil ! "List of regexps representing groups to be subscribed/ignored unconditionally.") (defvar gnus-newsrc-last-checked-date nil "Date Gnus last asked server for new newsgroups.") + (defvar gnus-topic-topology nil + "The complete topic hierarchy.") + + (defvar gnus-topic-alist nil + "The complete topic-group alist.") + (defvar gnus-newsrc-alist nil "Assoc list of read articles. *************** gnus-newsrc-hashtb should be kept so tha *** 1460,1463 **** --- 1863,1871 ---- (defvar gnus-newsgroup-active nil) + (defvar gnus-newsgroup-data nil) + (defvar gnus-newsgroup-data-reverse nil) + (defvar gnus-newsgroup-limit nil) + (defvar gnus-newsgroup-limits nil) + (defvar gnus-newsgroup-unreads nil "List of unread articles in the current newsgroup.") *************** gnus-newsrc-hashtb should be kept so tha *** 1469,1472 **** --- 1877,1882 ---- "Alist of read articles and article marks in the current newsgroup.") + (defvar gnus-newsgroup-expunged-tally nil) + (defvar gnus-newsgroup-marked nil "List of ticked articles in the current newsgroup (a subset of unread art).") *************** gnus-newsrc-hashtb should be kept so tha *** 1475,1478 **** --- 1885,1894 ---- "List of ranges of articles that have been through the scoring process.") + (defvar gnus-newsgroup-cached nil + "List of articles that come from the article cache.") + + (defvar gnus-newsgroup-saved nil + "List of articles that have been saved.") + (defvar gnus-newsgroup-kill-headers nil) *************** gnus-newsrc-hashtb should be kept so tha *** 1497,1505 **** (defvar gnus-newsgroup-headers nil "List of article headers in the current newsgroup.") ! (defvar gnus-newsgroup-headers-hashtb-by-number nil) (defvar gnus-newsgroup-ancient nil "List of `gnus-fetch-old-headers' articles in the current newsgroup.") (defvar gnus-current-article nil) (defvar gnus-article-current nil) --- 1913,1927 ---- (defvar gnus-newsgroup-headers nil "List of article headers in the current newsgroup.") ! ! (defvar gnus-newsgroup-threads nil) ! ! (defvar gnus-newsgroup-prepared nil ! "Whether the current group has been prepared properly.") (defvar gnus-newsgroup-ancient nil "List of `gnus-fetch-old-headers' articles in the current newsgroup.") + (defvar gnus-newsgroup-sparse nil) + (defvar gnus-current-article nil) (defvar gnus-article-current nil) *************** gnus-newsrc-hashtb should be kept so tha *** 1513,1556 **** (defvar gnus-prev-winconf nil) - ;; Format specs - (defvar gnus-summary-line-format-spec nil) - (defvar gnus-summary-dummy-line-format-spec nil) - (defvar gnus-group-line-format-spec nil) - (defvar gnus-summary-mode-line-format-spec nil) - (defvar gnus-article-mode-line-format-spec nil) - (defvar gnus-group-mode-line-format-spec nil) (defvar gnus-summary-mark-positions nil) (defvar gnus-group-mark-positions nil) - (defvar gnus-summary-expunge-below nil) (defvar gnus-reffed-article-number nil) ! ; Let the byte-compiler know that we know about this variable. (defvar rmail-default-rmail-file) (defvar gnus-cache-removable-articles nil) ! (defconst gnus-summary-local-variables ! '(gnus-newsgroup-name ! gnus-newsgroup-begin gnus-newsgroup-end ! gnus-newsgroup-last-rmail gnus-newsgroup-last-mail ! gnus-newsgroup-last-folder gnus-newsgroup-last-file ! gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked ! gnus-newsgroup-reads gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-bookmarks gnus-newsgroup-dormant ! gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers ! gnus-newsgroup-threads gnus-newsgroup-async ! gnus-score-alist gnus-current-score-file gnus-summary-expunge-below ! gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) ! gnus-cache-removable-articles) "Variables that are buffer-local to the summary buffers.") --- 1935,1979 ---- (defvar gnus-prev-winconf nil) (defvar gnus-summary-mark-positions nil) (defvar gnus-group-mark-positions nil) (defvar gnus-reffed-article-number nil) ! ;;; Let the byte-compiler know that we know about this variable. (defvar rmail-default-rmail-file) (defvar gnus-cache-removable-articles nil) ! (defvar gnus-dead-summary nil) ! ! (defconst gnus-summary-local-variables ! '(gnus-newsgroup-name ! gnus-newsgroup-begin gnus-newsgroup-end ! gnus-newsgroup-last-rmail gnus-newsgroup-last-mail ! gnus-newsgroup-last-folder gnus-newsgroup-last-file ! gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked ! gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-bookmarks gnus-newsgroup-dormant ! gnus-newsgroup-headers gnus-newsgroup-threads ! gnus-newsgroup-prepared gnus-summary-highlight-line-function gnus-current-article gnus-current-headers gnus-have-all-headers gnus-last-article gnus-article-internal-prepare-hook gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay gnus-newsgroup-scored gnus-newsgroup-kill-headers ! gnus-newsgroup-async gnus-thread-expunge-below ! gnus-score-alist gnus-current-score-file gnus-summary-expunge-below ! (gnus-summary-mark-below . global) ! gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient + gnus-newsgroup-sparse (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) ! gnus-newsgroup-adaptive-score-file ! (gnus-newsgroup-expunged-tally . 0) ! gnus-cache-removable-articles gnus-newsgroup-cached ! gnus-newsgroup-data gnus-newsgroup-data-reverse ! gnus-newsgroup-limit gnus-newsgroup-limits) "Variables that are buffer-local to the summary buffers.") *************** gnus-newsrc-hashtb should be kept so tha *** 1560,1564 **** The buffer below is a mail buffer. When you press `C-c C-c', it will ! be sent to the Gnus Bug Exterminators. At the bottom of the buffer you'll see lots of variable settings. --- 1983,1987 ---- The buffer below is a mail buffer. When you press `C-c C-c', it will ! be sent to the Gnus Bug Exterminators. At the bottom of the buffer you'll see lots of variable settings. *************** environment is, so that it will be easie *** 1567,1571 **** If you have found a bug that makes Emacs go \"beep\", set ! debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') and include the backtrace in your bug report. --- 1990,1994 ---- If you have found a bug that makes Emacs go \"beep\", set ! debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') and include the backtrace in your bug report. *************** Thank you for your help in stamping out *** 1580,1749 **** (eval-and-compile ! ;; Various ! (autoload 'metamail-buffer "metamail") ! (autoload 'Info-goto-node "info") ! (autoload 'hexl-hex-string-to-integer "hexl") ! (autoload 'pp "pp") ! (autoload 'pp-to-string "pp") ! (autoload 'pp-eval-expression "pp") ! (autoload 'mail-extract-address-components "mail-extr") ! ! (autoload 'nnmail-split-fancy "nnmail") ! (autoload 'nnvirtual-catchup-group "nnvirtual") ! ! ;; timezone ! (autoload 'timezone-make-date-arpa-standard "timezone") ! (autoload 'timezone-fix-time "timezone") ! (autoload 'timezone-make-sortable-date "timezone") ! (autoload 'timezone-make-time-string "timezone") ! ! ;; rmail & friends ! (autoload 'mail-position-on-field "sendmail") ! (autoload 'mail-setup "sendmail") ! (autoload 'rmail-output "rmailout") ! (autoload 'news-mail-other-window "rnewspost") ! (autoload 'news-reply-yank-original "rnewspost") ! (autoload 'news-caesar-buffer-body "rnewspost") ! (autoload 'rmail-insert-rmail-file-header "rmail") ! (autoload 'rmail-count-new-messages "rmail") ! (autoload 'rmail-show-message "rmail") ! ! ;; gnus-soup ! ;;(autoload 'gnus-group-brew-soup "gnus-soup" nil t) ! ;;(autoload 'gnus-brew-soup "gnus-soup" nil t) ! ;;(autoload 'gnus-soup-add-article "gnus-soup" nil t) ! ;;(autoload 'gnus-soup-send-replies "gnus-soup" nil t) ! ;;(autoload 'gnus-soup-save-areas "gnus-soup" nil t) ! ;;(autoload 'gnus-soup-pack-packet "gnus-soup" nil t) ! ;;(autoload 'nnsoup-pack-replies "nnsoup" nil t) ! ! ;; gnus-mh ! (autoload 'gnus-mail-reply-using-mhe "gnus-mh") ! (autoload 'gnus-mail-forward-using-mhe "gnus-mh") ! (autoload 'gnus-mail-other-window-using-mhe "gnus-mh") ! (autoload 'gnus-summary-save-in-folder "gnus-mh" nil t) ! (autoload 'gnus-summary-save-article-folder "gnus-mh") ! (autoload 'gnus-Folder-save-name "gnus-mh") ! (autoload 'gnus-folder-save-name "gnus-mh") ! ! ;; gnus-vis misc ! (autoload 'gnus-group-make-menu-bar "gnus-vis") ! (autoload 'gnus-summary-make-menu-bar "gnus-vis") ! (autoload 'gnus-server-make-menu-bar "gnus-vis") ! (autoload 'gnus-article-make-menu-bar "gnus-vis") ! (autoload 'gnus-browse-make-menu-bar "gnus-vis") ! (autoload 'gnus-highlight-selected-summary "gnus-vis") ! (autoload 'gnus-summary-highlight-line "gnus-vis") ! (autoload 'gnus-carpal-setup-buffer "gnus-vis") ! ! ;; gnus-vis article ! (autoload 'gnus-article-push-button "gnus-vis" nil t) ! (autoload 'gnus-article-press-button "gnus-vis" nil t) ! (autoload 'gnus-article-highlight "gnus-vis" nil t) ! (autoload 'gnus-article-highlight-some "gnus-vis" nil t) ! (autoload 'gnus-article-hide "gnus-vis" nil t) ! (autoload 'gnus-article-hide-signature "gnus-vis" nil t) ! (autoload 'gnus-article-highlight-headers "gnus-vis" nil t) ! (autoload 'gnus-article-highlight-signature "gnus-vis" nil t) ! (autoload 'gnus-article-add-buttons "gnus-vis" nil t) ! (autoload 'gnus-article-next-button "gnus-vis" nil t) ! (autoload 'gnus-article-add-button "gnus-vis") ! ! ;; gnus-cite ! (autoload 'gnus-article-highlight-citation "gnus-cite" nil t) ! (autoload 'gnus-article-hide-citation-maybe "gnus-cite" nil t) ! (autoload 'gnus-article-hide-citation "gnus-cite" nil t) ! ! ;; gnus-kill ! (autoload 'gnus-kill "gnus-kill") ! (autoload 'gnus-apply-kill-file-internal "gnus-kill") ! (autoload 'gnus-kill-file-edit-file "gnus-kill") ! (autoload 'gnus-kill-file-raise-followups-to-author "gnus-kill") ! (autoload 'gnus-execute "gnus-kill") ! (autoload 'gnus-expunge "gnus-kill") ! ! ;; gnus-cache ! (autoload 'gnus-cache-possibly-enter-article "gnus-cache") ! (autoload 'gnus-cache-save-buffers "gnus-cache") ! (autoload 'gnus-cache-possibly-remove-articles "gnus-cache") ! (autoload 'gnus-cache-request-article "gnus-cache") ! (autoload 'gnus-cache-retrieve-headers "gnus-cache") ! (autoload 'gnus-cache-possibly-alter-active "gnus-cache") ! (autoload 'gnus-jog-cache "gnus-cache" nil t) ! (autoload 'gnus-cache-enter-remove-article "gnus-cache") ! ! ;; gnus-score ! (autoload 'gnus-summary-increase-score "gnus-score" nil t) ! (autoload 'gnus-summary-lower-score "gnus-score" nil t) ! (autoload 'gnus-summary-score-map "gnus-score" nil nil 'keymap) ! (autoload 'gnus-score-save "gnus-score") ! (autoload 'gnus-score-headers "gnus-score") ! (autoload 'gnus-current-score-file-nondirectory "gnus-score") ! (autoload 'gnus-score-adaptive "gnus-score") ! (autoload 'gnus-score-remove-lines-adaptive "gnus-score") ! (autoload 'gnus-score-find-trace "gnus-score") ! ! ;; gnus-edit ! (autoload 'gnus-score-customize "gnus-edit" nil t) ! ! ;; gnus-uu ! (autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap) ! (autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap) ! (autoload 'gnus-uu-digest-mail-forward "gnus-uu" nil t) ! (autoload 'gnus-uu-digest-post-forward "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-series "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-region "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-by-regexp "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-all "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-sparse "gnus-uu" nil t) ! (autoload 'gnus-uu-mark-thread "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu-and-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar-and-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-save "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-binhex "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-save-view "gnus-uu" nil t) ! (autoload 'gnus-uu-decode-binhex-view "gnus-uu" nil t) ! ! ;; gnus-msg ! (autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap) ! (autoload 'gnus-group-post-news "gnus-msg" nil t) ! (autoload 'gnus-group-mail "gnus-msg" nil t) ! (autoload 'gnus-summary-post-news "gnus-msg" nil t) ! (autoload 'gnus-summary-followup "gnus-msg" nil t) ! (autoload 'gnus-summary-followup-with-original "gnus-msg" nil t) ! (autoload 'gnus-summary-followup-and-reply "gnus-msg" nil t) ! (autoload 'gnus-summary-followup-and-reply-with-original "gnus-msg" nil t) ! (autoload 'gnus-summary-cancel-article "gnus-msg" nil t) ! (autoload 'gnus-summary-supersede-article "gnus-msg" nil t) ! (autoload 'gnus-post-news "gnus-msg" nil t) ! (autoload 'gnus-inews-news "gnus-msg" nil t) ! (autoload 'gnus-cancel-news "gnus-msg" nil t) ! (autoload 'gnus-summary-reply "gnus-msg" nil t) ! (autoload 'gnus-summary-reply-with-original "gnus-msg" nil t) ! (autoload 'gnus-summary-mail-forward "gnus-msg" nil t) ! (autoload 'gnus-summary-mail-other-window "gnus-msg" nil t) ! (autoload 'gnus-mail-reply-using-mail "gnus-msg") ! (autoload 'gnus-mail-yank-original "gnus-msg") ! (autoload 'gnus-mail-send-and-exit "gnus-msg") ! (autoload 'gnus-mail-forward-using-mail "gnus-msg") ! (autoload 'gnus-mail-other-window-using-mail "gnus-msg") ! (autoload 'gnus-article-mail "gnus-msg") ! (autoload 'gnus-bug "gnus-msg" nil t) ! ! ;; gnus-vm ! (autoload 'gnus-summary-save-in-vm "gnus-vm" nil t) ! (autoload 'gnus-summary-save-article-vm "gnus-vm" nil t) ! (autoload 'gnus-mail-forward-using-vm "gnus-vm") ! (autoload 'gnus-mail-reply-using-vm "gnus-vm") ! (autoload 'gnus-mail-other-window-using-vm "gnus-vm" nil t) ! (autoload 'gnus-yank-article "gnus-vm" nil t) ! ! ) --- 2003,2128 ---- (eval-and-compile ! ;; This little mapcar goes through the list below and marks the ! ;; symbols in question as autoloaded functions. ! (mapcar ! (lambda (package) ! (let ((interactive (nth 1 (memq ':interactive package)))) ! (mapcar ! (lambda (function) ! (let (keymap) ! (when (consp function) ! (setq keymap (car (memq 'keymap function))) ! (setq function (car function))) ! (autoload function (car package) nil interactive keymap))) ! (if (eq (nth 1 package) ':interactive) ! (cdddr package) ! (cdr package))))) ! '(("metamail" metamail-buffer) ! ("info" Info-goto-node) ! ("hexl" hexl-hex-string-to-integer) ! ("pp" pp pp-to-string pp-eval-expression) ! ("mail-extr" mail-extract-address-components) ! ("nnmail" nnmail-split-fancy nnmail-article-group) ! ("nnvirtual" nnvirtual-catchup-group) ! ("timezone" timezone-make-date-arpa-standard timezone-fix-time ! timezone-make-sortable-date timezone-make-time-string) ! ("rmailout" rmail-output) ! ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages ! rmail-show-message) ! ("gnus-soup" :interactive t ! gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article ! gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) ! ("nnsoup" nnsoup-pack-replies) ! ("score-mode" :interactive t gnus-score-mode) ! ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder ! gnus-Folder-save-name gnus-folder-save-name) ! ("gnus-mh" :interactive t gnus-summary-save-in-folder) ! ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar ! gnus-server-make-menu-bar gnus-article-make-menu-bar ! gnus-browse-make-menu-bar gnus-highlight-selected-summary ! gnus-summary-highlight-line gnus-carpal-setup-buffer ! gnus-group-highlight-line ! gnus-article-add-button gnus-insert-next-page-button ! gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu) ! ("gnus-vis" :interactive t ! gnus-article-push-button gnus-article-press-button ! gnus-article-highlight gnus-article-highlight-some ! gnus-article-highlight-headers gnus-article-highlight-signature ! gnus-article-add-buttons gnus-article-add-buttons-to-head ! gnus-article-next-button gnus-article-prev-button) ! ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail ! gnus-demon-add-disconnection gnus-demon-add-handler ! gnus-demon-remove-handler) ! ("gnus-demon" :interactive t ! gnus-demon-init gnus-demon-cancel) ! ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree ! gnus-tree-open gnus-tree-close) ! ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close ! gnus-nocem-unwanted-article-p) ! ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info) ! ("gnus-srvr" gnus-browse-foreign-server) ! ("gnus-cite" :interactive t ! gnus-article-highlight-citation gnus-article-hide-citation-maybe ! gnus-article-hide-citation gnus-article-fill-cited-article ! gnus-article-hide-citation-in-followups) ! ("gnus-kill" gnus-kill gnus-apply-kill-file-internal ! gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author ! gnus-execute gnus-expunge) ! ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers ! gnus-cache-possibly-remove-articles gnus-cache-request-article ! gnus-cache-retrieve-headers gnus-cache-possibly-alter-active ! gnus-cache-enter-remove-article gnus-cached-article-p ! gnus-cache-open gnus-cache-close gnus-cache-update-article) ! ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article ! gnus-cache-remove-article) ! ("gnus-score" :interactive t ! gnus-summary-increase-score gnus-summary-lower-score ! gnus-score-flush-cache gnus-score-close ! gnus-score-raise-same-subject-and-select ! gnus-score-raise-same-subject gnus-score-default ! gnus-score-raise-thread gnus-score-lower-same-subject-and-select ! gnus-score-lower-same-subject gnus-score-lower-thread ! gnus-possibly-score-headers gnus-summary-raise-score ! gnus-summary-set-score gnus-summary-current-score) ! ("gnus-score" ! (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers ! gnus-current-score-file-nondirectory gnus-score-adaptive ! gnus-score-find-trace gnus-score-file-name) ! ("gnus-edit" :interactive t gnus-score-customize) ! ("gnus-topic" :interactive t gnus-topic-mode) ! ("gnus-topic" gnus-topic-remove-group) ! ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) ! ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) ! ("gnus-uu" :interactive t ! gnus-uu-digest-mail-forward gnus-uu-digest-post-forward ! gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer ! gnus-uu-mark-by-regexp gnus-uu-mark-all ! gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu ! gnus-uu-decode-uu-and-save gnus-uu-decode-unshar ! gnus-uu-decode-unshar-and-save gnus-uu-decode-save ! gnus-uu-decode-binhex gnus-uu-decode-uu-view ! gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view ! gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view ! gnus-uu-decode-binhex-view) ! ("gnus-msg" (gnus-summary-send-map keymap) ! gnus-mail-yank-original gnus-mail-send-and-exit ! gnus-article-mail gnus-new-mail gnus-mail-reply) ! ("gnus-msg" :interactive t ! gnus-group-post-news gnus-group-mail gnus-summary-post-news ! gnus-summary-followup gnus-summary-followup-with-original ! gnus-summary-cancel-article gnus-summary-supersede-article ! gnus-post-news gnus-inews-news ! gnus-summary-reply gnus-summary-reply-with-original ! gnus-summary-mail-forward gnus-summary-mail-other-window ! gnus-bug) ! ("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-grouplens-mode) ! ("smiley" :interactive t gnus-smiley-display) ! ("gnus-vm" gnus-vm-mail-setup) ! ("gnus-vm" :interactive t gnus-summary-save-in-vm ! gnus-summary-save-article-vm)))) *************** Thank you for your help in stamping out *** 1752,1783 **** ;; If you want the cursor to go somewhere else, set these two ;; functions in some startup hook to whatever you want. ! (defalias 'gnus-summary-position-cursor 'gnus-goto-colon) ! (defalias 'gnus-group-position-cursor 'gnus-goto-colon) ;;; Various macros and substs. (defmacro gnus-eval-in-buffer-window (buffer &rest forms) ! "Pop to BUFFER, evaluate FORMS, and then returns to original window." ! (` (let ((GnusStartBufferWindow (selected-window))) (unwind-protect (progn ! (pop-to-buffer (, buffer)) ! (,@ forms)) ! (select-window GnusStartBufferWindow))))) (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." ! ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable)))) ! ;;(` (abbrev-expansion (, string) (, hashtable))) ! (` (symbol-value (intern-soft (, string) (, hashtable))))) (defmacro gnus-sethash (string value hashtable) ! "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." ! ;; We cannot use define-abbrev since it only accepts string as value. ! ;; (set (intern string hashtable) value)) ! (` (set (intern (, string) (, hashtable)) (, value)))) ! (defsubst gnus-buffer-substring (beg end) ! (buffer-substring (match-beginning beg) (match-end end))) ;; modified by MORIOKA Tomohiko --- 2131,2192 ---- ;; If you want the cursor to go somewhere else, set these two ;; functions in some startup hook to whatever you want. ! (defalias 'gnus-summary-position-point 'gnus-goto-colon) ! (defalias 'gnus-group-position-point 'gnus-goto-colon) ;;; Various macros and substs. + (defun gnus-header-from (header) + (mail-header-from header)) + (defmacro gnus-eval-in-buffer-window (buffer &rest forms) ! "Pop to BUFFER, evaluate FORMS, and then return to the original window." ! (let ((tempvar (make-symbol "GnusStartBufferWindow")) ! (w (make-symbol "w")) ! (buf (make-symbol "buf"))) ! `(let* ((,tempvar (selected-window)) ! (,buf ,buffer) ! (,w (get-buffer-window ,buf 'visible))) (unwind-protect (progn ! (if ,w ! (select-window ,w) ! (pop-to-buffer ,buf)) ! ,@forms) ! (select-window ,tempvar))))) ! ! (put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) ! (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) ! (put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) (defmacro gnus-gethash (string hashtable) "Get hash value of STRING in HASHTABLE." ! `(symbol-value (intern-soft ,string ,hashtable))) (defmacro gnus-sethash (string value hashtable) ! "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." ! `(set (intern ,string ,hashtable) ,value)) ! (defmacro gnus-intern-safe (string hashtable) ! "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." ! `(let ((symbol (intern ,string ,hashtable))) ! (or (boundp symbol) ! (set symbol nil)) ! symbol)) ! ! (defmacro gnus-group-unread (group) ! "Get the currently computed number of unread articles in GROUP." ! `(car (gnus-gethash ,group gnus-newsrc-hashtb))) ! ! (defmacro gnus-group-entry (group) ! "Get the newsrc entry for GROUP." ! `(gnus-gethash ,group gnus-newsrc-hashtb)) ! ! (defmacro gnus-active (group) ! "Get active info on GROUP." ! `(gnus-gethash ,group gnus-active-hashtb)) ! ! (defmacro gnus-set-active (group active) ! "Set GROUP's active info." ! `(gnus-sethash ,group ,active gnus-active-hashtb)) ;; modified by MORIOKA Tomohiko *************** Thank you for your help in stamping out *** 1787,1792 **** (substring str 0 width)) ! ;; Added by Geoffrey T. Dairiki . A safe way ! ;; to limit the length of a string. This function is necessary since ;; `(substr "abc" 0 30)' pukes with "Args out of range". (defsubst gnus-limit-string (str width) --- 2196,2201 ---- (substring str 0 width)) ! ;; Added by Geoffrey T. Dairiki . A safe way ! ;; to limit the length of a string. This function is necessary since ;; `(substr "abc" 0 30)' pukes with "Args out of range". (defsubst gnus-limit-string (str width) *************** Thank you for your help in stamping out *** 1797,1804 **** (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." ! (let ((case-fold-search t)) ! (if (string-match "^re: *" subject) ! (substring subject (match-end 0)) ! subject))) (defsubst gnus-goto-char (point) --- 2206,2217 ---- (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." ! (if (string-match "^[Rr][Ee]: *" subject) ! (substring subject (match-end 0)) ! subject)) ! ! (defsubst gnus-functionp (form) ! "Return non-nil if FORM is funcallable." ! (or (and (symbolp form) (fboundp form)) ! (and (listp form) (eq (car form) 'lambda)))) (defsubst gnus-goto-char (point) *************** Thank you for your help in stamping out *** 1806,1819 **** (defmacro gnus-buffer-exists-p (buffer) ! (` (and (, buffer) ! (funcall (if (stringp (, buffer)) 'get-buffer 'buffer-name) ! (, buffer))))) (defmacro gnus-kill-buffer (buffer) ! (` (if (gnus-buffer-exists-p (, buffer)) ! (kill-buffer (, buffer))))) (defsubst gnus-point-at-bol () ! "Return point at the beginning of line." (let ((p (point))) (beginning-of-line) --- 2219,2234 ---- (defmacro gnus-buffer-exists-p (buffer) ! `(let ((buffer ,buffer)) ! (and buffer ! (funcall (if (stringp buffer) 'get-buffer 'buffer-name) ! buffer)))) (defmacro gnus-kill-buffer (buffer) ! `(let ((buf ,buffer)) ! (if (gnus-buffer-exists-p buf) ! (kill-buffer buf)))) (defsubst gnus-point-at-bol () ! "Return point at the beginning of the line." (let ((p (point))) (beginning-of-line) *************** Thank you for your help in stamping out *** 1823,1827 **** (defsubst gnus-point-at-eol () ! "Return point at the beginning of line." (let ((p (point))) (end-of-line) --- 2238,2242 ---- (defsubst gnus-point-at-eol () ! "Return point at the end of the line." (let ((p (point))) (end-of-line) *************** Thank you for your help in stamping out *** 1830,1837 **** (goto-char p)))) ;; Delete the current line (and the next N lines.); (defmacro gnus-delete-line (&optional n) ! (` (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line (, (or n 1))) (point))))) ;; Suggested by Brian Edmonds . --- 2245,2269 ---- (goto-char p)))) + (defun gnus-alive-p () + "Say whether Gnus is running or not." + (and gnus-group-buffer + (get-buffer gnus-group-buffer))) + + (defun gnus-delete-first (elt list) + "Delete by side effect the first occurrence of ELT as a member of LIST." + (if (equal (car list) elt) + (cdr list) + (let ((total list)) + (while (and (cdr list) + (not (equal (cadr list) elt))) + (setq list (cdr list))) + (when (cdr list) + (setcdr list (cddr list))) + total))) + ;; Delete the current line (and the next N lines.); (defmacro gnus-delete-line (&optional n) ! `(delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line ,(or n 1)) (point)))) ;; Suggested by Brian Edmonds . *************** Thank you for your help in stamping out *** 1842,1856 **** (setq gnus-init-inhibit inhibit-next) (and gnus-init-file ! (or (and (file-exists-p gnus-init-file) ;; Don't try to load a directory. (not (file-directory-p gnus-init-file))) (file-exists-p (concat gnus-init-file ".el")) (file-exists-p (concat gnus-init-file ".elc"))) ! (load gnus-init-file nil t)))) ! ! ;;; Load the user startup file. ! ;; (eval '(gnus-read-init-file 'inhibit)) ! ;;; Load the compatibility functions. (require 'gnus-cus) --- 2274,2358 ---- (setq gnus-init-inhibit inhibit-next) (and gnus-init-file ! (or (and (file-exists-p gnus-init-file) ;; Don't try to load a directory. (not (file-directory-p gnus-init-file))) (file-exists-p (concat gnus-init-file ".el")) (file-exists-p (concat gnus-init-file ".elc"))) ! (condition-case var ! (load gnus-init-file nil t) ! (error ! (error "Error in %s: %s" gnus-init-file var)))))) ! ! ;; Info access macros. ! ! (defmacro gnus-info-group (info) ! `(nth 0 ,info)) ! (defmacro gnus-info-rank (info) ! `(nth 1 ,info)) ! (defmacro gnus-info-read (info) ! `(nth 2 ,info)) ! (defmacro gnus-info-marks (info) ! `(nth 3 ,info)) ! (defmacro gnus-info-method (info) ! `(nth 4 ,info)) ! (defmacro gnus-info-params (info) ! `(nth 5 ,info)) ! ! (defmacro gnus-info-level (info) ! `(let ((rank (gnus-info-rank ,info))) ! (if (consp rank) ! (car rank) ! rank))) ! (defmacro gnus-info-score (info) ! `(let ((rank (gnus-info-rank ,info))) ! (or (and (consp rank) (cdr rank)) 0))) ! ! (defmacro gnus-info-set-group (info group) ! `(setcar ,info ,group)) ! (defmacro gnus-info-set-rank (info rank) ! `(setcar (nthcdr 1 ,info) ,rank)) ! (defmacro gnus-info-set-read (info read) ! `(setcar (nthcdr 2 ,info) ,read)) ! (defmacro gnus-info-set-marks (info marks) ! `(setcar (nthcdr 3 ,info) ,marks)) ! (defmacro gnus-info-set-method (info method) ! `(setcar (nthcdr 4 ,info) ,method)) ! (defmacro gnus-info-set-params (info params) ! `(setcar (nthcdr 5 ,info) ,params)) ! ! (defmacro gnus-info-set-level (info level) ! `(let ((rank (cdr ,info))) ! (if (consp (car rank)) ! (setcar (car rank) ,level) ! (setcar rank ,level)))) ! (defmacro gnus-info-set-score (info score) ! `(let ((rank (cdr ,info))) ! (if (consp (car rank)) ! (setcdr (car rank) ,score) ! (setcar rank (cons (car rank) ,score))))) ! ! (defmacro gnus-get-info (group) ! `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) ! ! (defun gnus-byte-code (func) ! "Return a form that can be `eval'ed based on FUNC." ! (let ((fval (symbol-function func))) ! (if (byte-code-function-p fval) ! (let ((flist (append fval nil))) ! (setcar flist 'byte-code) ! flist) ! (cons 'progn (cddr fval))))) ! ! ;; Find out whether the gnus-visual TYPE is wanted. ! (defun gnus-visual-p (&optional type class) ! (and gnus-visual ; Has to be non-nil, at least. ! (if (not type) ; We don't care about type. ! gnus-visual ! (if (listp gnus-visual) ; It's a list, so we check it. ! (or (memq type gnus-visual) ! (memq class gnus-visual)) ! t)))) ! ;;; Load the compatability functions. (require 'gnus-cus) *************** Thank you for your help in stamping out *** 1859,1862 **** --- 2361,2480 ---- ;;; + ;;; Shutdown + ;;; + + (defvar gnus-shutdown-alist nil) + + (defun gnus-add-shutdown (function &rest symbols) + "Run FUNCTION whenever one of SYMBOLS is shut down." + (push (cons function symbols) gnus-shutdown-alist)) + + (defun gnus-shutdown (symbol) + "Shut down everything that waits for SYMBOL." + (let ((alist gnus-shutdown-alist) + entry) + (while (setq entry (pop alist)) + (when (memq symbol (cdr entry)) + (funcall (car entry)))))) + + + + ;; Format specs. The chunks below are the machine-generated forms + ;; that are to be evaled as the result of the default format strings. + ;; We write them in here to get them byte-compiled. That way the + ;; default actions will be quite fast, while still retaining the full + ;; flexibility of the user-defined format specs. + + ;; First we have lots of dummy defvars to let the compiler know these + ;; are really dynamic variables. + + (defvar gnus-tmp-unread) + (defvar gnus-tmp-replied) + (defvar gnus-tmp-score-char) + (defvar gnus-tmp-indentation) + (defvar gnus-tmp-opening-bracket) + (defvar gnus-tmp-lines) + (defvar gnus-tmp-name) + (defvar gnus-tmp-closing-bracket) + (defvar gnus-tmp-subject-or-nil) + (defvar gnus-tmp-subject) + (defvar gnus-tmp-marked) + (defvar gnus-tmp-marked-mark) + (defvar gnus-tmp-subscribed) + (defvar gnus-tmp-process-marked) + (defvar gnus-tmp-number-of-unread) + (defvar gnus-tmp-group-name) + (defvar gnus-tmp-group) + (defvar gnus-tmp-article-number) + (defvar gnus-tmp-unread-and-unselected) + (defvar gnus-tmp-news-method) + (defvar gnus-tmp-news-server) + (defvar gnus-tmp-article-number) + (defvar gnus-mouse-face) + (defvar gnus-mouse-face-prop) + + (defun gnus-summary-line-format-spec () + (insert gnus-tmp-unread gnus-tmp-replied + gnus-tmp-score-char gnus-tmp-indentation) + (gnus-put-text-property + (point) + (progn + (insert + gnus-tmp-opening-bracket + (format "%4d: %-20s" + gnus-tmp-lines + (if (> (length gnus-tmp-name) 20) + (substring gnus-tmp-name 0 20) + gnus-tmp-name)) + gnus-tmp-closing-bracket) + (point)) + gnus-mouse-face-prop gnus-mouse-face) + (insert " " gnus-tmp-subject-or-nil "\n")) + + (defvar gnus-summary-line-format-spec + (gnus-byte-code 'gnus-summary-line-format-spec)) + + (defun gnus-summary-dummy-line-format-spec () + (insert "* ") + (gnus-put-text-property + (point) + (progn + (insert ": :") + (point)) + gnus-mouse-face-prop gnus-mouse-face) + (insert " " gnus-tmp-subject "\n")) + + (defvar gnus-summary-dummy-line-format-spec + (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) + + (defun gnus-group-line-format-spec () + (insert gnus-tmp-marked-mark gnus-tmp-subscribed + gnus-tmp-process-marked + gnus-group-indentation + (format "%5s: " gnus-tmp-number-of-unread)) + (gnus-put-text-property + (point) + (progn + (insert gnus-tmp-group "\n") + (1- (point))) + gnus-mouse-face-prop gnus-mouse-face)) + (defvar gnus-group-line-format-spec + (gnus-byte-code 'gnus-group-line-format-spec)) + + (defvar gnus-format-specs + `((version . ,emacs-version) + (group ,gnus-group-line-format ,gnus-group-line-format-spec) + (summary-dummy ,gnus-summary-dummy-line-format + ,gnus-summary-dummy-line-format-spec) + (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec))) + + (defvar gnus-article-mode-line-format-spec nil) + (defvar gnus-summary-mode-line-format-spec nil) + (defvar gnus-group-mode-line-format-spec nil) + + ;;; Phew. All that gruft is over, fortunately. + + + ;;; ;;; Gnus Utility Functions ;;; *************** Thank you for your help in stamping out *** 1871,1878 **** ;; Then we check whether the "name
" format is used. (and address ! ;; Fix by MORIOKA Tomohiko ! ;; Linear white space is not required. ! (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) ! (and (setq name (substring from 0 (match-beginning 0))) ;; Strip any quotes from the name. (string-match "\".*\"" name) --- 2489,2496 ---- ;; Then we check whether the "name
" format is used. (and address ! ;; Fix by MORIOKA Tomohiko ! ;; Linear white space is not required. ! (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) ! (and (setq name (substring from 0 (match-beginning 0))) ;; Strip any quotes from the name. (string-match "\".*\"" name) *************** Thank you for your help in stamping out *** 1881,1885 **** (or name (and (string-match "(.+)" from) ! (setq name (substring from (1+ (match-beginning 0)) (1- (match-end 0))))) (and (string-match "()" from) --- 2499,2503 ---- (or name (and (string-match "(.+)" from) ! (setq name (substring from (1+ (match-beginning 0)) (1- (match-end 0))))) (and (string-match "()" from) *************** Thank you for your help in stamping out *** 1888,1892 **** ;; XOVER might not support folded From headers. (and (string-match "(.*" from) ! (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ;; Fix by Hallvard B Furuseth . --- 2506,2510 ---- ;; XOVER might not support folded From headers. (and (string-match "(.*" from) ! (setq name (substring from (1+ (match-beginning 0)) (match-end 0))))) ;; Fix by Hallvard B Furuseth . *************** Thank you for your help in stamping out *** 1897,1903 **** (save-excursion (save-restriction ! (let ((case-fold-search t)) ! (gnus-narrow-to-headers) ! (mail-fetch-field field))))) (defun gnus-goto-colon () --- 2515,2522 ---- (save-excursion (save-restriction ! (let ((case-fold-search t) ! (inhibit-point-motion-hooks t)) ! (nnheader-narrow-to-headers) ! (message-fetch-field field))))) (defun gnus-goto-colon () *************** Thank you for your help in stamping out *** 1905,1968 **** (search-forward ":" (gnus-point-at-eol) t)) ! (defun gnus-narrow-to-headers () ! (widen) ! (save-excursion ! (narrow-to-region ! (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (1- (point)) ! (point-max))))) ! (defvar gnus-old-specs nil) ! (defun gnus-update-format-specifications () (gnus-make-thread-indent-array) ! (let ((formats '(summary summary-dummy group ! summary-mode group-mode article-mode)) ! old-format new-format) ! (while formats ! (setq new-format (symbol-value ! (intern (format "gnus-%s-line-format" (car formats))))) ! (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs))) ! (equal old-format new-format)) ! (set (intern (format "gnus-%s-line-format-spec" (car formats))) ! (gnus-parse-format ! new-format ! (symbol-value ! (intern (format "gnus-%s-line-format-alist" ! (if (eq (car formats) 'article-mode) ! 'summary-mode (car formats)))))))) ! (setq gnus-old-specs (cons (cons (car formats) new-format) ! (delq (car formats) gnus-old-specs))) ! (setq formats (cdr formats)))) ! ! (gnus-update-group-mark-positions) ! (gnus-update-summary-mark-positions) ! (if (and (string-match "%D" gnus-group-line-format) ! (not gnus-description-hashtb) ! gnus-read-active-file) ! (gnus-read-all-descriptions-files))) (defun gnus-update-summary-mark-positions () (save-excursion (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) (thread nil) pos) ! (gnus-set-work-buffer) ! (gnus-summary-insert-line ! nil [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) ! (goto-char (point-min)) ! (setq pos (list (cons 'unread (and (search-forward "\200" nil t) ! (- (point) 2))))) ! (goto-char (point-min)) ! (setq pos (cons (cons 'replied (and (search-forward "\201" nil t) ! (- (point) 2))) pos)) ! (goto-char (point-min)) ! (setq pos (cons (cons 'score (and (search-forward "\202" nil t) ! (- (point) 2))) pos)) (setq gnus-summary-mark-positions pos)))) --- 2524,2648 ---- (search-forward ":" (gnus-point-at-eol) t)) ! ;;;###autoload ! (defun gnus-update-format (var) ! "Update the format specification near point." ! (interactive ! (list ! (save-excursion ! (eval-defun nil) ! ;; Find the end of the current word. ! (re-search-forward "[ \t\n]" nil t) ! ;; Search backward. ! (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) ! (match-string 1))))) ! (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) ! (match-string 1 var)))) ! (entry (assq type gnus-format-specs)) ! value spec) ! (when entry ! (setq gnus-format-specs (delq entry gnus-format-specs))) ! (set ! (intern (format "%s-spec" var)) ! (gnus-parse-format (setq value (symbol-value (intern var))) ! (symbol-value (intern (format "%s-alist" var))) ! (not (string-match "mode" var)))) ! (setq spec (symbol-value (intern (format "%s-spec" var)))) ! (push (list type value spec) gnus-format-specs) ! (pop-to-buffer "*Gnus Format*") ! (erase-buffer) ! (lisp-interaction-mode) ! (insert (pp-to-string spec)))) ! (defun gnus-update-format-specifications (&optional force) ! "Update all (necessary) format specifications." ! ;; Make the indentation array. (gnus-make-thread-indent-array) ! ;; See whether all the stored info needs to be flushed. ! (when (or force ! (not (equal emacs-version ! (cdr (assq 'version gnus-format-specs))))) ! (setq gnus-format-specs nil)) ! ! ;; Go through all the formats and see whether they need updating. ! (let ((types '(summary summary-dummy group ! summary-mode group-mode article-mode)) ! new-format entry type val) ! (while (setq type (pop types)) ! ;; Jump to the proper buffer to find out the value of ! ;; the variable, if possible. (It may be buffer-local.) ! (save-excursion ! (let ((buffer (intern (format "gnus-%s-buffer" type))) ! val) ! (when (and (boundp buffer) ! (setq val (symbol-value buffer)) ! (get-buffer val) ! (buffer-name (get-buffer val))) ! (set-buffer (get-buffer val))) ! (setq new-format (symbol-value ! (intern (format "gnus-%s-line-format" type)))))) ! (setq entry (cdr (assq type gnus-format-specs))) ! (if (and entry ! (equal (car entry) new-format)) ! ;; Use the old format. ! (set (intern (format "gnus-%s-line-format-spec" type)) ! (cadr entry)) ! ;; This is a new format. ! (setq val ! (if (not (stringp new-format)) ! ;; This is a function call or something. ! new-format ! ;; This is a "real" format. ! (gnus-parse-format ! new-format ! (symbol-value ! (intern (format "gnus-%s-line-format-alist" ! (if (eq type 'article-mode) ! 'summary-mode type)))) ! (not (string-match "mode$" (symbol-name type)))))) ! ;; Enter the new format spec into the list. ! (if entry ! (progn ! (setcar (cdr entry) val) ! (setcar entry new-format)) ! (push (list type new-format val) gnus-format-specs)) ! (set (intern (format "gnus-%s-line-format-spec" type)) val)))) ! ! (unless (assq 'version gnus-format-specs) ! (push (cons 'version emacs-version) gnus-format-specs)) ! (gnus-update-group-mark-positions) ! (gnus-update-summary-mark-positions)) (defun gnus-update-summary-mark-positions () + "Compute where the summary marks are to go." (save-excursion + (when (and gnus-summary-buffer + (get-buffer gnus-summary-buffer) + (buffer-name (get-buffer gnus-summary-buffer))) + (set-buffer gnus-summary-buffer)) (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) (gnus-score-over-mark 130) (thread nil) + (gnus-visual nil) + (spec gnus-summary-line-format-spec) pos) ! (save-excursion ! (gnus-set-work-buffer) ! (let ((gnus-summary-line-format-spec spec)) ! (gnus-summary-insert-line ! [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) ! (goto-char (point-min)) ! (setq pos (list (cons 'unread (and (search-forward "\200" nil t) ! (- (point) 2))))) ! (goto-char (point-min)) ! (push (cons 'replied (and (search-forward "\201" nil t) ! (- (point) 2))) ! pos) ! (goto-char (point-min)) ! (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) ! pos))) (setq gnus-summary-mark-positions pos)))) *************** Thank you for your help in stamping out *** 1970,1977 **** (save-excursion (let ((gnus-process-mark 128) ! (gnus-group-marked '("dummy.group"))) ! (gnus-sethash "dummy.group" '(0 . 0) gnus-active-hashtb) (gnus-set-work-buffer) ! (gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil) (goto-char (point-min)) (setq gnus-group-mark-positions --- 2650,2658 ---- (save-excursion (let ((gnus-process-mark 128) ! (gnus-group-marked '("dummy.group")) ! (gnus-active-hashtb (make-vector 10 0))) ! (gnus-set-active "dummy.group" '(0 . 0)) (gnus-set-work-buffer) ! (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) (goto-char (point-min)) (setq gnus-group-mark-positions *************** Thank you for your help in stamping out *** 1979,2067 **** (- (point) 2)))))))) ! (defun gnus-mouse-face-function (form) ! (` (let ((string (, form))) ! (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string) ! string))) (defun gnus-max-width-function (el max-width) (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) ! (` (let* ((val (eval (, el))) ! (valstr (if (numberp val) ! (int-to-string val) val))) ! (if (> (length valstr) (, max-width)) ! (substring valstr 0 (, max-width)) ! valstr)))) ! (defun gnus-parse-format (format spec-alist) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. ! (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format) ! (if (and gnus-visual gnus-mouse-face) ! (let ((pre (substring format (match-beginning 1) (match-end 1))) ! (button (substring format (match-beginning 2) (match-end 2))) ! (post (substring format (match-beginning 3) (match-end 3)))) ! (list 'concat ! (gnus-parse-simple-format pre spec-alist) ! (gnus-mouse-face-function ! (gnus-parse-simple-format button spec-alist)) ! (gnus-parse-simple-format post spec-alist))) ! (gnus-parse-simple-format ! (concat (substring format (match-beginning 1) (match-end 1)) ! (substring format (match-beginning 2) (match-end 2)) ! (substring format (match-beginning 3) (match-end 3))) ! spec-alist)) ! (gnus-parse-simple-format format spec-alist))) ! (defun gnus-parse-simple-format (format spec-alist) ;; This function parses the FORMAT string with the help of the ! ;; SPEC-ALIST and returns a list that can be eval'ed to return the ! ;; string. The list will consist of the symbol `format', a format ! ;; specification string, and a list of forms depending on the ! ;; SPEC-ALIST. (let ((max-width 0) ! spec flist fstring newspec elem beg) (save-excursion (gnus-set-work-buffer) (insert format) (goto-char (point-min)) ! (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" nil t) ! (setq spec (string-to-char (buffer-substring (match-beginning 2) ! (match-end 2)))) ! ;; First check if there are any specs that look anything like ! ;; "%12,12A", ie. with a "max width specification". These have ! ;; to be treated specially. ! (if (setq beg (match-beginning 1)) ! (setq max-width ! (string-to-int ! (buffer-substring (1+ (match-beginning 1)) (match-end 1)))) ! (setq max-width 0) ! (setq beg (match-beginning 2))) ! ;; Find the specification from `spec-alist'. ! (if (not (setq elem (cdr (assq spec spec-alist)))) (setq elem '("*" ?s))) ! ;; Treat user defined format specifiers specially ! (and (eq (car elem) 'user-defined) ! (setq elem ! (list ! (list (intern (concat "gnus-user-format-function-" ! (buffer-substring ! (match-beginning 3) ! (match-end 3)))) ! 'header) ! ?s)) ! (delete-region (match-beginning 3) (match-end 3))) ! (if (not (zerop max-width)) ! (let ((el (car elem))) ! (cond ((= (car (cdr elem)) ?c) ! (setq el (list 'char-to-string el))) ! ((= (car (cdr elem)) ?d) ! (numberp el) (setq el (list 'int-to-string el)))) ! (setq flist (cons (gnus-max-width-function el max-width) ! flist)) ! (setq newspec ?s)) ! (setq flist (cons (car elem) flist)) ! (setq newspec (car (cdr elem)))) ;; Remove the old specification (and possibly a ",12" string). (delete-region beg (match-end 2)) --- 2660,2795 ---- (- (point) 2)))))))) ! (defvar gnus-mouse-face-0 'highlight) ! (defvar gnus-mouse-face-1 'highlight) ! (defvar gnus-mouse-face-2 'highlight) ! (defvar gnus-mouse-face-3 'highlight) ! (defvar gnus-mouse-face-4 'highlight) ! ! (defun gnus-mouse-face-function (form type) ! `(gnus-put-text-property ! (point) (progn ,@form (point)) ! gnus-mouse-face-prop ! ,(if (equal type 0) ! 'gnus-mouse-face ! `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) ! ! (defvar gnus-face-0 'bold) ! (defvar gnus-face-1 'italic) ! (defvar gnus-face-2 'bold-italic) ! (defvar gnus-face-3 'bold) ! (defvar gnus-face-4 'bold) ! ! (defun gnus-face-face-function (form type) ! `(gnus-put-text-property ! (point) (progn ,@form (point)) ! 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) (defun gnus-max-width-function (el max-width) (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width))) ! (if (symbolp el) ! `(if (> (length ,el) ,max-width) ! (substring ,el 0 ,max-width) ! ,el) ! `(let ((val (eval ,el))) ! (if (numberp val) ! (setq val (int-to-string val))) ! (if (> (length val) ,max-width) ! (substring val 0 ,max-width) ! val)))) ! (defun gnus-parse-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the ;; SPEC-ALIST and returns a list that can be eval'ed to return the ;; string. If the FORMAT string contains the specifiers %( and %) ;; the text between them will have the mouse-face text property. ! (if (string-match ! "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" ! format) ! (gnus-parse-complex-format format spec-alist) ! ;; This is a simple format. ! (gnus-parse-simple-format format spec-alist insert))) ! ! (defun gnus-parse-complex-format (format spec-alist) ! (save-excursion ! (gnus-set-work-buffer) ! (insert format) ! (goto-char (point-min)) ! (while (re-search-forward "\"" nil t) ! (replace-match "\\\"" nil t)) ! (goto-char (point-min)) ! (insert "(\"") ! (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) ! (let ((number (if (match-beginning 1) ! (match-string 1) "0")) ! (delim (aref (match-string 2) 0))) ! (if (or (= delim ?\() (= delim ?\{)) ! (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") ! " " number " \"")) ! (replace-match "\")\"")))) ! (goto-char (point-max)) ! (insert "\")") ! (goto-char (point-min)) ! (let ((form (read (current-buffer)))) ! (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) ! (defun gnus-complex-form-to-spec (form spec-alist) ! (delq nil ! (mapcar ! (lambda (sform) ! (if (stringp sform) ! (gnus-parse-simple-format sform spec-alist t) ! (funcall (intern (format "gnus-%s-face-function" (car sform))) ! (gnus-complex-form-to-spec (cddr sform) spec-alist) ! (nth 1 sform)))) ! form))) ! ! (defun gnus-parse-simple-format (format spec-alist &optional insert) ;; This function parses the FORMAT string with the help of the ! ;; SPEC-ALIST and returns a list that can be eval'ed to return a ! ;; string. (let ((max-width 0) ! spec flist fstring newspec elem beg result dontinsert) (save-excursion (gnus-set-work-buffer) (insert format) (goto-char (point-min)) ! (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?" ! nil t) ! (if (= (setq spec (string-to-char (match-string 2))) ?%) ! (setq newspec "%" ! beg (1+ (match-beginning 0))) ! ;; First check if there are any specs that look anything like ! ;; "%12,12A", ie. with a "max width specification". These have ! ;; to be treated specially. ! (if (setq beg (match-beginning 1)) ! (setq max-width ! (string-to-int ! (buffer-substring ! (1+ (match-beginning 1)) (match-end 1)))) ! (setq max-width 0) ! (setq beg (match-beginning 2))) ! ;; Find the specification from `spec-alist'. ! (unless (setq elem (cdr (assq spec spec-alist))) (setq elem '("*" ?s))) ! ;; Treat user defined format specifiers specially. ! (when (eq (car elem) 'gnus-tmp-user-defined) ! (setq elem ! (list ! (list (intern (concat "gnus-user-format-function-" ! (match-string 3))) ! 'gnus-tmp-header) ?s)) ! (delete-region (match-beginning 3) (match-end 3))) ! (if (not (zerop max-width)) ! (let ((el (car elem))) ! (cond ((= (cadr elem) ?c) ! (setq el (list 'char-to-string el))) ! ((= (cadr elem) ?d) ! (setq el (list 'int-to-string el)))) ! (setq flist (cons (gnus-max-width-function el max-width) ! flist)) ! (setq newspec ?s)) ! (progn ! (setq flist (cons (car elem) flist)) ! (setq newspec (cadr elem))))) ;; Remove the old specification (and possibly a ",12" string). (delete-region beg (match-end 2)) *************** Thank you for your help in stamping out *** 2070,2074 **** (insert newspec)) (setq fstring (buffer-substring 1 (point-max)))) ! (cons 'format (cons fstring (nreverse flist))))) (defun gnus-set-work-buffer () --- 2798,2866 ---- (insert newspec)) (setq fstring (buffer-substring 1 (point-max)))) ! ;; Do some postprocessing to increase efficiency. ! (setq ! result ! (cond ! ;; Emptyness. ! ((string= fstring "") ! nil) ! ;; Not a format string. ! ((not (string-match "%" fstring)) ! (list fstring)) ! ;; A format string with just a single string spec. ! ((string= fstring "%s") ! (list (car flist))) ! ;; A single character. ! ((string= fstring "%c") ! (list (car flist))) ! ;; A single number. ! ((string= fstring "%d") ! (setq dontinsert) ! (if insert ! (list `(princ ,(car flist))) ! (list `(int-to-string ,(car flist))))) ! ;; Just lots of chars and strings. ! ((string-match "\\`\\(%[cs]\\)+\\'" fstring) ! (nreverse flist)) ! ;; A single string spec at the beginning of the spec. ! ((string-match "\\`%[sc][^%]+\\'" fstring) ! (list (car flist) (substring fstring 2))) ! ;; A single string spec in the middle of the spec. ! ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) ! (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) ! ;; A single string spec in the end of the spec. ! ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) ! (list (match-string 1 fstring) (car flist))) ! ;; A more complex spec. ! (t ! (list (cons 'format (cons fstring (nreverse flist))))))) ! ! (if insert ! (when result ! (if dontinsert ! result ! (cons 'insert result))) ! (cond ((stringp result) ! result) ! ((consp result) ! (cons 'concat result)) ! (t ""))))) ! ! (defun gnus-eval-format (format &optional alist props) ! "Eval the format variable FORMAT, using ALIST. ! If PROPS, insert the result." ! (let ((form (gnus-parse-format format alist props))) ! (if props ! (gnus-add-text-properties (point) (progn (eval form) (point)) props) ! (eval form)))) ! ! (defun gnus-remove-text-with-property (prop) ! "Delete all text in the current buffer with text property PROP." ! (save-excursion ! (goto-char (point-min)) ! (while (not (eobp)) ! (while (get-text-property (point) prop) ! (delete-char 1)) ! (goto-char (next-single-property-change (point) prop nil (point-max)))))) (defun gnus-set-work-buffer () *************** Otherwise, it is like ~/News/news/group/ *** 2094,2098 **** (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! (or gnus-article-save-directory "~/News")))) (if (and last-file (string-equal (file-name-directory default) --- 2886,2890 ---- (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! gnus-article-save-directory))) (if (and last-file (string-equal (file-name-directory default) *************** Otherwise, it is like ~/News/news/group/ *** 2105,2109 **** "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ! ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name --- 2897,2901 ---- "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. If variable `gnus-use-long-file-name' is non-nil, it is ! ~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." (let ((default (expand-file-name *************** If variable `gnus-use-long-file-name' is *** 2112,2116 **** (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! (or gnus-article-save-directory "~/News")))) (if (and last-file (string-equal (file-name-directory default) --- 2904,2908 ---- (gnus-newsgroup-directory-form newsgroup)) "/" (int-to-string (mail-header-number headers))) ! gnus-article-save-directory))) (if (and last-file (string-equal (file-name-directory default) *************** If variable `gnus-use-long-file-name' is *** 2129,2133 **** (gnus-capitalize-newsgroup newsgroup) (concat (gnus-newsgroup-directory-form newsgroup) "/news")) ! (or gnus-article-save-directory "~/News")))) (defun gnus-plain-save-name (newsgroup headers &optional last-file) --- 2921,2925 ---- (gnus-capitalize-newsgroup newsgroup) (concat (gnus-newsgroup-directory-form newsgroup) "/news")) ! gnus-article-save-directory))) (defun gnus-plain-save-name (newsgroup headers &optional last-file) *************** If variable `gnus-use-long-file-name' is *** 2140,2144 **** newsgroup (concat (gnus-newsgroup-directory-form newsgroup) "/news")) ! (or gnus-article-save-directory "~/News")))) ;; For subscribing new newsgroup --- 2932,2936 ---- newsgroup (concat (gnus-newsgroup-directory-form newsgroup) "/news")) ! gnus-article-save-directory))) ;; For subscribing new newsgroup *************** If variable `gnus-use-long-file-name' is *** 2156,2172 **** (if (and (string-match "[^\\.]\\." (car groups) start) (cdr groups) ! (setq prefix (concat "^" (substring (car groups) 0 (match-end 0)))) ! (string-match prefix (car (cdr groups)))) (progn (setq prefixes (cons prefix prefixes)) ! (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix)))) ! (setq ans (read-char)) (cond ((= ans ?n) ! (while (and groups ! (string-match prefix (setq group (car groups)))) ! (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) --- 2948,2967 ---- (if (and (string-match "[^\\.]\\." (car groups) start) (cdr groups) ! (setq prefix (concat "^" (substring (car groups) 0 (match-end 0)))) ! (string-match prefix (cadr groups))) (progn (setq prefixes (cons prefix prefixes)) ! (message "Descend hierarchy %s? ([y]nsq): " (substring prefix 1 (1- (length prefix)))) ! (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q))) ! (ding) ! (message "Descend hierarchy %s? ([y]nsq): " ! (substring prefix 1 (1- (length prefix))))) (cond ((= ans ?n) ! (while (and groups ! (string-match prefix (setq group (car groups)))) ! (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb) *************** If variable `gnus-use-long-file-name' is *** 2174,2179 **** (setq starts (cdr starts))) ((= ans ?s) ! (while (and groups ! (string-match prefix (setq group (car groups)))) (gnus-sethash group group gnus-killed-hashtb) --- 2969,2974 ---- (setq starts (cdr starts))) ((= ans ?s) ! (while (and groups ! (string-match prefix (setq group (car groups)))) (gnus-sethash group group gnus-killed-hashtb) *************** If variable `gnus-use-long-file-name' is *** 2189,2193 **** (t nil))) (message "Subscribe %s? ([n]yq)" (car groups)) ! (setq ans (read-char)) (setq group (car groups)) (cond ((= ans ?y) --- 2984,2990 ---- (t nil))) (message "Subscribe %s? ([n]yq)" (car groups)) ! (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n))) ! (ding) ! (message "Subscribe %s? ([n]yq)" (car groups))) (setq group (car groups)) (cond ((= ans ?y) *************** If variable `gnus-use-long-file-name' is *** 2200,2204 **** (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) ! (t (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb))) --- 2997,3001 ---- (gnus-sethash group group gnus-killed-hashtb) (setq groups (cdr groups)))) ! (t (setq gnus-killed-list (cons group gnus-killed-list)) (gnus-sethash group group gnus-killed-hashtb))) *************** If variable `gnus-use-long-file-name' is *** 2211,2220 **** (defun gnus-subscribe-alphabetically (newgroup) "Subscribe new NEWSGROUP and insert it in alphabetical order." - ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) (let ((groups (cdr gnus-newsrc-alist)) before) (while (and (not before) groups) ! (if (string< newgroup (car (car groups))) ! (setq before (car (car groups))) (setq groups (cdr groups)))) (gnus-subscribe-newsgroup newgroup before))) --- 3008,3016 ---- (defun gnus-subscribe-alphabetically (newgroup) "Subscribe new NEWSGROUP and insert it in alphabetical order." (let ((groups (cdr gnus-newsrc-alist)) before) (while (and (not before) groups) ! (if (string< newgroup (caar groups)) ! (setq before (caar groups)) (setq groups (cdr groups)))) (gnus-subscribe-newsgroup newgroup before))) *************** If variable `gnus-use-long-file-name' is *** 2233,2238 **** (while (and (re-search-forward groupkey-re nil t) (progn ! (setq before (buffer-substring ! (match-beginning 1) (match-end 1))) (string< before newgroup))))) ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) --- 3029,3033 ---- (while (and (re-search-forward groupkey-re nil t) (progn ! (setq before (match-string 1)) (string< before newgroup))))) ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) *************** If variable `gnus-use-long-file-name' is *** 2240,2263 **** (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) (substring groupkey (match-beginning 1) (match-end 1))))) ! (gnus-subscribe-newsgroup newgroup before)))) ! (defun gnus-subscribe-interactively (newsgroup) ! "Subscribe new NEWSGROUP interactively. ! It is inserted in hierarchical newsgroup order if subscribed. If not, it is killed." ! (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup)) ! (gnus-subscribe-hierarchically newsgroup) ! (setq gnus-killed-list (cons newsgroup gnus-killed-list)))) ! ! (defun gnus-subscribe-zombies (newsgroup) ! "Make new NEWSGROUP a zombie group." ! (setq gnus-zombie-list (cons newsgroup gnus-zombie-list))) (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. ! If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. ! (gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) --- 3035,3063 ---- (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) (substring groupkey (match-beginning 1) (match-end 1))))) ! (gnus-subscribe-newsgroup newgroup before)) ! (kill-buffer (current-buffer)))) ! (defun gnus-subscribe-interactively (group) ! "Subscribe the new GROUP interactively. ! It is inserted in hierarchical newsgroup order if subscribed. If not, it is killed." ! (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) ! (gnus-subscribe-hierarchically group) ! (push group gnus-killed-list))) ! ! (defun gnus-subscribe-zombies (group) ! "Make the new GROUP into a zombie group." ! (push group gnus-zombie-list)) ! ! (defun gnus-subscribe-killed (group) ! "Make the new GROUP a killed group." ! (push group gnus-killed-list)) (defun gnus-subscribe-newsgroup (newsgroup &optional next) "Subscribe new NEWSGROUP. ! If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made the first newsgroup." ;; We subscribe the group by changing its level to `subscribed'. ! (gnus-group-change-level newsgroup gnus-level-default-subscribed gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb)) *************** the first newsgroup." *** 2272,2276 **** idx) ;; If this is a foreign group, we don't want to translate the ! ;; entire name. (if (setq idx (string-match ":" newsgroup)) (aset newsgroup idx ?/) --- 3072,3076 ---- idx) ;; If this is a foreign group, we don't want to translate the ! ;; entire name. (if (setq idx (string-match ":" newsgroup)) (aset newsgroup idx ?/) *************** the first newsgroup." *** 2286,2294 **** ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) ;; with dots. ! (gnus-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ! ;; Why don't we use `(make-directory dir 'parents)'? That's just one ;; of the many mysteries of the universe. (let* ((dir (expand-file-name dir default-directory)) --- 3086,3094 ---- ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) ;; with dots. ! (nnheader-replace-chars-in-string group ?/ ?.)) (defun gnus-make-directory (dir) "Make DIRECTORY recursively." ! ;; Why don't we use `(make-directory dir 'parents)'? That's just one ;; of the many mysteries of the universe. (let* ((dir (expand-file-name dir default-directory)) *************** the first newsgroup." *** 2307,2311 **** (error (setq err t))) (setq dirs (cdr dirs))) ! ;; We return whether we were successful or not. (not dirs))) --- 3107,3111 ---- (error (setq err t))) (setq dirs (cdr dirs))) ! ;; We return whether we were successful or not. (not dirs))) *************** the first newsgroup." *** 2316,2332 **** (substring newsgroup 1)))) ! ;; Var (defun gnus-simplify-subject (subject &optional re-only) "Remove `Re:' and words in parentheses. ! If optional argument RE-ONLY is non-nil, strip `Re:' only." (let ((case-fold-search t)) ;Ignore case. ! ;; Remove `Re:' and `Re^N:'. ! (if (string-match "^re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) ;; Remove words in parentheses from end. ! (or re-only ! (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) ! (setq subject (substring subject 0 (match-beginning 0))))) ;; Return subject string. subject)) --- 3116,3137 ---- (substring newsgroup 1)))) ! ;; Various... things. (defun gnus-simplify-subject (subject &optional re-only) "Remove `Re:' and words in parentheses. ! If RE-ONLY is non-nil, strip leading `Re:'s only." (let ((case-fold-search t)) ;Ignore case. ! ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. ! (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) ! (setq subject (substring subject (match-end 0)))) ! ;; Remove uninteresting prefixes. ! (if (and (not re-only) ! gnus-simplify-ignored-prefixes ! (string-match gnus-simplify-ignored-prefixes subject)) (setq subject (substring subject (match-end 0)))) ;; Remove words in parentheses from end. ! (unless re-only ! (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) ! (setq subject (substring subject 0 (match-beginning 0))))) ;; Return subject string. subject)) *************** If optional argument RE-ONLY is non-nil, *** 2334,2368 **** ;; Remove any leading "re:"s, any trailing paren phrases, and simplify ;; all whitespace. ! (defun gnus-simplify-subject-fuzzy (subject) (let ((case-fold-search t)) ! (save-excursion ! (gnus-set-work-buffer) (insert subject) (inline (gnus-simplify-buffer-fuzzy)) (buffer-string)))) ! (defun gnus-simplify-buffer-fuzzy () ! (goto-char (point-min)) ! ;; Fix by Stainless Steel Rat . ! (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*" ! nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (while (re-search-forward "[ \t\n]*([^()]*)[ \t\n]*$" nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (while (re-search-forward "[ \t]+" nil t) ! (replace-match " " t t)) ! (goto-char (point-min)) ! (while (re-search-forward "[ \t]+$" nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (while (re-search-forward "^[ \t]+" nil t) ! (replace-match "" t t)) ! (if gnus-simplify-subject-fuzzy-regexp ! (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) ! (replace-match "" t t)))) ! ! ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (or (memq (current-buffer) gnus-buffer-list) --- 3139,3199 ---- ;; Remove any leading "re:"s, any trailing paren phrases, and simplify ;; all whitespace. ! ;; Written by Stainless Steel Rat . ! (defun gnus-simplify-buffer-fuzzy () (let ((case-fold-search t)) ! (goto-char (point-min)) ! (while (search-forward "\t" nil t) ! (replace-match " " t t)) ! (goto-char (point-min)) ! (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t) ! (goto-char (match-beginning 0)) ! (while (or ! (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") ! (looking-at "^[[].*: .*[]]$")) ! (goto-char (point-min)) ! (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" ! nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (while (re-search-forward "^[[].*: .*[]]$" nil t) ! (goto-char (match-end 0)) ! (delete-char -1) ! (delete-region ! (progn (goto-char (match-beginning 0))) ! (re-search-forward ":")))) ! (goto-char (point-min)) ! (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (while (re-search-forward " +" nil t) ! (replace-match " " t t)) ! (goto-char (point-min)) ! (while (re-search-forward " $" nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (while (re-search-forward "^ +" nil t) ! (replace-match "" t t)) ! (goto-char (point-min)) ! (when gnus-simplify-subject-fuzzy-regexp ! (if (listp gnus-simplify-subject-fuzzy-regexp) ! (let ((list gnus-simplify-subject-fuzzy-regexp)) ! (while list ! (goto-char (point-min)) ! (while (re-search-forward (car list) nil t) ! (replace-match "" t t)) ! (setq list (cdr list)))) ! (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t) ! (replace-match "" t t)))))) ! ! (defun gnus-simplify-subject-fuzzy (subject) ! "Siplify a subject string fuzzily." ! (save-excursion ! (gnus-set-work-buffer) ! (let ((case-fold-search t)) (insert subject) (inline (gnus-simplify-buffer-fuzzy)) (buffer-string)))) ! ;; Add the current buffer to the list of buffers to be killed on exit. (defun gnus-add-current-to-buffer-list () (or (memq (current-buffer) gnus-buffer-list) *************** If optional argument RE-ONLY is non-nil, *** 2373,2408 **** (string= s1 s2)))) ! ;; Functions accessing headers. ! ;; Functions are more convenient than macros in some cases. ! ! (defun gnus-header-number (header) ! (mail-header-number header)) ! ! (defun gnus-header-subject (header) ! (mail-header-subject header)) ! ! (defun gnus-header-from (header) ! (mail-header-from header)) ! ! (defun gnus-header-xref (header) ! (mail-header-xref header)) ! ! (defun gnus-header-lines (header) ! (mail-header-lines header)) ! ! (defun gnus-header-date (header) ! (mail-header-date header)) ! ! (defun gnus-header-id (header) ! (mail-header-id header)) ! ! (defun gnus-header-message-id (header) ! (mail-header-id header)) ! ! (defun gnus-header-chars (header) ! (mail-header-chars header)) ! ! (defun gnus-header-references (header) ! (mail-header-references header)) ;;; General various misc type functions. --- 3204,3210 ---- (string= s1 s2)))) ! (defun gnus-read-active-file-p () ! "Say whether the active file has been read from `gnus-select-method'." ! (memq gnus-select-method gnus-have-read-active-file)) ;;; General various misc type functions. *************** If optional argument RE-ONLY is non-nil, *** 2426,2476 **** gnus-moderated-list nil gnus-description-hashtb nil gnus-newsgroup-headers nil - gnus-newsgroup-headers-hashtb-by-number nil gnus-newsgroup-name nil gnus-server-alist nil gnus-current-select-method nil) ! ;; Reset any score variables. ! (and (boundp 'gnus-score-cache) ! (set 'gnus-score-cache nil)) ! (and (boundp 'gnus-internal-global-score-files) ! (set 'gnus-internal-global-score-files nil)) ;; Kill the startup file. (and gnus-current-startup-file (get-file-buffer gnus-current-startup-file) (kill-buffer (get-file-buffer gnus-current-startup-file))) - ;; Save any cache buffers. - (and gnus-use-cache (gnus-cache-save-buffers)) ;; Clear the dribble buffer. (gnus-dribble-clear) ;; Kill global KILL file buffer. ! (if (get-file-buffer (gnus-newsgroup-kill-file nil)) ! (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. (while gnus-buffer-list ! (gnus-kill-buffer (car gnus-buffer-list)) ! (setq gnus-buffer-list (cdr gnus-buffer-list)))) (defun gnus-windows-old-to-new (setting) ;; First we take care of the really, really old Gnus 3 actions. ! (if (symbolp setting) ! (setq setting ! (cond ((memq setting '(SelectArticle)) ! 'article) ! ((memq setting '(SelectSubject ExpandSubject)) ! 'summary) ! ((memq setting '(SelectNewsgroup ExitNewsgroup)) ! 'group) ! (t setting)))) (if (or (listp setting) (not (and gnus-window-configuration (memq setting '(group summary article))))) setting ! (let* ((setting (if (eq setting 'group) (if (assq 'newsgroup gnus-window-configuration) 'newsgroup 'newsgroups) setting)) ! (elem (car (cdr (assq setting gnus-window-configuration)))) (total (apply '+ elem)) (types '(group summary article)) --- 3228,3289 ---- gnus-moderated-list nil gnus-description-hashtb nil + gnus-current-headers nil + gnus-thread-indent-array nil gnus-newsgroup-headers nil gnus-newsgroup-name nil gnus-server-alist nil + gnus-group-list-mode nil + gnus-opened-servers nil + gnus-group-mark-positions nil + gnus-newsgroup-data nil + gnus-newsgroup-unreads nil + nnoo-state-alist nil gnus-current-select-method nil) ! (gnus-shutdown 'gnus) ;; Kill the startup file. (and gnus-current-startup-file (get-file-buffer gnus-current-startup-file) (kill-buffer (get-file-buffer gnus-current-startup-file))) ;; Clear the dribble buffer. (gnus-dribble-clear) ;; Kill global KILL file buffer. ! (when (get-file-buffer (gnus-newsgroup-kill-file nil)) ! (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) (gnus-kill-buffer nntp-server-buffer) ;; Kill Gnus buffers. (while gnus-buffer-list ! (gnus-kill-buffer (pop gnus-buffer-list))) ! ;; Remove Gnus frames. ! (gnus-kill-gnus-frames)) ! ! (defun gnus-kill-gnus-frames () ! "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 ! ;; against errors if we try do delete the single frame that's left. ! (condition-case () ! (delete-frame (car gnus-created-frames)) ! (error nil))) ! (pop gnus-created-frames))) (defun gnus-windows-old-to-new (setting) ;; First we take care of the really, really old Gnus 3 actions. ! (when (symbolp setting) ! (setq setting ! ;; Take care of ooold GNUS 3.x values. ! (cond ((eq setting 'SelectArticle) 'article) ! ((memq setting '(SelectSubject ExpandSubject)) 'summary) ! ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group) ! (t setting)))) (if (or (listp setting) (not (and gnus-window-configuration (memq setting '(group summary article))))) setting ! (let* ((setting (if (eq setting 'group) (if (assq 'newsgroup gnus-window-configuration) 'newsgroup 'newsgroups) setting)) ! (elem (cadr (assq setting gnus-window-configuration))) (total (apply '+ elem)) (types '(group summary article)) *************** If optional argument RE-ONLY is non-nil, *** 2483,2631 **** (zerop (nth i elem)) (progn ! (setq perc (/ (* 1.0 (nth 0 elem)) total)) (setq out (cons (if (eq pbuf (nth i types)) ! (vector (nth i types) perc 'point) ! (vector (nth i types) perc)) out)))) (setq i (1+ i))) ! (list (nreverse out))))) ! (defun gnus-add-configuration (conf) ! (setq gnus-buffer-configuration (cons conf (delq (assq (car conf) gnus-buffer-configuration) gnus-buffer-configuration)))) (defun gnus-configure-windows (setting &optional force) (setq setting (gnus-windows-old-to-new setting)) ! (let ((r (if (symbolp setting) ! (cdr (assq setting gnus-buffer-configuration)) ! setting)) ! (in-buf (current-buffer)) ! rule val w height hor ohor heights sub jump-buffer ! rel total to-buf all-visible) ! (or r (error "No such setting: %s" setting)) ! (if (and (not force) (setq all-visible (gnus-all-windows-visible-p r))) ;; All the windows mentioned are already visible, so we just ;; put point in the assigned buffer, and do not touch the ! ;; winconf. ! (select-window (get-buffer-window all-visible t)) ! ;; Either remove all windows or just remove all Gnus windows. ! (if gnus-use-full-window ! (delete-other-windows) ! (gnus-remove-some-windows) ! (switch-to-buffer nntp-server-buffer)) ! ! (while r ! (setq hor (car r) ! ohor nil) ! ! ;; We have to do the (possible) horizontal splitting before the ! ;; vertical. ! (if (and (listp (car hor)) ! (eq (car (car hor)) 'horizontal)) ! (progn ! (split-window ! nil ! (if (integerp (nth 1 (car hor))) ! (nth 1 (car hor)) ! (- (frame-width) (floor (* (frame-width) (nth 1 (car hor)))))) ! t) ! (setq hor (cdr hor)))) ! ! ;; Go through the rules and eval the elements that are to be ! ;; evalled. ! (while hor ! (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor)))) ! (progn ! ;; Expand short buffer name. ! (setq w (aref val 0)) ! (and (setq w (cdr (assq w gnus-window-to-buffer))) ! (progn ! (setq val (apply 'vector (mapcar 'identity val))) ! (aset val 0 w))) ! (setq ohor (cons val ohor)))) ! (setq hor (cdr hor))) ! (setq rule (cons (nreverse ohor) rule)) ! (setq r (cdr r))) ! (setq rule (nreverse rule)) ! ! ;; We tally the window sizes. ! (setq total (window-height)) ! (while rule ! (setq hor (car rule)) ! (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal)) ! (setq hor (cdr hor))) ! (setq sub 0) ! (while hor ! (setq rel (aref (car hor) 1) ! heights (cons ! (cond ((and (floatp rel) (= 1.0 rel)) ! 'x) ! ((integerp rel) ! rel) ! (t ! (max (floor (* total rel)) 4))) ! heights) ! sub (+ sub (if (numberp (car heights)) (car heights) 0)) ! hor (cdr hor))) ! (setq heights (nreverse heights) ! hor (car rule)) ! ! ;; We then go through these heights and create windows for them. ! (while heights ! (setq height (car heights) ! heights (cdr heights)) ! (and (eq height 'x) ! (setq height (- total sub))) ! (and heights ! (split-window nil height)) ! (setq to-buf (aref (car hor) 0)) ! (switch-to-buffer ! (cond ((not to-buf) ! in-buf) ! ((symbolp to-buf) ! (symbol-value (aref (car hor) 0))) ! (t ! (aref (car hor) 0)))) ! (and (> (length (car hor)) 2) ! (eq (aref (car hor) 2) 'point) ! (setq jump-buffer (current-buffer))) ! (other-window 1) ! (setq hor (cdr hor))) ! ! (setq rule (cdr rule))) ! ! ;; Finally, we pop to the buffer that's supposed to have point. ! (or jump-buffer (error "Missing `point' in spec for %s" setting)) ! ! (select-window (get-buffer-window jump-buffer t)) ! (set-buffer jump-buffer)))) ! ! (defun gnus-all-windows-visible-p (rule) ! (let (invisible hor jump-buffer val buffer) ! ;; Go through the rules and eval the elements that are to be ! ;; evalled. ! (while (and rule (not invisible)) ! (setq hor (car rule) ! rule (cdr rule)) ! (while (and hor (not invisible)) ! (if (setq val (if (vectorp (car hor)) ! (car hor) ! (if (not (eq (car (car hor)) 'horizontal)) ! (eval (car hor))))) ! (progn ! ;; Expand short buffer name. ! (setq buffer (or (cdr (assq (aref val 0) gnus-window-to-buffer)) ! (aref val 0))) ! (setq buffer (if (symbolp buffer) (symbol-value buffer) ! buffer)) ! (and (> (length val) 2) (eq 'point (aref val 2)) ! (setq jump-buffer buffer)) ! (setq invisible (not (and buffer (get-buffer-window buffer)))))) ! (setq hor (cdr hor)))) ! (and (not invisible) jump-buffer))) (defun gnus-window-top-edge (&optional window) --- 3296,3535 ---- (zerop (nth i elem)) (progn ! (setq perc (if (= i 2) ! 1.0 ! (/ (float (nth 0 elem)) total))) (setq out (cons (if (eq pbuf (nth i types)) ! (list (nth i types) perc 'point) ! (list (nth i types) perc)) out)))) (setq i (1+ i))) ! `(vertical 1.0 ,@(nreverse out))))) ! ! ;;;###autoload (defun gnus-add-configuration (conf) ! "Add the window configuration CONF to `gnus-buffer-configuration'." ! (setq gnus-buffer-configuration (cons conf (delq (assq (car conf) gnus-buffer-configuration) gnus-buffer-configuration)))) + (defvar gnus-frame-list nil) + + (defun gnus-configure-frame (split &optional window) + "Split WINDOW according to SPLIT." + (unless window + (setq window (get-buffer-window (current-buffer)))) + (select-window window) + ;; This might be an old-stylee buffer config. + (when (vectorp split) + (setq split (append split nil))) + (when (or (consp (car split)) + (vectorp (car split))) + (push 1.0 split) + (push 'vertical split)) + ;; The SPLIT might be something that is to be evaled to + ;; return a new SPLIT. + (while (and (not (assq (car split) gnus-window-to-buffer)) + (gnus-functionp (car split))) + (setq split (eval split))) + (let* ((type (car split)) + (subs (cddr split)) + (len (if (eq type 'horizontal) (window-width) (window-height))) + (total 0) + (window-min-width (or gnus-window-min-width window-min-width)) + (window-min-height (or gnus-window-min-height window-min-height)) + s result new-win rest comp-subs size sub) + (cond + ;; Nothing to do here. + ((null split)) + ;; Don't switch buffers. + ((null type) + (and (memq 'point split) window)) + ;; This is a buffer to be selected. + ((not (memq type '(frame horizontal vertical))) + (let ((buffer (cond ((stringp type) type) + (t (cdr (assq type gnus-window-to-buffer))))) + buf) + (unless buffer + (error "Illegal buffer type: %s" type)) + (unless (setq buf (get-buffer (if (symbolp buffer) + (symbol-value buffer) buffer))) + (setq buf (get-buffer-create (if (symbolp buffer) + (symbol-value buffer) buffer)))) + (switch-to-buffer buf) + ;; We return the window if it has the `point' spec. + (and (memq 'point split) window))) + ;; This is a frame split. + ((eq type 'frame) + (unless gnus-frame-list + (setq gnus-frame-list (list (window-frame + (get-buffer-window (current-buffer)))))) + (let ((i 0) + params frame fresult) + (while (< i (length subs)) + ;; Frame parameter is gotten from the sub-split. + (setq params (cadr (elt subs i))) + ;; It should be a list. + (unless (listp params) + (setq params nil)) + ;; Create a new frame? + (unless (setq frame (elt gnus-frame-list i)) + (nconc gnus-frame-list (list (setq frame (make-frame params)))) + (push frame gnus-created-frames)) + ;; Is the old frame still alive? + (unless (frame-live-p frame) + (setcar (nthcdr i gnus-frame-list) + (setq frame (make-frame params)))) + ;; Select the frame in question and do more splits there. + (select-frame frame) + (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) + (incf i)) + ;; Select the frame that has the selected buffer. + (when fresult + (select-frame (window-frame fresult))))) + ;; This is a normal split. + (t + (when (> (length subs) 0) + ;; First we have to compute the sizes of all new windows. + (while subs + (setq sub (append (pop subs) nil)) + (while (and (not (assq (car sub) gnus-window-to-buffer)) + (gnus-functionp (car sub))) + (setq sub (eval sub))) + (when sub + (push sub comp-subs) + (setq size (cadar comp-subs)) + (cond ((equal size 1.0) + (setq rest (car comp-subs)) + (setq s 0)) + ((floatp size) + (setq s (floor (* size len)))) + ((integerp size) + (setq s size)) + (t + (error "Illegal size: %s" size))) + ;; Try to make sure that we are inside the safe limits. + (cond ((zerop s)) + ((eq type 'horizontal) + (setq s (max s window-min-width))) + ((eq type 'vertical) + (setq s (max s window-min-height)))) + (setcar (cdar comp-subs) s) + (incf total s))) + ;; Take care of the "1.0" spec. + (if rest + (setcar (cdr rest) (- len total)) + (error "No 1.0 specs in %s" split)) + ;; The we do the actual splitting in a nice recursive + ;; fashion. + (setq comp-subs (nreverse comp-subs)) + (while comp-subs + (if (null (cdr comp-subs)) + (setq new-win window) + (setq new-win + (split-window window (cadar comp-subs) + (eq type 'horizontal)))) + (setq result (or (gnus-configure-frame + (car comp-subs) window) result)) + (select-window new-win) + (setq window new-win) + (setq comp-subs (cdr comp-subs)))) + ;; Return the proper window, if any. + (when result + (select-window result)))))) + + (defvar gnus-frame-split-p nil) + (defun gnus-configure-windows (setting &optional force) (setq setting (gnus-windows-old-to-new setting)) ! (let ((split (if (symbolp setting) ! (cadr (assq setting gnus-buffer-configuration)) ! setting)) ! all-visible) ! ! (setq gnus-frame-split-p nil) ! (unless split ! (error "No such setting: %s" setting)) ! ! (if (and (setq all-visible (gnus-all-windows-visible-p split)) ! (not force)) ;; All the windows mentioned are already visible, so we just ;; put point in the assigned buffer, and do not touch the ! ;; winconf. ! (select-window all-visible) ;; Either remove all windows or just remove all Gnus windows. ! (let ((frame (selected-frame))) ! (unwind-protect ! (if gnus-use-full-window ! ;; 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. ! (delete-other-windows) ! ;; This is a `frame' split, so we delete all windows ! ;; on all frames. ! (mapcar ! (lambda (frame) ! (unless (eq (cdr (assq 'minibuffer ! (frame-parameters frame))) ! 'only) ! (select-frame frame) ! (delete-other-windows))) ! (frame-list))) ! ;; Just remove some windows. ! (gnus-remove-some-windows) ! (switch-to-buffer nntp-server-buffer)) ! (select-frame frame))) ! ! (switch-to-buffer nntp-server-buffer) ! (gnus-configure-frame split (get-buffer-window (current-buffer)))))) ! ! (defun gnus-all-windows-visible-p (split) ! "Say whether all buffers in SPLIT are currently visible. ! In particular, the value returned will be the window that ! should have point." ! (let ((stack (list split)) ! (all-visible t) ! type buffer win buf) ! (while (and (setq split (pop stack)) ! all-visible) ! ;; Be backwards compatible. ! (when (vectorp split) ! (setq split (append split nil))) ! (when (or (consp (car split)) ! (vectorp (car split))) ! (push 1.0 split) ! (push 'vertical split)) ! ;; The SPLIT might be something that is to be evaled to ! ;; return a new SPLIT. ! (while (and (not (assq (car split) gnus-window-to-buffer)) ! (gnus-functionp (car split))) ! (setq split (eval split))) ! ! (setq type (elt split 0)) ! (cond ! ;; Nothing here. ! ((null split) t) ! ;; A buffer. ! ((not (memq type '(horizontal vertical frame))) ! (setq buffer (cond ((stringp type) type) ! (t (cdr (assq type gnus-window-to-buffer))))) ! (unless buffer ! (error "Illegal buffer type: %s" type)) ! (when (setq buf (get-buffer (if (symbolp buffer) ! (symbol-value buffer) ! buffer))) ! (setq win (get-buffer-window buf t))) ! (if win ! (when (memq 'point split) ! (setq all-visible win)) ! (setq all-visible nil))) ! (t ! (when (eq type 'frame) ! (setq gnus-frame-split-p t)) ! (setq stack (append (cddr split) stack))))) ! (unless (eq all-visible t) ! all-visible))) (defun gnus-window-top-edge (&optional window) *************** If optional argument RE-ONLY is non-nil, *** 2638,2645 **** ;; Remove windows on all known Gnus buffers. (while buffers ! (setq buf (cdr (car buffers))) (if (symbolp buf) (setq buf (and (boundp buf) (symbol-value buf)))) ! (and buf (get-buffer-window buf) (progn --- 3542,3549 ---- ;; Remove windows on all known Gnus buffers. (while buffers ! (setq buf (cdar buffers)) (if (symbolp buf) (setq buf (and (boundp buf) (symbol-value buf)))) ! (and buf (get-buffer-window buf) (progn *************** If optional argument RE-ONLY is non-nil, *** 2653,2670 **** (setq buffers (cdr buffers))) ;; Remove windows on *all* summary buffers. ! (let (wins) ! (walk-windows ! (lambda (win) ! (let ((buf (window-buffer win))) ! (if (string-match "^\\*Summary" (buffer-name buf)) ! (progn ! (setq bufs (cons buf bufs)) ! (pop-to-buffer buf) ! (if (or (not lowest) ! (< (gnus-window-top-edge) lowest)) ! (progn ! (setq lowest-buf buf) ! (setq lowest (gnus-window-top-edge)))))))))) ! (and lowest-buf (progn (pop-to-buffer lowest-buf) --- 3557,3573 ---- (setq buffers (cdr buffers))) ;; Remove windows on *all* summary buffers. ! (walk-windows ! (lambda (win) ! (let ((buf (window-buffer win))) ! (if (string-match "^\\*Summary" (buffer-name buf)) ! (progn ! (setq bufs (cons buf bufs)) ! (pop-to-buffer buf) ! (if (or (not lowest) ! (< (gnus-window-top-edge) lowest)) ! (progn ! (setq lowest-buf buf) ! (setq lowest (gnus-window-top-edge))))))))) ! (and lowest-buf (progn (pop-to-buffer lowest-buf) *************** If optional argument RE-ONLY is non-nil, *** 2674,2695 **** (delete-windows-on (car bufs))) (setq bufs (cdr bufs)))))) ! ! (defun gnus-version () ! "Version numbers of this version of Gnus." ! (interactive) (let ((methods gnus-valid-select-methods) (mess gnus-version) meth) ;; Go through all the legal select methods and add their version ! ;; numbers to the total version string. Only the backends that are ;; currently in use will have their message numbers taken into ! ;; consideration. (while methods ! (setq meth (intern (concat (car (car methods)) "-version"))) (and (boundp meth) (stringp (symbol-value meth)) (setq mess (concat mess "; " (symbol-value meth)))) (setq methods (cdr methods))) ! (gnus-message 2 mess))) (defun gnus-info-find-node () --- 3577,3601 ---- (delete-windows-on (car bufs))) (setq bufs (cdr bufs)))))) ! ! (defun gnus-version (&optional arg) ! "Version number of this version of Gnus. ! If ARG, insert string at point." ! (interactive "P") (let ((methods gnus-valid-select-methods) (mess gnus-version) meth) ;; Go through all the legal select methods and add their version ! ;; numbers to the total version string. Only the backends that are ;; currently in use will have their message numbers taken into ! ;; consideration. (while methods ! (setq meth (intern (concat (caar methods) "-version"))) (and (boundp meth) (stringp (symbol-value meth)) (setq mess (concat mess "; " (symbol-value meth)))) (setq methods (cdr methods))) ! (if arg ! (insert (message mess)) ! (message mess)))) (defun gnus-info-find-node () *************** If optional argument RE-ONLY is non-nil, *** 2697,2734 **** (interactive) ;; Enlarge info window if needed. ! (let ((mode major-mode)) ! (gnus-configure-windows 'info) ! (Info-goto-node (car (cdr (assq mode gnus-info-nodes)))))) ! ! (defun gnus-overload-functions (&optional overloads) ! "Overload functions specified by optional argument OVERLOADS. ! If nothing is specified, use the variable gnus-overload-functions." ! (let ((defs nil) ! (overloads (or overloads gnus-overload-functions))) ! (while overloads ! (setq defs (car overloads)) ! (setq overloads (cdr overloads)) ! ;; Load file before overloading function if necessary. Make ! ;; sure we cannot use `require' always. ! (and (not (fboundp (car defs))) ! (car (cdr (cdr defs))) ! (load (car (cdr (cdr defs))) nil 'nomessage)) ! (fset (car defs) (car (cdr defs)))))) ! ! (defun gnus-replace-chars-in-string (string &rest pairs) ! "Replace characters in STRING from FROM to TO." ! (let ((string (substring string 0)) ;Copy string. ! (len (length string)) ! (idx 0) ! sym to) ! (or (zerop (% (length pairs) 2)) ! (error "Odd number of translation pairs")) ! (setplist 'sym pairs) ! ;; Replace all occurrences of FROM with TO. ! (while (< idx len) ! (if (setq to (get 'sym (aref string idx))) ! (aset string idx to)) ! (setq idx (1+ idx))) ! string)) (defun gnus-days-between (date1 date2) --- 3603,3611 ---- (interactive) ;; Enlarge info window if needed. ! (let ((mode major-mode) ! gnus-info-buffer) ! (Info-goto-node (cadr (assq mode gnus-info-nodes))) ! (setq gnus-info-buffer (current-buffer)) ! (gnus-configure-windows 'info))) (defun gnus-days-between (date1 date2) *************** If nothing is specified, use the variabl *** 2739,2763 **** (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date)))) ! (timezone-absolute-from-gregorian (nth 1 dat) (nth 2 dat) (car dat)))) ! ;; Returns a floating point number that says how many seconds have ! ;; lapsed between Jan 1 12:00:00 1970 and DATE. ! (defun gnus-seconds-since-epoch (date) ! (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) ! (timezone-parse-date date))) ! (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) ! (timezone-parse-time ! (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 ! (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) ! (timezone-absolute-from-gregorian ! (nth 1 edate) (nth 2 edate) (nth 0 edate))))) ! (+ (nth 2 ttime) ! (* (nth 1 ttime) 60) ! (* 1.0 (nth 0 ttime) 60 60) ! (* 1.0 tday 60 60 24)))) (defun gnus-file-newer-than (file date) --- 3616,3635 ---- (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) (timezone-parse-date date)))) ! (timezone-absolute-from-gregorian (nth 1 dat) (nth 2 dat) (car dat)))) ! (defun gnus-encode-date (date) ! "Convert DATE to internal time." ! (let* ((parse (timezone-parse-date date)) ! (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) ! (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) ! (encode-time (caddr time) (cadr time) (car time) ! (caddr date) (cadr date) (car date) (nth 4 date)))) ! ! (defun gnus-time-minus (t1 t2) ! "Subtract two internal times." ! (let ((borrow (< (cadr t1) (cadr t2)))) ! (list (- (car t1) (car t2) (if borrow 1 0)) ! (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) (defun gnus-file-newer-than (file date) *************** If nothing is specified, use the variabl *** 2767,2783 **** (> (nth 1 fdate) (nth 1 date)))))) (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. ! If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) ! ;; Two silly functions to ensure that all `y-or-n-p' questions clear ! ;; the echo area. ! (defun gnus-y-or-n-p (prompt) ! (prog1 ! (y-or-n-p prompt) ! (message ""))) (defun gnus-yes-or-no-p (prompt) --- 3639,3759 ---- (> (nth 1 fdate) (nth 1 date)))))) + (defmacro gnus-local-set-keys (&rest plist) + "Set the keys in PLIST in the current keymap." + `(gnus-define-keys-1 (current-local-map) ',plist)) + + (defmacro gnus-define-keys (keymap &rest plist) + "Define all keys in PLIST in KEYMAP." + `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) + + (put 'gnus-define-keys 'lisp-indent-function 1) + (put 'gnus-define-keys 'lisp-indent-hook 1) + (put 'gnus-define-keymap 'lisp-indent-function 1) + (put 'gnus-define-keymap 'lisp-indent-hook 1) + + (defmacro gnus-define-keymap (keymap &rest plist) + "Define all keys in PLIST in KEYMAP." + `(gnus-define-keys-1 ,keymap (quote ,plist))) + + (defun gnus-define-keys-1 (keymap plist) + (when (null keymap) + (error "Can't set keys in a null keymap")) + (cond ((symbolp keymap) + (setq keymap (symbol-value keymap))) + ((keymapp keymap)) + ((listp keymap) + (set (car keymap) nil) + (define-prefix-command (car keymap)) + (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) + (setq keymap (symbol-value (car keymap))))) + (let (key) + (while plist + (when (symbolp (setq key (pop plist))) + (setq key (symbol-value key))) + (define-key keymap key (pop plist))))) + (defun gnus-group-read-only-p (&optional group) "Check whether GROUP supports editing or not. ! If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note that that variable is buffer-local to the summary buffers." (let ((group (or group gnus-newsgroup-name))) (not (gnus-check-backend-function 'request-replace-article group)))) ! (defun gnus-group-total-expirable-p (group) ! "Check whether GROUP is total-expirable or not." ! (let ((params (gnus-info-params (gnus-get-info group)))) ! (or (memq 'total-expire params) ! (cdr (assq 'total-expire params)) ; (total-expire . t) ! (and gnus-total-expirable-newsgroups ; Check var. ! (string-match gnus-total-expirable-newsgroups group))))) ! ! (defun gnus-group-auto-expirable-p (group) ! "Check whether GROUP is total-expirable or not." ! (let ((params (gnus-info-params (gnus-get-info group)))) ! (or (memq 'auto-expire params) ! (cdr (assq 'auto-expire params)) ; (auto-expire . t) ! (and gnus-auto-expirable-newsgroups ; Check var. ! (string-match gnus-auto-expirable-newsgroups group))))) ! ! (defun gnus-virtual-group-p (group) ! "Say whether GROUP is virtual or not." ! (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) ! gnus-valid-select-methods))) ! ! (defun gnus-news-group-p (group &optional article) ! "Return non-nil if GROUP (and ARTICLE) come from a news server." ! (or (gnus-member-of-valid 'post group) ; Ordinary news group. ! (and (gnus-member-of-valid 'post-mail group) ; Combined group. ! (eq (gnus-request-type group article) 'news)))) ! ! (defsubst gnus-simplify-subject-fully (subject) ! "Simplify a subject string according to the user's wishes." ! (cond ! ((null gnus-summary-gather-subject-limit) ! (gnus-simplify-subject-re subject)) ! ((eq gnus-summary-gather-subject-limit 'fuzzy) ! (gnus-simplify-subject-fuzzy subject)) ! ((numberp gnus-summary-gather-subject-limit) ! (gnus-limit-string (gnus-simplify-subject-re subject) ! gnus-summary-gather-subject-limit)) ! (t ! subject))) ! ! (defsubst gnus-subject-equal (s1 s2 &optional simple-first) ! "Check whether two subjects are equal. If optional argument ! simple-first is t, first argument is already simplified." ! (cond ! ((null simple-first) ! (equal (gnus-simplify-subject-fully s1) ! (gnus-simplify-subject-fully s2))) ! (t ! (equal s1 ! (gnus-simplify-subject-fully s2))))) ! ! ;; Returns a list of writable groups. ! (defun gnus-writable-groups () ! (let ((alist gnus-newsrc-alist) ! groups group) ! (while (setq group (car (pop alist))) ! (unless (gnus-group-read-only-p group) ! (push group groups))) ! (nreverse groups))) ! ! (defun gnus-completing-read (default prompt &rest args) ! ;; Like `completing-read', except that DEFAULT is the default argument. ! (let* ((prompt (if default ! (concat prompt " (default " default ") ") ! (concat prompt " "))) ! (answer (apply 'completing-read prompt args))) ! (if (or (null answer) (zerop (length answer))) ! default ! answer))) ! ! ;; Two silly functions to ensure that all `y-or-n-p' questions clear ! ;; the echo area. ! (defun gnus-y-or-n-p (prompt) ! (prog1 ! (y-or-n-p prompt) ! (message ""))) (defun gnus-yes-or-no-p (prompt) *************** that that variable is buffer-local to th *** 2793,2797 **** (or (not (listp gnus-use-long-file-name)) ;; If it is a list, and the list contains `symbol', we ! ;; return nil. (not (memq symbol gnus-use-long-file-name))))) --- 3769,3773 ---- (or (not (listp gnus-use-long-file-name)) ;; If it is a list, and the list contains `symbol', we ! ;; return nil. (not (memq symbol gnus-use-long-file-name))))) *************** that that variable is buffer-local to th *** 2800,2811 **** (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string" ! (let ((datevec (timezone-parse-date messy-date))) ! (format "%2s-%s" ! (or (aref datevec 2) "??") ! (capitalize ! (or (car ! (nth (1- (string-to-number (aref datevec 1))) ! timezone-months-assoc)) ! "???"))))) ;; Make a hash table (default and minimum size is 255). --- 3776,3803 ---- (defun gnus-dd-mmm (messy-date) "Return a string like DD-MMM from a big messy string" ! (let ((datevec (condition-case () (timezone-parse-date messy-date) ! (error nil)))) ! (if (not datevec) ! "??-???" ! (format "%2s-%s" ! (condition-case () ! ;; Make sure leading zeroes are stripped. ! (number-to-string (string-to-number (aref datevec 2))) ! (error "??")) ! (capitalize ! (or (car ! (nth (1- (string-to-number (aref datevec 1))) ! timezone-months-assoc)) ! "???")))))) ! ! (defun gnus-mode-string-quote (string) ! "Quote all \"%\" in STRING." ! (save-excursion ! (gnus-set-work-buffer) ! (insert string) ! (goto-char (point-min)) ! (while (search-forward "%" nil t) ! (insert "%")) ! (buffer-string))) ;; Make a hash table (default and minimum size is 255). *************** that that variable is buffer-local to th *** 2822,2827 **** (1- i))) ! ;; Show message if message has a lower level than `gnus-verbose'. ! ;; Guide-line for numbers: ;; 1 - error messages, 3 - non-serious error messages, 5 - messages ;; for things that take a long time, 7 - not very important messages --- 3814,3819 ---- (1- i))) ! ;; Show message if message has a lower level than `gnus-verbose'. ! ;; Guideline for numbers: ;; 1 - error messages, 3 - non-serious error messages, 5 - messages ;; for things that take a long time, 7 - not very important messages *************** that that variable is buffer-local to th *** 2835,2838 **** --- 3827,3841 ---- (apply 'format args))) + (defun gnus-error (level &rest args) + "Beep an error if LEVEL is equal to or less than `gnus-verbose'." + (when (<= (floor level) gnus-verbose) + (apply 'message args) + (ding) + (let (duration) + (when (and (floatp level) + (not (zerop (setq duration (* 10 (- level (floor level))))))) + (sit-for duration)))) + nil) + ;; Generate a unique new group name. (defun gnus-generate-new-group-name (leaf) *************** that that variable is buffer-local to th *** 2843,2863 **** name)) (defun gnus-ephemeral-group-p (group) "Say whether GROUP is ephemeral or not." ! (assoc 'quit-config (gnus-find-method-for-group group))) (defun gnus-group-quit-config (group) "Return the quit-config of GROUP." ! (nth 1 (assoc 'quit-config (gnus-find-method-for-group group)))) (defun gnus-simplify-mode-line () "Make mode lines a bit simpler." (setq mode-line-modified "-- ") ! (if (listp mode-line-format) ! (progn ! (make-local-variable 'mode-line-format) ! (setq mode-line-format (copy-sequence mode-line-format)) ! (and (equal (nth 3 mode-line-format) " ") ! (setcar (nthcdr 3 mode-line-format) ""))))) ;;; List and range functions --- 3846,3917 ---- name)) + (defsubst gnus-hide-text (b e props) + "Set text PROPS on the B to E region, extending `intangible' 1 past B." + (gnus-add-text-properties b e props) + (when (memq 'intangible props) + (gnus-put-text-property (max (1- b) (point-min)) + b 'intangible (cddr (memq 'intangible props))))) + + (defsubst gnus-unhide-text (b e) + "Remove hidden text properties from region between B and E." + (remove-text-properties b e gnus-hidden-properties) + (when (memq 'intangible gnus-hidden-properties) + (gnus-put-text-property (max (1- b) (point-min)) + b 'intangible nil))) + + (defun gnus-hide-text-type (b e type) + "Hide text of TYPE between B and E." + (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties)))) + + (defun gnus-parent-headers (headers &optional generation) + "Return the headers of the GENERATIONeth parent of HEADERS." + (unless generation + (setq generation 1)) + (let (references parent) + (while (and headers (not (zerop generation))) + (setq references (mail-header-references headers)) + (when (and references + (setq parent (gnus-parent-id references)) + (setq headers (car (gnus-id-to-thread parent)))) + (decf generation))) + headers)) + + (defun gnus-parent-id (references) + "Return the last Message-ID in REFERENCES." + (when (and references + (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references)) + (substring references (match-beginning 1) (match-end 1)))) + + (defun gnus-split-references (references) + "Return a list of Message-IDs in REFERENCES." + (let ((beg 0) + ids) + (while (string-match "<[^>]+>" references beg) + (push (substring references (match-beginning 0) (setq beg (match-end 0))) + ids)) + (nreverse ids))) + + (defun gnus-buffer-live-p (buffer) + "Say whether BUFFER is alive or not." + (and buffer + (get-buffer buffer) + (buffer-name (get-buffer buffer)))) + (defun gnus-ephemeral-group-p (group) "Say whether GROUP is ephemeral or not." ! (gnus-group-get-parameter group 'quit-config)) (defun gnus-group-quit-config (group) "Return the quit-config of GROUP." ! (gnus-group-get-parameter group 'quit-config)) (defun gnus-simplify-mode-line () "Make mode lines a bit simpler." (setq mode-line-modified "-- ") ! (when (listp mode-line-format) ! (make-local-variable 'mode-line-format) ! (setq mode-line-format (copy-sequence mode-line-format)) ! (when (equal (nth 3 mode-line-format) " ") ! (setcar (nthcdr 3 mode-line-format) " ")))) ;;; List and range functions *************** that that variable is buffer-local to th *** 2873,2877 **** (if (and (consp list) (not (consp (cdr list)))) (cons (car list) (cdr list)) ! (mapcar (lambda (elem) (if (consp elem) (if (consp (cdr elem)) (gnus-copy-sequence elem) --- 3927,3931 ---- (if (and (consp list) (not (consp (cdr list)))) (cons (car list) (cdr list)) ! (mapcar (lambda (elem) (if (consp elem) (if (consp (cdr elem)) (gnus-copy-sequence elem) *************** Both lists have to be sorted over <." *** 2906,2910 **** (nconc (nreverse out) (or list1 list2))))) ! (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 --- 3960,3964 ---- (nconc (nreverse out) (or list1 list2))))) ! (defun gnus-intersection (list1 list2) (let ((result nil)) (while list2 *************** ranges." *** 2962,2966 **** (setq last (car numbers))) (t ;End of one sequence ! (setq result (cons (if (= first last) first (cons first last)) result)) --- 4016,4020 ---- (setq last (car numbers))) (t ;End of one sequence ! (setq result (cons (if (= first last) first (cons first last)) result)) *************** RANGES is either a single range on the f *** 2979,2983 **** these ranges." (let (first last result) ! (cond ((null ranges) nil) --- 4033,4037 ---- these ranges." (let (first last result) ! (cond ((null ranges) nil) *************** these ranges." *** 2994,2999 **** (if (numberp (car ranges)) (setq result (cons (car ranges) result))) ! (setq first (car (car ranges))) ! (setq last (cdr (car ranges))) (while (<= first last) (setq result (cons first result)) --- 4048,4053 ---- (if (numberp (car ranges)) (setq result (cons (car ranges) result))) ! (setq first (caar ranges)) ! (setq last (cdar ranges)) (while (<= first last) (setq result (cons first result)) *************** Note: LIST has to be sorted over `<'." *** 3015,3020 **** (setq ilist list) (setq lowest (or (and (atom (car ranges)) (car ranges)) ! (car (car ranges)))) ! (while (and list (cdr list) (< (car (cdr list)) lowest)) (setq list (cdr list))) (if (< (car ilist) lowest) --- 4069,4074 ---- (setq ilist list) (setq lowest (or (and (atom (car ranges)) (car ranges)) ! (caar ranges))) ! (while (and list (cdr list) (< (cadr list) lowest)) (setq list (cdr list))) (if (< (car ilist) lowest) *************** Note: LIST has to be sorted over `<'." *** 3025,3029 **** (setq out (nconc (gnus-compress-sequence ilist t) out)))) (setq highest (or (and (atom (car ranges)) (car ranges)) ! (cdr (car ranges)))) (while (and list (<= (car list) highest)) (setq list (cdr list))) --- 4079,4083 ---- (setq out (nconc (gnus-compress-sequence ilist t) out)))) (setq highest (or (and (atom (car ranges)) (car ranges)) ! (cdar ranges))) (while (and list (<= (car list) highest)) (setq list (cdr list))) *************** Note: LIST has to be sorted over `<'." *** 3031,3035 **** (if list (setq out (nconc (gnus-compress-sequence list t) out))) ! (setq out (sort out (lambda (r1 r2) (< (or (and (atom r1) r1) (car r1)) (or (and (atom r2) r2) (car r2)))))) --- 4085,4089 ---- (if list (setq out (nconc (gnus-compress-sequence list t) out))) ! (setq out (sort out (lambda (r1 r2) (< (or (and (atom r1) r1) (car r1)) (or (and (atom r2) r2) (car r2)))))) *************** Note: LIST has to be sorted over `<'." *** 3038,3062 **** (if (atom (car ranges)) (if (cdr ranges) ! (if (atom (car (cdr ranges))) ! (if (= (1+ (car ranges)) (car (cdr ranges))) (progn ! (setcar ranges (cons (car ranges) ! (car (cdr ranges)))) ! (setcdr ranges (cdr (cdr ranges))))) ! (if (= (1+ (car ranges)) (car (car (cdr ranges)))) (progn ! (setcar (car (cdr ranges)) (car ranges)) ! (setcar ranges (car (cdr ranges))) ! (setcdr ranges (cdr (cdr ranges))))))) (if (cdr ranges) ! (if (atom (car (cdr ranges))) ! (if (= (1+ (cdr (car ranges))) (car (cdr ranges))) (progn ! (setcdr (car ranges) (car (cdr ranges))) ! (setcdr ranges (cdr (cdr ranges))))) ! (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges)))) (progn ! (setcdr (car ranges) (cdr (car (cdr ranges)))) ! (setcdr ranges (cdr (cdr ranges)))))))) (setq ranges (cdr ranges))) out))) --- 4092,4116 ---- (if (atom (car ranges)) (if (cdr ranges) ! (if (atom (cadr ranges)) ! (if (= (1+ (car ranges)) (cadr ranges)) (progn ! (setcar ranges (cons (car ranges) ! (cadr ranges))) ! (setcdr ranges (cddr ranges)))) ! (if (= (1+ (car ranges)) (caadr ranges)) (progn ! (setcar (cadr ranges) (car ranges)) ! (setcar ranges (cadr ranges)) ! (setcdr ranges (cddr ranges)))))) (if (cdr ranges) ! (if (atom (cadr ranges)) ! (if (= (1+ (cdar ranges)) (cadr ranges)) (progn ! (setcdr (car ranges) (cadr ranges)) ! (setcdr ranges (cddr ranges)))) ! (if (= (1+ (cdar ranges)) (caadr ranges)) (progn ! (setcdr (car ranges) (cdadr ranges)) ! (setcdr ranges (cddr ranges))))))) (setq ranges (cdr ranges))) out))) *************** Note: LIST has to be sorted over `<'." *** 3066,3070 **** Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. ! (gnus-compress-sequence (gnus-sorted-complement (gnus-uncompress-range ranges) list))) --- 4120,4124 ---- Note: LIST has to be sorted over `<'." ;; !!! This function shouldn't look like this, but I've got a headache. ! (gnus-compress-sequence (gnus-sorted-complement (gnus-uncompress-range ranges) list))) *************** Note: LIST has to be sorted over `<'." *** 3072,3091 **** (defun gnus-member-of-range (number ranges) (if (not (listp (cdr ranges))) ! (and (>= number (car ranges)) (<= number (cdr ranges))) (let ((not-stop t)) ! (while (and ranges (if (numberp (car ranges)) (>= number (car ranges)) ! (>= number (car (car ranges)))) not-stop) (if (if (numberp (car ranges)) (= number (car ranges)) ! (and (>= number (car (car ranges))) ! (<= number (cdr (car ranges))))) (setq not-stop nil)) (setq ranges (cdr ranges))) (not not-stop)))) ;;; --- 4126,4158 ---- (defun gnus-member-of-range (number ranges) (if (not (listp (cdr ranges))) ! (and (>= number (car ranges)) (<= number (cdr ranges))) (let ((not-stop t)) ! (while (and ranges (if (numberp (car ranges)) (>= number (car ranges)) ! (>= number (caar ranges))) not-stop) (if (if (numberp (car ranges)) (= number (car ranges)) ! (and (>= number (caar ranges)) ! (<= number (cdar ranges)))) (setq not-stop nil)) (setq ranges (cdr ranges))) (not not-stop)))) + (defun gnus-range-length (range) + "Return the length RANGE would have if uncompressed." + (length (gnus-uncompress-range range))) + + (defun gnus-sublist-p (list sublist) + "Test whether all elements in SUBLIST are members of LIST." + (let ((sublistp t)) + (while sublist + (unless (memq (pop sublist) list) + (setq sublistp nil + sublist nil))) + sublistp)) + ;;; *************** Note: LIST has to be sorted over `<'." *** 3094,3219 **** (defvar gnus-group-mode-map nil) - (defvar gnus-group-group-map nil) - (defvar gnus-group-mark-map nil) - (defvar gnus-group-list-map nil) - (defvar gnus-group-help-map nil) - (defvar gnus-group-sub-map nil) (put 'gnus-group-mode 'mode-class 'special) ! (if gnus-group-mode-map ! nil (setq gnus-group-mode-map (make-keymap)) (suppress-keymap gnus-group-mode-map) ! (define-key gnus-group-mode-map " " 'gnus-group-read-group) ! (define-key gnus-group-mode-map "=" 'gnus-group-select-group) ! (define-key gnus-group-mode-map "\r" 'gnus-group-select-group) ! (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group) ! (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group) ! (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group) ! (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group) ! (define-key gnus-group-mode-map "N" 'gnus-group-next-group) ! (define-key gnus-group-mode-map "P" 'gnus-group-prev-group) ! (define-key gnus-group-mode-map ! "\M-n" 'gnus-group-next-unread-group-same-level) ! (define-key gnus-group-mode-map ! "\M-p" 'gnus-group-prev-unread-group-same-level) ! (define-key gnus-group-mode-map "," 'gnus-group-best-unread-group) ! (define-key gnus-group-mode-map "." 'gnus-group-first-unread-group) ! (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group) ! (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group) ! (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current) ! (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all) ! (define-key gnus-group-mode-map "l" 'gnus-group-list-groups) ! (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups) ! (define-key gnus-group-mode-map "m" 'gnus-group-mail) ! (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news) ! (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group) ! (define-key gnus-group-mode-map "R" 'gnus-group-restart) ! (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file) ! (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server) ! (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups) ! (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups) ! (define-key gnus-group-mode-map "\C-c\C-d" 'gnus-group-describe-group) ! (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups) ! (define-key gnus-group-mode-map "\C-c\C-a" 'gnus-group-apropos) ! (define-key gnus-group-mode-map "\C-c\M-\C-a" 'gnus-group-description-apropos) ! (define-key gnus-group-mode-map "a" 'gnus-group-post-news) ! (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill) ! (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill) ! (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group) ! (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group) ! (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region) ! (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups) ! (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed) ! (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles) ! (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups) ! (define-key gnus-group-mode-map "V" 'gnus-version) ! (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc) ! (define-key gnus-group-mode-map "z" 'gnus-group-suspend) ! (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble) ! (define-key gnus-group-mode-map "q" 'gnus-group-exit) ! (define-key gnus-group-mode-map "Q" 'gnus-group-quit) ! (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) ! (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node) ! (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-group-method) ! (define-key gnus-group-mode-map "^" 'gnus-group-enter-server-mode) ! (define-key gnus-group-mode-map gnus-mouse-2 'gnus-mouse-pick-group) ! (define-key gnus-group-mode-map "<" 'beginning-of-buffer) ! (define-key gnus-group-mode-map ">" 'end-of-buffer) ! (define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug) ! (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups) ! ! (define-key gnus-group-mode-map "#" 'gnus-group-mark-group) ! (define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group) ! (define-prefix-command 'gnus-group-mark-map) ! (define-key gnus-group-mode-map "M" 'gnus-group-mark-map) ! (define-key gnus-group-mark-map "m" 'gnus-group-mark-group) ! (define-key gnus-group-mark-map "u" 'gnus-group-unmark-group) ! (define-key gnus-group-mark-map "w" 'gnus-group-mark-region) ! ! (define-prefix-command 'gnus-group-group-map) ! (define-key gnus-group-mode-map "G" 'gnus-group-group-map) ! (define-key gnus-group-group-map "d" 'gnus-group-make-directory-group) ! (define-key gnus-group-group-map "h" 'gnus-group-make-help-group) ! (define-key gnus-group-group-map "a" 'gnus-group-make-archive-group) ! (define-key gnus-group-group-map "k" 'gnus-group-make-kiboze-group) ! (define-key gnus-group-group-map "m" 'gnus-group-make-group) ! (define-key gnus-group-group-map "E" 'gnus-group-edit-group) ! (define-key gnus-group-group-map "e" 'gnus-group-edit-group-method) ! (define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters) ! (define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual) ! (define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual) ! (define-key gnus-group-group-map "D" 'gnus-group-enter-directory) ! (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group) ! ;;(define-key gnus-group-group-map "sb" 'gnus-group-brew-soup) ! ;;(define-key gnus-group-group-map "sw" 'gnus-soup-save-areas) ! ;;(define-key gnus-group-group-map "ss" 'gnus-soup-send-replies) ! ;;(define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet) ! ;;(define-key gnus-group-group-map "sr" 'nnsoup-pack-replies) ! ! (define-prefix-command 'gnus-group-list-map) ! (define-key gnus-group-mode-map "A" 'gnus-group-list-map) ! (define-key gnus-group-list-map "k" 'gnus-group-list-killed) ! (define-key gnus-group-list-map "z" 'gnus-group-list-zombies) ! (define-key gnus-group-list-map "s" 'gnus-group-list-groups) ! (define-key gnus-group-list-map "u" 'gnus-group-list-all-groups) ! (define-key gnus-group-list-map "a" 'gnus-group-apropos) ! (define-key gnus-group-list-map "d" 'gnus-group-description-apropos) ! (define-key gnus-group-list-map "m" 'gnus-group-list-matching) ! (define-key gnus-group-list-map "M" 'gnus-group-list-all-matching) ! ! (define-prefix-command 'gnus-group-help-map) ! (define-key gnus-group-mode-map "H" 'gnus-group-help-map) ! (define-key gnus-group-help-map "f" 'gnus-group-fetch-faq) ! ! (define-prefix-command 'gnus-group-sub-map) ! (define-key gnus-group-mode-map "S" 'gnus-group-sub-map) ! (define-key gnus-group-sub-map "l" 'gnus-group-set-current-level) ! (define-key gnus-group-sub-map "t" 'gnus-group-unsubscribe-current-group) ! (define-key gnus-group-sub-map "s" 'gnus-group-unsubscribe-group) ! (define-key gnus-group-sub-map "k" 'gnus-group-kill-group) ! (define-key gnus-group-sub-map "y" 'gnus-group-yank-group) ! (define-key gnus-group-sub-map "w" 'gnus-group-kill-region) ! (define-key gnus-group-sub-map "z" 'gnus-group-kill-all-zombies)) (defun gnus-group-mode () --- 4161,4303 ---- (defvar gnus-group-mode-map nil) (put 'gnus-group-mode 'mode-class 'special) ! (unless gnus-group-mode-map (setq gnus-group-mode-map (make-keymap)) (suppress-keymap gnus-group-mode-map) ! ! (gnus-define-keys gnus-group-mode-map ! " " gnus-group-read-group ! "=" gnus-group-select-group ! "\r" gnus-group-select-group ! "\M-\r" gnus-group-quick-select-group ! "j" gnus-group-jump-to-group ! "n" gnus-group-next-unread-group ! "p" gnus-group-prev-unread-group ! "\177" gnus-group-prev-unread-group ! [delete] gnus-group-prev-unread-group ! "N" gnus-group-next-group ! "P" gnus-group-prev-group ! "\M-n" gnus-group-next-unread-group-same-level ! "\M-p" gnus-group-prev-unread-group-same-level ! "," gnus-group-best-unread-group ! "." gnus-group-first-unread-group ! "u" gnus-group-unsubscribe-current-group ! "U" gnus-group-unsubscribe-group ! "c" gnus-group-catchup-current ! "C" gnus-group-catchup-current-all ! "l" gnus-group-list-groups ! "L" gnus-group-list-all-groups ! "m" gnus-group-mail ! "g" gnus-group-get-new-news ! "\M-g" gnus-group-get-new-news-this-group ! "R" gnus-group-restart ! "r" gnus-group-read-init-file ! "B" gnus-group-browse-foreign-server ! "b" gnus-group-check-bogus-groups ! "F" gnus-find-new-newsgroups ! "\C-c\C-d" gnus-group-describe-group ! "\M-d" gnus-group-describe-all-groups ! "\C-c\C-a" gnus-group-apropos ! "\C-c\M-\C-a" gnus-group-description-apropos ! "a" gnus-group-post-news ! "\ek" gnus-group-edit-local-kill ! "\eK" gnus-group-edit-global-kill ! "\C-k" gnus-group-kill-group ! "\C-y" gnus-group-yank-group ! "\C-w" gnus-group-kill-region ! "\C-x\C-t" gnus-group-transpose-groups ! "\C-c\C-l" gnus-group-list-killed ! "\C-c\C-x" gnus-group-expire-articles ! "\C-c\M-\C-x" gnus-group-expire-all-groups ! "V" gnus-version ! "s" gnus-group-save-newsrc ! "z" gnus-group-suspend ! ; "Z" gnus-group-clear-dribble ! "q" gnus-group-exit ! "Q" gnus-group-quit ! "?" gnus-group-describe-briefly ! "\C-c\C-i" gnus-info-find-node ! "\M-e" gnus-group-edit-group-method ! "^" gnus-group-enter-server-mode ! gnus-mouse-2 gnus-mouse-pick-group ! "<" beginning-of-buffer ! ">" end-of-buffer ! "\C-c\C-b" gnus-bug ! "\C-c\C-s" gnus-group-sort-groups ! "t" gnus-topic-mode ! "\C-c\M-g" gnus-activate-all-groups ! "\M-&" gnus-group-universal-argument ! "#" gnus-group-mark-group ! "\M-#" gnus-group-unmark-group) ! ! (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) ! "m" gnus-group-mark-group ! "u" gnus-group-unmark-group ! "w" gnus-group-mark-region ! "m" gnus-group-mark-buffer ! "r" gnus-group-mark-regexp ! "U" gnus-group-unmark-all-groups) ! ! (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) ! "d" gnus-group-make-directory-group ! "h" gnus-group-make-help-group ! "a" gnus-group-make-archive-group ! "k" gnus-group-make-kiboze-group ! "m" gnus-group-make-group ! "E" gnus-group-edit-group ! "e" gnus-group-edit-group-method ! "p" gnus-group-edit-group-parameters ! "v" gnus-group-add-to-virtual ! "V" gnus-group-make-empty-virtual ! "D" gnus-group-enter-directory ! "f" gnus-group-make-doc-group ! "r" gnus-group-rename-group ! "\177" gnus-group-delete-group ! [delete] gnus-group-delete-group) ! ! (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) ! "b" gnus-group-brew-soup ! "w" gnus-soup-save-areas ! "s" gnus-soup-send-replies ! "p" gnus-soup-pack-packet ! "r" nnsoup-pack-replies) ! ! (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) ! "s" gnus-group-sort-groups ! "a" gnus-group-sort-groups-by-alphabet ! "u" gnus-group-sort-groups-by-unread ! "l" gnus-group-sort-groups-by-level ! "v" gnus-group-sort-groups-by-score ! "r" gnus-group-sort-groups-by-rank ! "m" gnus-group-sort-groups-by-method) ! ! (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) ! "k" gnus-group-list-killed ! "z" gnus-group-list-zombies ! "s" gnus-group-list-groups ! "u" gnus-group-list-all-groups ! "A" gnus-group-list-active ! "a" gnus-group-apropos ! "d" gnus-group-description-apropos ! "m" gnus-group-list-matching ! "M" gnus-group-list-all-matching ! "l" gnus-group-list-level) ! ! (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) ! "f" gnus-score-flush-cache) ! ! (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) ! "f" gnus-group-fetch-faq) ! ! (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) ! "l" gnus-group-set-current-level ! "t" gnus-group-unsubscribe-current-group ! "s" gnus-group-unsubscribe-group ! "k" gnus-group-kill-group ! "y" gnus-group-yank-group ! "w" gnus-group-kill-region ! "\C-k" gnus-group-kill-level ! "z" gnus-group-kill-all-zombies)) (defun gnus-group-mode () *************** Note: LIST has to be sorted over `<'." *** 3222,3233 **** All normal editing commands are switched off. \\ ! The group buffer lists (some of) the groups available. For instance, `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' ! lists all zombie groups. ! Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe ! to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. ! For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). The following commands are available: --- 4306,4317 ---- All normal editing commands are switched off. \\ ! The group buffer lists (some of) the groups available. For instance, `\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' ! lists all zombie groups. ! Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe ! to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. ! For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). The following commands are available: *************** The following commands are available: *** 3235,3239 **** \\{gnus-group-mode-map}" (interactive) ! (if gnus-visual (gnus-group-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) --- 4319,4325 ---- \\{gnus-group-mode-map}" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'group-menu 'menu)) ! (gnus-group-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) *************** The following commands are available: *** 3246,3252 **** --- 4332,4344 ---- (setq truncate-lines t) (setq buffer-read-only t) + (gnus-make-local-hook 'post-command-hook) + (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (run-hooks 'gnus-group-mode-hook)) + (defun gnus-clear-inboxes-moved () + (setq nnmail-moved-inboxes nil)) + (defun gnus-mouse-pick-group (e) + "Enter the group under the mouse pointer." (interactive "e") (mouse-set-point e) *************** The following commands are available: *** 3257,3301 **** ;; will depend on whether `gnus-group-use-permanent-levels' is used. (defun gnus-group-default-level (&optional level number-or-nil) ! (cond (gnus-group-use-permanent-levels ! (setq gnus-group-default-list-level ! (or level gnus-group-default-list-level)) ! (or gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t (or level gnus-group-default-list-level gnus-level-subscribed)))) - ! (defvar gnus-tmp-prev-perm nil) ;;;###autoload ! (defun gnus-no-server (&optional arg) "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. 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." (interactive "P") ! (let ((perm ! (cons gnus-group-use-permanent-levels gnus-group-default-list-level))) ! (setq gnus-tmp-prev-perm nil) ! (setq gnus-group-use-permanent-levels t) ! (gnus (or arg (1- gnus-level-default-subscribed)) t) ! (setq gnus-tmp-prev-perm perm))) ;;;###autoload ! (defun read-news (&optional arg dont-connect) ! "Read network news. This is an alias for the `gnus' command." ! (gnus arg dont-connect)) ;;;###autoload ! (defun gnus (&optional arg dont-connect) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the ! startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") (if (get-buffer gnus-group-buffer) (progn --- 4349,4409 ---- ;; will depend on whether `gnus-group-use-permanent-levels' is used. (defun gnus-group-default-level (&optional level number-or-nil) ! (cond (gnus-group-use-permanent-levels ! (or (setq gnus-group-use-permanent-levels ! (or level (if (numberp gnus-group-use-permanent-levels) ! gnus-group-use-permanent-levels ! (or gnus-group-default-list-level ! gnus-level-subscribed)))) ! gnus-group-default-list-level gnus-level-subscribed)) (number-or-nil level) (t (or level gnus-group-default-list-level gnus-level-subscribed)))) ! ;;;###autoload ! (defun gnus-slave-no-server (&optional arg) ! "Read network news as a slave, without connecting to local server" ! (interactive "P") ! (gnus-no-server arg t)) ;;;###autoload ! (defun gnus-no-server (&optional arg slave) "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. 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." (interactive "P") ! (let ((val (or arg (1- gnus-level-default-subscribed)))) ! (gnus val t slave) ! (make-local-variable 'gnus-group-use-permanent-levels) ! (setq gnus-group-use-permanent-levels val))) ;;;###autoload ! (defun gnus-slave (&optional arg) ! "Read news as a slave." ! (interactive "P") ! (gnus arg nil 'slave)) ! ! ;;;###autoload ! (defun gnus-other-frame (&optional arg) ! "Pop up a frame to read news." ! (interactive "P") ! (if (get-buffer gnus-group-buffer) ! (let ((pop-up-frames t)) ! (gnus arg)) ! (select-frame (make-frame)) ! (gnus arg))) ;;;###autoload ! (defun gnus (&optional arg dont-connect slave) "Read network news. If ARG is non-nil and a positive number, Gnus will use that as the ! startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." (interactive "P") + (if (get-buffer gnus-group-buffer) (progn *************** prompt the user for the name of an NNTP *** 3304,3315 **** (gnus-clear-system) - (nnheader-init-server-buffer) - ;; We do this if `gnus-no-server' has been run. - (if gnus-tmp-prev-perm - (setq gnus-group-use-permanent-levels (car gnus-tmp-prev-perm) - gnus-group-default-list-level (cdr gnus-tmp-prev-perm) - gnus-tmp-prev-perm nil)) (gnus-read-init-file) (gnus-group-setup-buffer) --- 4412,4418 ---- (gnus-clear-system) (nnheader-init-server-buffer) (gnus-read-init-file) + (setq gnus-slave slave) (gnus-group-setup-buffer) *************** prompt the user for the name of an NNTP *** 3320,3348 **** (gnus-group-startup-message) (sit-for 0)))) ! ! (let ((level (and arg (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect (progn ! (or dont-connect (setq did-connect (gnus-start-news-server (and arg (not level)))))) ! (if (and (not dont-connect) (not did-connect)) (gnus-group-quit) (run-hooks 'gnus-startup-hook) ! ;; NNTP server is successfully open. ;; Find the current startup file name. ! (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) ;; Read the dribble file. ! (and gnus-use-dribble-file (gnus-dribble-read-file)) (gnus-summary-make-display-table) ! (gnus-setup-news nil level) (gnus-group-list-groups level) ! (gnus-configure-windows 'group)))))) (defun gnus-unload () --- 4423,4461 ---- (gnus-group-startup-message) (sit-for 0)))) ! ! (let ((level (and (numberp arg) (> arg 0) arg)) did-connect) (unwind-protect (progn ! (or dont-connect (setq did-connect (gnus-start-news-server (and arg (not level)))))) ! (if (and (not dont-connect) (not did-connect)) (gnus-group-quit) (run-hooks 'gnus-startup-hook) ! ;; NNTP server is successfully open. ;; Find the current startup file name. ! (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) ;; Read the dribble file. ! (when (or gnus-slave gnus-use-dribble-file) ! (gnus-dribble-read-file)) ! ! ;; Allow using GroupLens predictions. ! (when gnus-use-grouplens ! (bbb-login) ! (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) (gnus-summary-make-display-table) ! ;; Do the actual startup. ! (gnus-setup-news nil level dont-connect) ! ;; Generate the group buffer. (gnus-group-list-groups level) ! (gnus-group-first-unread-group) ! (gnus-configure-windows 'group) ! (gnus-group-set-mode-line)))))) (defun gnus-unload () *************** prompt the user for the name of an NNTP *** 3354,3362 **** feature) (while history ! (and (string-match "^gnus" (car (car history))) (setq feature (cdr (assq 'provide (car history)))) (unload-feature feature 'force)) (setq history (cdr history))))) (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." --- 4467,4508 ---- feature) (while history ! (and (string-match "^\\(gnus\\|nn\\)" (caar history)) (setq feature (cdr (assq 'provide (car history)))) (unload-feature feature 'force)) (setq history (cdr history))))) + (defun gnus-compile () + "Byte-compile the user-defined format specs." + (interactive) + (let ((entries gnus-format-specs) + entry gnus-tmp-func) + (save-excursion + (gnus-message 7 "Compiling format specs...") + + (while entries + (setq entry (pop entries)) + (if (eq (car entry) 'version) + (setq gnus-format-specs (delq entry gnus-format-specs)) + (when (and (listp (caddr entry)) + (not (eq 'byte-code (caaddr entry)))) + (fset 'gnus-tmp-func + `(lambda () ,(caddr entry))) + (byte-compile 'gnus-tmp-func) + (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) + + (push (cons 'version emacs-version) gnus-format-specs) + + (gnus-message 7 "Compiling user specs...done")))) + + (defun gnus-indent-rigidly (start end arg) + "Indent rigidly using only spaces and no tabs." + (save-excursion + (save-restriction + (narrow-to-region start end) + (indent-rigidly start end arg) + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " " t t))))) + (defun gnus-group-startup-message (&optional x y) "Insert startup message in current buffer." *************** prompt the user for the name of an NNTP *** 3364,3440 **** (erase-buffer) (insert ! (format " ! _ ___ _ _ ! _ ___ __ ___ __ _ ___ ! __ _ ___ __ ___ ! _ ___ _ ! _ _ __ _ ! ___ __ _ ! __ _ ! _ _ _ ! _ _ _ ! _ _ _ ! __ ___ ! _ _ _ _ ! _ _ ! _ _ ! _ _ ! _ ! __ ! ! ! Gnus * A newsreader for Emacsen ! A Praxis release * larsi@ifi.uio.no ! " ! gnus-version)) ;; And then hack it. ! ;; 18 is the longest line. ! (indent-rigidly (point-min) (point-max) ! (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) (let* ((pheight (count-lines (point-min) (point-max))) (wheight (window-height)) ! (rest (- wheight pheight))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - - - ;; Fontify some. (goto-char (point-min)) ! (search-forward "Praxis") ! (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) ! (goto-char (point-min))) ! ! (defun gnus-group-startup-message-old (&optional x y) ! "Insert startup message in current buffer." ! ;; Insert the message. ! (erase-buffer) ! (insert ! (format " ! %s ! A newsreader ! for GNU Emacs ! ! Based on GNUS ! written by ! Masanobu UMEDA ! ! A Praxis Release ! larsi@ifi.uio.no ! " ! gnus-version)) ! ;; And then hack it. ! ;; 18 is the longest line. ! (indent-rigidly (point-min) (point-max) ! (/ (max (- (window-width) (or x 28)) 0) 2)) ! (goto-char (point-min)) ! ;; +4 is fuzzy factor. ! (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)) ! ! ;; Fontify some. (goto-char (point-min)) ! (search-forward "Praxis") ! (put-text-property (match-beginning 0) (match-end 0) 'face 'bold) ! (goto-char (point-min))) (defun gnus-group-setup-buffer () --- 4510,4552 ---- (erase-buffer) (insert ! (format " %s ! _ ___ _ _ ! _ ___ __ ___ __ _ ___ ! __ _ ___ __ ___ ! _ ___ _ ! _ _ __ _ ! ___ __ _ ! __ _ ! _ _ _ ! _ _ _ ! _ _ _ ! __ ___ ! _ _ _ _ ! _ _ ! _ _ ! _ _ ! _ ! __ ! ! " ! "")) ;; And then hack it. ! (gnus-indent-rigidly (point-min) (point-max) ! (/ (max (- (window-width) (or x 46)) 0) 2)) (goto-char (point-min)) + (forward-line 1) (let* ((pheight (count-lines (point-min) (point-max))) (wheight (window-height)) ! (rest (- wheight pheight))) (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) ;; Fontify some. (goto-char (point-min)) ! (and (search-forward "Praxis" nil t) ! (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold)) (goto-char (point-min)) ! (let* ((mode-string (gnus-group-set-mode-line))) ! (setq mode-line-buffer-identification ! (list (concat gnus-version (substring (car mode-string) 4)))) ! (set-buffer-modified-p t))) (defun gnus-group-setup-buffer () *************** prompt the user for the name of an NNTP *** 3446,3454 **** (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) ! (defun gnus-group-list-groups (&optional level unread) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also ! listed." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) --- 4558,4566 ---- (and gnus-carpal (gnus-carpal-setup-buffer 'group))))) ! (defun gnus-group-list-groups (&optional level unread lowest) "List newsgroups with level LEVEL or lower that have unread articles. Default is all subscribed groups. If argument UNREAD is non-nil, groups with no unread articles are also ! listed." (interactive (list (if current-prefix-arg (prefix-numeric-value current-prefix-arg) *************** listed." *** 3462,3494 **** (setq level (gnus-group-default-level level)) (gnus-group-setup-buffer) ;May call from out of group buffer (let ((case-fold-search nil) (group (gnus-group-group-name))) ! (funcall gnus-group-prepare-function level unread nil) (if (zerop (buffer-size)) (gnus-message 5 gnus-no-groups-message) ! (goto-char (point-min)) ! (if (not group) ! ;; Go to the first group with unread articles. ! (gnus-group-search-forward nil nil nil t) ! ;; Find the right group to put point on. If the current group ! ;; has disappeared in the new listing, try to find the next ! ;; one. If no next one can be found, just leave point at the ! ;; first newsgroup in the buffer. ! (if (not (gnus-goto-char ! (text-property-any (point-min) (point-max) ! 'gnus-group (intern group)))) ! (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) ! (while (and newsrc ! (not (gnus-goto-char ! (text-property-any ! (point-min) (point-max) 'gnus-group ! (intern (car (car newsrc))))))) ! (setq newsrc (cdr newsrc))) ! (or newsrc (progn (goto-char (point-max)) ! (forward-line -1)))))) ;; Adjust cursor point. ! (gnus-group-position-cursor)))) ! (defun gnus-group-prepare-flat (level &optional all lowest regexp) "List all newsgroups with unread articles of level LEVEL or lower. If ALL is non-nil, list groups that have no unread articles. --- 4574,4620 ---- (setq level (gnus-group-default-level level)) (gnus-group-setup-buffer) ;May call from out of group buffer + (gnus-update-format-specifications) (let ((case-fold-search nil) + (props (text-properties-at (gnus-point-at-bol))) (group (gnus-group-group-name))) ! (set-buffer gnus-group-buffer) ! (funcall gnus-group-prepare-function level unread lowest) (if (zerop (buffer-size)) (gnus-message 5 gnus-no-groups-message) ! (goto-char (point-max)) ! (when (or (not gnus-group-goto-next-group-function) ! (not (funcall gnus-group-goto-next-group-function ! group props))) ! (if (not group) ! ;; Go to the first group with unread articles. ! (gnus-group-search-forward t) ! ;; Find the right group to put point on. If the current group ! ;; has disappeared in the new listing, try to find the next ! ;; one. If no next one can be found, just leave point at the ! ;; first newsgroup in the buffer. ! (if (not (gnus-goto-char ! (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) ! (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) ! (while (and newsrc ! (not (gnus-goto-char ! (text-property-any ! (point-min) (point-max) 'gnus-group ! (gnus-intern-safe ! (caar newsrc) gnus-active-hashtb))))) ! (setq newsrc (cdr newsrc))) ! (or newsrc (progn (goto-char (point-max)) ! (forward-line -1))))))) ;; Adjust cursor point. ! (gnus-group-position-point)))) ! ! (defun gnus-group-list-level (level &optional all) ! "List groups on LEVEL. ! If ALL (the prefix), also list groups that have no unread articles." ! (interactive "nList groups on level: \nP") ! (gnus-group-list-groups level all level)) ! (defun gnus-group-prepare-flat (level &optional all lowest regexp) "List all newsgroups with unread articles of level LEVEL or lower. If ALL is non-nil, list groups that have no unread articles. *************** If REGEXP, only list groups matching REG *** 3499,3503 **** (newsrc (cdr gnus-newsrc-alist)) (lowest (or lowest 1)) ! info clevel unread group) (erase-buffer) (if (< lowest gnus-level-zombie) --- 4625,4629 ---- (newsrc (cdr gnus-newsrc-alist)) (lowest (or lowest 1)) ! info clevel unread group params) (erase-buffer) (if (< lowest gnus-level-zombie) *************** If REGEXP, only list groups matching REG *** 3505,3509 **** (while newsrc (setq info (car newsrc) ! group (car info) newsrc (cdr newsrc) unread (car (gnus-gethash group gnus-newsrc-hashtb))) --- 4631,4636 ---- (while newsrc (setq info (car newsrc) ! group (gnus-info-group info) ! params (gnus-info-params info) newsrc (cdr newsrc) unread (car (gnus-gethash group gnus-newsrc-hashtb))) *************** If REGEXP, only list groups matching REG *** 3511,3532 **** (or (not regexp) (string-match regexp group)) ! (<= (setq clevel (car (cdr info))) level) (>= clevel lowest) (or all ; We list all groups? ! (eq unread t) ; We list unactivated groups ! (> unread 0) ; We list groups with unread articles ! (cdr (assq 'tick (nth 3 info)))) ; And ticked groups ! (gnus-group-insert-group-line ! nil group (car (cdr info)) (nth 3 info) unread (nth 4 info))))) ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) --- 4638,4669 ---- (or (not regexp) (string-match regexp group)) ! (<= (setq clevel (gnus-info-level info)) level) (>= clevel lowest) (or all ; We list all groups? ! (if (eq unread t) ; 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)))) ! ; And groups with tickeds ! ;; Check for permanent visibility. ! (and gnus-permanently-visible-groups ! (string-match gnus-permanently-visible-groups ! group)) ! (memq 'visible params) ! (cdr (assq 'visible params))) ! (gnus-group-insert-group-line ! group (gnus-info-level info) ! (gnus-info-marks info) unread (gnus-info-method info))))) ;; List dead groups. (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) ! (gnus-group-prepare-flat-list-dead ! (setq gnus-killed-list (sort gnus-killed-list 'string<)) gnus-level-killed ?K regexp)) *************** If REGEXP, only list groups matching REG *** 3537,3562 **** (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) ;; List zombies and killed lists somewhat faster, which was ! ;; suggested by Jack Vinson . It does ;; this by ignoring the group format specification altogether. ! (let (group beg) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (if (or (not regexp) ! (string-match regexp group)) ! (progn ! (setq beg (point)) ! (insert (format " %c *: %s\n" mark group)) ! (add-text-properties ! beg (1+ beg) ! (list 'gnus-group (intern group) 'gnus-unread t ! 'gnus-level level))))))) ! (defun gnus-group-real-name (group) "Find the real name of a foreign newsgroup." ! (if (string-match ":[^:]+$" group) ! (substring group (1+ (match-beginning 0))) ! group)) (defun gnus-group-prefixed-name (group method) --- 4674,4794 ---- (defun gnus-group-prepare-flat-list-dead (groups level mark regexp) ;; List zombies and killed lists somewhat faster, which was ! ;; suggested by Jack Vinson . It does ;; this by ignoring the group format specification altogether. ! (let (group) ! (if regexp ! ;; This loop is used when listing groups that match some ! ;; regexp. ! (while groups ! (setq group (pop groups)) ! (when (string-match regexp group) ! (gnus-add-text-properties ! (point) (prog1 (1+ (point)) ! (insert " " mark " *: " group "\n")) ! (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) 'gnus-unread t ! 'gnus-level level)))) ! ;; This loop is used when listing all groups. ! (while groups ! (gnus-add-text-properties ! (point) (prog1 (1+ (point)) ! (insert " " mark " *: " ! (setq group (pop groups)) "\n")) ! (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) ! 'gnus-unread t ! 'gnus-level level)))))) ! (defmacro gnus-group-real-name (group) "Find the real name of a foreign newsgroup." ! `(let ((gname ,group)) ! (if (string-match ":[^:]+$" gname) ! (substring gname (1+ (match-beginning 0))) ! gname))) ! ! (defsubst gnus-server-add-address (method) ! (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))) ! (append method (list (list (intern (concat method-name "-address")) ! (nth 1 method)))) ! method))) ! ! (defsubst gnus-server-get-method (group method) ! ;; Input either a server name, and extended server name, or a ! ;; select method, and return a select method. ! (cond ((stringp method) ! (gnus-server-to-method method)) ! ((equal method gnus-select-method) ! gnus-select-method) ! ((and (stringp (car method)) group) ! (gnus-server-extend-method group method)) ! ((and method (not group) ! (equal (cadr method) "")) ! method) ! (t ! (gnus-server-add-address method)))) ! ! (defun gnus-server-to-method (server) ! "Map virtual server names to select methods." ! (or ! ;; Is this a method, perhaps? ! (and server (listp server) server) ! ;; Perhaps this is the native server? ! (and (equal server "native") gnus-select-method) ! ;; It should be in the server alist. ! (cdr (assoc server gnus-server-alist)) ! ;; If not, we look through all the opened server ! ;; to see whether we can find it there. ! (let ((opened gnus-opened-servers)) ! (while (and opened ! (not (equal server (format "%s:%s" (caaar opened) ! (cadaar opened))))) ! (pop opened)) ! (caar opened)))) ! ! (defmacro gnus-method-equal (ss1 ss2) ! "Say whether two servers are equal." ! `(let ((s1 ,ss1) ! (s2 ,ss2)) ! (or (equal s1 s2) ! (and (= (length s1) (length s2)) ! (progn ! (while (and s1 (member (car s1) s2)) ! (setq s1 (cdr s1))) ! (null s1)))))) ! ! (defun gnus-server-equal (m1 m2) ! "Say whether two methods are equal." ! (let ((m1 (cond ((null m1) gnus-select-method) ! ((stringp m1) (gnus-server-to-method m1)) ! (t m1))) ! (m2 (cond ((null m2) gnus-select-method) ! ((stringp m2) (gnus-server-to-method m2)) ! (t m2)))) ! (gnus-method-equal m1 m2))) ! ! (defun gnus-servers-using-backend (backend) ! "Return a list of known servers using BACKEND." ! (let ((opened gnus-opened-servers) ! out) ! (while opened ! (when (eq backend (caaar opened)) ! (push (caar opened) out)) ! (pop opened)) ! out)) ! ! (defun gnus-archive-server-wanted-p () ! "Say whether the user wants to use the archive server." ! (cond ! ((or (not gnus-message-archive-method) ! (not gnus-message-archive-group)) ! nil) ! ((and gnus-message-archive-method gnus-message-archive-group) ! t) ! (t ! (let ((active (cadr (assq 'nnfolder-active-file ! gnus-message-archive-method)))) ! (and active ! (file-exists-p active)))))) (defun gnus-group-prefixed-name (group method) *************** If REGEXP, only list groups matching REG *** 3564,3569 **** (and (stringp method) (setq method (gnus-server-to-method method))) (concat (format "%s" (car method)) ! (if (and ! (assoc (format "%s" (car method)) (gnus-methods-using 'address)) (not (string= (nth 1 method) ""))) (concat "+" (nth 1 method))) --- 4796,4804 ---- (and (stringp method) (setq method (gnus-server-to-method method))) (concat (format "%s" (car method)) ! (if (and ! (or (assoc (format "%s" (car method)) ! (gnus-methods-using 'address)) ! (gnus-server-equal method gnus-message-archive-method)) ! (nth 1 method) (not (string= (nth 1 method) ""))) (concat "+" (nth 1 method))) *************** If REGEXP, only list groups matching REG *** 3576,3641 **** "")) ! (defun gnus-group-method-name (group) ! "Return the method used for selecting GROUP." (let ((prefix (gnus-group-real-prefix group))) (if (equal prefix "") gnus-select-method ! (if (string-match "^[^\\+]+\\+" prefix) ! (list (intern (substring prefix 0 (1- (match-end 0)))) ! (substring prefix (match-end 0) (1- (length prefix)))) ! (list (intern (substring prefix 0 (1- (length prefix)))) ""))))) (defun gnus-group-foreign-p (group) ! "Return nil if GROUP is native, non-nil if it is foreign." ! (string-match ":" group)) (defun gnus-group-set-info (info &optional method-only-group part) (let* ((entry (gnus-gethash ! (or method-only-group (car info)) gnus-newsrc-hashtb)) (part-info info) ! (info (if method-only-group (nth 2 entry) info))) ! (if (not method-only-group) ! () ! (or entry ! (error "Trying to change non-existent group %s" method-only-group)) ;; We have received parts of the actual group info - either the ! ;; select method or the group parameters. We first check ;; whether we have to extend the info, and if so, do that. (let ((len (length info)) (total (if (eq part 'method) 5 6))) ! (and (< len total) ! (setcdr (nthcdr (1- len) info) ! (make-list (- total len) nil))) ;; Then we enter the new info. (setcar (nthcdr (1- total) info) part-info))) ! ;; We uncompress some lists of marked articles. ! (let (marked) ! (if (not (setq marked (nth 3 info))) ! () ! (while marked ! (or (eq 'score (car (car marked))) ! (eq 'bookmark (car (car marked))) ! (eq 'killed (car (car marked))) ! (setcdr (car marked) ! (gnus-uncompress-range (cdr (car marked))))) ! (setq marked (cdr marked))))) ! (if entry ! () ;; This is a new group, so we just create it. (save-excursion (set-buffer gnus-group-buffer) ! (if (nth 4 info) ! ;; It's a foreign group... ! (gnus-group-make-group ! (gnus-group-real-name (car info)) ! (prin1-to-string (car (nth 4 info))) ! (nth 1 (nth 4 info))) ! ;; It's a native group. ! (gnus-group-make-group (car info))) (gnus-message 6 "Note: New group created") ! (setq entry ! (gnus-gethash (gnus-group-prefixed-name ! (gnus-group-real-name (car info)) ! (or (nth 4 info) gnus-select-method)) gnus-newsrc-hashtb)))) ;; Whether it was a new group or not, we now have the entry, so we --- 4811,4954 ---- "")) ! (defun gnus-group-method (group) ! "Return the server or method used for selecting GROUP." (let ((prefix (gnus-group-real-prefix group))) (if (equal prefix "") gnus-select-method ! (let ((servers gnus-opened-servers) ! (server "") ! backend possible found) ! (if (string-match "^[^\\+]+\\+" prefix) ! (setq backend (intern (substring prefix 0 (1- (match-end 0)))) ! server (substring prefix (match-end 0) (1- (length prefix)))) ! (setq backend (intern (substring prefix 0 (1- (length prefix)))))) ! (while servers ! (when (eq (caaar servers) backend) ! (setq possible (caar servers)) ! (when (equal (cadaar servers) server) ! (setq found (caar servers)))) ! (pop servers)) ! (or (car (rassoc found gnus-server-alist)) ! found ! (car (rassoc possible gnus-server-alist)) ! possible ! (list backend server)))))) ! ! (defsubst gnus-secondary-method-p (method) ! "Return whether METHOD is a secondary select method." ! (let ((methods gnus-secondary-select-methods) ! (gmethod (gnus-server-get-method nil method))) ! (while (and methods ! (not (equal (gnus-server-get-method nil (car methods)) ! gmethod))) ! (setq methods (cdr methods))) ! methods)) (defun gnus-group-foreign-p (group) ! "Say whether a group is foreign or not." ! (and (not (gnus-group-native-p group)) ! (not (gnus-group-secondary-p group)))) ! ! (defun gnus-group-native-p (group) ! "Say whether the group is native or not." ! (not (string-match ":" group))) ! ! (defun gnus-group-secondary-p (group) ! "Say whether the group is secondary or not." ! (gnus-secondary-method-p (gnus-find-method-for-group group))) ! ! (defun gnus-group-get-parameter (group &optional symbol) ! "Returns the group parameters for GROUP. ! If SYMBOL, return the value of that symbol in the group parameters." ! (let ((params (gnus-info-params (gnus-get-info group)))) ! (if symbol ! (gnus-group-parameter-value params symbol) ! params))) ! ! (defun gnus-group-parameter-value (params symbol) ! "Return the value of SYMBOL in group PARAMS." ! (or (car (memq symbol params)) ; It's either a simple symbol ! (cdr (assq symbol params)))) ; or a cons. ! ! (defun gnus-group-add-parameter (group param) ! "Add parameter PARAM to GROUP." ! (let ((info (gnus-get-info group))) ! (if (not info) ! () ; This is a dead group. We just ignore it. ! ;; Cons the new param to the old one and update. ! (gnus-group-set-info (cons param (gnus-info-params info)) ! group 'params)))) ! ! (defun gnus-group-set-parameter (group name value) ! "Set parameter NAME to VALUE in GROUP." ! (let ((info (gnus-get-info group))) ! (if (not info) ! () ; This is a dead group. We just ignore it. ! (let ((old-params (gnus-info-params info)) ! (new-params (list (cons name value)))) ! (while old-params ! (if (or (not (listp (car old-params))) ! (not (eq (caar old-params) name))) ! (setq new-params (append new-params (list (car old-params))))) ! (setq old-params (cdr old-params))) ! (gnus-group-set-info new-params group 'params))))) ! ! (defun gnus-group-add-score (group &optional score) ! "Add SCORE to the GROUP score. ! If SCORE is nil, add 1 to the score of GROUP." ! (let ((info (gnus-get-info group))) ! (when info ! (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) ! ! (defun gnus-summary-bubble-group () ! "Increase the score of the current group. ! This is a handy function to add to `gnus-summary-exit-hook' to ! increase the score of each group you read." ! (gnus-group-add-score gnus-newsgroup-name)) (defun gnus-group-set-info (info &optional method-only-group part) (let* ((entry (gnus-gethash ! (or method-only-group (gnus-info-group info)) ! gnus-newsrc-hashtb)) (part-info info) ! (info (if method-only-group (nth 2 entry) info)) ! method) ! (when method-only-group ! (unless entry ! (error "Trying to change non-existent group %s" method-only-group)) ;; We have received parts of the actual group info - either the ! ;; select method or the group parameters. We first check ;; whether we have to extend the info, and if so, do that. (let ((len (length info)) (total (if (eq part 'method) 5 6))) ! (when (< len total) ! (setcdr (nthcdr (1- len) info) ! (make-list (- total len) nil))) ;; Then we enter the new info. (setcar (nthcdr (1- total) info) part-info))) ! (unless entry ;; This is a new group, so we just create it. (save-excursion (set-buffer gnus-group-buffer) ! (setq method (gnus-info-method info)) ! (when (gnus-server-equal method "native") ! (setq method nil)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (if method ! ;; It's a foreign group... ! (gnus-group-make-group ! (gnus-group-real-name (gnus-info-group info)) ! (if (stringp method) method ! (prin1-to-string (car method))) ! (and (consp method) ! (nth 1 (gnus-info-method info)))) ! ;; It's a native group. ! (gnus-group-make-group (gnus-info-group info)))) (gnus-message 6 "Note: New group created") ! (setq entry ! (gnus-gethash (gnus-group-prefixed-name ! (gnus-group-real-name (gnus-info-group info)) ! (or (gnus-info-method info) gnus-select-method)) gnus-newsrc-hashtb)))) ;; Whether it was a new group or not, we now have the entry, so we *************** If REGEXP, only list groups matching REG *** 3644,3656 **** (progn (setcar (nthcdr 2 entry) info) ! (if (and (not (eq (car entry) t)) ! (gnus-gethash (car info) gnus-active-hashtb)) ! (let ((marked (nth 3 info))) ! (setcar entry ! (max 0 (- (length (gnus-list-of-unread-articles ! (car info))) ! (length (cdr (assq 'tick marked))) ! (length (cdr (assq 'dormant marked))))))))) ! (error "No such group: %s" (car info))))) (defun gnus-group-set-method-info (group select-method) --- 4957,4964 ---- (progn (setcar (nthcdr 2 entry) info) ! (when (and (not (eq (car entry) t)) ! (gnus-active (gnus-info-group info))) ! (setcar entry (length (gnus-list-of-unread-articles (car info)))))) ! (error "No such group: %s" (gnus-info-group info))))) (defun gnus-group-set-method-info (group select-method) *************** If REGEXP, only list groups matching REG *** 3661,3817 **** (defun gnus-group-update-group-line () ! "This function updates the current line in the newsgroup buffer and ! moves the point to the colon." (let* ((buffer-read-only nil) (group (gnus-group-group-name)) ! (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))) ! (if (and entry (not (gnus-ephemeral-group-p group))) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ! ")"))) ! (beginning-of-line) ! (delete-region (point) (progn (forward-line 1) (point))) ! (gnus-group-insert-group-line-info group) ! (forward-line -1) ! (gnus-group-position-cursor))) (defun gnus-group-insert-group-line-info (group) ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) active info) (if entry (progn (setq info (nth 2 entry)) ! (gnus-group-insert-group-line ! nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) ! (setq active (gnus-gethash group gnus-active-hashtb)) ! (gnus-group-insert-group-line ! nil group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) ! nil (if active (- (1+ (cdr active)) (car active)) 0) nil)))) ! ! (defun gnus-group-insert-group-line (gformat group level marked number method) ! (let* ((gformat (or gformat gnus-group-line-format-spec)) ! (active (gnus-gethash group gnus-active-hashtb)) ! (number-total (if active (1+ (- (cdr active) (car active))) 0)) ! (number-of-dormant (length (cdr (assq 'dormant marked)))) ! (number-of-ticked (length (cdr (assq 'tick marked)))) ! (number-of-ticked-and-dormant ! (+ number-of-ticked number-of-dormant)) ! (number-of-unread-unticked (if (numberp number) (int-to-string (max 0 number)) "*")) ! (number-of-read (if (numberp number) ! (max 0 (- number-total number)) "*")) ! (subscribed (cond ((<= level gnus-level-subscribed) ? ) ! ((<= level gnus-level-unsubscribed) ?U) ! ((= level gnus-level-zombie) ?Z) ! (t ?K))) ! (qualified-group (gnus-group-real-name group)) ! (newsgroup-description (if gnus-description-hashtb ! (or (gnus-gethash group gnus-description-hashtb) "") "")) ! (moderated (if (member group gnus-moderated-list) ?m ? )) ! (moderated-string (if (eq moderated ?m) "(m)" "")) ! (method (gnus-server-get-method group method)) ! (news-server (or (car (cdr method)) "")) ! (news-method (or (car method) "")) ! (news-method-string ! (if method (format "(%s:%s)" (car method) (car (cdr method))) "")) ! (marked (if (and ! (numberp number) ! (zerop number) ! (> number-of-ticked 0)) ! ?* ? )) ! (number (if (eq number t) "*" (+ number number-of-dormant ! number-of-ticked))) ! (process-marked (if (member group gnus-group-marked) ! gnus-process-mark ? )) (buffer-read-only nil) ! header ; passed as parameter to user-funcs. ! b) (beginning-of-line) ! (setq b (point)) ! ;; Insert the text. ! (insert (eval gformat)) ! ! (add-text-properties ! b (1+ b) (list 'gnus-group (intern group) ! 'gnus-unread (if (numberp number) ! (string-to-int number-of-unread-unticked) ! t) ! 'gnus-marked marked ! 'gnus-level level)))) (defun gnus-group-update-group (group &optional visible-only) ! "Update newsgroup info of GROUP. ! If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." (save-excursion (set-buffer gnus-group-buffer) ! (let ((buffer-read-only nil) ! visible) ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) ! (if (and entry ! (not (gnus-ephemeral-group-p group))) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ! ")")))) ! ;; Buffer may be narrowed. ! (save-restriction ! (widen) ! ;; Search a line to modify. If the buffer is large, the search ! ;; takes long time. In most cases, current point is on the line ! ;; we are looking for. So, first of all, check current line. ! (if (or (progn ! (beginning-of-line) ! (eq (get-text-property (point) 'gnus-group) ! (intern group))) ! (progn ! (gnus-goto-char ! (text-property-any ! (point-min) (point-max) 'gnus-group (intern group))))) ! ;; GROUP is listed in current buffer. So, delete old line. ! (progn ! (setq visible t) ! (beginning-of-line) ! (delete-region (point) (progn (forward-line 1) (point)))) ;; No such line in the buffer, find out where it's supposed to ;; go, and insert it there (or at the end of the buffer). ! ;; Fix by Per Abrahamsen . ! (or visible-only ! (let ((entry ! (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb))))) ! (while (and entry ! (car entry) ! (not ! (gnus-goto-char ! (text-property-any ! (point-min) (point-max) ! 'gnus-group (intern (car (car entry))))))) ! (setq entry (cdr entry))) ! (or entry (goto-char (point-max))))))) ! (if (or visible (not visible-only)) ! (gnus-group-insert-group-line-info group)) ! (gnus-group-set-mode-line)))) (defun gnus-group-set-mode-line () ! (if (memq 'group gnus-updated-mode-lines) (let* ((gformat (or gnus-group-mode-line-format-spec (setq gnus-group-mode-line-format-spec ! (gnus-parse-format ! gnus-group-mode-line-format gnus-group-mode-line-format-alist)))) ! (news-server (car (cdr gnus-select-method))) ! (news-method (car gnus-select-method)) (max-len 60) ! header ;Dummy binding for user-defined specs. (mode-string (eval gformat))) ! (setq mode-string (eval gformat)) ! (if (> (length mode-string) max-len) ! (setq mode-string (substring mode-string 0 (- max-len 4)))) ! (setq mode-line-buffer-identification mode-string) ! (set-buffer-modified-p t)))) (defun gnus-group-group-name () --- 4969,5171 ---- (defun gnus-group-update-group-line () ! "Update the current line in the group buffer." (let* ((buffer-read-only nil) (group (gnus-group-group-name)) ! (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) ! gnus-group-indentation) ! (when group ! (and entry ! (not (gnus-ephemeral-group-p group)) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" ! (prin1-to-string (nth 2 entry)) ")"))) ! (setq gnus-group-indentation (gnus-group-group-indentation)) ! (gnus-delete-line) ! (gnus-group-insert-group-line-info group) ! (forward-line -1) ! (gnus-group-position-point)))) (defun gnus-group-insert-group-line-info (group) ! "Insert GROUP on the current line." ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) active info) (if entry (progn + ;; (Un)subscribed group. (setq info (nth 2 entry)) ! (gnus-group-insert-group-line ! group (gnus-info-level info) (gnus-info-marks info) ! (or (car entry) t) (gnus-info-method info))) ! ;; This group is dead. ! (gnus-group-insert-group-line ! group (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) ! nil ! (if (setq active (gnus-active group)) ! (- (1+ (cdr active)) (car active)) 0) ! nil)))) ! ! (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." ! (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) ! (gnus-tmp-number-total ! (if gnus-tmp-active ! (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) ! 0)) ! (gnus-tmp-number-of-unread (if (numberp number) (int-to-string (max 0 number)) "*")) ! (gnus-tmp-number-of-read (if (numberp number) ! (int-to-string (max 0 (- gnus-tmp-number-total number))) "*")) ! (gnus-tmp-subscribed ! (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) ! ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ! ((= gnus-tmp-level gnus-level-zombie) ?Z) ! (t ?K))) ! (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) ! (gnus-tmp-newsgroup-description (if gnus-description-hashtb ! (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") "")) ! (gnus-tmp-moderated ! (if (member gnus-tmp-group gnus-moderated-list) ?m ? )) ! (gnus-tmp-moderated-string ! (if (eq gnus-tmp-moderated ?m) "(m)" "")) ! (gnus-tmp-method ! (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) ! (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) ! (gnus-tmp-news-method (or (car gnus-tmp-method) "")) ! (gnus-tmp-news-method-string ! (if gnus-tmp-method ! (format "(%s:%s)" (car gnus-tmp-method) ! (cadr gnus-tmp-method)) "")) ! (gnus-tmp-marked-mark ! (if (and (numberp number) ! (zerop number) ! (cdr (assq 'tick gnus-tmp-marked))) ! ?* ? )) ! (gnus-tmp-process-marked ! (if (member gnus-tmp-group gnus-group-marked) ! gnus-process-mark ? )) ! (gnus-tmp-grouplens ! (or (and gnus-use-grouplens ! (bbb-grouplens-group-p gnus-tmp-group)) ! "")) (buffer-read-only nil) ! header gnus-tmp-header) ; passed as parameter to user-funcs. (beginning-of-line) ! (gnus-add-text-properties ! (point) ! (prog1 (1+ (point)) ! ;; Insert the text. ! (eval gnus-group-line-format-spec)) ! `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) ! gnus-unread ,(if (numberp number) ! (string-to-int gnus-tmp-number-of-unread) ! t) ! gnus-marked ,gnus-tmp-marked-mark ! gnus-indentation ,gnus-group-indentation ! gnus-level ,gnus-tmp-level)) ! (when (inline (gnus-visual-p 'group-highlight 'highlight)) ! (forward-line -1) ! (run-hooks 'gnus-group-update-hook) ! (forward-line)) ! ;; Allow XEmacs to remove front-sticky text properties. ! (gnus-group-remove-excess-properties))) (defun gnus-group-update-group (group &optional visible-only) ! "Update all lines where GROUP appear. ! If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't ! already." (save-excursion (set-buffer gnus-group-buffer) ! ;; The buffer may be narrowed. ! (save-restriction ! (widen) ! (let ((ident (gnus-intern-safe group gnus-active-hashtb)) ! (loc (point-min)) ! found buffer-read-only) ! ;; Enter the current status into the dribble buffer. ! (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) ! (if (and entry (not (gnus-ephemeral-group-p group))) ! (gnus-dribble-enter ! (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) ! ")")))) ! ;; Find all group instances. If topics are in use, each group ! ;; may be listed in more than once. ! (while (setq loc (text-property-any ! loc (point-max) 'gnus-group ident)) ! (setq found t) ! (goto-char loc) ! (let ((gnus-group-indentation (gnus-group-group-indentation))) ! (gnus-delete-line) ! (gnus-group-insert-group-line-info group) ! (save-excursion ! (forward-line -1) ! (run-hooks 'gnus-group-update-group-hook))) ! (setq loc (1+ loc))) ! (unless (or found visible-only) ;; No such line in the buffer, find out where it's supposed to ;; go, and insert it there (or at the end of the buffer). ! (if gnus-goto-missing-group-function ! (funcall gnus-goto-missing-group-function group) ! (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) ! (while (and entry (car entry) ! (not ! (gnus-goto-char ! (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! (caar entry) gnus-active-hashtb))))) ! (setq entry (cdr entry))) ! (or entry (goto-char (point-max))))) ! ;; Finally insert the line. ! (let ((gnus-group-indentation (gnus-group-group-indentation))) ! (gnus-group-insert-group-line-info group) ! (save-excursion ! (forward-line -1) ! (run-hooks 'gnus-group-update-group-hook)))) ! (gnus-group-set-mode-line))))) (defun gnus-group-set-mode-line () ! "Update the mode line in the group buffer." ! (when (memq 'group gnus-updated-mode-lines) ! ;; Yes, we want to keep this mode line updated. ! (save-excursion ! (set-buffer gnus-group-buffer) (let* ((gformat (or gnus-group-mode-line-format-spec (setq gnus-group-mode-line-format-spec ! (gnus-parse-format ! gnus-group-mode-line-format gnus-group-mode-line-format-alist)))) ! (gnus-tmp-news-server (cadr gnus-select-method)) ! (gnus-tmp-news-method (car gnus-select-method)) ! (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) (max-len 60) ! gnus-tmp-header ;Dummy binding for user-defined formats ! ;; Get the resulting string. ! (modified ! (and gnus-dribble-buffer ! (buffer-name gnus-dribble-buffer) ! (buffer-modified-p gnus-dribble-buffer) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (not (zerop (buffer-size)))))) (mode-string (eval gformat))) ! ;; Say whether the dribble buffer has been modified. ! (setq mode-line-modified ! (if modified "---*- " "----- ")) ! ;; If the line is too long, we chop it off. ! (when (> (length mode-string) max-len) ! (setq mode-string (substring mode-string 0 (- max-len 4)))) ! (prog1 ! (setq mode-line-buffer-identification ! (gnus-mode-line-buffer-identification ! (list mode-string))) ! (set-buffer-modified-p modified)))))) (defun gnus-group-group-name () *************** If VISIBLE-ONLY is non-nil, the group wo *** 3824,3827 **** --- 5178,5188 ---- (get-text-property (gnus-point-at-bol) 'gnus-level)) + (defun gnus-group-group-indentation () + "Get the indentation of the newsgroup on the current line." + (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) + (and gnus-group-indentation-function + (funcall gnus-group-indentation-function)) + "")) + (defun gnus-group-group-unread () "Get the number of unread articles of the newsgroup on the current line." *************** If FIRST-TOO, the current line is also e *** 3842,3854 **** nil (or first-too (forward-line way)) ! (while (and (not (eobp)) ! (not (setq ! found (and (or all (and ! (let ((unread (get-text-property (point) 'gnus-unread))) ! (or (eq unread t) (and unread (> unread 0)))) (setq lev (get-text-property (point) 'gnus-level)) --- 5203,5215 ---- nil (or first-too (forward-line way)) ! (while (and (not (eobp)) ! (not (setq ! found (and (or all (and ! (let ((unread (get-text-property (point) 'gnus-unread))) ! (and (numberp unread) (> unread 0))) (setq lev (get-text-property (point) 'gnus-level)) *************** If FIRST-TOO, the current line is also e *** 3865,3870 **** nil)))))))) (zerop (forward-line way))))) ! (if found ! (progn (gnus-group-position-cursor) t) (goto-char (or pos beg)) (and pos t)))) --- 5226,5231 ---- nil)))))))) (zerop (forward-line way))))) ! (if found ! (progn (gnus-group-position-point) t) (goto-char (or pos beg)) (and pos t)))) *************** If FIRST-TOO, the current line is also e *** 3879,3901 **** (let ((buffer-read-only nil) group) ! (while ! (and (> n 0) ! (setq group (gnus-group-group-name)) ! (progn ! (beginning-of-line) ! (forward-char ! (or (cdr (assq 'process gnus-group-mark-positions)) 2)) ! (delete-char 1) ! (if unmark ! (progn ! (insert " ") ! (setq gnus-group-marked (delete group gnus-group-marked))) ! (insert "#") ! (setq gnus-group-marked ! (cons group (delete group gnus-group-marked)))) ! t) ! (or no-advance (zerop (gnus-group-next-group 1)))) ! (setq n (1- n))) ! (gnus-summary-position-cursor) n)) --- 5240,5261 ---- (let ((buffer-read-only nil) group) ! (while (and (> n 0) ! (not (eobp))) ! (when (setq group (gnus-group-group-name)) ! ;; Update the mark. ! (beginning-of-line) ! (forward-char ! (or (cdr (assq 'process gnus-group-mark-positions)) 2)) ! (delete-char 1) ! (if unmark ! (progn ! (insert " ") ! (setq gnus-group-marked (delete group gnus-group-marked))) ! (insert "#") ! (setq gnus-group-marked ! (cons group (delete group gnus-group-marked))))) ! (or no-advance (gnus-group-next-group 1)) ! (decf n)) ! (gnus-summary-position-point) n)) *************** If FIRST-TOO, the current line is also e *** 3903,3907 **** "Remove the mark from the current group." (interactive "p") ! (gnus-group-mark-group n 'unmark)) (defun gnus-group-mark-region (unmark beg end) --- 5263,5277 ---- "Remove the mark from the current group." (interactive "p") ! (gnus-group-mark-group n 'unmark) ! (gnus-group-position-point)) ! ! (defun gnus-group-unmark-all-groups () ! "Unmark all groups." ! (interactive) ! (let ((groups gnus-group-marked)) ! (save-excursion ! (while groups ! (gnus-group-remove-mark (pop groups))))) ! (gnus-group-position-point)) (defun gnus-group-mark-region (unmark beg end) *************** If UNMARK, remove the mark instead." *** 3914,3947 **** (- num (gnus-group-mark-group num unmark))))) (defun gnus-group-remove-mark (group) ! (and (gnus-group-goto-group group) ! (save-excursion ! (gnus-group-mark-group 1 'unmark t)))) - ;; Return a list of groups to work on. Take into consideration N (the - ;; prefix) and the list of marked groups. (defun gnus-group-process-prefix (n) ! (cond (n ! (setq n (prefix-numeric-value n)) ! ;; There is a prefix, so we return a list of the N next ! ;; groups. ! (let ((way (if (< n 0) -1 1)) ! (n (abs n)) ! group groups) ! (save-excursion ! (while (and (> n 0) ! (setq group (gnus-group-group-name))) ! (setq groups (cons group groups)) ! (setq n (1- n)) ! (forward-line way))) ! (nreverse groups))) ! (gnus-group-marked ! ;; No prefix, but a list of marked articles. ! (reverse gnus-group-marked)) ! (t ! ;; Neither marked articles or a prefix, so we return the ! ;; current group. ! (let ((group (gnus-group-group-name))) ! (and group (list group)))))) ;; Selecting groups. --- 5284,5379 ---- (- num (gnus-group-mark-group num unmark))))) + (defun gnus-group-mark-buffer (&optional unmark) + "Mark all groups in the buffer. + If UNMARK, remove the mark instead." + (interactive "P") + (gnus-group-mark-region unmark (point-min) (point-max))) + + (defun gnus-group-mark-regexp (regexp) + "Mark all groups that match some regexp." + (interactive "sMark (regexp): ") + (let ((alist (cdr gnus-newsrc-alist)) + group) + (while alist + (when (string-match regexp (setq group (gnus-info-group (pop alist)))) + (gnus-group-set-mark group)))) + (gnus-group-position-point)) + (defun gnus-group-remove-mark (group) ! "Remove the process mark from GROUP and move point there. ! Return nil if the group isn't displayed." ! (if (gnus-group-goto-group group) ! (save-excursion ! (gnus-group-mark-group 1 'unmark t) ! t) ! (setq gnus-group-marked ! (delete group gnus-group-marked)) ! nil)) ! ! (defun gnus-group-set-mark (group) ! "Set the process mark on GROUP." ! (if (gnus-group-goto-group group) ! (save-excursion ! (gnus-group-mark-group 1 nil t)) ! (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) ! ! (defun gnus-group-universal-argument (arg &optional groups func) ! "Perform any command on all groups accoring to the process/prefix convention." ! (interactive "P") ! (let ((groups (or groups (gnus-group-process-prefix arg))) ! group func) ! (if (eq (setq func (or func ! (key-binding ! (read-key-sequence ! (substitute-command-keys ! "\\\\[gnus-group-universal-argument]"))))) ! 'undefined) ! (gnus-error 1 "Undefined key") ! (while groups ! (gnus-group-remove-mark (setq group (pop groups))) ! (command-execute func)))) ! (gnus-group-position-point)) (defun gnus-group-process-prefix (n) ! "Return a list of groups to work on. ! Take into consideration N (the prefix) and the list of marked groups." ! (cond ! (n ! (setq n (prefix-numeric-value n)) ! ;; There is a prefix, so we return a list of the N next ! ;; groups. ! (let ((way (if (< n 0) -1 1)) ! (n (abs n)) ! group groups) ! (save-excursion ! (while (and (> n 0) ! (setq group (gnus-group-group-name))) ! (setq groups (cons group groups)) ! (setq n (1- n)) ! (gnus-group-next-group way))) ! (nreverse groups))) ! ((and (boundp 'transient-mark-mode) ! transient-mark-mode ! (boundp 'mark-active) ! mark-active) ! ;; Work on the region between point and mark. ! (let ((max (max (point) (mark))) ! groups) ! (save-excursion ! (goto-char (min (point) (mark))) ! (while ! (and ! (push (gnus-group-group-name) groups) ! (zerop (gnus-group-next-group 1)) ! (< (point) max))) ! (nreverse groups)))) ! (gnus-group-marked ! ;; No prefix, but a list of marked articles. ! (reverse gnus-group-marked)) ! (t ! ;; Neither marked articles or a prefix, so we return the ! ;; current group. ! (let ((group (gnus-group-group-name))) ! (and group (list group)))))) ;; Selecting groups. *************** If UNMARK, remove the mark instead." *** 3950,3969 **** "Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become ! readable. If the optional argument NO-ARTICLE is non-nil, no article ! will be auto-selected upon group entry." (interactive "P") (let ((group (or group (gnus-group-group-name))) number active marked entry) (or group (error "No group on current line")) ! (setq marked ! (nth 3 (nth 2 (setq entry (gnus-gethash group gnus-newsrc-hashtb))))) ! ;; This group might be a dead group. In that case we have to get ;; the number of unread articles from `gnus-active-hashtb'. ! (if entry ! (setq number (car entry)) ! (if (setq active (gnus-gethash group gnus-active-hashtb)) ! (setq number (- (1+ (cdr active)) (car active))))) ! (gnus-summary-read-group ! group (or all (and (numberp number) (zerop (+ number (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))) --- 5382,5404 ---- "Read news in this newsgroup. If the prefix argument ALL is non-nil, already read articles become ! readable. IF ALL is a number, fetch this number of articles. If the ! optional argument NO-ARTICLE is non-nil, no article will be ! auto-selected upon group entry. If GROUP is non-nil, fetch that ! group." (interactive "P") (let ((group (or group (gnus-group-group-name))) number active marked entry) (or group (error "No group on current line")) ! (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash ! group gnus-newsrc-hashtb))))) ! ;; This group might be a dead group. In that case we have to get ;; the number of unread articles from `gnus-active-hashtb'. ! (setq number ! (cond ((numberp all) all) ! (entry (car entry)) ! ((setq active (gnus-active group)) ! (- (1+ (cdr active)) (car active))))) ! (gnus-summary-read-group ! group (or all (and (numberp number) (zerop (+ number (length (cdr (assq 'tick marked))) (length (cdr (assq 'dormant marked))))))) *************** will be auto-selected upon group entry." *** 3973,3999 **** "Select this newsgroup. No article is selected automatically. ! If argument ALL is non-nil, already read articles become readable." (interactive "P") (gnus-group-read-group all t)) ! (defun gnus-group-select-group-all () ! "Select the current group and display all articles in it." ! (interactive) ! (gnus-group-select-group 'all)) ! ;; 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 quit-config) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) ! (gnus-sethash group ! (list t nil (list group gnus-level-default-subscribed nil nil ! (append method ! (list ! (list 'quit-config ! (if quit-config quit-config ! (cons (current-buffer) 'summary))))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) --- 5408,5452 ---- "Select this newsgroup. No article is selected automatically. ! If ALL is non-nil, already read articles become readable. ! If ALL is a number, fetch this number of articles." (interactive "P") (gnus-group-read-group all t)) ! (defun gnus-group-quick-select-group (&optional all) ! "Select the current group \"quickly\". ! This means that no highlighting or scoring will be performed." ! (interactive "P") ! (let (gnus-visual ! gnus-score-find-score-files-function ! gnus-apply-kill-hook ! gnus-summary-expunge-below) ! (gnus-group-read-group all t))) ! ! (defun gnus-group-visible-select-group (&optional all) ! "Select the current group without hiding any articles." ! (interactive "P") ! (let ((gnus-inhibit-limiting t)) ! (gnus-group-read-group all t))) ! ;;;###autoload ! (defun gnus-fetch-group (group) ! "Start Gnus if necessary and enter GROUP. ! Returns whether the fetching was successful or not." ! (interactive "sGroup name: ") ! (or (get-buffer gnus-group-buffer) ! (gnus)) ! (gnus-group-read-group nil nil group)) ! ! ;; 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 quit-config) (let ((group (if (gnus-group-foreign-p group) group (gnus-group-prefixed-name group method)))) ! (gnus-sethash group ! `(t nil (,group ,gnus-level-default-subscribed nil nil ,method ! ((quit-config . ,(if quit-config quit-config ! (cons (current-buffer) 'summary)))))) gnus-newsrc-hashtb) (set-buffer gnus-group-buffer) *************** If argument ALL is non-nil, already read *** 4005,4043 **** (gnus-group-read-group t t group) (error nil) ! (quit nil)) ! (not (equal major-mode 'gnus-group-mode)))) ! (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." ! (interactive ! (list (completing-read ! "Group: " gnus-active-hashtb nil ! (memq gnus-select-method gnus-have-read-active-file)))) ! (if (equal group "") ! (error "Empty group name")) ! (let ((b (text-property-any ! (point-min) (point-max) 'gnus-group (intern group)))) ! (if b ! ;; Either go to the line in the group buffer... ! (goto-char b) ! ;; ... or insert the line. ! (or ! (gnus-gethash group gnus-active-hashtb) ! (gnus-activate-group group) ! (error "%s error: %s" group (gnus-status-message group))) ! ! (gnus-group-update-group group) ! (goto-char (text-property-any ! (point-min) (point-max) 'gnus-group (intern group))))) ! ;; Adjust cursor point. ! (gnus-group-position-cursor)) (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." ! (let ((b (text-property-any (point-min) (point-max) ! 'gnus-group (intern group)))) ! (and b (goto-char b)))) (defun gnus-group-next-group (n) --- 5458,5505 ---- (gnus-group-read-group t t group) (error nil) ! (quit nil)))) ! (defun gnus-group-jump-to-group (group) "Jump to newsgroup GROUP." ! (interactive ! (list (completing-read ! "Group: " gnus-active-hashtb nil ! (gnus-read-active-file-p) ! nil ! 'gnus-group-history))) ! (when (equal group "") ! (error "Empty group name")) ! (when (string-match "[\000-\032]" group) ! (error "Control characters in group: %s" group)) ! ! (let ((b (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) ! (unless (gnus-ephemeral-group-p group) ! (if b ! ;; Either go to the line in the group buffer... ! (goto-char b) ! ;; ... or insert the line. ! (or ! (gnus-active group) ! (gnus-activate-group group) ! (error "%s error: %s" group (gnus-status-message group))) ! ! (gnus-group-update-group group) ! (goto-char (text-property-any ! (point-min) (point-max) ! 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))) ! ;; Adjust cursor point. ! (gnus-group-position-point))) (defun gnus-group-goto-group (group) "Goto to newsgroup GROUP." ! (when group ! (let ((b (text-property-any (point-min) (point-max) ! 'gnus-group (gnus-intern-safe ! group gnus-active-hashtb)))) ! (and b (goto-char b))))) (defun gnus-group-next-group (n) *************** made." *** 4062,4066 **** (n (abs n))) (while (and (> n 0) ! (gnus-group-search-forward backward (or (not gnus-group-goto-unread) all) level)) (setq n (1- n))) --- 5524,5528 ---- (n (abs n))) (while (and (> n 0) ! (gnus-group-search-forward backward (or (not gnus-group-goto-unread) all) level)) (setq n (1- n))) *************** done." *** 4079,4083 **** "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually ! done." (interactive "p") (gnus-group-next-unread-group (- n))) --- 5541,5545 ---- "Go to previous N'th unread newsgroup. Returns the difference between N and the number of skips actually ! done." (interactive "p") (gnus-group-next-unread-group (- n))) *************** done." *** 4090,4094 **** (interactive "p") (gnus-group-next-unread-group n t (gnus-group-group-level)) ! (gnus-group-position-cursor)) (defun gnus-group-prev-unread-group-same-level (n) --- 5552,5556 ---- (interactive "p") (gnus-group-next-unread-group n t (gnus-group-group-level)) ! (gnus-group-position-point)) (defun gnus-group-prev-unread-group-same-level (n) *************** done." *** 4098,4102 **** (interactive "p") (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) ! (gnus-group-position-cursor)) (defun gnus-group-best-unread-group (&optional exclude-group) --- 5560,5564 ---- (interactive "p") (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) ! (gnus-group-position-point)) (defun gnus-group-best-unread-group (&optional exclude-group) *************** If EXCLUDE-GROUP, do not go to that grou *** 4107,4122 **** (let ((best 100000) unread best-point) ! (while (setq unread (get-text-property (point) 'gnus-unread)) (if (and (numberp unread) (> unread 0)) (progn ! (if (and (< (get-text-property (point) 'gnus-level) best) (or (not exclude-group) (not (equal exclude-group (gnus-group-group-name))))) ! (progn (setq best (get-text-property (point) 'gnus-level)) (setq best-point (point)))))) (forward-line 1)) (if best-point (goto-char best-point)) ! (gnus-summary-position-cursor) (and best-point (gnus-group-group-name)))) --- 5569,5586 ---- (let ((best 100000) unread best-point) ! (while (not (eobp)) ! (setq unread (get-text-property (point) 'gnus-unread)) (if (and (numberp unread) (> unread 0)) (progn ! (if (and (get-text-property (point) 'gnus-level) ! (< (get-text-property (point) 'gnus-level) best) (or (not exclude-group) (not (equal exclude-group (gnus-group-group-name))))) ! (progn (setq best (get-text-property (point) 'gnus-level)) (setq best-point (point)))))) (forward-line 1)) (if best-point (goto-char best-point)) ! (gnus-summary-position-point) (and best-point (gnus-group-group-name)))) *************** If EXCLUDE-GROUP, do not go to that grou *** 4129,4145 **** (goto-char (point-min)) (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. ! (not (zerop unread)) ; Has unread articles. (zerop (gnus-group-next-unread-group 1))) ; Next unread group. (point) ; Success. (goto-char opoint) nil)) ; Not success. ! (gnus-group-position-cursor))) (defun gnus-group-enter-server-mode () "Jump to the server buffer." (interactive) ! (gnus-server-setup-buffer) ! (gnus-configure-windows 'server) ! (gnus-server-prepare)) (defun gnus-group-make-group (name &optional method address) --- 5593,5608 ---- (goto-char (point-min)) (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. ! (and (numberp unread) ; Not a topic. ! (not (zerop unread))) ; Has unread articles. (zerop (gnus-group-next-unread-group 1))) ; Next unread group. (point) ; Success. (goto-char opoint) nil)) ; Not success. ! (gnus-group-position-point))) (defun gnus-group-enter-server-mode () "Jump to the server buffer." (interactive) ! (gnus-enter-server-buffer)) (defun gnus-group-make-group (name &optional method address) *************** The user will be prompted for a NAME, fo *** 4148,4200 **** ADDRESS." (interactive ! (cons (read-string "Group name: ") (let ((method ! (completing-read "Method: " (append gnus-valid-select-methods gnus-server-alist) ! nil t))) ! (if (assoc method gnus-valid-select-methods) ! (list method ! (if (memq 'prompt-address ! (assoc method gnus-valid-select-methods)) ! (read-string "Address: ") ! "")) ! (list method nil))))) ! ! (let* ((meth (and method (if address (list (intern method) address) method))) (nname (if method (gnus-group-prefixed-name name meth) name)) ! info) ! (and (gnus-gethash nname gnus-newsrc-hashtb) ! (error "Group %s already exists" nname)) ! (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) ! gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) ! (gnus-sethash nname (cons 1 0) gnus-active-hashtb) (or (gnus-ephemeral-group-p name) ! (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) (gnus-group-insert-group-line-info nname) ! (if (assoc method gnus-valid-select-methods) ! (require (intern method))) (and (gnus-check-backend-function 'request-create-group nname) ! (gnus-request-create-group nname)))) (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let ((done-func '(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done 'part 'group))) ! (part (or part 'info)) ! (winconf (current-window-configuration)) ! info) (or group (error "No group on current line")) ! (or (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) (error "Killed group; can't be edited")) (set-buffer (get-buffer-create gnus-group-edit-buffer)) --- 5611,5745 ---- ADDRESS." (interactive ! (cons (read-string "Group name: ") (let ((method ! (completing-read "Method: " (append gnus-valid-select-methods gnus-server-alist) ! nil t nil 'gnus-method-history))) ! (cond ((assoc method gnus-valid-select-methods) ! (list method ! (if (memq 'prompt-address ! (assoc method gnus-valid-select-methods)) ! (read-string "Address: ") ! ""))) ! ((assoc method gnus-server-alist) ! (list method)) ! (t ! (list method "")))))) ! ! (let* ((meth (and method (if address (list (intern method) address) ! method))) (nname (if method (gnus-group-prefixed-name name meth) name)) ! backend info) ! (when (gnus-gethash nname gnus-newsrc-hashtb) ! (error "Group %s already exists" nname)) ! ;; Subscribe to the new group. ! (gnus-group-change-level (setq info (list t nname gnus-level-default-subscribed nil nil meth)) ! gnus-level-default-subscribed gnus-level-killed (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) t) ! ;; Make it active. ! (gnus-set-active nname (cons 1 0)) (or (gnus-ephemeral-group-p name) ! (gnus-dribble-enter (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))) + ;; Insert the line. (gnus-group-insert-group-line-info nname) + (forward-line -1) + (gnus-group-position-point) ! ;; Load the backend and try to make the backend create ! ;; the group as well. ! (when (assoc (symbol-name (setq backend (car (gnus-server-get-method ! nil meth)))) ! gnus-valid-select-methods) ! (require backend)) ! (gnus-check-server meth) (and (gnus-check-backend-function 'request-create-group nname) ! (gnus-request-create-group nname)) ! t)) ! ! (defun gnus-group-delete-group (group &optional force) ! "Delete the current group. Only meaningful with mail groups. ! If FORCE (the prefix) is non-nil, all the articles in the group will ! be deleted. This is \"deleted\" as in \"removed forever from the face ! of the Earth\". There is no undo. The user will be prompted before ! doing the deletion." ! (interactive ! (list (gnus-group-group-name) ! current-prefix-arg)) ! (or group (error "No group to rename")) ! (or (gnus-check-backend-function 'request-delete-group group) ! (error "This backend does not support group deletion")) ! (prog1 ! (if (not (gnus-yes-or-no-p ! (format ! "Do you really want to delete %s%s? " ! group (if force " and all its contents" "")))) ! () ; Whew! ! (gnus-message 6 "Deleting group %s..." group) ! (if (not (gnus-request-delete-group group force)) ! (gnus-error 3 "Couldn't delete group %s" group) ! (gnus-message 6 "Deleting group %s...done" group) ! (gnus-group-goto-group group) ! (gnus-group-kill-group 1 t) ! (gnus-sethash group nil gnus-active-hashtb) ! t)) ! (gnus-group-position-point))) ! ! (defun gnus-group-rename-group (group new-name) ! (interactive ! (list ! (gnus-group-group-name) ! (progn ! (or (gnus-check-backend-function ! 'request-rename-group (gnus-group-group-name)) ! (error "This backend does not support renaming groups")) ! (read-string "New group name: ")))) ! ! (or (gnus-check-backend-function 'request-rename-group group) ! (error "This backend does not support renaming groups")) ! ! (or group (error "No group to rename")) ! (and (string-match "^[ \t]*$" new-name) ! (error "Not a valid group name")) ! ! ;; We find the proper prefixed name. ! (setq new-name ! (gnus-group-prefixed-name ! (gnus-group-real-name new-name) ! (gnus-info-method (gnus-get-info group)))) ! ! (gnus-message 6 "Renaming group %s to %s..." group new-name) ! (prog1 ! (if (not (gnus-request-rename-group group new-name)) ! (gnus-error 3 "Couldn't rename group %s to %s" group new-name) ! ;; We rename the group internally by killing it... ! (gnus-group-goto-group group) ! (gnus-group-kill-group) ! ;; ... changing its name ... ! (setcar (cdar gnus-list-of-killed-groups) new-name) ! ;; ... and then yanking it. Magic! ! (gnus-group-yank-group) ! (gnus-set-active new-name (gnus-active group)) ! (gnus-message 6 "Renaming group %s to %s...done" group new-name) ! new-name) ! (gnus-group-position-point))) (defun gnus-group-edit-group (group &optional part) "Edit the group on the current line." (interactive (list (gnus-group-group-name))) ! (let* ((part (or part 'info)) ! (done-func `(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-group-edit-group-done ',part ,group))) ! (winconf (current-window-configuration)) ! info) (or group (error "No group on current line")) ! (or (setq info (gnus-get-info group)) (error "Killed group; can't be edited")) (set-buffer (get-buffer-create gnus-group-edit-buffer)) *************** ADDRESS." *** 4207,4216 **** (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) - ;; We modify the func to let it know what part it is editing. - (setcar (cdr (nth 4 done-func)) (list 'quote part)) - (setcar (cdr (cdr (nth 4 done-func))) group) (erase-buffer) (insert ! (cond ((eq part 'method) ";; Type `C-c C-c' after editing the select method.\n\n") --- 5752,5758 ---- (make-local-variable 'gnus-prev-winconf) (setq gnus-prev-winconf winconf) (erase-buffer) (insert ! (cond ((eq part 'method) ";; Type `C-c C-c' after editing the select method.\n\n") *************** ADDRESS." *** 4219,4243 **** ((eq part 'info) ";; Type `C-c C-c' after editing the group info.\n\n"))) ! (let ((cinfo (gnus-copy-sequence info)) ! marked) ! (if (not (setq marked (nth 3 cinfo))) ! () ! (while marked ! (or (eq 'score (car (car marked))) ! (eq 'bookmark (car (car marked))) ! (eq 'killed (car (car marked))) ! (not (numberp (car (cdr (car marked))))) ! (setcdr (car marked) ! (gnus-compress-sequence (sort (cdr (car marked)) '<) t))) ! (setq marked (cdr marked)))) ! (insert ! (pp-to-string ! (cond ((eq part 'method) ! (or (nth 4 info) "native")) ! ((eq part 'params) ! (nth 5 info)) ! (t ! cinfo))) ! "\n")))) (defun gnus-group-edit-group-method (group) --- 5761,5772 ---- ((eq part 'info) ";; Type `C-c C-c' after editing the group info.\n\n"))) ! (insert ! (pp-to-string ! (cond ((eq part 'method) ! (or (gnus-info-method info) "native")) ! ((eq part 'params) ! (gnus-info-params info)) ! (t info))) ! "\n"))) (defun gnus-group-edit-group-method (group) *************** ADDRESS." *** 4255,4316 **** (set-buffer (get-buffer-create gnus-group-edit-buffer)) (goto-char (point-min)) ! (let ((form (read (current-buffer))) ! (winconf gnus-prev-winconf)) ! (if (eq part 'info) ! (gnus-group-set-info form) ! (gnus-group-set-info form group part)) (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (set-buffer gnus-group-buffer) ! (gnus-group-update-group (gnus-group-group-name)) ! (gnus-group-position-cursor))) (defun gnus-group-make-help-group () "Create the Gnus documentation group." (interactive) ! (let ((path (if installation-directory ! (cons (concat installation-directory "etc/") load-path) ! (cons data-directory load-path))) (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) ! file) (and (gnus-gethash name gnus-newsrc-hashtb) (error "Documentation group already exists")) ! (while (and path ! (not (file-exists-p ! (setq file (concat (file-name-as-directory (car path)) ! "gnus-tut.txt"))))) ! (setq path (cdr path))) ! (if (not path) ! (message "Couldn't find doc group") ! (gnus-group-make-group (gnus-group-real-name name) ! (list 'nndoc name (list 'nndoc-address file) (list 'nndoc-article-type 'mbox))))) ! (gnus-group-position-cursor)) (defun gnus-group-make-doc-group (file type) "Create a group that uses a single file as the source." ! (interactive ! (list (read-file-name "File name: ") ! (let ((err "") ! found char) ! (while (not found) ! (message "%sFile type (mbox, babyl, digest) [mbd]: " err) ! (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ! ((= char ?b) 'babyl) ! ((= char ?d) 'digest) ! (t (setq err (format "%c unknown. " char)) ! nil)))) ! found))) (let* ((file (expand-file-name file)) (name (gnus-generate-new-group-name (gnus-group-prefixed-name (file-name-nondirectory file) '(nndoc ""))))) ! (gnus-group-make-group (gnus-group-real-name name) ! (list 'nndoc name (list 'nndoc-address file) ! (list 'nndoc-article-type type))))) (defun gnus-group-make-archive-group (&optional all) --- 5784,5882 ---- (set-buffer (get-buffer-create gnus-group-edit-buffer)) (goto-char (point-min)) ! (let* ((form (read (current-buffer))) ! (winconf gnus-prev-winconf) ! (method (cond ((eq part 'info) (nth 4 form)) ! ((eq part 'method) form) ! (t nil))) ! (info (cond ((eq part 'info) form) ! ((eq part 'method) (gnus-get-info group)) ! (t nil))) ! (new-group (if info ! (if (or (not method) ! (gnus-server-equal ! gnus-select-method method)) ! (gnus-group-real-name (car info)) ! (gnus-group-prefixed-name ! (gnus-group-real-name (car info)) method)) ! nil))) ! (when (and new-group ! (not (equal new-group group))) ! (when (gnus-group-goto-group group) ! (gnus-group-kill-group 1)) ! (gnus-activate-group new-group)) ! ;; Set the info. ! (if (and info new-group) ! (progn ! (setq info (gnus-copy-sequence info)) ! (setcar info new-group) ! (unless (gnus-server-equal method "native") ! (unless (nthcdr 3 info) ! (nconc info (list nil nil))) ! (unless (nthcdr 4 info) ! (nconc info (list nil))) ! (gnus-info-set-method info method)) ! (gnus-group-set-info info)) ! (gnus-group-set-info form (or new-group group) part)) (kill-buffer (current-buffer)) (and winconf (set-window-configuration winconf)) (set-buffer gnus-group-buffer) ! (gnus-group-update-group (or new-group group)) ! (gnus-group-position-point))) (defun gnus-group-make-help-group () "Create the Gnus documentation group." (interactive) ! (let ((path load-path) (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) ! file dir) (and (gnus-gethash name gnus-newsrc-hashtb) (error "Documentation group already exists")) ! (while path ! (setq dir (file-name-as-directory (expand-file-name (pop path))) ! file nil) ! (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt"))) ! (file-exists-p ! (setq file (concat (file-name-directory ! (directory-file-name dir)) ! "etc/gnus-tut.txt")))) ! (setq path nil))) ! (if (not file) ! (gnus-message 1 "Couldn't find doc group") ! (gnus-group-make-group (gnus-group-real-name name) ! (list 'nndoc "gnus-help" (list 'nndoc-address file) (list 'nndoc-article-type 'mbox))))) ! (gnus-group-position-point)) (defun gnus-group-make-doc-group (file type) "Create a group that uses a single file as the source." ! (interactive ! (list (read-file-name "File name: ") ! (and current-prefix-arg 'ask))) ! (when (eq type 'ask) ! (let ((err "") ! char found) ! (while (not found) ! (message ! "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: " ! err) ! (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) ! ((= char ?b) 'babyl) ! ((= char ?d) 'digest) ! ((= char ?f) 'forward) ! ((= char ?a) 'mmfd) ! (t (setq err (format "%c unknown. " char)) ! nil)))) ! (setq type found))) (let* ((file (expand-file-name file)) (name (gnus-generate-new-group-name (gnus-group-prefixed-name (file-name-nondirectory file) '(nndoc ""))))) ! (gnus-group-make-group (gnus-group-real-name name) ! (list 'nndoc (file-name-nondirectory file) (list 'nndoc-address file) ! (list 'nndoc-article-type (or type 'guess)))))) (defun gnus-group-make-archive-group (&optional all) *************** ADDRESS." *** 4318,4322 **** Given a prefix, create a full group." (interactive "P") ! (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) (and (gnus-gethash group gnus-newsrc-hashtb) --- 5884,5888 ---- Given a prefix, create a full group." (interactive "P") ! (let ((group (gnus-group-prefixed-name (if all "ding.archives" "ding.recent") '(nndir "")))) (and (gnus-gethash group gnus-newsrc-hashtb) *************** Given a prefix, create a full group." *** 4324,4336 **** (gnus-group-make-group (gnus-group-real-name group) ! "nndir" ! (if all gnus-group-archive-directory ! gnus-group-recent-archive-directory))) ! (gnus-group-position-cursor)) (defun gnus-group-make-directory-group (dir) "Create an nndir group. ! The user will be prompted for a directory. The contents of this ! directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive --- 5890,5902 ---- (gnus-group-make-group (gnus-group-real-name group) ! (list 'nndir (if all "hpc" "edu") ! (list 'nndir-directory ! (if all gnus-group-archive-directory ! gnus-group-recent-archive-directory)))))) (defun gnus-group-make-directory-group (dir) "Create an nndir group. ! The user will be prompted for a directory. The contents of this ! directory will be used as a newsgroup. The directory should contain mail messages or news articles in files that have numeric names." (interactive *************** mail messages or news articles in files *** 4338,4343 **** (or (file-exists-p dir) (error "No such directory")) (or (file-directory-p dir) (error "Not a directory")) ! (gnus-group-make-group dir "nndir" dir) ! (gnus-group-position-cursor)) (defun gnus-group-make-kiboze-group (group address scores) --- 5904,5920 ---- (or (file-exists-p dir) (error "No such directory")) (or (file-directory-p dir) (error "Not a directory")) ! (let ((ext "") ! (i 0) ! group) ! (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) ! (setq group ! (gnus-group-prefixed-name ! (concat (file-name-as-directory (directory-file-name dir)) ! ext) ! '(nndir ""))) ! (setq ext (format "<%d>" (setq i (1+ i))))) ! (gnus-group-make-group ! (gnus-group-real-name group) ! (list 'nndir group (list 'nndir-directory dir))))) (defun gnus-group-make-kiboze-group (group address scores) *************** score file entries for articles to inclu *** 4351,4360 **** (let ((headers (mapcar (lambda (group) (list group)) '("subject" "from" "number" "date" "message-id" ! "references" "chars" "lines" "xref"))) scores header regexp regexps) ! (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) (setq regexps nil) ! (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) --- 5928,5938 ---- (let ((headers (mapcar (lambda (group) (list group)) '("subject" "from" "number" "date" "message-id" ! "references" "chars" "lines" "xref" ! "followup" "all" "body" "head"))) scores header regexp regexps) ! (while (not (equal "" (setq header (completing-read "Match on header: " headers nil t)))) (setq regexps nil) ! (while (not (equal "" (setq regexp (read-string (format "Match on %s (string): " header))))) *************** score file entries for articles to inclu *** 4363,4374 **** scores))) (gnus-group-make-group group "nnkiboze" address) ! (save-excursion ! (gnus-set-work-buffer) (let (emacs-lisp-mode-hook) ! (pp scores (current-buffer))) ! (write-region (point-min) (point-max) ! (concat (or gnus-kill-files-directory "~/News") ! "nnkiboze:" group "." gnus-score-file-suffix))) ! (gnus-group-position-cursor)) (defun gnus-group-add-to-virtual (n vgroup) --- 5941,5947 ---- scores))) (gnus-group-make-group group "nnkiboze" address) ! (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) (let (emacs-lisp-mode-hook) ! (pp scores (current-buffer))))) (defun gnus-group-add-to-virtual (n vgroup) *************** score file entries for articles to inclu *** 4381,4394 **** (error "%s is not an nnvirtual group" vgroup)) (let* ((groups (gnus-group-process-prefix n)) ! (method (nth 4 (nth 2 (gnus-gethash vgroup gnus-newsrc-hashtb))))) (setcar (cdr method) ! (concat (nth 1 method) "\\|" ! (mapconcat ! (lambda (s) (gnus-group-remove-mark s) (concat "\\(^" (regexp-quote s) "$\\)")) groups "\\|")))) ! (gnus-group-position-cursor)) (defun gnus-group-make-empty-virtual (group) --- 5954,5967 ---- (error "%s is not an nnvirtual group" vgroup)) (let* ((groups (gnus-group-process-prefix n)) ! (method (gnus-info-method (gnus-get-info vgroup)))) (setcar (cdr method) ! (concat (nth 1 method) "\\|" ! (mapconcat ! (lambda (s) (gnus-group-remove-mark s) (concat "\\(^" (regexp-quote s) "$\\)")) groups "\\|")))) ! (gnus-group-position-point)) (defun gnus-group-make-empty-virtual (group) *************** score file entries for articles to inclu *** 4404,4408 **** (gnus-group-update-group pgroup) (forward-line -1) ! (gnus-group-position-cursor))) (defun gnus-group-enter-directory (dir) --- 5977,5981 ---- (gnus-group-update-group pgroup) (forward-line -1) ! (gnus-group-position-point))) (defun gnus-group-enter-directory (dir) *************** score file entries for articles to inclu *** 4415,4419 **** (name (gnus-generate-new-group-name leaf))) (let ((nneething-read-only t)) ! (or (gnus-group-read-ephemeral-group name method t (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) --- 5988,5992 ---- (name (gnus-generate-new-group-name leaf))) (let ((nneething-read-only t)) ! (or (gnus-group-read-ephemeral-group name method t (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode) *************** score file entries for articles to inclu *** 4424,4457 **** ;; Suggested by Joe Hildebrand . ! (defun gnus-group-sort-groups () ! "Sort the group buffer using `gnus-group-sort-function'." ! (interactive) ! (setq gnus-newsrc-alist ! (sort (cdr gnus-newsrc-alist) gnus-group-sort-function)) ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups)) (defun gnus-group-sort-by-alphabet (info1 info2) ! (string< (car info1) (car info2))) (defun gnus-group-sort-by-unread (info1 info2) ! (let ((n1 (car (gnus-gethash (car info1) gnus-newsrc-hashtb))) ! (n2 (car (gnus-gethash (car info2) gnus-newsrc-hashtb)))) (< (or (and (numberp n1) n1) 0) (or (and (numberp n2) n2) 0)))) (defun gnus-group-sort-by-level (info1 info2) ! (< (nth 1 info1) (nth 1 info2))) ;; Group catching up. (defun gnus-group-catchup-current (&optional n all) "Mark all articles not marked as unread in current newsgroup as read. If prefix argument N is numeric, the ARG next newsgroups will be ! caught up. If ALL is non-nil, marked articles will also be marked as ! read. Cross references (Xref: header) of articles are ignored. The difference between N and actual number of newsgroups that were caught up is returned." (interactive "P") (if (not (or (not gnus-interactive-catchup) ;Without confirmation? gnus-expert-user --- 5997,6122 ---- ;; Suggested by Joe Hildebrand . ! (defun gnus-group-sort-groups (func &optional reverse) ! "Sort the group buffer according to FUNC. ! If REVERSE, reverse the sorting order." ! (interactive (list gnus-group-sort-function ! current-prefix-arg)) ! (let ((func (cond ! ((not (listp func)) func) ! ((null func) func) ! ((= 1 (length func)) (car func)) ! (t `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse func))))))) ! ;; We peel off the dummy group from the alist. ! (when func ! (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group") ! (pop gnus-newsrc-alist)) ! ;; Do the sorting. ! (setq gnus-newsrc-alist ! (sort gnus-newsrc-alist func)) ! (when reverse ! (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) ! ;; Regenerate the hash table. ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups)))) ! ! (defun gnus-group-sort-groups-by-alphabet (&optional reverse) ! "Sort the group buffer alphabetically by group name. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) ! ! (defun gnus-group-sort-groups-by-unread (&optional reverse) ! "Sort the group buffer by number of unread articles. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) ! ! (defun gnus-group-sort-groups-by-level (&optional reverse) ! "Sort the group buffer by group level. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) ! ! (defun gnus-group-sort-groups-by-score (&optional reverse) ! "Sort the group buffer by group score. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) ! ! (defun gnus-group-sort-groups-by-rank (&optional reverse) ! "Sort the group buffer by group rank. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) ! ! (defun gnus-group-sort-groups-by-method (&optional reverse) ! "Sort the group buffer alphabetically by backend name. ! If REVERSE, sort in reverse order." ! (interactive "P") ! (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) (defun gnus-group-sort-by-alphabet (info1 info2) ! "Sort alphabetically." ! (string< (gnus-info-group info1) (gnus-info-group info2))) (defun gnus-group-sort-by-unread (info1 info2) ! "Sort by number of unread articles." ! (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) ! (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) (< (or (and (numberp n1) n1) 0) (or (and (numberp n2) n2) 0)))) (defun gnus-group-sort-by-level (info1 info2) ! "Sort by level." ! (< (gnus-info-level info1) (gnus-info-level info2))) ! ! (defun gnus-group-sort-by-method (info1 info2) ! "Sort alphabetically by backend name." ! (string< (symbol-name (car (gnus-find-method-for-group ! (gnus-info-group info1) info1))) ! (symbol-name (car (gnus-find-method-for-group ! (gnus-info-group info2) info2))))) ! ! (defun gnus-group-sort-by-score (info1 info2) ! "Sort by group score." ! (< (gnus-info-score info1) (gnus-info-score info2))) ! ! (defun gnus-group-sort-by-rank (info1 info2) ! "Sort by level and score." ! (let ((level1 (gnus-info-level info1)) ! (level2 (gnus-info-level info2))) ! (or (< level1 level2) ! (and (= level1 level2) ! (> (gnus-info-score info1) (gnus-info-score info2)))))) ;; Group catching up. + (defun gnus-group-clear-data (n) + "Clear all marks and read ranges from the current group." + (interactive "P") + (let ((groups (gnus-group-process-prefix n)) + group info) + (while (setq group (pop groups)) + (setq info (gnus-get-info group)) + (gnus-info-set-read info nil) + (when (gnus-info-marks info) + (gnus-info-set-marks info nil)) + (gnus-get-unread-articles-in-group info (gnus-active group) t) + (when (gnus-group-goto-group group) + (gnus-group-remove-mark group) + (gnus-group-update-group-line))))) + (defun gnus-group-catchup-current (&optional n all) "Mark all articles not marked as unread in current newsgroup as read. If prefix argument N is numeric, the ARG next newsgroups will be ! caught up. If ALL is non-nil, marked articles will also be marked as ! read. Cross references (Xref: header) of articles are ignored. The difference between N and actual number of newsgroups that were caught up is returned." (interactive "P") + (unless (gnus-group-group-name) + (error "No group on the current line")) (if (not (or (not gnus-interactive-catchup) ;Without confirmation? gnus-expert-user *************** caught up is returned." *** 4464,4468 **** (ret 0)) (while groups ! ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) (if (eq 'nnvirtual (car method)) --- 6129,6133 ---- (ret 0)) (while groups ! ;; Virtual groups have to be given special treatment. (let ((method (gnus-find-method-for-group (car groups)))) (if (eq 'nnvirtual (car method)) *************** caught up is returned." *** 4470,4478 **** (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) ! (if (prog1 ! (gnus-group-goto-group (car groups)) ! (gnus-group-catchup (car groups) all)) ! (gnus-group-update-group-line) ! (setq ret (1+ ret))) (setq groups (cdr groups))) (gnus-group-next-unread-group 1) --- 6135,6145 ---- (gnus-group-real-name (car groups)) (nth 1 method) all))) (gnus-group-remove-mark (car groups)) ! (if (>= (gnus-group-group-level) gnus-level-zombie) ! (gnus-message 2 "Dead groups can't be caught up") ! (if (prog1 ! (gnus-group-goto-group (car groups)) ! (gnus-group-catchup (car groups) all)) ! (gnus-group-update-group-line) ! (setq ret (1+ ret)))) (setq groups (cdr groups))) (gnus-group-next-unread-group 1) *************** The return value is the number of articl *** 4491,4511 **** or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ! (num (car entry)) ! (marked (nth 3 (nth 2 entry)))) (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up; non-active group") ! ;; Do the updating only if the newsgroup isn't killed. ! (if (not entry) ! () ! (gnus-update-read-articles ! group (and (not all) (append (cdr (assq 'tick marked)) ! (cdr (assq 'dormant marked)))) ! nil (and (not all) (cdr (assq 'tick marked)))) ! (and all ! (setq marked (nth 3 (nth 2 entry))) ! (setcar (nthcdr 3 (nth 2 entry)) ! (delq (assq 'dormant marked) ! (nth 3 (nth 2 entry))))))) ! num)) (defun gnus-group-expire-articles (&optional n) --- 6158,6183 ---- or nil if no action could be taken." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ! (num (car entry))) ! ;; Do the updating only if the newsgroup isn't killed. (if (not (numberp (car entry))) (gnus-message 1 "Can't catch up; non-active group") ! ;; Do auto-expirable marks if that's required. ! (when (gnus-group-auto-expirable-p group) ! (gnus-add-marked-articles ! group 'expire (gnus-list-of-unread-articles group)) ! (when all ! (let ((marks (nth 3 (nth 2 entry)))) ! (gnus-add-marked-articles ! group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) ! (gnus-add-marked-articles ! group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) ! (when entry ! (gnus-update-read-articles group nil) ! ;; Also nix out the lists of marks and dormants. ! (when all ! (gnus-add-marked-articles group 'tick nil nil 'force) ! (gnus-add-marked-articles group 'dormant nil nil 'force)) ! (run-hooks 'gnus-group-catchup-group-hook) ! num)))) (defun gnus-group-expire-articles (&optional n) *************** or nil if no action could be taken." *** 4514,4532 **** (let ((groups (gnus-group-process-prefix n)) group) ! (or groups (error "No groups to expire")) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) (gnus-group-remove-mark group) ! (if (not (gnus-check-backend-function 'request-expire-articles group)) ! () ! (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) ! (expirable (if (memq 'total-expire (nth 5 info)) (cons nil (gnus-list-of-read-articles group)) ! (assq 'expire (nth 3 info))))) ! (and expirable ! (setcdr expirable ! (gnus-request-expire-articles ! (cdr expirable) group)))))))) (defun gnus-group-expire-all-groups () --- 6186,6217 ---- (let ((groups (gnus-group-process-prefix n)) group) ! (unless groups ! (error "No groups to expire")) ! (while (setq group (pop groups)) (gnus-group-remove-mark group) ! (when (gnus-check-backend-function 'request-expire-articles group) ! (gnus-message 6 "Expiring articles in %s..." group) ! (let* ((info (gnus-get-info group)) ! (expirable (if (gnus-group-total-expirable-p group) (cons nil (gnus-list-of-read-articles group)) ! (assq 'expire (gnus-info-marks info)))) ! (expiry-wait (gnus-group-get-parameter group 'expiry-wait))) ! (when expirable ! (setcdr ! expirable ! (gnus-compress-sequence ! (if expiry-wait ! ;; We set the expiry variables to the groupp ! ;; parameter. ! (let ((nnmail-expiry-wait-function nil) ! (nnmail-expiry-wait expiry-wait)) ! (gnus-request-expire-articles ! (gnus-uncompress-sequence (cdr expirable)) group)) ! ;; Just expire using the normal expiry values. ! (gnus-request-expire-articles ! (gnus-uncompress-sequence (cdr expirable)) group)))) ! (gnus-close-group group)) ! (gnus-message 6 "Expiring articles in %s...done" group))) ! (gnus-group-position-point)))) (defun gnus-group-expire-all-groups () *************** or nil if no action could be taken." *** 4535,4561 **** (save-excursion (gnus-message 5 "Expiring...") ! (let ((gnus-group-marked (mapcar (lambda (info) (car info)) (cdr gnus-newsrc-alist)))) (gnus-group-expire-articles nil))) ! (gnus-group-position-cursor) (gnus-message 5 "Expiring...done")) (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." ! (interactive "P\nnLevel: ") (or (and (>= level 1) (<= level gnus-level-killed)) (error "Illegal level: %d" level)) (let ((groups (gnus-group-process-prefix n)) group) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) (gnus-group-remove-mark group) ! (gnus-message 6 "Changed level of %s from %d to %d" ! group (gnus-group-group-level) level) ! (gnus-group-change-level group level ! (gnus-group-group-level)) (gnus-group-update-group-line))) ! (gnus-group-position-cursor)) (defun gnus-group-unsubscribe-current-group (&optional n) --- 6220,6256 ---- (save-excursion (gnus-message 5 "Expiring...") ! (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) (cdr gnus-newsrc-alist)))) (gnus-group-expire-articles nil))) ! (gnus-group-position-point) (gnus-message 5 "Expiring...done")) (defun gnus-group-set-current-level (n level) "Set the level of the next N groups to LEVEL." ! (interactive ! (list ! current-prefix-arg ! (string-to-int ! (let ((s (read-string ! (format "Level (default %s): " ! (or (gnus-group-group-level) ! gnus-level-default-subscribed))))) ! (if (string-match "^\\s-*$" s) ! (int-to-string (or (gnus-group-group-level) ! gnus-level-default-subscribed)) ! s))))) (or (and (>= level 1) (<= level gnus-level-killed)) (error "Illegal level: %d" level)) (let ((groups (gnus-group-process-prefix n)) group) ! (while (setq group (pop groups)) (gnus-group-remove-mark group) ! (gnus-message 6 "Changed level of %s from %d to %d" ! group (or (gnus-group-group-level) gnus-level-killed) ! level) ! (gnus-group-change-level ! group level (or (gnus-group-group-level) gnus-level-killed)) (gnus-group-update-group-line))) ! (gnus-group-position-point)) (defun gnus-group-unsubscribe-current-group (&optional n) *************** If given numerical prefix, toggle the N *** 4572,4586 **** group (if (<= (gnus-group-group-level) gnus-level-subscribed) gnus-level-default-unsubscribed ! gnus-level-default-subscribed)) (gnus-group-update-group-line)) (gnus-group-next-group 1))) ! (defun gnus-group-unsubscribe-group (group &optional level) ! "Toggle subscribe from/to unsubscribe GROUP. ! New newsgroup is added to .newsrc automatically." (interactive (list (completing-read ! "Group: " gnus-active-hashtb nil ! (memq gnus-select-method gnus-have-read-active-file)))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond --- 6267,6284 ---- group (if (<= (gnus-group-group-level) gnus-level-subscribed) gnus-level-default-unsubscribed ! gnus-level-default-subscribed) t) (gnus-group-update-group-line)) (gnus-group-next-group 1))) ! (defun gnus-group-unsubscribe-group (group &optional level silent) ! "Toggle subscription to GROUP. ! Killed newsgroups are subscribed. If SILENT, don't try to update the ! group line." (interactive (list (completing-read ! "Group: " gnus-active-hashtb nil ! (gnus-read-active-file-p) ! nil ! 'gnus-group-history))) (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) (cond *************** New newsgroup is added to .newsrc automa *** 4589,4618 **** (newsrc ;; Toggle subscription flag. ! (gnus-group-change-level ! newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) ! gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) ! (gnus-group-update-group group)) ((and (stringp group) ! (or (not (memq gnus-select-method gnus-have-read-active-file)) ! (gnus-gethash group gnus-active-hashtb))) ;; Add new newsgroup. ! (gnus-group-change-level ! group ! (if level level gnus-level-default-subscribed) ! (or (and (member group gnus-zombie-list) ! gnus-level-zombie) gnus-level-killed) (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) ! (gnus-group-update-group group)) (t (error "No such newsgroup: %s" group))) ! (gnus-group-position-cursor))) (defun gnus-group-transpose-groups (n) "Move the current newsgroup up N places. ! If given a negative prefix, move down instead. The difference between ! N and the number of steps taken is returned." (interactive "p") (or (gnus-group-group-name) --- 6287,6318 ---- (newsrc ;; Toggle subscription flag. ! (gnus-group-change-level ! newsrc (if level level (if (<= (nth 1 (nth 2 newsrc)) ! gnus-level-subscribed) (1+ gnus-level-subscribed) gnus-level-default-subscribed))) ! (unless silent ! (gnus-group-update-group group))) ((and (stringp group) ! (or (not (gnus-read-active-file-p)) ! (gnus-active group))) ;; Add new newsgroup. ! (gnus-group-change-level ! group ! (if level level gnus-level-default-subscribed) ! (or (and (member group gnus-zombie-list) ! gnus-level-zombie) gnus-level-killed) (and (gnus-group-group-name) (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) ! (unless silent ! (gnus-group-update-group group))) (t (error "No such newsgroup: %s" group))) ! (gnus-group-position-point))) (defun gnus-group-transpose-groups (n) "Move the current newsgroup up N places. ! If given a negative prefix, move down instead. The difference between ! N and the number of steps taken is returned." (interactive "p") (or (gnus-group-group-name) *************** N and the number of steps taken is retur *** 4622,4626 **** (forward-line (- n)) (gnus-group-yank-group) ! (gnus-group-position-cursor))) (defun gnus-group-kill-all-zombies () --- 6322,6326 ---- (forward-line (- n)) (gnus-group-yank-group) ! (gnus-group-position-point))) (defun gnus-group-kill-all-zombies () *************** The killed newsgroups can be yanked by u *** 4651,4724 **** (gnus-group-kill-group lines))) ! (defun gnus-group-kill-group (&optional n) ! "The the next N groups. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. ! However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. ! The return value is the name of the (last) group that was killed." (interactive "P") (let ((buffer-read-only nil) (groups (gnus-group-process-prefix n)) ! group entry level) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) ! (gnus-group-remove-mark group) ! (setq level (gnus-group-group-level)) ! (gnus-delete-line) ! (if (setq entry (gnus-gethash group gnus-newsrc-hashtb)) ! (setq gnus-list-of-killed-groups ! (cons (cons (car entry) (nth 2 entry)) ! gnus-list-of-killed-groups))) ! (gnus-group-change-level ! (if entry entry group) gnus-level-killed (if entry nil level))) ! (gnus-group-position-cursor) ! group)) (defun gnus-group-yank-group (&optional arg) "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup. The numeric ARG specifies ! how many newsgroups are to be yanked. The name of the (last) ! newsgroup yanked is returned." (interactive "p") ! (if (not arg) (setq arg 1)) ! (let (info group prev) ! (while (>= (setq arg (1- arg)) 0) ! (if (not (setq info (car gnus-list-of-killed-groups))) (error "No more newsgroups to yank")) ! (setq group (nth 2 info)) ;; Find which newsgroup to insert this one before - search ! ;; backward until something suitable is found. If there are no ;; other newsgroups in this buffer, just make this newsgroup the ;; first newsgroup. (setq prev (gnus-group-group-name)) ! (gnus-group-change-level ! info (nth 2 info) gnus-level-killed (and prev (gnus-gethash prev gnus-newsrc-hashtb)) t) ! (gnus-group-insert-group-line-info (nth 1 info)) ! (setq gnus-list-of-killed-groups ! (cdr gnus-list-of-killed-groups))) (forward-line -1) ! (gnus-group-position-cursor) ! group)) ! ! (defun gnus-group-list-all-groups (&optional arg) ! "List all newsgroups with level ARG or lower. ! Default is gnus-level-unsubscribed, which lists all subscribed and most ! unsubscribed groups." (interactive "P") (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) ! (defun gnus-group-list-killed () ! "List all killed newsgroups in the group buffer." ! (interactive) (if (not gnus-killed-list) (gnus-message 6 "No killed groups") (let (gnus-group-list-mode) ! (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)) (goto-char (point-min))) ! (gnus-group-position-cursor)) (defun gnus-group-list-zombies () --- 6351,6483 ---- (gnus-group-kill-group lines))) ! (defun gnus-group-kill-group (&optional n discard) ! "Kill the next N groups. The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. ! However, only groups that were alive can be yanked; already killed groups or zombie groups can't be yanked. ! The return value is the name of the group that was killed, or a list ! of groups killed." (interactive "P") (let ((buffer-read-only nil) (groups (gnus-group-process-prefix n)) ! group entry level out) ! (if (< (length groups) 10) ! ;; This is faster when there are few groups. ! (while groups ! (push (setq group (pop groups)) out) ! (gnus-group-remove-mark group) ! (setq level (gnus-group-group-level)) ! (gnus-delete-line) ! (when (and (not discard) ! (setq entry (gnus-gethash group gnus-newsrc-hashtb))) ! (push (cons (car entry) (nth 2 entry)) ! gnus-list-of-killed-groups)) ! (gnus-group-change-level ! (if entry entry group) gnus-level-killed (if entry nil level))) ! ;; If there are lots and lots of groups to be killed, we use ! ;; this thing instead. ! (let (entry) ! (setq groups (nreverse groups)) ! (while groups ! (gnus-group-remove-mark (setq group (pop groups))) ! (gnus-delete-line) ! (push group gnus-killed-list) ! (setq gnus-newsrc-alist ! (delq (assoc group gnus-newsrc-alist) ! gnus-newsrc-alist)) ! (when gnus-group-change-level-function ! (funcall gnus-group-change-level-function group 9 3)) ! (cond ! ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) ! (push (cons (car entry) (nth 2 entry)) ! gnus-list-of-killed-groups) ! (setcdr (cdr entry) (cdddr entry))) ! ((member group gnus-zombie-list) ! (setq gnus-zombie-list (delete group gnus-zombie-list))))) ! (gnus-make-hashtable-from-newsrc-alist))) ! ! (gnus-group-position-point) ! (if (< (length out) 2) (car out) (nreverse out)))) (defun gnus-group-yank-group (&optional arg) "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup. The numeric ARG specifies ! how many newsgroups are to be yanked. The name of the newsgroup yanked ! is returned, or (if several groups are yanked) a list of yanked groups ! is returned." (interactive "p") ! (setq arg (or arg 1)) ! (let (info group prev out) ! (while (>= (decf arg) 0) ! (if (not (setq info (pop gnus-list-of-killed-groups))) (error "No more newsgroups to yank")) ! (push (setq group (nth 1 info)) out) ;; Find which newsgroup to insert this one before - search ! ;; backward until something suitable is found. If there are no ;; other newsgroups in this buffer, just make this newsgroup the ;; first newsgroup. (setq prev (gnus-group-group-name)) ! (gnus-group-change-level ! info (gnus-info-level (cdr info)) gnus-level-killed (and prev (gnus-gethash prev gnus-newsrc-hashtb)) t) ! (gnus-group-insert-group-line-info group)) (forward-line -1) ! (gnus-group-position-point) ! (if (< (length out) 2) (car out) (nreverse out)))) ! ! (defun gnus-group-kill-level (level) ! "Kill all groups that is on a certain LEVEL." ! (interactive "nKill all groups on level: ") ! (cond ! ((= level gnus-level-zombie) ! (setq gnus-killed-list ! (nconc gnus-zombie-list gnus-killed-list)) ! (setq gnus-zombie-list nil)) ! ((and (< level gnus-level-zombie) ! (> level 0) ! (or gnus-expert-user ! (gnus-yes-or-no-p ! (format ! "Do you really want to kill all groups on level %d? " ! level)))) ! (let* ((prev gnus-newsrc-alist) ! (alist (cdr prev))) ! (while alist ! (if (= (gnus-info-level (car alist)) level) ! (progn ! (push (gnus-info-group (car alist)) gnus-killed-list) ! (setcdr prev (cdr alist))) ! (setq prev alist)) ! (setq alist (cdr alist))) ! (gnus-make-hashtable-from-newsrc-alist) ! (gnus-group-list-groups))) ! (t ! (error "Can't kill; illegal level: %d" level)))) ! ! (defun gnus-group-list-all-groups (&optional arg) ! "List all newsgroups with level ARG or lower. ! Default is gnus-level-unsubscribed, which lists all subscribed and most ! unsubscribed groups." (interactive "P") (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) ! ;; Redefine this to list ALL killed groups if prefix arg used. ! ;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). ! (defun gnus-group-list-killed (&optional arg) ! "List all killed newsgroups in the group buffer. ! If ARG is non-nil, list ALL killed groups known to Gnus. This may ! entail asking the server for the groups." ! (interactive "P") ! ;; Find all possible killed newsgroups if arg. ! (when arg ! (gnus-get-killed-groups)) (if (not gnus-killed-list) (gnus-message 6 "No killed groups") (let (gnus-group-list-mode) ! (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)) (goto-char (point-min))) ! (gnus-group-position-point)) (defun gnus-group-list-zombies () *************** unsubscribed groups." *** 4731,4749 **** gnus-level-zombie t gnus-level-zombie)) (goto-char (point-min))) ! (gnus-group-position-cursor)) (defun gnus-group-get-new-news (&optional arg) "Get newly arrived articles. ! If ARG is non-nil, it should be a number between one and nine to ! specify which levels you are interested in re-scanning." (interactive "P") (run-hooks 'gnus-get-new-news-hook) (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) (progn (gnus-read-active-file) ! (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed)))) (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) ! (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed))))) (gnus-group-list-groups)) --- 6490,6552 ---- gnus-level-zombie t gnus-level-zombie)) (goto-char (point-min))) ! (gnus-group-position-point)) ! ! (defun gnus-group-list-active () ! "List all groups that are available from the server(s)." ! (interactive) ! ;; First we make sure that we have really read the active file. ! (unless (gnus-read-active-file-p) ! (let ((gnus-read-active-file t)) ! (gnus-read-active-file))) ! ;; Find all groups and sort them. ! (let ((groups ! (sort ! (let (list) ! (mapatoms ! (lambda (sym) ! (and (boundp sym) ! (symbol-value sym) ! (setq list (cons (symbol-name sym) list)))) ! gnus-active-hashtb) ! list) ! 'string<)) ! (buffer-read-only nil)) ! (erase-buffer) ! (while groups ! (gnus-group-insert-group-line-info (pop groups))) ! (goto-char (point-min)))) ! ! (defun gnus-activate-all-groups (level) ! "Activate absolutely all groups." ! (interactive (list 7)) ! (let ((gnus-activate-level level) ! (gnus-activate-foreign-newsgroups level)) ! (gnus-group-get-new-news))) (defun gnus-group-get-new-news (&optional arg) "Get newly arrived articles. ! If ARG is a number, it specifies which levels you are interested in ! re-scanning. If ARG is non-nil and not a number, this will force ! \"hard\" re-reading of the active files from all servers." (interactive "P") (run-hooks 'gnus-get-new-news-hook) + ;; We might read in new NoCeM messages here. + (when (and gnus-use-nocem + (null arg)) + (gnus-nocem-scan-groups)) + ;; If ARG is not a number, then we read the active file. + (when (and arg (not (numberp arg))) + (let ((gnus-read-active-file t)) + (gnus-read-active-file)) + (setq arg nil)) + (setq arg (gnus-group-default-level arg t)) (if (and gnus-read-active-file (not arg)) (progn (gnus-read-active-file) ! (gnus-get-unread-articles arg)) (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) ! (gnus-get-unread-articles arg))) ! (run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups)) *************** If N is negative, this group and the N-1 *** 4755,4807 **** (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) group) ! (while groups ! (setq group (car groups) ! groups (cdr groups)) (gnus-group-remove-mark group) ! (or (gnus-get-new-news-in-group group) ! (progn ! (ding) ! (message "%s error: %s" group (gnus-status-message group)) ! (sit-for 2)))) ! (gnus-group-next-unread-group 1 t) ! (gnus-summary-position-cursor) ret)) ! (defun gnus-get-new-news-in-group (group) ! (and group ! (gnus-activate-group group) ! (progn ! (gnus-get-unread-articles-in-group ! (nth 2 (gnus-gethash group gnus-newsrc-hashtb)) ! (gnus-gethash group gnus-active-hashtb)) ! (gnus-group-update-group-line) ! t))) ! ! (defun gnus-group-fetch-faq (group) "Fetch the FAQ for the current group." ! (interactive (list (gnus-group-real-name (gnus-group-group-name)))) (or group (error "No group name given")) ! (let ((file (concat gnus-group-faq-directory (gnus-group-real-name group)))) (if (not (file-exists-p file)) (error "No such file: %s" file) (find-file file)))) ! (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) ! (and force (setq gnus-description-hashtb nil)) ! (let ((method (gnus-find-method-for-group group)) ! desc) (or group (error "No group name given")) (and (or (and gnus-description-hashtb ;; We check whether this group's method has been ! ;; queried for a description file. ! (gnus-gethash ! (gnus-group-prefixed-name "" method) ! gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) ! (message (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) --- 6558,6621 ---- (let* ((groups (gnus-group-process-prefix n)) (ret (if (numberp n) (- n (length groups)) 0)) + (beg (unless n (point))) group) ! (while (setq group (pop groups)) (gnus-group-remove-mark group) ! (if (gnus-activate-group group 'scan) ! (progn ! (gnus-get-unread-articles-in-group ! (gnus-get-info group) (gnus-active group) t) ! (unless (gnus-virtual-group-p group) ! (gnus-close-group group)) ! (gnus-group-update-group group)) ! (if (eq (gnus-server-status (gnus-find-method-for-group group)) ! 'denied) ! (gnus-error "Server denied access") ! (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) ! (when beg (goto-char beg)) ! (when gnus-goto-next-group-when-activating ! (gnus-group-next-unread-group 1 t)) ! (gnus-summary-position-point) ret)) ! (defun gnus-group-fetch-faq (group &optional faq-dir) "Fetch the FAQ for the current group." ! (interactive ! (list ! (and (gnus-group-group-name) ! (gnus-group-real-name (gnus-group-group-name))) ! (cond (current-prefix-arg ! (completing-read ! "Faq dir: " (and (listp gnus-group-faq-directory) ! (mapcar (lambda (file) (list file)) ! gnus-group-faq-directory))))))) ! (or faq-dir ! (setq faq-dir (if (listp gnus-group-faq-directory) ! (car gnus-group-faq-directory) ! gnus-group-faq-directory))) (or group (error "No group name given")) ! (let ((file (concat (file-name-as-directory faq-dir) ! (gnus-group-real-name group)))) (if (not (file-exists-p file)) (error "No such file: %s" file) (find-file file)))) ! (defun gnus-group-describe-group (force &optional group) "Display a description of the current newsgroup." (interactive (list current-prefix-arg (gnus-group-group-name))) ! (let* ((method (gnus-find-method-for-group group)) ! (mname (gnus-group-prefixed-name "" method)) ! desc) ! (when (and force ! gnus-description-hashtb) ! (gnus-sethash mname nil gnus-description-hashtb)) (or group (error "No group name given")) (and (or (and gnus-description-hashtb ;; We check whether this group's method has been ! ;; queried for a description file. ! (gnus-gethash mname gnus-description-hashtb)) (setq desc (gnus-group-get-description group)) (gnus-read-descriptions-file method)) ! (gnus-message 1 (or desc (gnus-gethash group gnus-description-hashtb) "No description available"))))) *************** If N is negative, this group and the N-1 *** 4823,4827 **** (insert (format " *: %-20s %s\n" (symbol-name group) (symbol-value group))) ! (add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil --- 6637,6641 ---- (insert (format " *: %-20s %s\n" (symbol-name group) (symbol-value group))) ! (gnus-add-text-properties b (1+ b) (list 'gnus-group group 'gnus-unread t 'gnus-marked nil *************** If N is negative, this group and the N-1 *** 4829,4833 **** gnus-description-hashtb) (goto-char (point-min)) ! (gnus-group-position-cursor))) ;; Suggested by by Daniel Quinlan . --- 6643,6647 ---- gnus-description-hashtb) (goto-char (point-min)) ! (gnus-group-position-point))) ;; Suggested by by Daniel Quinlan . *************** If N is negative, this group and the N-1 *** 4839,4843 **** groups des) ;; Go through all newsgroups that are known to Gnus. ! (mapatoms (lambda (group) (and (symbol-name group) --- 6653,6657 ---- groups des) ;; Go through all newsgroups that are known to Gnus. ! (mapatoms (lambda (group) (and (symbol-name group) *************** If N is negative, this group and the N-1 *** 4845,4856 **** (setq groups (cons (symbol-name group) groups)))) gnus-active-hashtb) ! ;; Go through all descriptions that are known to Gnus. ! (if search-description ! (mapatoms ! (lambda (group) ! (and (string-match regexp (symbol-value group)) ! (gnus-gethash (symbol-name group) gnus-active-hashtb) ! (setq groups (cons (symbol-name group) groups)))) ! gnus-description-hashtb)) (if (not groups) (gnus-message 3 "No groups matched \"%s\"." regexp) --- 6659,6670 ---- (setq groups (cons (symbol-name group) groups)))) gnus-active-hashtb) ! ;; Also go through all descriptions that are known to Gnus. ! (when search-description ! (mapatoms ! (lambda (group) ! (and (string-match regexp (symbol-value group)) ! (gnus-active (symbol-name group)) ! (setq groups (cons (symbol-name group) groups)))) ! gnus-description-hashtb)) (if (not groups) (gnus-message 3 "No groups matched \"%s\"." regexp) *************** If N is negative, this group and the N-1 *** 4867,4871 **** (insert (setq prev (car groups)) "\n") (if (and gnus-description-hashtb ! (setq des (gnus-gethash (car groups) gnus-description-hashtb))) (insert " " des "\n")))) --- 6681,6685 ---- (insert (setq prev (car groups)) "\n") (if (and gnus-description-hashtb ! (setq des (gnus-gethash (car groups) gnus-description-hashtb))) (insert " " des "\n")))) *************** If N is negative, this group and the N-1 *** 4883,4902 **** ;; Suggested by Per Abrahamsen . ! (defun gnus-group-list-matching (level regexp &optional all lowest) "List all groups with unread articles that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If ALL, also list groups with no unread articles. ! If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") (gnus-group-prepare-flat (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) ! (gnus-group-position-cursor)) ! (defun gnus-group-list-all-matching (level regexp &optional lowest) "List all groups that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") --- 6697,6722 ---- ;; Suggested by Per Abrahamsen . ! (defun gnus-group-list-matching (level regexp &optional all lowest) "List all groups with unread articles that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If ALL, also list groups with no unread articles. ! If LOWEST, don't list groups with level lower than LOWEST. ! ! This command may read the active file." (interactive "P\nsList newsgroups matching: ") + ;; First make sure active file has been read. + (when (and level + (> (prefix-numeric-value level) gnus-level-killed)) + (gnus-get-killed-groups)) (gnus-group-prepare-flat (or level gnus-level-subscribed) all (or lowest 1) regexp) (goto-char (point-min)) ! (gnus-group-position-point)) ! (defun gnus-group-list-all-matching (level regexp &optional lowest) "List all groups that match REGEXP. If the prefix LEVEL is non-nil, it should be a number that says which ! level to cut off listing groups. If LOWEST, don't list groups with level lower than LOWEST." (interactive "P\nsList newsgroups matching: ") *************** If LOWEST, don't list groups with level *** 4904,4918 **** ;; Suggested by Jack Vinson . ! (defun gnus-group-save-newsrc () ! "Save the Gnus startup files." ! (interactive) ! (gnus-save-newsrc-file)) (defun gnus-group-restart (&optional arg) "Force Gnus to read the .newsrc file." (interactive "P") ! (gnus-save-newsrc-file) ! (gnus-setup-news 'force) ! (gnus-group-list-groups arg)) (defun gnus-group-read-init-file () --- 6724,6742 ---- ;; Suggested by Jack Vinson . ! (defun gnus-group-save-newsrc (&optional force) ! "Save the Gnus startup files. ! If FORCE, force saving whether it is necessary or not." ! (interactive "P") ! (gnus-save-newsrc-file force)) (defun gnus-group-restart (&optional arg) "Force Gnus to read the .newsrc file." (interactive "P") ! (when (gnus-yes-or-no-p ! (format "Are you sure you want to read %s? " ! gnus-current-startup-file)) ! (gnus-save-newsrc-file) ! (gnus-setup-news 'force) ! (gnus-group-list-groups arg))) (defun gnus-group-read-init-file () *************** If GROUP, edit that local kill file inst *** 4935,4942 **** (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) ! (gnus-message 6 (substitute-command-keys ! "Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)"))) (defun gnus-group-edit-local-kill (article group) --- 6759,6767 ---- (setq gnus-current-kill-article article) (gnus-kill-file-edit-file group) ! (gnus-message 6 (substitute-command-keys ! (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" ! (if group "local" "global"))))) (defun gnus-group-edit-local-kill (article group) *************** The hook gnus-suspend-gnus-hook is calle *** 4957,4978 **** (run-hooks 'gnus-suspend-gnus-hook) ;; Kill Gnus buffers except for group mode buffer. ! (let ((group-buf (get-buffer gnus-group-buffer))) ! ;; Do this on a separate list in case the user does a ^G before we finish ! (let ((gnus-buffer-list ! (delq group-buf (delq gnus-dribble-buffer ! (append gnus-buffer-list nil))))) ! (while gnus-buffer-list ! (gnus-kill-buffer (car gnus-buffer-list)) ! (setq gnus-buffer-list (cdr gnus-buffer-list)))) ! (if group-buf ! (progn ! (setq gnus-buffer-list (list group-buf)) ! (bury-buffer group-buf) ! (delete-windows-on group-buf t))))) (defun gnus-group-clear-dribble () "Clear all information from the dribble buffer." (interactive) ! (gnus-dribble-clear)) (defun gnus-group-exit () --- 6782,6803 ---- (run-hooks 'gnus-suspend-gnus-hook) ;; Kill Gnus buffers except for group mode buffer. ! (let* ((group-buf (get-buffer gnus-group-buffer)) ! ;; Do this on a separate list in case the user does a ^G before we finish ! (gnus-buffer-list ! (delete group-buf (delete gnus-dribble-buffer ! (append gnus-buffer-list nil))))) ! (while gnus-buffer-list ! (gnus-kill-buffer (pop gnus-buffer-list))) ! (gnus-kill-gnus-frames) ! (when group-buf ! (setq gnus-buffer-list (list group-buf)) ! (bury-buffer group-buf) ! (delete-windows-on group-buf t)))) (defun gnus-group-clear-dribble () "Clear all information from the dribble buffer." (interactive) ! (gnus-dribble-clear) ! (gnus-message 7 "Cleared dribble buffer")) (defun gnus-group-exit () *************** The hook gnus-suspend-gnus-hook is calle *** 4980,5005 **** The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) ! (if (or noninteractive ;For gnus-batch-kill ! (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed (not gnus-interactive-exit) ;Without confirmation gnus-expert-user (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) ! (progn ! (run-hooks 'gnus-exit-gnus-hook) ! ;; Offer to save data from non-quitted summary buffers. ! (gnus-offer-save-summaries) ! ;; Save the newsrc file(s). ! (gnus-save-newsrc-file) ! ;; Kill-em-all. ! (gnus-close-backends) ! ;; Reset everything. ! (gnus-clear-system)))) (defun gnus-close-backends () ! ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) func) (while methods ! (if (fboundp (setq func (intern (concat (car (car methods)) "-request-close")))) (funcall func)) --- 6805,6831 ---- The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) ! (when ! (or noninteractive ;For gnus-batch-kill (not gnus-interactive-exit) ;Without confirmation gnus-expert-user (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) ! (run-hooks 'gnus-exit-gnus-hook) ! ;; Offer to save data from non-quitted summary buffers. ! (gnus-offer-save-summaries) ! ;; Save the newsrc file(s). ! (gnus-save-newsrc-file) ! ;; Kill-em-all. ! (gnus-close-backends) ! ;; Reset everything. ! (gnus-clear-system) ! ;; Allow the user to do things after cleaning up. ! (run-hooks 'gnus-after-exiting-gnus-hook))) (defun gnus-close-backends () ! ;; Send a close request to all backends that support such a request. (let ((methods gnus-valid-select-methods) func) (while methods ! (if (fboundp (setq func (intern (concat (caar methods) "-request-close")))) (funcall func)) *************** The hook `gnus-exit-gnus-hook' is called *** 5010,5034 **** The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) ! (if (or noninteractive ;For gnus-batch-kill ! (zerop (buffer-size)) ! (not (gnus-server-opened gnus-select-method)) ! gnus-expert-user ! (not gnus-current-startup-file) ! (gnus-yes-or-no-p ! (format "Quit reading news without saving %s? " ! (file-name-nondirectory gnus-current-startup-file)))) ! (progn ! (run-hooks 'gnus-exit-gnus-hook) ! (if gnus-use-full-window ! (delete-other-windows) ! (gnus-remove-some-windows)) ! (gnus-dribble-save) ! (gnus-close-backends) ! (gnus-clear-system)))) (defun gnus-offer-save-summaries () (save-excursion ! (let ((buflist (buffer-list)) buffers bufname) (while buflist (and (setq bufname (buffer-name (car buflist))) --- 6836,6863 ---- The hook `gnus-exit-gnus-hook' is called before actually exiting." (interactive) ! (when (or noninteractive ;For gnus-batch-kill ! (zerop (buffer-size)) ! (not (gnus-server-opened gnus-select-method)) ! gnus-expert-user ! (not gnus-current-startup-file) ! (gnus-yes-or-no-p ! (format "Quit reading news without saving %s? " ! (file-name-nondirectory gnus-current-startup-file)))) ! (run-hooks 'gnus-exit-gnus-hook) ! (if gnus-use-full-window ! (delete-other-windows) ! (gnus-remove-some-windows)) ! (gnus-dribble-save) ! (gnus-close-backends) ! (gnus-clear-system) ! ;; Allow the user to do things after cleaning up. ! (run-hooks 'gnus-after-exiting-gnus-hook))) (defun gnus-offer-save-summaries () + "Offer to save all active summary buffers." (save-excursion ! (let ((buflist (buffer-list)) buffers bufname) + ;; Go through all buffers and find all summaries. (while buflist (and (setq bufname (buffer-name (car buflist))) *************** The hook `gnus-exit-gnus-hook' is called *** 5037,5050 **** (set-buffer bufname) ;; We check that this is, indeed, a summary buffer. ! (eq major-mode 'gnus-summary-mode)) ! (setq buffers (cons bufname buffers))) (setq buflist (cdr buflist))) ! (and buffers ! (map-y-or-n-p ! "Update summary buffer %s? " ! (lambda (buf) ! (set-buffer buf) ! (gnus-summary-exit)) ! buffers))))) (defun gnus-group-describe-briefly () --- 6866,6880 ---- (set-buffer bufname) ;; We check that this is, indeed, a summary buffer. ! (and (eq major-mode 'gnus-summary-mode) ! ;; Also make sure this isn't bogus. ! gnus-newsgroup-prepared)) ! (push bufname buffers)) (setq buflist (cdr buflist))) ! ;; Go through all these summary buffers and offer to save them. ! (when buffers ! (map-y-or-n-p ! "Update summary buffer %s? " ! (lambda (buf) (set-buffer buf) (gnus-summary-exit)) ! buffers))))) (defun gnus-group-describe-briefly () *************** The hook `gnus-exit-gnus-hook' is called *** 5056,5067 **** "Browse a foreign news server. If called interactively, this function will ask for a select method ! (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive ! (list (let ((how (completing-read "Which backend: " (append gnus-valid-select-methods gnus-server-alist) ! nil t "nntp"))) ;; We either got a backend name or a virtual server name. ;; If the first, we also need an address. --- 6886,6897 ---- "Browse a foreign news server. If called interactively, this function will ask for a select method ! (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). If not, METHOD should be a list where the first element is the method and the second element is the address." (interactive ! (list (let ((how (completing-read "Which backend: " (append gnus-valid-select-methods gnus-server-alist) ! nil t (cons "nntp" 0) 'gnus-method-history))) ;; We either got a backend name or a virtual server name. ;; If the first, we also need an address. *************** and the second element is the address." *** 5069,5074 **** (list (intern how) ;; Suggested by mapjph@bath.ac.uk. ! (completing-read ! "Address: " (mapcar (lambda (server) (list server)) gnus-secondary-servers))) --- 6899,6904 ---- (list (intern how) ;; Suggested by mapjph@bath.ac.uk. ! (completing-read ! "Address: " (mapcar (lambda (server) (list server)) gnus-secondary-servers))) *************** and the second element is the address." *** 5079,5313 **** ;;; - ;;; Browse Server Mode - ;;; - - (defvar gnus-browse-mode-hook nil) - (defvar gnus-browse-mode-map nil) - (put 'gnus-browse-mode 'mode-class 'special) - - (if gnus-browse-mode-map - nil - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - (define-key gnus-browse-mode-map " " 'gnus-browse-read-group) - (define-key gnus-browse-mode-map "=" 'gnus-browse-select-group) - (define-key gnus-browse-mode-map "n" 'gnus-browse-next-group) - (define-key gnus-browse-mode-map "p" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "\177" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "N" 'gnus-browse-next-group) - (define-key gnus-browse-mode-map "P" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "\M-n" 'gnus-browse-next-group) - (define-key gnus-browse-mode-map "\M-p" 'gnus-browse-prev-group) - (define-key gnus-browse-mode-map "\r" 'gnus-browse-select-group) - (define-key gnus-browse-mode-map "u" 'gnus-browse-unsubscribe-current-group) - (define-key gnus-browse-mode-map "l" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "L" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "q" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "Q" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "\C-c\C-c" 'gnus-browse-exit) - (define-key gnus-browse-mode-map "?" 'gnus-browse-describe-briefly) - (define-key gnus-browse-mode-map "\C-c\C-i" 'gnus-info-find-node) - ) - - (defvar gnus-browse-current-method nil) - (defvar gnus-browse-return-buffer nil) - - (defvar gnus-browse-buffer "*Gnus Browse Server*") - - (defun gnus-browse-foreign-server (method &optional return-buffer) - (setq gnus-browse-current-method method) - (setq gnus-browse-return-buffer return-buffer) - (let ((gnus-select-method method) - groups group) - (gnus-message 5 "Connecting to %s..." (nth 1 method)) - (or (gnus-check-server method) - (error "Unable to contact server: %s" (gnus-status-message method))) - (or (gnus-request-list method) - (error "Couldn't request list: %s" (gnus-status-message method))) - (get-buffer-create gnus-browse-buffer) - (gnus-add-current-to-buffer-list) - (and gnus-carpal (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer)) - (gnus-browse-mode) - (setq mode-line-buffer-identification - (format - "Gnus Browse Server {%s:%s}" (car method) (car (cdr method)))) - (save-excursion - (set-buffer nntp-server-buffer) - (let ((cur (current-buffer))) - (goto-char (point-min)) - (or (string= gnus-ignored-newsgroups "") - (delete-matching-lines gnus-ignored-newsgroups)) - (while (re-search-forward - "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) - (goto-char (match-end 1)) - (setq groups (cons (cons (buffer-substring (match-beginning 1) - (match-end 1)) - (max 0 (- (1+ (read cur)) (read cur)))) - groups))))) - (setq groups (sort groups - (lambda (l1 l2) - (string< (car l1) (car l2))))) - (let ((buffer-read-only nil)) - (while groups - (setq group (car groups)) - (insert - (format "K%7d: %s\n" (cdr group) (car group))) - (setq groups (cdr groups)))) - (switch-to-buffer (current-buffer)) - (goto-char (point-min)) - (gnus-group-position-cursor))) - - (defun gnus-browse-mode () - "Major mode for browsing a foreign server. - - All normal editing commands are switched off. - - \\ - The only things you can do in this buffer is - - 1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. - The group will be inserted into the group buffer upon exit from this - buffer. - - 2) `\\[gnus-browse-read-group]' to read a group ephemerally. - - 3) `\\[gnus-browse-exit]' to return to the group buffer." - (interactive) - (kill-all-local-variables) - (if gnus-visual (gnus-browse-make-menu-bar)) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-browse-mode) - (setq mode-name "Browse Server") - (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (run-hooks 'gnus-browse-mode-hook)) - - (defun gnus-browse-read-group (&optional no-article) - "Enter the group at the current line." - (interactive) - (let ((group (gnus-browse-group-name))) - (or (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil - (cons (current-buffer) 'browse)) - (error "Couldn't enter %s" group)))) - - (defun gnus-browse-select-group () - "Select the current group." - (interactive) - (gnus-browse-read-group 'no)) - - (defun gnus-browse-next-group (n) - "Go to the next group." - (interactive "p") - (prog1 - (forward-line n) - (gnus-group-position-cursor))) - - (defun gnus-browse-prev-group (n) - "Go to the next group." - (interactive "p") - (gnus-browse-next-group (- n))) - - (defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." - (interactive "p") - (and (eobp) - (error "No group at current line.")) - (let ((ward (if (< arg 0) -1 1)) - (arg (abs arg))) - (while (and (> arg 0) - (not (eobp)) - (gnus-browse-unsubscribe-group) - (zerop (gnus-browse-next-group ward))) - (setq arg (1- arg))) - (gnus-group-position-cursor) - (if (/= 0 arg) (gnus-message 7 "No more newsgroups")) - arg)) - - (defun gnus-browse-group-name () - (save-excursion - (beginning-of-line) - (if (not (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)) - () - (gnus-group-prefixed-name - (buffer-substring (match-beginning 1) (match-end 1)) - gnus-browse-current-method)))) - - (defun gnus-browse-unsubscribe-group () - "Toggle subscription of the current group in the browse buffer." - (let ((sub nil) - (buffer-read-only nil) - group) - (save-excursion - (beginning-of-line) - ;; If this group it killed, then we want to subscribe it. - (if (= (following-char) ?K) (setq sub t)) - (setq group (gnus-browse-group-name)) - (delete-char 1) - (if sub - (progn - (gnus-group-change-level - (list t group gnus-level-default-subscribed - nil nil gnus-browse-current-method) - gnus-level-default-subscribed gnus-level-killed - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) - t) - (insert ? )) - (gnus-group-change-level - group gnus-level-killed gnus-level-default-subscribed) - (insert ?K))) - t)) - - (defun gnus-browse-exit () - "Quit browsing and return to the group buffer." - (interactive) - (if (eq major-mode 'gnus-browse-mode) - (kill-buffer (current-buffer))) - (if gnus-browse-return-buffer - (gnus-configure-windows 'server 'force) - (gnus-configure-windows 'group 'force) - (gnus-group-list-groups nil))) - - (defun gnus-browse-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) - - - ;;; ;;; Gnus summary mode ;;; (defvar gnus-summary-mode-map nil) - (defvar gnus-summary-mark-map nil) - (defvar gnus-summary-mscore-map nil) - (defvar gnus-summary-article-map nil) - (defvar gnus-summary-thread-map nil) - (defvar gnus-summary-goto-map nil) - (defvar gnus-summary-exit-map nil) - (defvar gnus-summary-interest-map nil) - (defvar gnus-summary-sort-map nil) - (defvar gnus-summary-backend-map nil) - (defvar gnus-summary-save-map nil) - (defvar gnus-summary-wash-map nil) - (defvar gnus-summary-wash-hide-map nil) - (defvar gnus-summary-wash-highlight-map nil) - (defvar gnus-summary-wash-time-map nil) - (defvar gnus-summary-help-map nil) (put 'gnus-summary-mode 'mode-class 'special) ! (if gnus-summary-mode-map ! nil (setq gnus-summary-mode-map (make-keymap)) (suppress-keymap gnus-summary-mode-map) --- 6909,6920 ---- ;;; ;;; Gnus summary mode ;;; (defvar gnus-summary-mode-map nil) (put 'gnus-summary-mode 'mode-class 'special) ! (unless gnus-summary-mode-map (setq gnus-summary-mode-map (make-keymap)) (suppress-keymap gnus-summary-mode-map) *************** buffer. *** 5315,5629 **** ;; Non-orthogonal keys ! (define-key gnus-summary-mode-map " " 'gnus-summary-next-page) ! (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page) ! (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up) ! (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article) ! (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article) ! (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article) ! (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article) ! (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject) ! (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject) ! (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject) ! (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject) ! (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article) ! (define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article) ! (define-key gnus-summary-mode-map ! "\M-s" 'gnus-summary-search-article-forward) ! (define-key gnus-summary-mode-map ! "\M-r" 'gnus-summary-search-article-backward) ! (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article) ! (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article) ! (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject) ! (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article) ! (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article) ! (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mode-map "!" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward) ! (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward) ! (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward) ! (define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable) ! (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward) ! (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward) ! (define-key gnus-summary-mode-map ! "k" 'gnus-summary-kill-same-subject-and-select) ! (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject) ! (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread) ! (define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread) ! (define-key gnus-summary-mode-map "e" 'gnus-summary-edit-article) ! (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable) ! (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable) ! (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads) ! (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread) ! (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread) ! (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread) ! (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread) ! (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread) ! (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread) ! (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command) ! (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit) ! (define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read) ! (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation) ! (define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant) ! (define-key gnus-summary-mode-map ! "\C-c\M-\C-s" 'gnus-summary-show-all-expunged) ! (define-key gnus-summary-mode-map ! "\C-c\C-s\C-n" 'gnus-summary-sort-by-number) ! (define-key gnus-summary-mode-map ! "\C-c\C-s\C-a" 'gnus-summary-sort-by-author) ! (define-key gnus-summary-mode-map ! "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject) ! (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date) ! (define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score) ! (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window) ! (define-key gnus-summary-mode-map ! "\C-x\C-s" 'gnus-summary-reselect-current-group) ! (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group) ! (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking) ! (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message) ! (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime) ! (define-key gnus-summary-mode-map "f" 'gnus-summary-followup) ! (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original) ! (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article) ! (define-key gnus-summary-mode-map "r" 'gnus-summary-reply) ! (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original) ! (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward) ! (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article) ! (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-mail) ! (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output) ! (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill) ! (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill) ! (define-key gnus-summary-mode-map "V" 'gnus-version) ! (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group) ! (define-key gnus-summary-mode-map "q" 'gnus-summary-exit) ! (define-key gnus-summary-mode-map "Q" 'gnus-summary-exit-no-update) ! (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node) ! (define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article) ! (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window) ! (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news) ! (define-key gnus-summary-mode-map ! "x" 'gnus-summary-remove-lines-marked-as-read) ! ; (define-key gnus-summary-mode-map "X" 'gnus-summary-remove-lines-marked-with) ! (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article) ! (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header) ! (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article) ! ; (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly) ! (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article) ! (define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view) ! (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group) ! (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers) ! (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug) ! ;; Sort of orthogonal keymap ! (define-prefix-command 'gnus-summary-mark-map) ! (define-key gnus-summary-mode-map "M" 'gnus-summary-mark-map) ! (define-key gnus-summary-mark-map "t" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mark-map "!" 'gnus-summary-tick-article-forward) ! (define-key gnus-summary-mark-map "d" 'gnus-summary-mark-as-read-forward) ! (define-key gnus-summary-mark-map "r" 'gnus-summary-mark-as-read-forward) ! (define-key gnus-summary-mark-map "c" 'gnus-summary-clear-mark-forward) ! (define-key gnus-summary-mark-map " " 'gnus-summary-clear-mark-forward) ! (define-key gnus-summary-mark-map "e" 'gnus-summary-mark-as-expirable) ! (define-key gnus-summary-mark-map "x" 'gnus-summary-mark-as-expirable) ! (define-key gnus-summary-mark-map "?" 'gnus-summary-mark-as-dormant) ! (define-key gnus-summary-mark-map "b" 'gnus-summary-set-bookmark) ! (define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark) ! (define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable) ! (define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable) ! (define-key gnus-summary-mark-map ! "\M-r" 'gnus-summary-remove-lines-marked-as-read) ! (define-key gnus-summary-mark-map ! "\M-\C-r" 'gnus-summary-remove-lines-marked-with) ! (define-key gnus-summary-mark-map "D" 'gnus-summary-show-all-dormant) ! (define-key gnus-summary-mark-map "\M-D" 'gnus-summary-hide-all-dormant) ! (define-key gnus-summary-mark-map "S" 'gnus-summary-show-all-expunged) ! (define-key gnus-summary-mark-map "C" 'gnus-summary-catchup) ! (define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here) ! (define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all) ! (define-key gnus-summary-mark-map ! "k" 'gnus-summary-kill-same-subject-and-select) ! (define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject) ! ! (define-prefix-command 'gnus-summary-mscore-map) ! (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map) ! (define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above) ! (define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above) ! (define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above) ! (define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below) ! ! (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map) ! ! (define-key gnus-summary-mode-map "S" 'gnus-summary-send-map) ! ! (define-prefix-command 'gnus-summary-goto-map) ! (define-key gnus-summary-mode-map "G" 'gnus-summary-goto-map) ! (define-key gnus-summary-goto-map "n" 'gnus-summary-next-unread-article) ! (define-key gnus-summary-goto-map "p" 'gnus-summary-prev-unread-article) ! (define-key gnus-summary-goto-map "N" 'gnus-summary-next-article) ! (define-key gnus-summary-goto-map "P" 'gnus-summary-prev-article) ! (define-key gnus-summary-goto-map "\C-n" 'gnus-summary-next-same-subject) ! (define-key gnus-summary-goto-map "\C-p" 'gnus-summary-prev-same-subject) ! (define-key gnus-summary-goto-map "\M-n" 'gnus-summary-next-unread-subject) ! (define-key gnus-summary-goto-map "\M-p" 'gnus-summary-prev-unread-subject) ! (define-key gnus-summary-goto-map "f" 'gnus-summary-first-unread-article) ! (define-key gnus-summary-goto-map "b" 'gnus-summary-best-unread-article) ! (define-key gnus-summary-goto-map "g" 'gnus-summary-goto-subject) ! (define-key gnus-summary-goto-map "l" 'gnus-summary-goto-last-article) ! (define-key gnus-summary-goto-map "p" 'gnus-summary-pop-article) ! ! ! (define-prefix-command 'gnus-summary-thread-map) ! (define-key gnus-summary-mode-map "T" 'gnus-summary-thread-map) ! (define-key gnus-summary-thread-map "k" 'gnus-summary-kill-thread) ! (define-key gnus-summary-thread-map "l" 'gnus-summary-lower-thread) ! (define-key gnus-summary-thread-map "i" 'gnus-summary-raise-thread) ! (define-key gnus-summary-thread-map "T" 'gnus-summary-toggle-threads) ! (define-key gnus-summary-thread-map "s" 'gnus-summary-show-thread) ! (define-key gnus-summary-thread-map "S" 'gnus-summary-show-all-threads) ! (define-key gnus-summary-thread-map "h" 'gnus-summary-hide-thread) ! (define-key gnus-summary-thread-map "H" 'gnus-summary-hide-all-threads) ! (define-key gnus-summary-thread-map "n" 'gnus-summary-next-thread) ! (define-key gnus-summary-thread-map "p" 'gnus-summary-prev-thread) ! (define-key gnus-summary-thread-map "u" 'gnus-summary-up-thread) ! (define-key gnus-summary-thread-map "d" 'gnus-summary-down-thread) ! (define-key gnus-summary-thread-map "#" 'gnus-uu-mark-thread) ! ! ! (define-prefix-command 'gnus-summary-exit-map) ! (define-key gnus-summary-mode-map "Z" 'gnus-summary-exit-map) ! (define-key gnus-summary-exit-map "c" 'gnus-summary-catchup-and-exit) ! (define-key gnus-summary-exit-map "C" 'gnus-summary-catchup-all-and-exit) ! (define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update) ! (define-key gnus-summary-exit-map "Q" 'gnus-summary-exit) ! (define-key gnus-summary-exit-map "Z" 'gnus-summary-exit) ! (define-key gnus-summary-exit-map ! "n" 'gnus-summary-catchup-and-goto-next-group) ! (define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group) ! (define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group) ! (define-key gnus-summary-exit-map "N" 'gnus-summary-next-group) ! (define-key gnus-summary-exit-map "P" 'gnus-summary-prev-group) ! ! ! (define-prefix-command 'gnus-summary-article-map) ! (define-key gnus-summary-mode-map "A" 'gnus-summary-article-map) ! (define-key gnus-summary-article-map " " 'gnus-summary-next-page) ! (define-key gnus-summary-article-map "n" 'gnus-summary-next-page) ! (define-key gnus-summary-article-map "\177" 'gnus-summary-prev-page) ! (define-key gnus-summary-article-map "p" 'gnus-summary-prev-page) ! (define-key gnus-summary-article-map "\r" 'gnus-summary-scroll-up) ! (define-key gnus-summary-article-map "<" 'gnus-summary-beginning-of-article) ! (define-key gnus-summary-article-map ">" 'gnus-summary-end-of-article) ! (define-key gnus-summary-article-map "b" 'gnus-summary-beginning-of-article) ! (define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article) ! (define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article) ! (define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article) ! (define-key gnus-summary-article-map "g" 'gnus-summary-show-article) ! (define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article) ! ! ! ! (define-prefix-command 'gnus-summary-wash-map) ! (define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map) ! ! (define-prefix-command 'gnus-summary-wash-hide-map) ! (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map) ! (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide) ! (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers) ! (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature) ! (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation) ! (define-key gnus-summary-wash-hide-map ! "\C-c" 'gnus-article-hide-citation-maybe) ! ! (define-prefix-command 'gnus-summary-wash-highlight-map) ! (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map) ! (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight) ! (define-key gnus-summary-wash-highlight-map ! "h" 'gnus-article-highlight-headers) ! (define-key gnus-summary-wash-highlight-map ! "c" 'gnus-article-highlight-citation) ! (define-key gnus-summary-wash-highlight-map ! "s" 'gnus-article-highlight-signature) ! ! (define-prefix-command 'gnus-summary-wash-time-map) ! (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map) ! (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut) ! (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local) ! (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed) ! ! (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons) ! (define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike) ! (define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap) ! (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr) ! (define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable) ! (define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face) ! (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking) ! (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message) ! (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header) ! (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime) ! ! ! (define-prefix-command 'gnus-summary-help-map) ! (define-key gnus-summary-mode-map "H" 'gnus-summary-help-map) ! (define-key gnus-summary-help-map "v" 'gnus-version) ! (define-key gnus-summary-help-map "f" 'gnus-summary-fetch-faq) ! (define-key gnus-summary-help-map "d" 'gnus-summary-describe-group) ! (define-key gnus-summary-help-map "h" 'gnus-summary-describe-briefly) ! (define-key gnus-summary-help-map "i" 'gnus-info-find-node) ! ! ! (define-prefix-command 'gnus-summary-backend-map) ! (define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map) ! (define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles) ! (define-key gnus-summary-backend-map "\M-\C-e" ! 'gnus-summary-expire-articles-now) ! (define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article) ! (define-key gnus-summary-backend-map "m" 'gnus-summary-move-article) ! (define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article) ! (define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article) ! (define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article) ! (define-key gnus-summary-backend-map "q" 'gnus-summary-fancy-query) ! (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article) ! ! ! (define-prefix-command 'gnus-summary-save-map) ! (define-key gnus-summary-mode-map "O" 'gnus-summary-save-map) ! (define-key gnus-summary-save-map "o" 'gnus-summary-save-article) ! (define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail) ! (define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail) ! (define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file) ! (define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder) ! (define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm) ! (define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output) ! ; (define-key gnus-summary-save-map "s" 'gnus-soup-add-article) ! ! (define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map) ! ! (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument) ! ; (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward) ! ; (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward) ! ; (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article) ! ; (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command) ! ; (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation) ! ; (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window) ! (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group) ! ; (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill) ! ; (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill) ! ! (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map) ! ! ; (define-prefix-command 'gnus-summary-sort-map) ! ; (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map) ! ; (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number) ! ; (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author) ! ; (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject) ! ; (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date) ! ; (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score) ! ! (define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score) ! (define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score) ) - --- 6922,7203 ---- ;; Non-orthogonal keys ! (gnus-define-keys gnus-summary-mode-map ! " " gnus-summary-next-page ! "\177" gnus-summary-prev-page ! [delete] gnus-summary-prev-page ! "\r" gnus-summary-scroll-up ! "n" gnus-summary-next-unread-article ! "p" gnus-summary-prev-unread-article ! "N" gnus-summary-next-article ! "P" gnus-summary-prev-article ! "\M-\C-n" gnus-summary-next-same-subject ! "\M-\C-p" gnus-summary-prev-same-subject ! "\M-n" gnus-summary-next-unread-subject ! "\M-p" gnus-summary-prev-unread-subject ! "." gnus-summary-first-unread-article ! "," gnus-summary-best-unread-article ! "\M-s" gnus-summary-search-article-forward ! "\M-r" gnus-summary-search-article-backward ! "<" gnus-summary-beginning-of-article ! ">" gnus-summary-end-of-article ! "j" gnus-summary-goto-article ! "^" gnus-summary-refer-parent-article ! "\M-^" gnus-summary-refer-article ! "u" gnus-summary-tick-article-forward ! "!" gnus-summary-tick-article-forward ! "U" gnus-summary-tick-article-backward ! "d" gnus-summary-mark-as-read-forward ! "D" gnus-summary-mark-as-read-backward ! "E" gnus-summary-mark-as-expirable ! "\M-u" gnus-summary-clear-mark-forward ! "\M-U" gnus-summary-clear-mark-backward ! "k" gnus-summary-kill-same-subject-and-select ! "\C-k" gnus-summary-kill-same-subject ! "\M-\C-k" gnus-summary-kill-thread ! "\M-\C-l" gnus-summary-lower-thread ! "e" gnus-summary-edit-article ! "#" gnus-summary-mark-as-processable ! "\M-#" gnus-summary-unmark-as-processable ! "\M-\C-t" gnus-summary-toggle-threads ! "\M-\C-s" gnus-summary-show-thread ! "\M-\C-h" gnus-summary-hide-thread ! "\M-\C-f" gnus-summary-next-thread ! "\M-\C-b" gnus-summary-prev-thread ! "\M-\C-u" gnus-summary-up-thread ! "\M-\C-d" gnus-summary-down-thread ! "&" gnus-summary-execute-command ! "c" gnus-summary-catchup-and-exit ! "\C-w" gnus-summary-mark-region-as-read ! "\C-t" gnus-summary-toggle-truncation ! "?" gnus-summary-mark-as-dormant ! "\C-c\M-\C-s" gnus-summary-limit-include-expunged ! "\C-c\C-s\C-n" gnus-summary-sort-by-number ! "\C-c\C-s\C-a" gnus-summary-sort-by-author ! "\C-c\C-s\C-s" gnus-summary-sort-by-subject ! "\C-c\C-s\C-d" gnus-summary-sort-by-date ! "\C-c\C-s\C-i" gnus-summary-sort-by-score ! "=" gnus-summary-expand-window ! "\C-x\C-s" gnus-summary-reselect-current-group ! "\M-g" gnus-summary-rescan-group ! "w" gnus-summary-stop-page-breaking ! "\C-c\C-r" gnus-summary-caesar-message ! "\M-t" gnus-summary-toggle-mime ! "f" gnus-summary-followup ! "F" gnus-summary-followup-with-original ! "C" gnus-summary-cancel-article ! "r" gnus-summary-reply ! "R" gnus-summary-reply-with-original ! "\C-c\C-f" gnus-summary-mail-forward ! "o" gnus-summary-save-article ! "\C-o" gnus-summary-save-article-mail ! "|" gnus-summary-pipe-output ! "\M-k" gnus-summary-edit-local-kill ! "\M-K" gnus-summary-edit-global-kill ! "V" gnus-version ! "\C-c\C-d" gnus-summary-describe-group ! "q" gnus-summary-exit ! "Q" gnus-summary-exit-no-update ! "\C-c\C-i" gnus-info-find-node ! gnus-mouse-2 gnus-mouse-pick-article ! "m" gnus-summary-mail-other-window ! "a" gnus-summary-post-news ! "x" gnus-summary-limit-to-unread ! "s" gnus-summary-isearch-article ! "t" gnus-article-hide-headers ! "g" gnus-summary-show-article ! "l" gnus-summary-goto-last-article ! "\C-c\C-v\C-v" gnus-uu-decode-uu-view ! "\C-d" gnus-summary-enter-digest-group ! "\C-c\C-b" gnus-bug ! "*" gnus-cache-enter-article ! "\M-*" gnus-cache-remove-article ! "\M-&" gnus-summary-universal-argument ! "\C-l" gnus-recenter ! "I" gnus-summary-increase-score ! "L" gnus-summary-lower-score ! ! "V" gnus-summary-score-map ! "X" gnus-uu-extract-map ! "S" gnus-summary-send-map) ;; Sort of orthogonal keymap ! (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) ! "t" gnus-summary-tick-article-forward ! "!" gnus-summary-tick-article-forward ! "d" gnus-summary-mark-as-read-forward ! "r" gnus-summary-mark-as-read-forward ! "c" gnus-summary-clear-mark-forward ! " " gnus-summary-clear-mark-forward ! "e" gnus-summary-mark-as-expirable ! "x" gnus-summary-mark-as-expirable ! "?" gnus-summary-mark-as-dormant ! "b" gnus-summary-set-bookmark ! "B" gnus-summary-remove-bookmark ! "#" gnus-summary-mark-as-processable ! "\M-#" gnus-summary-unmark-as-processable ! "S" gnus-summary-limit-include-expunged ! "C" gnus-summary-catchup ! "H" gnus-summary-catchup-to-here ! "\C-c" gnus-summary-catchup-all ! "k" gnus-summary-kill-same-subject-and-select ! "K" gnus-summary-kill-same-subject ! "P" gnus-uu-mark-map) ! ! (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map) ! "c" gnus-summary-clear-above ! "u" gnus-summary-tick-above ! "m" gnus-summary-mark-above ! "k" gnus-summary-kill-below) ! ! (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) ! "/" gnus-summary-limit-to-subject ! "n" gnus-summary-limit-to-articles ! "w" gnus-summary-pop-limit ! "s" gnus-summary-limit-to-subject ! "a" gnus-summary-limit-to-author ! "u" gnus-summary-limit-to-unread ! "m" gnus-summary-limit-to-marks ! "v" gnus-summary-limit-to-score ! "D" gnus-summary-limit-include-dormant ! "d" gnus-summary-limit-exclude-dormant ! ;; "t" gnus-summary-limit-exclude-thread ! "E" gnus-summary-limit-include-expunged ! "c" gnus-summary-limit-exclude-childless-dormant ! "C" gnus-summary-limit-mark-excluded-as-read) ! ! (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) ! "n" gnus-summary-next-unread-article ! "p" gnus-summary-prev-unread-article ! "N" gnus-summary-next-article ! "P" gnus-summary-prev-article ! "\C-n" gnus-summary-next-same-subject ! "\C-p" gnus-summary-prev-same-subject ! "\M-n" gnus-summary-next-unread-subject ! "\M-p" gnus-summary-prev-unread-subject ! "f" gnus-summary-first-unread-article ! "b" gnus-summary-best-unread-article ! "j" gnus-summary-goto-article ! "g" gnus-summary-goto-subject ! "l" gnus-summary-goto-last-article ! "p" gnus-summary-pop-article) ! ! (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) ! "k" gnus-summary-kill-thread ! "l" gnus-summary-lower-thread ! "i" gnus-summary-raise-thread ! "T" gnus-summary-toggle-threads ! "t" gnus-summary-rethread-current ! "^" gnus-summary-reparent-thread ! "s" gnus-summary-show-thread ! "S" gnus-summary-show-all-threads ! "h" gnus-summary-hide-thread ! "H" gnus-summary-hide-all-threads ! "n" gnus-summary-next-thread ! "p" gnus-summary-prev-thread ! "u" gnus-summary-up-thread ! "o" gnus-summary-top-thread ! "d" gnus-summary-down-thread ! "#" gnus-uu-mark-thread ! "\M-#" gnus-uu-unmark-thread) ! ! (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) ! "c" gnus-summary-catchup-and-exit ! "C" gnus-summary-catchup-all-and-exit ! "E" gnus-summary-exit-no-update ! "Q" gnus-summary-exit ! "Z" gnus-summary-exit ! "n" gnus-summary-catchup-and-goto-next-group ! "R" gnus-summary-reselect-current-group ! "G" gnus-summary-rescan-group ! "N" gnus-summary-next-group ! "P" gnus-summary-prev-group) ! ! (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) ! " " gnus-summary-next-page ! "n" gnus-summary-next-page ! "\177" gnus-summary-prev-page ! [delete] gnus-summary-prev-page ! "p" gnus-summary-prev-page ! "\r" gnus-summary-scroll-up ! "<" gnus-summary-beginning-of-article ! ">" gnus-summary-end-of-article ! "b" gnus-summary-beginning-of-article ! "e" gnus-summary-end-of-article ! "^" gnus-summary-refer-parent-article ! "r" gnus-summary-refer-parent-article ! "R" gnus-summary-refer-references ! "g" gnus-summary-show-article ! "s" gnus-summary-isearch-article) ! ! (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) ! "b" gnus-article-add-buttons ! "B" gnus-article-add-buttons-to-head ! "o" gnus-article-treat-overstrike ! ;; "w" gnus-article-word-wrap ! "w" gnus-article-fill-cited-article ! "c" gnus-article-remove-cr ! "L" gnus-article-remove-trailing-blank-lines ! "q" gnus-article-de-quoted-unreadable ! "f" gnus-article-display-x-face ! "l" gnus-summary-stop-page-breaking ! "r" gnus-summary-caesar-message ! "t" gnus-article-hide-headers ! "v" gnus-summary-verbose-headers ! "m" gnus-summary-toggle-mime) ! ! (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) ! "a" gnus-article-hide ! "h" gnus-article-hide-headers ! "b" gnus-article-hide-boring-headers ! "s" gnus-article-hide-signature ! "c" gnus-article-hide-citation ! "p" gnus-article-hide-pgp ! "\C-c" gnus-article-hide-citation-maybe) ! ! (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) ! "a" gnus-article-highlight ! "h" gnus-article-highlight-headers ! "c" gnus-article-highlight-citation ! "s" gnus-article-highlight-signature) ! ! (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) ! "z" gnus-article-date-ut ! "u" gnus-article-date-ut ! "l" gnus-article-date-local ! "e" gnus-article-date-lapsed ! "o" gnus-article-date-original) ! ! (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) ! "v" gnus-version ! "f" gnus-summary-fetch-faq ! "d" gnus-summary-describe-group ! "h" gnus-summary-describe-briefly ! "i" gnus-info-find-node) ! ! (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) ! "e" gnus-summary-expire-articles ! "\M-\C-e" gnus-summary-expire-articles-now ! "\177" gnus-summary-delete-article ! [delete] gnus-summary-delete-article ! "m" gnus-summary-move-article ! "r" gnus-summary-respool-article ! "w" gnus-summary-edit-article ! "c" gnus-summary-copy-article ! "B" gnus-summary-crosspost-article ! "q" gnus-summary-respool-query ! "i" gnus-summary-import-article) ! ! (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) ! "o" gnus-summary-save-article ! "m" gnus-summary-save-article-mail ! "r" gnus-summary-save-article-rmail ! "f" gnus-summary-save-article-file ! "b" gnus-summary-save-article-body-file ! "h" gnus-summary-save-article-folder ! "v" gnus-summary-save-article-vm ! "p" gnus-summary-pipe-output ! "s" gnus-soup-add-article) ) *************** All normal editing commands are switched *** 5635,5647 **** Each line in this buffer represents one article. To read an article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards ! and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', respectively. ! You can also post articles and send mail from this buffer. To ! follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\\[gnus-summary-reply]'. ! There are approx. one gazillion commands you can execute in this ! buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: --- 7209,7221 ---- Each line in this buffer represents one article. To read an article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards ! and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', respectively. ! You can also post articles and send mail from this buffer. To ! follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author of an article, type `\\[gnus-summary-reply]'. ! There are approx. one gazillion commands you can execute in this ! buffer; read the info pages for more information (`\\[gnus-info-find-node]'). The following commands are available: *************** The following commands are available: *** 5649,5663 **** \\{gnus-summary-mode-map}" (interactive) ! (if gnus-visual (gnus-summary-make-menu-bar)) (kill-all-local-variables) ! (let ((locals gnus-summary-local-variables)) ! (while locals ! (if (consp (car locals)) ! (progn ! (make-local-variable (car (car locals))) ! (set (car (car locals)) (eval (cdr (car locals))))) ! (make-local-variable (car locals)) ! (set (car locals) nil)) ! (setq locals (cdr locals)))) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) --- 7223,7231 ---- \\{gnus-summary-mode-map}" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'summary-menu 'menu)) ! (gnus-summary-make-menu-bar)) (kill-all-local-variables) ! (gnus-summary-make-local-variables) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) *************** The following commands are available: *** 5673,5685 **** (setq buffer-display-table gnus-summary-display-table) (setq gnus-newsgroup-name group) (run-hooks 'gnus-summary-mode-hook)) (defun gnus-summary-make-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. ;; We start from the standard display table, if any. ! (setq gnus-summary-display-table (or (copy-sequence standard-display-table) (make-display-table))) --- 7241,7276 ---- (setq buffer-display-table gnus-summary-display-table) (setq gnus-newsgroup-name group) + (make-local-variable 'gnus-summary-line-format) + (make-local-variable 'gnus-summary-line-format-spec) + (make-local-variable 'gnus-summary-mark-positions) + (gnus-make-local-hook 'post-command-hook) + (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (run-hooks 'gnus-summary-mode-hook)) + (defun gnus-summary-make-local-variables () + "Make all the local summary buffer variables." + (let ((locals gnus-summary-local-variables) + global local) + (while (setq local (pop locals)) + (if (consp local) + (progn + (if (eq (cdr local) 'global) + ;; Copy the global value of the variable. + (setq global (symbol-value (car local))) + ;; Use the value from the list. + (setq global (eval (cdr local)))) + (make-local-variable (car local)) + (set (car local) global)) + ;; Simple nil-valued local variable. + (make-local-variable local) + (set local nil))))) + (defun gnus-summary-make-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. ;; We start from the standard display table, if any. ! (setq gnus-summary-display-table (or (copy-sequence standard-display-table) (make-display-table))) *************** The following commands are available: *** 5689,5700 **** (aset gnus-summary-display-table i [??]))) ;; ... but not newline and cr, of course. (cr is necessary for the ! ;; selective display). (aset gnus-summary-display-table ?\n nil) (aset gnus-summary-display-table ?\r nil) ! ;; We nix out any glyphs over 126 that are not set already. (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. ! (or (aref gnus-summary-display-table i) (aset gnus-summary-display-table i [??]))))) --- 7280,7291 ---- (aset gnus-summary-display-table i [??]))) ;; ... but not newline and cr, of course. (cr is necessary for the ! ;; selective display). (aset gnus-summary-display-table ?\n nil) (aset gnus-summary-display-table ?\r nil) ! ;; We nix out any glyphs over 126 that are not set already. (let ((i 256)) (while (>= (setq i (1- i)) 127) ;; Only modify if the entry is nil. ! (or (aref gnus-summary-display-table i) (aset gnus-summary-display-table i [??]))))) *************** The following commands are available: *** 5703,5769 **** (while locals (if (consp (car locals)) ! (and (vectorp (car (car locals))) ! (set (car (car locals)) nil)) (and (vectorp (car locals)) (set (car locals) nil))) (setq locals (cdr locals))))) ! ;; Some summary mode macros. ! ;; Return a header specified by a NUMBER. ! (defun gnus-get-header-by-number (number) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (or gnus-newsgroup-headers-hashtb-by-number ! (gnus-make-headers-hashtable-by-number)) ! (gnus-gethash (int-to-string number) ! gnus-newsgroup-headers-hashtb-by-number))) ! ! ;; Fast version of the function above. ! (defmacro gnus-get-header-by-num (number) ! (` (gnus-gethash (int-to-string (, number)) ! gnus-newsgroup-headers-hashtb-by-number))) ! (defmacro gnus-summary-search-forward (&optional unread subject backward) ! "Search for article forward. ! If UNREAD is non-nil, only unread articles are selected. ! If SUBJECT is non-nil, the article which has the same subject will be ! searched for. ! If BACKWARD is non-nil, the search will be performed backwards instead." ! (` (gnus-summary-search-subject (, backward) (, unread) (, subject)))) ! ! (defmacro gnus-summary-search-backward (&optional unread subject) ! "Search for article backward. ! If 1st optional argument UNREAD is non-nil, only unread article is selected. ! If 2nd optional argument SUBJECT is non-nil, the article which has ! the same subject will be searched for." ! (` (gnus-summary-search-forward (, unread) (, subject) t))) ! (defmacro gnus-summary-article-number (&optional number-or-nil) "The article number of the article on the current line. If there isn's an article number here, then we return the current article number." ! (if number-or-nil ! '(get-text-property (gnus-point-at-bol) 'gnus-number) ! '(or (get-text-property (gnus-point-at-bol) 'gnus-number) ! gnus-current-article))) ! ! (defmacro gnus-summary-thread-level () ! "The thread level of the article on the current line." ! '(or (get-text-property (gnus-point-at-bol) 'gnus-level) ! 0)) ! ! (defmacro gnus-summary-article-mark () ! "The mark on the current line." ! '(get-text-property (gnus-point-at-bol) 'gnus-mark)) ! (defun gnus-summary-subject-string () "Return current subject string or nil if nothing." ! (let ((article (gnus-summary-article-number)) ! header) ! (and article ! (setq header (gnus-get-header-by-num article)) ! (vectorp header) ! (mail-header-subject header)))) ;; Various summary mode internalish functions. --- 7294,7558 ---- (while locals (if (consp (car locals)) ! (and (vectorp (caar locals)) ! (set (caar locals) nil)) (and (vectorp (car locals)) (set (car locals) nil))) (setq locals (cdr locals))))) ! ;; Summary data functions. ! (defmacro gnus-data-number (data) ! `(car ,data)) ! (defmacro gnus-data-set-number (data number) ! `(setcar ,data ,number)) ! ! (defmacro gnus-data-mark (data) ! `(nth 1 ,data)) ! ! (defmacro gnus-data-set-mark (data mark) ! `(setcar (nthcdr 1 ,data) ,mark)) ! ! (defmacro gnus-data-pos (data) ! `(nth 2 ,data)) ! ! (defmacro gnus-data-set-pos (data pos) ! `(setcar (nthcdr 2 ,data) ,pos)) ! ! (defmacro gnus-data-header (data) ! `(nth 3 ,data)) ! ! (defmacro gnus-data-level (data) ! `(nth 4 ,data)) ! ! (defmacro gnus-data-unread-p (data) ! `(= (nth 1 ,data) gnus-unread-mark)) ! ! (defmacro gnus-data-pseudo-p (data) ! `(consp (nth 3 ,data))) ! ! (defmacro gnus-data-find (number) ! `(assq ,number gnus-newsgroup-data)) ! ! (defmacro gnus-data-find-list (number &optional data) ! `(let ((bdata ,(or data 'gnus-newsgroup-data))) ! (memq (assq ,number bdata) ! bdata))) ! ! (defmacro gnus-data-make (number mark pos header level) ! `(list ,number ,mark ,pos ,header ,level)) ! ! (defun gnus-data-enter (after-article number mark pos header level offset) ! (let ((data (gnus-data-find-list after-article))) ! (or data (error "No such article: %d" after-article)) ! (setcdr data (cons (gnus-data-make number mark pos header level) ! (cdr data))) ! (setq gnus-newsgroup-data-reverse nil) ! (gnus-data-update-list (cddr data) offset))) ! ! (defun gnus-data-enter-list (after-article list &optional offset) ! (when list ! (let ((data (and after-article (gnus-data-find-list after-article))) ! (ilist list)) ! (or data (not after-article) (error "No such article: %d" after-article)) ! ;; Find the last element in the list to be spliced into the main ! ;; list. ! (while (cdr list) ! (setq list (cdr list))) ! (if (not data) ! (progn ! (setcdr list gnus-newsgroup-data) ! (setq gnus-newsgroup-data ilist) ! (and offset (gnus-data-update-list (cdr list) offset))) ! (setcdr list (cdr data)) ! (setcdr data ilist) ! (and offset (gnus-data-update-list (cdr data) offset))) ! (setq gnus-newsgroup-data-reverse nil)))) ! ! (defun gnus-data-remove (article &optional offset) ! (let ((data gnus-newsgroup-data)) ! (if (= (gnus-data-number (car data)) article) ! (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) ! gnus-newsgroup-data-reverse nil) ! (while (cdr data) ! (and (= (gnus-data-number (cadr data)) article) ! (progn ! (setcdr data (cddr data)) ! (and offset (gnus-data-update-list (cdr data) offset)) ! (setq data nil ! gnus-newsgroup-data-reverse nil))) ! (setq data (cdr data)))))) ! ! (defmacro gnus-data-list (backward) ! `(if ,backward ! (or gnus-newsgroup-data-reverse ! (setq gnus-newsgroup-data-reverse ! (reverse gnus-newsgroup-data))) ! gnus-newsgroup-data)) ! ! (defun gnus-data-update-list (data offset) ! "Add OFFSET to the POS of all data entries in DATA." ! (while data ! (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) ! (setq data (cdr data)))) ! ! (defun gnus-data-compute-positions () ! "Compute the positions of all articles." ! (let ((data gnus-newsgroup-data) ! pos) ! (while data ! (when (setq pos (text-property-any ! (point-min) (point-max) ! 'gnus-number (gnus-data-number (car data)))) ! (gnus-data-set-pos (car data) (+ pos 3))) ! (setq data (cdr data))))) ! ! (defun gnus-summary-article-pseudo-p (article) ! "Say whether this article is a pseudo article or not." ! (not (vectorp (gnus-data-header (gnus-data-find article))))) ! ! (defun gnus-article-parent-p (number) ! "Say whether this article is a parent or not." ! (let ((data (gnus-data-find-list number))) ! (and (cdr data) ; There has to be an article after... ! (< (gnus-data-level (car data)) ; And it has to have a higher level. ! (gnus-data-level (nth 1 data)))))) ! ! (defun gnus-article-children (number) ! "Return a list of all children to NUMBER." ! (let* ((data (gnus-data-find-list number)) ! (level (gnus-data-level (car data))) ! children) ! (setq data (cdr data)) ! (while (and data ! (= (gnus-data-level (car data)) (1+ level))) ! (push (gnus-data-number (car data)) children) ! (setq data (cdr data))) ! children)) ! ! (defmacro gnus-summary-skip-intangible () ! "If the current article is intangible, then jump to a different article." ! '(let ((to (get-text-property (point) 'gnus-intangible))) ! (and to (gnus-summary-goto-subject to)))) ! ! (defmacro gnus-summary-article-intangible-p () ! "Say whether this article is intangible or not." ! '(get-text-property (point) 'gnus-intangible)) ! ! ;; Some summary mode macros. ! (defmacro gnus-summary-article-number () "The article number of the article on the current line. If there isn's an article number here, then we return the current article number." ! '(progn ! (gnus-summary-skip-intangible) ! (or (get-text-property (point) 'gnus-number) ! (gnus-summary-last-subject)))) ! ! (defmacro gnus-summary-article-header (&optional number) ! `(gnus-data-header (gnus-data-find ! ,(or number '(gnus-summary-article-number))))) ! ! (defmacro gnus-summary-thread-level (&optional number) ! `(if (and (eq gnus-summary-make-false-root 'dummy) ! (get-text-property (point) 'gnus-intangible)) ! 0 ! (gnus-data-level (gnus-data-find ! ,(or number '(gnus-summary-article-number)))))) ! ! (defmacro gnus-summary-article-mark (&optional number) ! `(gnus-data-mark (gnus-data-find ! ,(or number '(gnus-summary-article-number))))) ! ! (defmacro gnus-summary-article-pos (&optional number) ! `(gnus-data-pos (gnus-data-find ! ,(or number '(gnus-summary-article-number))))) ! (defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) ! (defmacro gnus-summary-article-subject (&optional number) "Return current subject string or nil if nothing." ! `(let ((headers ! ,(if number ! `(gnus-data-header (assq ,number gnus-newsgroup-data)) ! '(gnus-data-header (assq (gnus-summary-article-number) ! gnus-newsgroup-data))))) ! (and headers ! (vectorp headers) ! (mail-header-subject headers)))) ! ! (defmacro gnus-summary-article-score (&optional number) ! "Return current article score." ! `(or (cdr (assq ,(or number '(gnus-summary-article-number)) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0)) ! ! (defun gnus-summary-article-children (&optional number) ! (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) ! (level (gnus-data-level (car data))) ! l children) ! (while (and (setq data (cdr data)) ! (> (setq l (gnus-data-level (car data))) level)) ! (and (= (1+ level) l) ! (setq children (cons (gnus-data-number (car data)) ! children)))) ! (nreverse children))) ! ! (defun gnus-summary-article-parent (&optional number) ! (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) ! (gnus-data-list t))) ! (level (gnus-data-level (car data)))) ! (if (zerop level) ! () ; This is a root. ! ;; We search until we find an article with a level less than ! ;; this one. That function has to be the parent. ! (while (and (setq data (cdr data)) ! (not (< (gnus-data-level (car data)) level)))) ! (and data (gnus-data-number (car data)))))) ! ! (defun gnus-unread-mark-p (mark) ! "Say whether MARK is the unread mark." ! (= mark gnus-unread-mark)) ! ! (defun gnus-read-mark-p (mark) ! "Say whether MARK is one of the marks that mark as read. ! This is all marks except unread, ticked, dormant, and expirable." ! (not (or (= mark gnus-unread-mark) ! (= mark gnus-ticked-mark) ! (= mark gnus-dormant-mark) ! (= mark gnus-expirable-mark)))) ! ! ;; Saving hidden threads. ! ! (put 'gnus-save-hidden-threads 'lisp-indent-function 0) ! (put 'gnus-save-hidden-threads 'lisp-indent-hook 0) ! (put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) ! ! (defmacro gnus-save-hidden-threads (&rest forms) ! "Save hidden threads, eval FORMS, and restore the hidden threads." ! (let ((config (make-symbol "config"))) ! `(let ((,config (gnus-hidden-threads-configuration))) ! (unwind-protect ! (progn ! ,@forms) ! (gnus-restore-hidden-threads-configuration ,config))))) ! ! (defun gnus-hidden-threads-configuration () ! "Return the current hidden threads configuration." ! (save-excursion ! (let (config) ! (goto-char (point-min)) ! (while (search-forward "\r" nil t) ! (push (1- (point)) config)) ! config))) ! ! (defun gnus-restore-hidden-threads-configuration (config) ! "Restore hidden threads configuration from CONFIG." ! (let (point buffer-read-only) ! (while (setq point (pop config)) ! (when (and (< point (point-max)) ! (goto-char point) ! (= (following-char) ?\n)) ! (subst-char-in-region point (1+ point) ?\n ?\r))))) ;; Various summary mode internalish functions. *************** article number." *** 5780,5789 **** (progn (set-buffer buffer) ! (not gnus-newsgroup-begin)) ;; Fix by Sudish Joseph (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) (gnus-add-current-to-buffer-list) (gnus-summary-mode group) ! (and gnus-carpal (gnus-carpal-setup-buffer 'summary)) (setq gnus-newsgroup-name group) t))) --- 7569,7584 ---- (progn (set-buffer buffer) ! (setq gnus-summary-buffer (current-buffer)) ! (not gnus-newsgroup-prepared)) ;; Fix by Sudish Joseph (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) (gnus-add-current-to-buffer-list) (gnus-summary-mode group) ! (when gnus-carpal ! (gnus-carpal-setup-buffer 'summary)) ! (unless gnus-single-article-buffer ! (make-local-variable 'gnus-article-buffer) ! (make-local-variable 'gnus-article-current) ! (make-local-variable 'gnus-original-article-buffer)) (setq gnus-newsgroup-name group) t))) *************** article number." *** 5791,5832 **** (defun gnus-set-global-variables () ;; Set the global equivalents of the summary buffer-local variables ! ;; to the latest values they had. These reflect the summary buffer ;; that was in action when the last article was fetched. ! (if (eq major-mode 'gnus-summary-mode) ! (progn ! (setq gnus-summary-buffer (current-buffer)) ! (let ((name gnus-newsgroup-name) ! (marked gnus-newsgroup-marked) ! (unread gnus-newsgroup-unreads) ! (headers gnus-current-headers) ! (score-file gnus-current-score-file)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (setq gnus-newsgroup-name name) ! (setq gnus-newsgroup-marked marked) ! (setq gnus-newsgroup-unreads unread) ! (setq gnus-current-headers headers) ! (setq gnus-current-score-file score-file)))))) ! ! (defun gnus-summary-insert-dummy-line (sformat subject number) ! (if (not sformat) ! (setq sformat gnus-summary-dummy-line-format-spec)) ! (let (b) ! (beginning-of-line) ! (setq b (point)) ! (insert (eval sformat)) ! (add-text-properties ! b (1+ b) ! (list 'gnus-number number ! 'gnus-mark gnus-dummy-mark ! 'gnus-level 0)))) - (defvar gnus-thread-indent-array nil) - (defvar gnus-thread-indent-array-level gnus-thread-indent-level) (defun gnus-make-thread-indent-array () (let ((n 200)) ! (if (and gnus-thread-indent-array ! (= gnus-thread-indent-level gnus-thread-indent-array-level)) ! nil (setq gnus-thread-indent-array (make-vector 201 "") gnus-thread-indent-array-level gnus-thread-indent-level) --- 7586,7633 ---- (defun gnus-set-global-variables () ;; Set the global equivalents of the summary buffer-local variables ! ;; to the latest values they had. These reflect the summary buffer ;; that was in action when the last article was fetched. ! (when (eq major-mode 'gnus-summary-mode) ! (setq gnus-summary-buffer (current-buffer)) ! (let ((name gnus-newsgroup-name) ! (marked gnus-newsgroup-marked) ! (unread gnus-newsgroup-unreads) ! (headers gnus-current-headers) ! (data gnus-newsgroup-data) ! (summary gnus-summary-buffer) ! (article-buffer gnus-article-buffer) ! (original gnus-original-article-buffer) ! (gac gnus-article-current) ! (score-file gnus-current-score-file)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (setq gnus-newsgroup-name name) ! (setq gnus-newsgroup-marked marked) ! (setq gnus-newsgroup-unreads unread) ! (setq gnus-current-headers headers) ! (setq gnus-newsgroup-data data) ! (setq gnus-article-current gac) ! (setq gnus-summary-buffer summary) ! (setq gnus-article-buffer article-buffer) ! (setq gnus-original-article-buffer original) ! (setq gnus-current-score-file score-file))))) ! ! (defun gnus-summary-last-article-p (&optional article) ! "Return whether ARTICLE is the last article in the buffer." ! (if (not (setq article (or article (gnus-summary-article-number)))) ! t ; All non-existant numbers are the last article. :-) ! (not (cdr (gnus-data-find-list article))))) ! ! (defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) ! "Insert a dummy root in the summary buffer." ! (beginning-of-line) ! (gnus-add-text-properties ! (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) ! (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) (defun gnus-make-thread-indent-array () (let ((n 200)) ! (unless (and gnus-thread-indent-array ! (= gnus-thread-indent-level gnus-thread-indent-array-level)) (setq gnus-thread-indent-array (make-vector 201 "") gnus-thread-indent-array-level gnus-thread-indent-level) *************** article number." *** 5836,5991 **** (setq n (1- n)))))) ! (defun gnus-summary-insert-line ! (sformat header level current unread replied expirable subject-or-nil ! &optional dummy score process) ! (or sformat (setq sformat gnus-summary-line-format-spec)) ! (let* ((indentation (aref gnus-thread-indent-array level)) ! (lines (mail-header-lines header)) ! (score (or score gnus-summary-default-score 0)) ! (score-char (if (or (null gnus-summary-default-score) ! (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) ? ! (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) ! (replied (cond (process gnus-process-mark) ! (replied gnus-replied-mark) ! (t gnus-unread-mark))) ! (from (mail-header-from header)) ! (name (cond ! ((string-match "(.+)" from) ! (substring from (1+ (match-beginning 0)) (1- (match-end 0)))) ! ((string-match "<[^>]+> *$" from) ! (let ((beg (match-beginning 0))) ! (or (and (string-match "^\"[^\"]*\"" from) ! (substring from (1+ (match-beginning 0)) ! (1- (match-end 0)))) ! (substring from 0 beg)))) ! (t from))) ! (subject (mail-header-subject header)) ! (number (mail-header-number header)) ! (opening-bracket (if dummy ?\< ?\[)) ! (closing-bracket (if dummy ?\> ?\])) ! (buffer-read-only nil) ! (b (progn (beginning-of-line) (point)))) ! (or (numberp lines) (setq lines 0)) ! (insert (eval sformat)) ! (add-text-properties ! b (1+ b) (list 'gnus-number number ! 'gnus-mark (or unread gnus-unread-mark) ! 'gnus-level level)))) (defun gnus-summary-update-line (&optional dont-update) ;; Update summary line after change. ! (or (not gnus-summary-default-score) ! gnus-summary-inhibit-highlight ! (let ((gnus-summary-inhibit-highlight t) ! (article (gnus-summary-article-number))) ! (progn ! (or dont-update ! (if (and gnus-summary-mark-below ! (< (gnus-summary-article-score) ! gnus-summary-mark-below)) ! (and (not (memq article gnus-newsgroup-marked)) ! (not (memq article gnus-newsgroup-dormant)) ! (memq article gnus-newsgroup-unreads) ! (gnus-summary-mark-article-as-read gnus-low-score-mark)) ! (and (eq (gnus-summary-article-mark) gnus-low-score-mark) ! (gnus-summary-mark-article-as-unread gnus-unread-mark)))) ! (and gnus-visual ! (run-hooks 'gnus-summary-update-hook)))))) ! ! (defun gnus-summary-update-lines (&optional beg end) ! ;; Mark article as read (or not) by taking into account scores. ! (let ((beg (or beg (point-min))) ! (end (or end (point-max)))) ! (if (or (not gnus-summary-default-score) ! gnus-summary-inhibit-highlight) ! () ! (let ((gnus-summary-inhibit-highlight t) ! article) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (goto-char beg) ! (beginning-of-line) ! (while (and (not (eobp)) (< (point) end)) ! (if (and gnus-summary-mark-below ! (< (or (cdr (assq ! (setq article (get-text-property ! (point) 'gnus-number)) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-mark-below)) ! ;; We want to possibly mark it as read... ! (and (not (memq article gnus-newsgroup-marked)) ! (not (memq article gnus-newsgroup-dormant)) ! (memq article gnus-newsgroup-unreads) ! (gnus-summary-mark-article-as-read gnus-low-score-mark)) ! ;; We want to possibly mark it as unread. ! (and (eq (get-text-property (point) 'gnus-mark) ! gnus-low-score-mark) ! (gnus-summary-mark-article-as-unread gnus-unread-mark))) ! ;; Do the visual highlights at the same time. ! (and gnus-visual (run-hooks 'gnus-summary-update-hook)) ! (forward-line 1))))))) ! (defvar gnus-tmp-gathered nil) ! (defun gnus-summary-number-of-articles-in-thread (thread &optional char) ;; Sum up all elements (and sub-elements) in a list. (let* ((number ;; Fix by Luc Van Eycken . ! (if (and (consp thread) (cdr thread)) ! (apply ! '+ 1 (mapcar ! 'gnus-summary-number-of-articles-in-thread ! (cdr thread))) ! 1))) ! (if char (if (> number 1) gnus-not-empty-thread-mark gnus-empty-thread-mark) number))) ! (defun gnus-summary-read-group ! (group &optional show-all no-article kill-buffer) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. ! If NO-ARTICLE is non-nil, no article is selected initially." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup group show-all)))) ! (cond ((not new-group) (gnus-set-global-variables) ! (gnus-kill-buffer kill-buffer) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary) ! (gnus-summary-position-cursor) (message "") t) ! ((null did-select) ! (and (eq major-mode 'gnus-summary-mode) ! (not (equal (current-buffer) kill-buffer)) ! (progn ! (kill-buffer (current-buffer)) ! (if (not quit-config) ! (progn ! (set-buffer gnus-group-buffer) ! (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1)) ! (if (not (buffer-name (car quit-config))) ! (gnus-configure-windows 'group 'force) ! (set-buffer (car quit-config)) ! (and (eq major-mode 'gnus-summary-mode) ! (gnus-set-global-variables)) ! (gnus-configure-windows (cdr quit-config)))))) ! (message "Can't select group") nil) ((eq did-select 'quit) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) ! (gnus-kill-buffer kill-buffer) (if (not quit-config) (progn --- 7637,7808 ---- (setq n (1- n)))))) ! (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 gnus-tmp-process) ! (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) ! (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) ! (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) ! (gnus-tmp-score-char (if (or (null gnus-summary-default-score) ! (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) ? ! (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) ! (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) ! ((memq gnus-tmp-current gnus-newsgroup-cached) ! gnus-cached-mark) ! (gnus-tmp-replied gnus-replied-mark) ! ((memq gnus-tmp-current gnus-newsgroup-saved) ! gnus-saved-mark) ! (t gnus-unread-mark))) ! (gnus-tmp-from (mail-header-from gnus-tmp-header)) ! (gnus-tmp-name ! (cond ! ((string-match "(.+)" gnus-tmp-from) ! (substring gnus-tmp-from ! (1+ (match-beginning 0)) (1- (match-end 0)))) ! ((string-match "<[^>]+> *$" gnus-tmp-from) ! (let ((beg (match-beginning 0))) ! (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) ! (substring gnus-tmp-from (1+ (match-beginning 0)) ! (1- (match-end 0)))) ! (substring gnus-tmp-from 0 beg)))) ! (t gnus-tmp-from))) ! (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) ! (gnus-tmp-number (mail-header-number gnus-tmp-header)) ! (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) ! (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) ! (buffer-read-only nil)) ! (when (string= gnus-tmp-name "") ! (setq gnus-tmp-name gnus-tmp-from)) ! (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) ! (gnus-put-text-property ! (point) ! (progn (eval gnus-summary-line-format-spec) (point)) ! 'gnus-number gnus-tmp-number) ! (when (gnus-visual-p 'summary-highlight 'highlight) ! (forward-line -1) ! (run-hooks 'gnus-summary-update-hook) ! (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) ;; Update summary line after change. ! (when (and gnus-summary-default-score ! (not gnus-summary-inhibit-highlight)) ! (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. ! (article (gnus-summary-article-number)) ! (score (gnus-summary-article-score article))) ! (unless dont-update ! (if (and gnus-summary-mark-below ! (< (gnus-summary-article-score) ! gnus-summary-mark-below)) ! ;; This article has a low score, so we mark it as read. ! (when (memq article gnus-newsgroup-unreads) ! (gnus-summary-mark-article-as-read gnus-low-score-mark)) ! (when (eq (gnus-summary-article-mark) gnus-low-score-mark) ! ;; This article was previously marked as read on account ! ;; of a low score, but now it has risen, so we mark it as ! ;; unread. ! (gnus-summary-mark-article-as-unread gnus-unread-mark))) ! (gnus-summary-update-mark ! (if (or (null gnus-summary-default-score) ! (<= (abs (- score gnus-summary-default-score)) ! gnus-summary-zcore-fuzz)) ? ! (if (< score gnus-summary-default-score) ! gnus-score-below-mark gnus-score-over-mark)) 'score)) ! ;; Do visual highlighting. ! (when (gnus-visual-p 'summary-highlight 'highlight) ! (run-hooks 'gnus-summary-update-hook))))) ! (defvar gnus-tmp-new-adopts nil) ! (defun gnus-summary-number-of-articles-in-thread (thread &optional level char) ;; Sum up all elements (and sub-elements) in a list. (let* ((number ;; Fix by Luc Van Eycken . ! (cond ! ((and (consp thread) (cdr thread)) ! (apply ! '+ 1 (mapcar ! 'gnus-summary-number-of-articles-in-thread (cdr thread)))) ! ((null thread) ! 1) ! ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) ! 1) ! (t 0)))) ! (when (and level (zerop level) gnus-tmp-new-adopts) ! (incf number ! (apply '+ (mapcar ! 'gnus-summary-number-of-articles-in-thread ! gnus-tmp-new-adopts)))) ! (if char (if (> number 1) gnus-not-empty-thread-mark gnus-empty-thread-mark) number))) ! (defun gnus-summary-set-local-parameters (group) ! "Go through the local params of GROUP and set all variable specs in that list." ! (let ((params (gnus-info-params (gnus-get-info group))) ! elem) ! (while params ! (setq elem (car params) ! params (cdr params)) ! (and (consp elem) ; Has to be a cons. ! (consp (cdr elem)) ; The cdr has to be a list. ! (symbolp (car elem)) ; Has to be a symbol in there. ! (not (memq (car elem) ! '(quit-config to-address to-list to-group))) ! (progn ; So we set it. ! (make-local-variable (car elem)) ! (set (car elem) (eval (nth 1 elem)))))))) ! ! (defun gnus-summary-read-group (group &optional show-all no-article ! kill-buffer no-display) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. ! If NO-ARTICLE is non-nil, no article is selected initially. ! If NO-DISPLAY, don't generate a summary buffer." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup group show-all)))) ! (cond ! ;; This summary buffer exists already, so we just select it. ((not new-group) (gnus-set-global-variables) ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) (gnus-configure-windows 'summary 'force) (gnus-set-mode-line 'summary) ! (gnus-summary-position-point) (message "") t) ! ;; We couldn't select this group. ! ((null did-select) ! (when (and (eq major-mode 'gnus-summary-mode) ! (not (equal (current-buffer) kill-buffer))) ! (kill-buffer (current-buffer)) ! (if (not quit-config) ! (progn ! (set-buffer gnus-group-buffer) ! (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1)) ! (if (not (buffer-name (car quit-config))) ! (gnus-configure-windows 'group 'force) ! (set-buffer (car quit-config)) ! (and (eq major-mode 'gnus-summary-mode) ! (gnus-set-global-variables)) ! (gnus-configure-windows (cdr quit-config))))) ! (gnus-message 3 "Can't select group") nil) + ;; The user did a `C-g' while prompting for number of articles, + ;; so we exit this group. ((eq did-select 'quit) (and (eq major-mode 'gnus-summary-mode) (not (equal (current-buffer) kill-buffer)) (kill-buffer (current-buffer))) ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) (if (not quit-config) (progn *************** If NO-ARTICLE is non-nil, no article is *** 6000,6035 **** (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) (signal 'quit nil)) (t (gnus-set-global-variables) ;; Save the active value in effect when the group was entered. ! (setq gnus-newsgroup-active (gnus-copy-sequence ! (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) ! ;; You can change the subjects in this hook. (run-hooks 'gnus-select-group-hook) ! ;; Do score processing. ! (and gnus-use-scoring (gnus-possibly-score-headers)) (gnus-update-format-specifications) ;; Generate the summary buffer. ! (gnus-summary-prepare) ! (if (zerop (buffer-size)) ! (cond (gnus-newsgroup-dormant ! (gnus-summary-show-all-dormant)) ! ((and gnus-newsgroup-scored show-all) ! (gnus-summary-show-all-expunged)))) ;; Function `gnus-apply-kill-file' must be called in this hook. (run-hooks 'gnus-apply-kill-hook) ! (if (zerop (buffer-size)) (progn ;; This newsgroup is empty. (gnus-summary-catchup-and-exit nil t) ;Without confirmations. (gnus-message 6 "No unread news") ! (gnus-kill-buffer kill-buffer) nil) - ;;(save-excursion - ;; (if kill-buffer - ;; (let ((gnus-summary-buffer kill-buffer)) - ;; (gnus-configure-windows 'group)))) ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not --- 7817,7878 ---- (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) + ;; Finally signal the quit. (signal 'quit nil)) + ;; The group was successfully selected. (t (gnus-set-global-variables) ;; Save the active value in effect when the group was entered. ! (setq gnus-newsgroup-active (gnus-copy-sequence ! (gnus-active gnus-newsgroup-name))) ! ;; You can change the summary buffer in some way with this hook. (run-hooks 'gnus-select-group-hook) ! ;; Set any local variables in the group parameters. ! (gnus-summary-set-local-parameters gnus-newsgroup-name) (gnus-update-format-specifications) + ;; Do score processing. + (when gnus-use-scoring + (gnus-possibly-score-headers)) + ;; Check whether to fill in the gaps in the threads. + (when gnus-build-sparse-threads + (gnus-build-sparse-threads)) + ;; Find the initial limit. + (if gnus-show-threads + (if show-all + (let ((gnus-newsgroup-dormant nil)) + (gnus-summary-initial-limit show-all)) + (gnus-summary-initial-limit show-all)) + (setq gnus-newsgroup-limit + (mapcar + (lambda (header) (mail-header-number header)) + gnus-newsgroup-headers))) ;; Generate the summary buffer. ! (unless no-display ! (gnus-summary-prepare)) ! (when gnus-use-trees ! (gnus-tree-open group) ! (setq gnus-summary-highlight-line-function ! 'gnus-tree-highlight-article)) ! ;; If the summary buffer is empty, but there are some low-scored ! ;; articles or some excluded dormants, we include these in the ! ;; buffer. ! (when (and (zerop (buffer-size)) ! (not no-display)) ! (cond (gnus-newsgroup-dormant ! (gnus-summary-limit-include-dormant)) ! ((and gnus-newsgroup-scored show-all) ! (gnus-summary-limit-include-expunged)))) ;; Function `gnus-apply-kill-file' must be called in this hook. (run-hooks 'gnus-apply-kill-hook) ! (if (and (zerop (buffer-size)) ! (not no-display)) (progn ;; This newsgroup is empty. (gnus-summary-catchup-and-exit nil t) ;Without confirmations. (gnus-message 6 "No unread news") ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) ! ;; Return nil from this function. nil) ;; Hide conversation thread subtrees. We cannot do this in ;; gnus-summary-prepare-hook since kill processing may not *************** If NO-ARTICLE is non-nil, no article is *** 6039,6098 **** (gnus-summary-hide-all-threads)) ;; Show first unread article if requested. - (goto-char (point-min)) (if (and (not no-article) ! gnus-auto-select-first ! (gnus-summary-first-unread-article)) ! () (gnus-configure-windows 'summary 'force)) ! (gnus-set-mode-line 'summary) ! (gnus-summary-position-cursor) ! ;; If in async mode, we send some info to the backend. ! (and gnus-newsgroup-async ! (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads)) ! (gnus-request-asynchronous ! gnus-newsgroup-name ! (if (and gnus-asynchronous-article-function ! (fboundp gnus-asynchronous-article-function)) ! (funcall gnus-asynchronous-article-function ! gnus-newsgroup-threads) ! gnus-newsgroup-threads))) ! (gnus-kill-buffer kill-buffer) ! (if (not (get-buffer-window gnus-group-buffer)) ! () ! ;; gotta use windows, because recenter does weird stuff if ;; the current buffer ain't the displayed window. ! (let ((owin (selected-window))) ! (select-window (get-buffer-window gnus-group-buffer)) ! (and (gnus-group-goto-group group) ! (recenter)) ! (select-window owin)))) t)))) (defun gnus-summary-prepare () ! ;; Generate the summary buffer. (let ((buffer-read-only nil)) (erase-buffer) ! (gnus-summary-prepare-threads ! (if gnus-show-threads ! (gnus-gather-threads ! (gnus-sort-threads ! (if (and gnus-summary-expunge-below ! (not gnus-fetch-old-headers)) ! (gnus-make-threads-and-expunge) ! (gnus-make-threads)))) ! gnus-newsgroup-headers) ! 'cull) ! (gnus-summary-update-lines) ! ;; Create the header hashtb. ! (gnus-make-headers-hashtable-by-number) ;; Call hooks for modifying summary buffer. - ;; Suggested by sven@tde.LTH.Se (Sven Mattisson). (goto-char (point-min)) (run-hooks 'gnus-summary-prepare-hook))) ! (defun gnus-gather-threads (threads) ! "Gather threads that have lost their roots." (if (not gnus-summary-make-false-root) ! threads (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) --- 7882,7942 ---- (gnus-summary-hide-all-threads)) ;; Show first unread article if requested. (if (and (not no-article) ! (not no-display) ! gnus-newsgroup-unreads ! gnus-auto-select-first) ! (unless (if (eq gnus-auto-select-first 'best) ! (gnus-summary-best-unread-article) ! (gnus-summary-first-unread-article)) ! (gnus-configure-windows 'summary)) ! ;; Don't select any articles, just move point to the first ! ;; article in the group. ! (goto-char (point-min)) ! (gnus-summary-position-point) ! (gnus-set-mode-line 'summary) (gnus-configure-windows 'summary 'force)) ! ;; If we are in async mode, we send some info to the backend. ! (when gnus-newsgroup-async ! (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data)) ! (when kill-buffer ! (gnus-kill-or-deaden-summary kill-buffer)) ! (when (get-buffer-window gnus-group-buffer t) ! ;; Gotta use windows, because recenter does wierd stuff if ;; the current buffer ain't the displayed window. ! (let ((owin (selected-window))) ! (select-window (get-buffer-window gnus-group-buffer t)) ! (when (gnus-group-goto-group group) ! (recenter)) ! (select-window owin)))) ! ;; Mark this buffer as "prepared". ! (setq gnus-newsgroup-prepared t) t)))) (defun gnus-summary-prepare () ! "Generate the summary buffer." (let ((buffer-read-only nil)) (erase-buffer) ! (setq gnus-newsgroup-data nil ! gnus-newsgroup-data-reverse nil) ! (run-hooks 'gnus-summary-generate-hook) ! ;; Generate the buffer, either with threads or without. ! (when gnus-newsgroup-headers ! (gnus-summary-prepare-threads ! (if gnus-show-threads ! (gnus-sort-gathered-threads ! (funcall gnus-summary-thread-gathering-function ! (gnus-sort-threads ! (gnus-cut-threads (gnus-make-threads))))) ! ;; Unthreaded display. ! (gnus-sort-articles gnus-newsgroup-headers)))) ! (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) ;; Call hooks for modifying summary buffer. (goto-char (point-min)) (run-hooks 'gnus-summary-prepare-hook))) ! (defun gnus-gather-threads-by-subject (threads) ! "Gather threads by looking at Subject headers." (if (not gnus-summary-make-false-root) ! threads (let ((hashtb (gnus-make-hashtable 1023)) (prev threads) *************** If NO-ARTICLE is non-nil, no article is *** 6100,6343 **** subject hthread whole-subject) (while threads ! (setq whole-subject ! (setq subject (mail-header-subject (car (car threads))))) ! (if gnus-summary-gather-subject-limit ! (or (and (numberp gnus-summary-gather-subject-limit) ! (> (length subject) gnus-summary-gather-subject-limit) ! (setq subject ! (substring subject 0 ! gnus-summary-gather-subject-limit))) ! (and (eq 'fuzzy gnus-summary-gather-subject-limit) ! (setq subject (gnus-simplify-subject-fuzzy subject)))) ! (setq subject (gnus-simplify-subject-re subject))) ! (if (setq hthread ! (gnus-gethash subject hashtb)) ! (progn ! (or (stringp (car (car hthread))) (setcar hthread (list whole-subject (car hthread)))) ! (setcdr (car hthread) (nconc (cdr (car hthread)) ! (list (car threads)))) ! (setcdr prev (cdr threads)) ! (setq threads prev)) ! (gnus-sethash subject threads hashtb)) (setq prev threads) (setq threads (cdr threads))) result))) ! (defun gnus-make-threads () ! ;; This function takes the dependencies already made by ! ;; `gnus-get-newsgroup-headers' and builds the trees. First we go ! ;; through the dependencies in the hash table and finds all the ! ;; roots. Roots do not refer back to any valid articles. ! (gnus-message 6 "Threading...") ! (let (roots new-roots) ! (and gnus-fetch-old-headers ! (eq gnus-headers-retrieved-by 'nov) ! (gnus-build-old-threads)) ! (mapatoms ! (lambda (refs) ! (if (not (car (symbol-value refs))) ! (setq roots (append (cdr (symbol-value refs)) roots)) ! ;; Ok, these refer back to valid articles, but if ! ;; `gnus-thread-ignore-subject' is nil, we have to check that ! ;; the root has the same subject as its children. The children ! ;; that do not are made into roots and removed from the list ! ;; of children. ! (or gnus-thread-ignore-subject ! (let* ((prev (symbol-value refs)) ! (subject (gnus-simplify-subject-re ! (mail-header-subject (car prev)))) ! (headers (cdr prev))) ! (while headers ! (if (not (string= subject ! (gnus-simplify-subject-re ! (mail-header-subject (car headers))))) ! (progn ! (setq new-roots (cons (car headers) new-roots)) ! (setcdr prev (cdr headers))) ! (setq prev headers)) ! (setq headers (cdr headers))))))) ! gnus-newsgroup-dependencies) ! ! ;; We enter the new roots into the dependencies structure to ! ;; ensure that any possible later thread-regeneration will be ! ;; possible. ! (let ((r new-roots)) ! (while r ! (gnus-sethash (concat (mail-header-id (car r)) ".boo") ! (list nil (car r)) gnus-newsgroup-dependencies) ! (setq r (cdr r)))) ! ! (setq roots (nconc new-roots roots)) ! (prog1 ! (mapcar 'gnus-trim-thread ! (apply 'append ! (mapcar 'gnus-cut-thread ! (mapcar 'gnus-make-sub-thread roots)))) ! (gnus-message 6 "Threading...done")))) ! ! (defun gnus-make-threads-and-expunge () ! ;; This function takes the dependencies already made by ! ;; `gnus-get-newsgroup-headers' and builds the trees. First we go ! ;; through the dependencies in the hash table and finds all the ! ;; roots. Roots do not refer back to any valid articles. ! (gnus-message 6 "Threading...") ! (let ((default (or gnus-summary-default-score 0)) ! (below gnus-summary-expunge-below) ! roots article new-roots) ! (and gnus-fetch-old-headers ! (eq gnus-headers-retrieved-by 'nov) ! (gnus-build-old-threads)) (mapatoms (lambda (refs) ! (if (not (car (symbol-value refs))) ! ;; These articles do not refer back to any other articles - ! ;; they are roots. ! (let ((headers (cdr (symbol-value refs)))) ! ;; We weed out the low-scored articles. ! (while headers ! (if (not (< (or (cdr (assq (mail-header-number (car headers)) ! gnus-newsgroup-scored)) default) ! below)) ! ;; It is over. ! (setq roots (cons (car headers) roots)) ! ;; It is below, so we mark it as read. ! (setq gnus-newsgroup-unreads ! (delq (mail-header-number (car headers)) ! gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons (mail-header-number (car headers)) ! gnus-low-score-mark) ! gnus-newsgroup-reads))) ! (setq headers (cdr headers)))) ! ;; Ok, these refer back to valid articles, but if ! ;; `gnus-thread-ignore-subject' is nil, we have to check that ! ;; the root has the same subject as its children. The children ! ;; that do not are made into roots and removed from the list ! ;; of children. ! (or gnus-thread-ignore-subject ! (let* ((prev (symbol-value refs)) ! (subject (gnus-simplify-subject-re ! (mail-header-subject (car prev)))) ! (headers (cdr prev))) ! (while headers ! (if (not (string= subject ! (gnus-simplify-subject-re ! (mail-header-subject (car headers))))) ! (progn ! (if (not (< (or (cdr (assq (mail-header-number ! (car headers)) ! gnus-newsgroup-scored)) ! default) below)) ! (setq new-roots (cons (car headers) new-roots)) ! (setq gnus-newsgroup-unreads ! (delq (mail-header-number (car headers)) ! gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons (mail-header-number (car headers)) ! gnus-low-score-mark) ! gnus-newsgroup-reads))) ! (setcdr prev (cdr headers))) ! (setq prev headers)) ! (setq headers (cdr headers))))) ! ;; If this article is expunged, some of the children might be ! ;; roots. ! (if (< (or (cdr (assq (mail-header-number (car (symbol-value refs))) ! gnus-newsgroup-scored)) default) ! below) ! (let* ((prev (symbol-value refs)) ! (headers (cdr prev))) ! (while headers ! (setq article (mail-header-number (car headers))) ! (if (not (< (or (cdr (assq article gnus-newsgroup-scored)) ! default) below)) ! (progn (setq new-roots (cons (car headers) new-roots)) ! (setq prev headers)) ! (setq gnus-newsgroup-unreads ! (delq article gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons article gnus-low-score-mark) ! gnus-newsgroup-reads)) ! (setcdr prev (cdr headers))) ! (setq headers (cdr headers)))) ! ;; It was not expunged, but we look at expunged children. ! (let* ((prev (symbol-value refs)) ! (headers (cdr prev)) ! article) ! (while headers ! (setq article (mail-header-number (car headers))) ! (if (not (< (or (cdr (assq article gnus-newsgroup-scored)) ! default) below)) ! (setq prev headers) ! (setq gnus-newsgroup-unreads ! (delq article gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons article gnus-low-score-mark) ! gnus-newsgroup-reads)) ! (setcdr prev (cdr headers))) ! (setq headers (cdr headers))))))) gnus-newsgroup-dependencies) ! ;; We enter the new roots into the dependencies structure to ! ;; ensure that any possible later thread-regeneration will be ! ;; possible. ! (let ((r new-roots)) ! (while r ! (gnus-sethash (concat (mail-header-id (car r)) ".boo") ! (list nil (car r)) gnus-newsgroup-dependencies) ! (setq r (cdr r)))) ! ! (setq roots (nconc new-roots roots)) ! ! (prog1 ! (mapcar 'gnus-trim-thread ! (apply 'append ! (mapcar 'gnus-cut-thread ! (mapcar 'gnus-make-sub-thread roots)))) ! (gnus-message 6 "Threading...done")))) ! ! ! (defun gnus-cut-thread (thread) ! ;; Remove leaf dormant or ancient articles from THREAD. ! (let ((head (car thread)) ! (tail (apply 'append (mapcar 'gnus-cut-thread (cdr thread))))) ! (if (and (null tail) ! (let ((number (mail-header-number head))) ! (or (memq number gnus-newsgroup-ancient) ! (memq number gnus-newsgroup-dormant) ! (and gnus-summary-expunge-below ! (eq gnus-fetch-old-headers 'some) ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-expunge-below) ! (progn ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons number gnus-low-score-mark) ! gnus-newsgroup-reads)) ! t))))) ! nil ! (list (cons head tail))))) ! ! (defun gnus-trim-thread (thread) ! ;; Remove root ancient articles with only one child from THREAD. ! (if (and (eq gnus-fetch-old-headers 'some) ! (memq (mail-header-number (car thread)) gnus-newsgroup-ancient) ! (= (length thread) 2)) ! (gnus-trim-thread (nth 1 thread)) ! thread)) ! ! (defun gnus-make-sub-thread (root) ! ;; This function makes a sub-tree for a node in the tree. ! (let ((children (reverse (cdr (gnus-gethash (downcase (mail-header-id root)) ! gnus-newsgroup-dependencies))))) ! (cons root (mapcar 'gnus-make-sub-thread children)))) (defun gnus-build-old-threads () ;; Look at all the articles that refer back to old articles, and ! ;; fetch the headers for the articles that aren't there. This will ;; build complete threads - if the roots haven't been expired by the ;; server, that is. --- 7944,8110 ---- subject hthread whole-subject) (while threads ! (setq whole-subject (mail-header-subject (caar threads))) ! (setq subject ! (cond ! ;; Truncate the subject. ! ((numberp gnus-summary-gather-subject-limit) ! (setq subject (gnus-simplify-subject-re whole-subject)) ! (if (> (length subject) gnus-summary-gather-subject-limit) ! (substring subject 0 gnus-summary-gather-subject-limit) ! subject)) ! ;; Fuzzily simplify it. ! ((eq 'fuzzy gnus-summary-gather-subject-limit) ! (gnus-simplify-subject-fuzzy whole-subject)) ! ;; Just remove the leading "Re:". ! (t ! (gnus-simplify-subject-re whole-subject)))) ! ! (if (and gnus-summary-gather-exclude-subject ! (string-match gnus-summary-gather-exclude-subject ! subject)) ! () ; We don't want to do anything with this article. ! ;; We simplify the subject before looking it up in the ! ;; hash table. ! ! (if (setq hthread (gnus-gethash subject hashtb)) ! (progn ! ;; We enter a dummy root into the thread, if we ! ;; haven't done that already. ! (unless (stringp (caar hthread)) (setcar hthread (list whole-subject (car hthread)))) ! ;; We add this new gathered thread to this gathered ! ;; thread. ! (setcdr (car hthread) ! (nconc (cdar hthread) (list (car threads)))) ! ;; Remove it from the list of threads. ! (setcdr prev (cdr threads)) ! (setq threads prev)) ! ;; Enter this thread into the hash table. ! (gnus-sethash subject threads hashtb))) (setq prev threads) (setq threads (cdr threads))) result))) ! (defun gnus-gather-threads-by-references (threads) ! "Gather threads by looking at References headers." ! (let ((idhashtb (gnus-make-hashtable 1023)) ! (thhashtb (gnus-make-hashtable 1023)) ! (prev threads) ! (result threads) ! ids references id gthread gid entered) ! (while threads ! (when (setq references (mail-header-references (caar threads))) ! (setq id (mail-header-id (caar threads))) ! (setq ids (gnus-split-references references)) ! (setq entered nil) ! (while ids ! (if (not (setq gid (gnus-gethash (car ids) idhashtb))) ! (progn ! (gnus-sethash (car ids) id idhashtb) ! (gnus-sethash id threads thhashtb)) ! (setq gthread (gnus-gethash gid thhashtb)) ! (unless entered ! ;; We enter a dummy root into the thread, if we ! ;; haven't done that already. ! (unless (stringp (caar gthread)) ! (setcar gthread (list (mail-header-subject (caar gthread)) ! (car gthread)))) ! ;; We add this new gathered thread to this gathered ! ;; thread. ! (setcdr (car gthread) ! (nconc (cdar gthread) (list (car threads))))) ! ;; Add it into the thread hash table. ! (gnus-sethash id gthread thhashtb) ! (setq entered t) ! ;; Remove it from the list of threads. ! (setcdr prev (cdr threads)) ! (setq threads prev)) ! (setq ids (cdr ids)))) ! (setq prev threads) ! (setq threads (cdr threads))) ! result)) ! (defun gnus-sort-gathered-threads (threads) ! "Sort subtreads inside each gathered thread by article number." ! (let ((result threads)) ! (while threads ! (when (stringp (caar threads)) ! (setcdr (car threads) ! (sort (cdar threads) 'gnus-thread-sort-by-number))) ! (setq threads (cdr threads))) ! result)) ! (defun gnus-make-threads () ! "Go through the dependency hashtb and find the roots. Return all threads." ! (let (threads) (mapatoms (lambda (refs) ! (unless (car (symbol-value refs)) ! ;; These threads do not refer back to any other articles, ! ;; so they're roots. ! (setq threads (append (cdr (symbol-value refs)) threads)))) gnus-newsgroup-dependencies) + threads)) ! (defun gnus-build-sparse-threads () ! (let ((headers gnus-newsgroup-headers) ! (deps gnus-newsgroup-dependencies) ! header references generation relations ! cthread subject child end pthread relation) ! ;; First we create an alist of generations/relations, where ! ;; generations is how much we trust the ralation, and the relation ! ;; is parent/child. ! (gnus-message 7 "Making sparse threads...") ! (save-excursion ! (nnheader-set-temp-buffer " *gnus sparse threads*") ! (while (setq header (pop headers)) ! (when (and (setq references (mail-header-references header)) ! (not (string= references ""))) ! (insert references) ! (setq child (mail-header-id header) ! subject (mail-header-subject header)) ! (setq generation 0) ! (while (search-backward ">" nil t) ! (setq end (1+ (point))) ! (when (search-backward "<" nil t) ! (push (list (incf generation) ! child (setq child (buffer-substring (point) end)) ! subject) ! relations))) ! (push (list (1+ generation) child nil subject) relations) ! (erase-buffer))) ! (kill-buffer (current-buffer))) ! ;; Sort over trustworthiness. ! (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2))))) ! (while (setq relation (pop relations)) ! (when (if (boundp (setq cthread (intern (cadr relation) deps))) ! (unless (car (symbol-value cthread)) ! ;; Make this article the parent of these threads. ! (setcar (symbol-value cthread) ! (vector gnus-reffed-article-number ! (cadddr relation) ! "" "" ! (cadr relation) ! (or (caddr relation) "") 0 0 ""))) ! (set cthread (list (vector gnus-reffed-article-number ! (cadddr relation) ! "" "" (cadr relation) ! (or (caddr relation) "") 0 0 "")))) ! (push gnus-reffed-article-number gnus-newsgroup-limit) ! (push gnus-reffed-article-number gnus-newsgroup-sparse) ! (push (cons gnus-reffed-article-number gnus-sparse-mark) ! gnus-newsgroup-reads) ! (decf gnus-reffed-article-number) ! ;; Make this new thread the child of its parent. ! (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) ! (setcdr (symbol-value pthread) ! (nconc (cdr (symbol-value pthread)) ! (list (symbol-value cthread)))) ! (set pthread (list nil (symbol-value cthread)))))) ! (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () ;; Look at all the articles that refer back to old articles, and ! ;; fetch the headers for the articles that aren't there. This will ;; build complete threads - if the roots haven't been expired by the ;; server, that is. *************** If NO-ARTICLE is non-nil, no article is *** 6345,6366 **** (mapatoms (lambda (refs) ! (if (not (car (symbol-value refs))) ! (progn ! (setq heads (cdr (symbol-value refs))) ! (while heads ! (if (not (memq (mail-header-number (car heads)) ! gnus-newsgroup-dormant)) ! (progn ! (setq id (symbol-name refs)) ! (while (and (setq id (gnus-build-get-header id)) ! (not (car (gnus-gethash ! id gnus-newsgroup-dependencies))))) ! (setq heads nil)) ! (setq heads (cdr heads))))))) gnus-newsgroup-dependencies))) (defun gnus-build-get-header (id) ;; Look through the buffer of NOV lines and find the header to ! ;; ID. Enter this line into the dependencies hash table, and return ;; the id of the parent article (if any). (let ((deps gnus-newsgroup-dependencies) --- 8112,8131 ---- (mapatoms (lambda (refs) ! (when (not (car (symbol-value refs))) ! (setq heads (cdr (symbol-value refs))) ! (while heads ! (if (memq (mail-header-number (caar heads)) ! gnus-newsgroup-dormant) ! (setq heads (cdr heads)) ! (setq id (symbol-name refs)) ! (while (and (setq id (gnus-build-get-header id)) ! (not (car (gnus-gethash ! id gnus-newsgroup-dependencies))))) ! (setq heads nil))))) gnus-newsgroup-dependencies))) (defun gnus-build-get-header (id) ;; Look through the buffer of NOV lines and find the header to ! ;; ID. Enter this line into the dependencies hash table, and return ;; the id of the parent article (if any). (let ((deps gnus-newsgroup-dependencies) *************** If NO-ARTICLE is non-nil, no article is *** 6372,6479 **** (while (and (not found) (search-forward id nil t)) (beginning-of-line) ! (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" (regexp-quote id)))) (or found (beginning-of-line 2))) ! (if found ! (let (ref) ! (beginning-of-line) ! (and ! (setq header (gnus-nov-parse-line ! (read (current-buffer)) deps)) ! (setq ref (mail-header-references header)) ! (string-match "\\(<[^>]+>\\) *$" ref) ! (substring ref (match-beginning 1) (match-end 1)))))) ! (and header ! (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers) ! gnus-newsgroup-ancient (cons (mail-header-number header) ! gnus-newsgroup-ancient)))))) - ;; Re-build the thread containing ID. (defun gnus-rebuild-thread (id) (let ((dep gnus-newsgroup-dependencies) ! (buffer-read-only nil) ! parent headers refs thread art) ! (while (and id (setq headers ! (car (setq art (gnus-gethash (downcase id) dep))))) ! (setq parent art) ! (setq id (and (setq refs (mail-header-references headers)) ! (string-match "\\(<[^>]+>\\) *$" refs) ! (substring refs (match-beginning 1) (match-end 1))))) ! (setq thread (gnus-make-sub-thread (car parent))) ! (gnus-rebuild-remove-articles thread) ! (let ((beg (point))) ! (gnus-summary-prepare-threads (list thread)) ! (gnus-summary-update-lines beg (point))))) ! ! ;; Delete all lines in the summary buffer that correspond to articles ! ;; in this thread. ! (defun gnus-rebuild-remove-articles (thread) ! (and (gnus-summary-goto-subject (mail-header-number (car thread))) ! (gnus-delete-line)) ! (mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread))) (defun gnus-sort-threads (threads) ! ;; Sort threads as specified in `gnus-thread-sort-functions'. ! (let ((fun gnus-thread-sort-functions)) ! (while fun ! (gnus-message 6 "Sorting with %S..." fun) ! (setq threads (sort threads (car fun)) ! fun (cdr fun)))) ! (if gnus-thread-sort-functions ! (gnus-message 6 "Sorting...done")) ! threads) ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) ;; Return header of first article in THREAD. ! ;; Note that THREAD must never, evr be anything else than a variable - ;; using some other form will lead to serious barfage. (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) ! (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; (vector thread) 2)) (defun gnus-thread-sort-by-number (h1 h2) "Sort threads by root article number." ! (< (mail-header-number (gnus-thread-header h1)) ! (mail-header-number (gnus-thread-header h2)))) ! (defun gnus-thread-sort-by-author (h1 h2) ! "Sort threads by root author." (string-lessp ! (let ((extract (funcall gnus-extract-address-components ! (mail-header-from (gnus-thread-header h1))))) (or (car extract) (cdr extract))) (let ((extract (funcall ! gnus-extract-address-components ! (mail-header-from (gnus-thread-header h2))))) (or (car extract) (cdr extract))))) (defun gnus-thread-sort-by-subject (h1 h2) "Sort threads by root subject." (string-lessp ! (downcase (gnus-simplify-subject-re ! (mail-header-subject (gnus-thread-header h1)))) ! (downcase (gnus-simplify-subject-re ! (mail-header-subject (gnus-thread-header h2)))))) (defun gnus-thread-sort-by-date (h1 h2) "Sort threads by root article date." ! (string-lessp ! (gnus-sortable-date (mail-header-date (gnus-thread-header h1))) ! (gnus-sortable-date (mail-header-date (gnus-thread-header h2))))) ! (defun gnus-thread-sort-by-score (h1 h2) ! "Sort threads by root article score. Unscored articles will be counted as having a score of zero." ! (> (or (cdr (assq (mail-header-number (gnus-thread-header h1)) gnus-newsgroup-scored)) gnus-summary-default-score 0) ! (or (cdr (assq (mail-header-number (gnus-thread-header h2)) gnus-newsgroup-scored)) gnus-summary-default-score 0))) (defun gnus-thread-sort-by-total-score (h1 h2) "Sort threads by the sum of all scores in the thread. --- 8137,8455 ---- (while (and (not found) (search-forward id nil t)) (beginning-of-line) ! (setq found (looking-at (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" (regexp-quote id)))) (or found (beginning-of-line 2))) ! (when found ! (beginning-of-line) ! (and ! (setq header (gnus-nov-parse-line ! (read (current-buffer)) deps)) ! (gnus-parent-id (mail-header-references header))))) ! (when header ! (let ((number (mail-header-number header))) ! (push number gnus-newsgroup-limit) ! (push header gnus-newsgroup-headers) ! (if (memq number gnus-newsgroup-unselected) ! (progn ! (push number gnus-newsgroup-unreads) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected))) ! (push number gnus-newsgroup-ancient))))))) ! ! (defun gnus-summary-update-article (article &optional iheader) ! "Update ARTICLE in the summary buffer." ! (set-buffer gnus-summary-buffer) ! (let* ((header (or iheader (gnus-summary-article-header article))) ! (id (mail-header-id header)) ! (data (gnus-data-find article)) ! (thread (gnus-id-to-thread id)) ! (references (mail-header-references header)) ! (parent ! (gnus-id-to-thread ! (or (gnus-parent-id ! (if (and references ! (not (equal "" references))) ! references)) ! "none"))) ! (buffer-read-only nil) ! (old (car thread)) ! (number (mail-header-number header)) ! pos) ! (when thread ! ;; !!! Should this be in or not? ! (unless iheader ! (setcar thread nil)) ! (when parent ! (delq thread parent)) ! (if (gnus-summary-insert-subject id header iheader) ! ;; Set the (possibly) new article number in the data structure. ! (gnus-data-set-number data (gnus-id-to-article id)) ! (setcar thread old) ! nil)))) (defun gnus-rebuild-thread (id) + "Rebuild the thread containing ID." + (let ((buffer-read-only nil) + current thread data) + (if (not gnus-show-threads) + (setq thread (list (car (gnus-id-to-thread id)))) + ;; Get the thread this article is part of. + (setq thread (gnus-remove-thread id))) + (setq current (save-excursion + (and (zerop (forward-line -1)) + (gnus-summary-article-number)))) + ;; If this is a gathered thread, we have to go some re-gathering. + (when (stringp (car thread)) + (let ((subject (car thread)) + roots thr) + (setq thread (cdr thread)) + (while thread + (unless (memq (setq thr (gnus-id-to-thread + (gnus-root-id + (mail-header-id (caar thread))))) + roots) + (push thr roots)) + (setq thread (cdr thread))) + ;; We now have all (unique) roots. + (if (= (length roots) 1) + ;; All the loose roots are now one solid root. + (setq thread (car roots)) + (setq thread (cons subject (gnus-sort-threads roots)))))) + (let (threads) + ;; We then insert this thread into the summary buffer. + (let (gnus-newsgroup-data gnus-newsgroup-threads) + (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) + (setq data (nreverse gnus-newsgroup-data)) + (setq threads gnus-newsgroup-threads)) + ;; We splice the new data into the data structure. + (gnus-data-enter-list current data) + (gnus-data-compute-positions) + (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) + + (defun gnus-number-to-header (number) + "Return the header for article NUMBER." + (let ((headers gnus-newsgroup-headers)) + (while (and headers + (not (= number (mail-header-number (car headers))))) + (pop headers)) + (when headers + (car headers)))) + + (defun gnus-id-to-thread (id) + "Return the (sub-)thread where ID appears." + (gnus-gethash id gnus-newsgroup-dependencies)) + + (defun gnus-id-to-article (id) + "Return the article number of ID." + (let ((thread (gnus-id-to-thread id))) + (when (and thread + (car thread)) + (mail-header-number (car thread))))) + + (defun gnus-id-to-header (id) + "Return the article headers of ID." + (car (gnus-id-to-thread id))) + + (defun gnus-article-displayed-root-p (article) + "Say whether ARTICLE is a root(ish) article." + (let ((level (gnus-summary-thread-level article)) + (refs (mail-header-references (gnus-summary-article-header article))) + particle) + (cond + ((null level) nil) + ((zerop level) t) + ((null refs) t) + ((null (gnus-parent-id refs)) t) + ((and (= 1 level) + (null (setq particle (gnus-id-to-article + (gnus-parent-id refs)))) + (null (gnus-summary-thread-level particle))))))) + + (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 + id gnus-newsgroup-dependencies)))) + (setq last-id id + id (gnus-parent-id (mail-header-references prev)))) + last-id)) + + (defun gnus-remove-thread (id &optional dont-remove) + "Remove the thread that has ID in it." (let ((dep gnus-newsgroup-dependencies) ! headers thread last-id) ! ;; First go up in this thread until we find the root. ! (setq last-id (gnus-root-id id)) ! (setq headers (list (car (gnus-id-to-thread last-id)) ! (caadr (gnus-id-to-thread last-id)))) ! ;; We have now found the real root of this thread. It might have ! ;; been gathered into some loose thread, so we have to search ! ;; through the threads to find the thread we wanted. ! (let ((threads gnus-newsgroup-threads) ! sub) ! (while threads ! (setq sub (car threads)) ! (if (stringp (car sub)) ! ;; This is a gathered threads, so we look at the roots ! ;; below it to find whether this article in in this ! ;; gathered root. ! (progn ! (setq sub (cdr sub)) ! (while sub ! (when (member (caar sub) headers) ! (setq thread (car threads) ! threads nil ! sub nil)) ! (setq sub (cdr sub)))) ! ;; It's an ordinary thread, so we check it. ! (when (eq (car sub) (car headers)) ! (setq thread sub ! threads nil))) ! (setq threads (cdr threads))) ! ;; If this article is in no thread, then it's a root. ! (if thread ! (unless dont-remove ! (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) ! (setq thread (gnus-gethash last-id dep))) ! (when thread ! (prog1 ! thread ; We return this thread. ! (unless dont-remove ! (if (stringp (car thread)) ! (progn ! ;; If we use dummy roots, then we have to remove the ! ;; dummy root as well. ! (when (eq gnus-summary-make-false-root 'dummy) ! ;; Uhm. ! ) ! (setq thread (cdr thread)) ! (while thread ! (gnus-remove-thread-1 (car thread)) ! (setq thread (cdr thread)))) ! (gnus-remove-thread-1 thread)))))))) ! ! (defun gnus-remove-thread-1 (thread) ! "Remove the thread THREAD recursively." ! (let ((number (mail-header-number (car thread))) ! pos) ! (when (setq pos (text-property-any ! (point-min) (point-max) 'gnus-number number)) ! (goto-char pos) ! (gnus-delete-line) ! (gnus-data-remove number)) ! (setq thread (cdr thread)) ! (while thread ! (gnus-remove-thread-1 (pop thread))))) (defun gnus-sort-threads (threads) ! "Sort THREADS." ! (if (not gnus-thread-sort-functions) ! threads ! (let ((func (if (= 1 (length gnus-thread-sort-functions)) ! (car gnus-thread-sort-functions) ! `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse gnus-thread-sort-functions)))))) ! (gnus-message 7 "Sorting threads...") ! (prog1 ! (sort threads func) ! (gnus-message 7 "Sorting threads...done"))))) ! ! (defun gnus-sort-articles (articles) ! "Sort ARTICLES." ! (when gnus-article-sort-functions ! (let ((func (if (= 1 (length gnus-article-sort-functions)) ! (car gnus-article-sort-functions) ! `(lambda (t1 t2) ! ,(gnus-make-sort-function ! (reverse gnus-article-sort-functions)))))) ! (gnus-message 7 "Sorting articles...") ! (prog1 ! (setq gnus-newsgroup-headers (sort articles func)) ! (gnus-message 7 "Sorting articles...done"))))) + (defun gnus-make-sort-function (funs) + "Return a composite sort condition based on the functions in FUNC." + (if (cdr funs) + `(or (,(car funs) t1 t2) + (and (not (,(car funs) t2 t1)) + ,(gnus-make-sort-function (cdr funs)))) + `(,(car funs) t1 t2))) + ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) ;; Return header of first article in THREAD. ! ;; Note that THREAD must never, ever be anything else than a variable - ;; using some other form will lead to serious barfage. (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) ! (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; (vector thread) 2)) + (defsubst gnus-article-sort-by-number (h1 h2) + "Sort articles by article number." + (< (mail-header-number h1) + (mail-header-number h2))) + (defun gnus-thread-sort-by-number (h1 h2) "Sort threads by root article number." ! (gnus-article-sort-by-number ! (gnus-thread-header h1) (gnus-thread-header h2))) ! (defsubst gnus-article-sort-by-author (h1 h2) ! "Sort articles by root author." (string-lessp ! (let ((extract (funcall gnus-extract-address-components ! (mail-header-from h1)))) (or (car extract) (cdr extract))) (let ((extract (funcall ! gnus-extract-address-components ! (mail-header-from h2)))) (or (car extract) (cdr extract))))) + (defun gnus-thread-sort-by-author (h1 h2) + "Sort threads by root author." + (gnus-article-sort-by-author + (gnus-thread-header h1) (gnus-thread-header h2))) + + (defsubst gnus-article-sort-by-subject (h1 h2) + "Sort articles by root subject." + (string-lessp + (downcase (gnus-simplify-subject-re (mail-header-subject h1))) + (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) + (defun gnus-thread-sort-by-subject (h1 h2) "Sort threads by root subject." + (gnus-article-sort-by-subject + (gnus-thread-header h1) (gnus-thread-header h2))) + + (defsubst gnus-article-sort-by-date (h1 h2) + "Sort articles by root article date." (string-lessp ! (inline (gnus-sortable-date (mail-header-date h1))) ! (inline (gnus-sortable-date (mail-header-date h2))))) (defun gnus-thread-sort-by-date (h1 h2) "Sort threads by root article date." ! (gnus-article-sort-by-date ! (gnus-thread-header h1) (gnus-thread-header h2))) ! (defsubst gnus-article-sort-by-score (h1 h2) ! "Sort articles by root article score. Unscored articles will be counted as having a score of zero." ! (> (or (cdr (assq (mail-header-number h1) gnus-newsgroup-scored)) gnus-summary-default-score 0) ! (or (cdr (assq (mail-header-number h2) gnus-newsgroup-scored)) gnus-summary-default-score 0))) + (defun gnus-thread-sort-by-score (h1 h2) + "Sort threads by root article score." + (gnus-article-sort-by-score + (gnus-thread-header h1) (gnus-thread-header h2))) + (defun gnus-thread-sort-by-total-score (h1 h2) "Sort threads by the sum of all scores in the thread. *************** Unscored articles will be counted as hav *** 6483,6492 **** (defun gnus-thread-total-score (thread) ;; This function find the total score of THREAD. ! (if (consp thread) ! (if (stringp (car thread)) ! (apply gnus-thread-score-function 0 ! (mapcar 'gnus-thread-total-score-1 (cdr thread))) ! (gnus-thread-total-score-1 thread)) ! (gnus-thread-total-score-1 (list thread)))) (defun gnus-thread-total-score-1 (root) --- 8459,8471 ---- (defun gnus-thread-total-score (thread) ;; This function find the total score of THREAD. ! (cond ((null thread) ! 0) ! ((consp thread) ! (if (stringp (car thread)) ! (apply gnus-thread-score-function 0 ! (mapcar 'gnus-thread-total-score-1 (cdr thread))) ! (gnus-thread-total-score-1 thread))) ! (t ! (gnus-thread-total-score-1 (list thread))))) (defun gnus-thread-total-score-1 (root) *************** Unscored articles will be counted as hav *** 6494,6683 **** (setq root (car root)) (apply gnus-thread-score-function ! (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! (mapcar 'gnus-thread-total-score ! (cdr (gnus-gethash (downcase (mail-header-id root)) ! gnus-newsgroup-dependencies))))) ;; Added by Per Abrahamsen . ! (defvar gnus-tmp-prev-subject "") ! ! (defun gnus-summary-prepare-threads (threads &optional cull) ! "Prepare summary buffer from THREADS and indentation LEVEL. ! THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' or a straight list of headers." ! (gnus-message 5 "Generating summary...") ! (let ((level 0) ! thread header number subject stack state gnus-tmp-gathered) (if (vectorp (car threads)) ;; If this is a straight (sic) list of headers, then a ;; threaded summary display isn't required, so we just create ;; an unthreaded one. ! (gnus-summary-prepare-unthreaded threads cull) ;; Do the threaded display. ! (while (or threads stack) ! ! (if threads ! ;; If there are some threads, we do them before the ! ;; threads on the stack. ! (setq thread threads ! header (car (car thread))) ! ;; There were no current threads, so we pop something off ! ;; the stack. ! (setq state (car stack) ! level (car state) ! thread (cdr state) ! stack (cdr stack) ! header (car (car thread)))) ! (if (stringp header) ! (progn ! ;; The header is a dummy root. ! (cond ! ((eq gnus-summary-make-false-root 'adopt) ! ;; We let the first article adopt the rest. ! (let ((th (car (cdr (car thread))))) ! (while (cdr th) ! (setq th (cdr th))) ! (setcdr th (cdr (cdr (car thread)))) ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cdr (cdr (car thread)))) ! gnus-tmp-gathered)) ! (setcdr (cdr (car thread)) nil)) ! (setq level -1)) ! ((eq gnus-summary-make-false-root 'empty) ! ;; We print adopted articles with empty subject fields. ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cdr (cdr (car thread)))) ! gnus-tmp-gathered)) ! (setq level -1)) ! ((eq gnus-summary-make-false-root 'dummy) ! ;; We output a dummy root. ! (gnus-summary-insert-dummy-line ! nil header (mail-header-number ! (car (car (cdr (car thread))))))) ! (t ! ;; We do not make a root for the gathered ! ;; sub-threads at all. ! (setq level -1)))) ! ! (setq number (mail-header-number header) ! subject (mail-header-subject header)) ! ! ;; Do the async thing. ! (and gnus-newsgroup-async ! (setq gnus-newsgroup-threads ! (cons (cons number (mail-header-lines header)) ! gnus-newsgroup-threads))) ! ! ;; We may have to root out some bad articles... ! (and cull ! (= level 0) ! (cond ((and (memq (setq number (mail-header-number header)) ! gnus-newsgroup-dormant) ! (null thread)) ! (setq header nil)) ! ((and gnus-summary-expunge-below ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-expunge-below)) ! (setq header nil) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))))) ! ! (and ! header ! (progn ! (inline ! (gnus-summary-insert-line ! nil header level nil ! (cond ! ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ! ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ! ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ! ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) ! (t (or (cdr (assq number gnus-newsgroup-reads)) ! gnus-ancient-mark))) ! (memq number gnus-newsgroup-replied) ! (memq number gnus-newsgroup-expirable) ! (cond ! ((and gnus-thread-ignore-subject ! (not (string= ! (gnus-simplify-subject-re gnus-tmp-prev-subject) ! (gnus-simplify-subject-re subject)))) ! subject) ! ((zerop level) ! (if (and (eq gnus-summary-make-false-root 'empty) ! (memq number gnus-tmp-gathered)) ! gnus-summary-same-subject ! subject)) ! (t gnus-summary-same-subject)) ! (and (eq gnus-summary-make-false-root 'adopt) (memq number gnus-tmp-gathered)) ! (cdr (assq number gnus-newsgroup-scored)) ! (memq number gnus-newsgroup-processable)) ! ! (setq gnus-tmp-prev-subject subject))))) ! ! (if (nth 1 thread) ! (setq stack (cons (cons (max 0 level) (nthcdr 1 thread)) stack))) ! (setq level (1+ level)) ! (setq threads (cdr (car thread)))))) ! (gnus-message 5 "Generating summary...done")) ! ! ! ! (defun gnus-summary-prepare-unthreaded (headers &optional cull) ! (let (header number) ! ! ;; Do the async thing, if that is required. ! (if gnus-newsgroup-async ! (setq gnus-newsgroup-threads ! (mapcar (lambda (h) ! (cons (mail-header-number h) (mail-header-lines h))) ! headers))) (while headers - (setq header (car headers) - headers (cdr headers) - number (mail-header-number header)) - ;; We may have to root out some bad articles... ! (cond ! ((and cull ! (memq (setq number (mail-header-number header)) ! gnus-newsgroup-dormant))) ! ((and cull gnus-summary-expunge-below ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-expunge-below)) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-reads ! (cons (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! (t ! (gnus-summary-insert-line ! nil header 0 nil ! (cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq number gnus-newsgroup-reads)) ! gnus-ancient-mark))) ! (memq number gnus-newsgroup-replied) (memq number gnus-newsgroup-expirable) (mail-header-subject header) nil (cdr (assq number gnus-newsgroup-scored)) ! (memq number gnus-newsgroup-processable))))))) (defun gnus-select-newsgroup (group &optional read-all) --- 8473,8783 ---- (setq root (car root)) (apply gnus-thread-score-function ! (or (append ! (mapcar 'gnus-thread-total-score ! (cdr (gnus-gethash (mail-header-id root) ! gnus-newsgroup-dependencies))) ! (if (> (mail-header-number root) 0) ! (list (or (cdr (assq (mail-header-number root) ! gnus-newsgroup-scored)) ! gnus-summary-default-score 0)))) ! (list gnus-summary-default-score) ! '(0)))) ;; Added by Per Abrahamsen . ! (defvar gnus-tmp-prev-subject nil) ! (defvar gnus-tmp-false-parent nil) ! (defvar gnus-tmp-root-expunged nil) ! (defvar gnus-tmp-dummy-line nil) ! ! (defun gnus-summary-prepare-threads (threads) ! "Prepare summary buffer from THREADS and indentation LEVEL. ! THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' or a straight list of headers." ! (gnus-message 7 "Generating summary...") ! ! (setq gnus-newsgroup-threads threads) ! (beginning-of-line) ! ! (let ((gnus-tmp-level 0) ! (default-score (or gnus-summary-default-score 0)) ! (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) ! thread number subject stack state gnus-tmp-gathered beg-match ! new-roots gnus-tmp-new-adopts thread-end ! gnus-tmp-header gnus-tmp-unread ! gnus-tmp-replied gnus-tmp-subject-or-nil ! gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score ! gnus-tmp-score-char gnus-tmp-from gnus-tmp-name ! gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) ! ! (setq gnus-tmp-prev-subject nil) ! (if (vectorp (car threads)) ;; If this is a straight (sic) list of headers, then a ;; threaded summary display isn't required, so we just create ;; an unthreaded one. ! (gnus-summary-prepare-unthreaded threads) ;; Do the threaded display. ! (while (or threads stack gnus-tmp-new-adopts new-roots) ! (if (and (= gnus-tmp-level 0) ! (not (setq gnus-tmp-dummy-line nil)) ! (or (not stack) ! (= (caar stack) 0)) ! (not gnus-tmp-false-parent) ! (or gnus-tmp-new-adopts new-roots)) ! (if gnus-tmp-new-adopts ! (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) ! thread (list (car gnus-tmp-new-adopts)) ! gnus-tmp-header (caar thread) ! gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) ! (if new-roots ! (setq thread (list (car new-roots)) ! gnus-tmp-header (caar thread) ! new-roots (cdr new-roots)))) ! ! (if threads ! ;; If there are some threads, we do them before the ! ;; threads on the stack. ! (setq thread threads ! gnus-tmp-header (caar thread)) ! ;; There were no current threads, so we pop something off ! ;; the stack. ! (setq state (car stack) ! gnus-tmp-level (car state) ! thread (cdr state) ! stack (cdr stack) ! gnus-tmp-header (caar thread)))) ! ! (setq gnus-tmp-false-parent nil) ! (setq gnus-tmp-root-expunged nil) ! (setq thread-end nil) ! ! (if (stringp gnus-tmp-header) ! ;; The header is a dummy root. ! (cond ! ((eq gnus-summary-make-false-root 'adopt) ! ;; We let the first article adopt the rest. ! (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts ! (cddar thread))) ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cddar thread)) ! gnus-tmp-gathered)) ! (setq thread (cons (list (caar thread) ! (cadar thread)) ! (cdr thread))) ! (setq gnus-tmp-level -1 ! gnus-tmp-false-parent t)) ! ((eq gnus-summary-make-false-root 'empty) ! ;; We print adopted articles with empty subject fields. ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cddar thread)) ! gnus-tmp-gathered)) ! (setq gnus-tmp-level -1)) ! ((eq gnus-summary-make-false-root 'dummy) ! ;; We remember that we probably want to output a dummy ! ;; root. ! (setq gnus-tmp-dummy-line gnus-tmp-header) ! (setq gnus-tmp-prev-subject gnus-tmp-header)) ! (t ! ;; We do not make a root for the gathered ! ;; sub-threads at all. ! (setq gnus-tmp-level -1))) ! ! (setq number (mail-header-number gnus-tmp-header) ! subject (mail-header-subject gnus-tmp-header)) ! ! (cond ! ;; If the thread has changed subject, we might want to make ! ;; this subthread into a root. ! ((and (null gnus-thread-ignore-subject) ! (not (zerop gnus-tmp-level)) ! gnus-tmp-prev-subject ! (not (inline ! (gnus-subject-equal gnus-tmp-prev-subject subject)))) ! (setq new-roots (nconc new-roots (list (car thread))) ! thread-end t ! gnus-tmp-header nil)) ! ;; If the article lies outside the current limit, ! ;; then we do not display it. ! ((and (not (memq number gnus-newsgroup-limit)) ! (not gnus-tmp-dummy-line)) ! (setq gnus-tmp-gathered ! (nconc (mapcar ! (lambda (h) (mail-header-number (car h))) ! (cdar thread)) ! gnus-tmp-gathered)) ! (setq gnus-tmp-new-adopts (if (cdar thread) ! (append gnus-tmp-new-adopts ! (cdar thread)) ! gnus-tmp-new-adopts) ! thread-end t ! gnus-tmp-header nil) ! (when (zerop gnus-tmp-level) ! (setq gnus-tmp-root-expunged t))) ! ;; Perhaps this article is to be marked as read? ! ((and gnus-summary-mark-below ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! default-score) ! gnus-summary-mark-below) ! ;; Don't touch sparse articles. ! (not (memq number gnus-newsgroup-sparse)) ! (not (memq number gnus-newsgroup-ancient))) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (push number gnus-newsgroup-expirable) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads)))) ! ! (when gnus-tmp-header ! ;; We may have an old dummy line to output before this ! ;; article. ! (when gnus-tmp-dummy-line ! (gnus-summary-insert-dummy-line ! gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) ! (setq gnus-tmp-dummy-line nil)) ! ! ;; Compute the mark. ! (setq ! gnus-tmp-unread ! (cond ! ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ! ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ! ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ! ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) ! (t (or (cdr (assq number gnus-newsgroup-reads)) ! gnus-ancient-mark)))) ! ! (push (gnus-data-make number gnus-tmp-unread (1+ (point)) ! gnus-tmp-header gnus-tmp-level) ! gnus-newsgroup-data) ! ! ;; Actually insert the line. ! (setq ! gnus-tmp-subject-or-nil ! (cond ! ((and gnus-thread-ignore-subject ! gnus-tmp-prev-subject ! (not (inline (gnus-subject-equal ! gnus-tmp-prev-subject subject)))) ! subject) ! ((zerop gnus-tmp-level) ! (if (and (eq gnus-summary-make-false-root 'empty) ! (memq number gnus-tmp-gathered) ! gnus-tmp-prev-subject ! (inline (gnus-subject-equal ! gnus-tmp-prev-subject subject))) ! gnus-summary-same-subject ! subject)) ! (t gnus-summary-same-subject))) ! (if (and (eq gnus-summary-make-false-root 'adopt) ! (= gnus-tmp-level 1) (memq number gnus-tmp-gathered)) ! (setq gnus-tmp-opening-bracket ?\< ! gnus-tmp-closing-bracket ?\>) ! (setq gnus-tmp-opening-bracket ?\[ ! gnus-tmp-closing-bracket ?\])) ! (setq ! gnus-tmp-indentation ! (aref gnus-thread-indent-array gnus-tmp-level) ! gnus-tmp-lines (mail-header-lines gnus-tmp-header) ! gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-tmp-score-char ! (if (or (null gnus-summary-default-score) ! (<= (abs (- gnus-tmp-score gnus-summary-default-score)) ! gnus-summary-zcore-fuzz)) ? ! (if (< gnus-tmp-score gnus-summary-default-score) ! gnus-score-below-mark gnus-score-over-mark)) ! gnus-tmp-replied ! (cond ((memq number gnus-newsgroup-processable) ! gnus-process-mark) ! ((memq number gnus-newsgroup-cached) ! gnus-cached-mark) ! ((memq number gnus-newsgroup-replied) ! gnus-replied-mark) ! ((memq number gnus-newsgroup-saved) ! gnus-saved-mark) ! (t gnus-unread-mark)) ! gnus-tmp-from (mail-header-from gnus-tmp-header) ! gnus-tmp-name ! (cond ! ((string-match "(.+)" gnus-tmp-from) ! (substring gnus-tmp-from ! (1+ (match-beginning 0)) (1- (match-end 0)))) ! ((string-match "<[^>]+> *$" gnus-tmp-from) ! (setq beg-match (match-beginning 0)) ! (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) ! (substring gnus-tmp-from (1+ (match-beginning 0)) ! (1- (match-end 0)))) ! (substring gnus-tmp-from 0 beg-match))) ! (t gnus-tmp-from))) ! (when (string= gnus-tmp-name "") ! (setq gnus-tmp-name gnus-tmp-from)) ! (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) ! (gnus-put-text-property ! (point) ! (progn (eval gnus-summary-line-format-spec) (point)) ! 'gnus-number number) ! (when gnus-visual-p ! (forward-line -1) ! (run-hooks 'gnus-summary-update-hook) ! (forward-line 1)) ! ! (setq gnus-tmp-prev-subject subject))) ! ! (when (nth 1 thread) ! (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) ! (incf gnus-tmp-level) ! (setq threads (if thread-end nil (cdar thread))) ! (unless threads ! (setq gnus-tmp-level 0))))) ! (gnus-message 7 "Generating summary...done")) ! ! (defun gnus-summary-prepare-unthreaded (headers) ! "Generate an unthreaded summary buffer based on HEADERS." ! (let (header number mark) (while headers ;; We may have to root out some bad articles... ! (when (memq (setq number (mail-header-number ! (setq header (pop headers)))) ! gnus-newsgroup-limit) ! ;; Mark article as read when it has a low score. ! (when (and gnus-summary-mark-below ! (< (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score 0) ! gnus-summary-mark-below) ! (not (memq number gnus-newsgroup-ancient))) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (push number gnus-newsgroup-expirable) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! ! (setq mark ! (cond ! ((memq number gnus-newsgroup-marked) gnus-ticked-mark) ((memq number gnus-newsgroup-dormant) gnus-dormant-mark) ((memq number gnus-newsgroup-unreads) gnus-unread-mark) ((memq number gnus-newsgroup-expirable) gnus-expirable-mark) (t (or (cdr (assq number gnus-newsgroup-reads)) ! gnus-ancient-mark)))) ! (setq gnus-newsgroup-data ! (cons (gnus-data-make number mark (1+ (point)) header 0) ! gnus-newsgroup-data)) ! (gnus-summary-insert-line ! header 0 nil mark (memq number gnus-newsgroup-replied) (memq number gnus-newsgroup-expirable) (mail-header-subject header) nil (cdr (assq number gnus-newsgroup-scored)) ! (memq number gnus-newsgroup-processable)))))) (defun gnus-select-newsgroup (group &optional read-all) *************** If READ-ALL is non-nil, all articles in *** 6686,6702 **** (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! articles) (or (gnus-check-server (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) ! (or (and entry (not (eq (car entry) t))) ; Either it's active... ! (gnus-activate-group group) ; Or we can activate it... ! (progn ; Or we bug out. ! (kill-buffer (current-buffer)) ! (error "Couldn't request group %s: %s" group (gnus-status-message group)))) (setq gnus-newsgroup-name group) (setq gnus-newsgroup-unselected nil) --- 8786,8809 ---- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! articles fetched-articles cached) (or (gnus-check-server (setq gnus-current-select-method (gnus-find-method-for-group group))) (error "Couldn't open server")) ! (or (and entry (not (eq (car entry) t))) ; Either it's active... ! (gnus-activate-group group) ; Or we can activate it... ! (progn ; Or we bug out. ! (when (equal major-mode 'gnus-summary-mode) ! (kill-buffer (current-buffer))) ! (error "Couldn't request group %s: %s" group (gnus-status-message group)))) + (unless (gnus-request-group group t) + (when (equal major-mode 'gnus-summary-mode) + (kill-buffer (current-buffer))) + (error "Couldn't request group %s: %s" + group (gnus-status-message group))) + (setq gnus-newsgroup-name group) (setq gnus-newsgroup-unselected nil) *************** If READ-ALL is non-nil, all articles in *** 6704,6797 **** (and gnus-asynchronous ! (gnus-check-backend-function 'request-asynchronous gnus-newsgroup-name) (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) (setq articles (gnus-articles-to-read group read-all)) ! (cond ! ((null articles) ! (gnus-message 3 "Couldn't select newsgroup") 'quit) ((eq articles 0) nil) (t ;; Init the dependencies hash table. ! (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) ;; Retrieve the headers and read them in. ! (gnus-message 5 "Fetching headers...") ! (setq gnus-newsgroup-headers ! (if (eq 'nov (setq gnus-headers-retrieved-by ! ;; This is a naughty hack. To get the ! ;; retrieval of old headers to work, we ! ;; set `nntp-nov-gap' to nil (locally), ! ;; and then just retrieve the headers. ! ;; Mucho magic. ! (if gnus-fetch-old-headers ! (let (nntp-nov-gap) ! (gnus-retrieve-headers ! (if (not (eq 1 (car articles))) ! (cons 1 articles) ! articles) ! gnus-newsgroup-name)) ! (gnus-retrieve-headers ! articles gnus-newsgroup-name)))) ! (progn ! (gnus-get-newsgroup-headers-xover articles)) ! ;; If we were to fetch old headers, but the backend didn't ! ;; support XOVER, then it is possible we fetched one article ! ;; that we shouldn't have. If that's the case, we remove it. ! (if (or (not gnus-fetch-old-headers) ! (eq 1 (car articles))) ! () ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (and ! (looking-at "[0-9]+[ \t]+1[ \t]") ; This is not a NOV line. ! (delete-region ; So we delete this head. ! (point) ! (search-forward "\n.\n" nil t))))) (gnus-get-newsgroup-headers))) ! (gnus-message 5 "Fetching headers...done") ;; Remove canceled articles from the list of unread articles. (setq gnus-newsgroup-unreads ! (gnus-set-sorted-intersection gnus-newsgroup-unreads ! (mapcar (lambda (headers) (mail-header-number headers)) ! gnus-newsgroup-headers))) ! ;; Adjust and set lists of article marks. ! (and info ! (let (marked) ! (gnus-adjust-marked-articles info) ! (setq gnus-newsgroup-marked ! (copy-sequence ! (cdr (assq 'tick (setq marked (nth 3 info)))))) ! (setq gnus-newsgroup-replied ! (copy-sequence (cdr (assq 'reply marked)))) ! (setq gnus-newsgroup-expirable ! (copy-sequence (cdr (assq 'expire marked)))) ! (setq gnus-newsgroup-killed ! (copy-sequence (cdr (assq 'killed marked)))) ! (setq gnus-newsgroup-bookmarks ! (copy-sequence (cdr (assq 'bookmark marked)))) ! (setq gnus-newsgroup-dormant ! (copy-sequence (cdr (assq 'dormant marked)))) ! (setq gnus-newsgroup-scored ! (copy-sequence (cdr (assq 'score marked)))) ! (setq gnus-newsgroup-processable nil))) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire ! (or (and (stringp gnus-auto-expirable-newsgroups) ! (string-match gnus-auto-expirable-newsgroups group)) ! (memq 'auto-expire (nth 5 info)))) ;; First and last article in this newsgroup. ! (and gnus-newsgroup-headers ! (setq gnus-newsgroup-begin ! (mail-header-number (car gnus-newsgroup-headers))) ! (setq gnus-newsgroup-end ! (mail-header-number ! (gnus-last-element gnus-newsgroup-headers)))) (setq gnus-reffed-article-number -1) ;; GROUP is successfully selected. --- 8811,8896 ---- (and gnus-asynchronous ! (gnus-check-backend-function 'request-asynchronous gnus-newsgroup-name) (setq gnus-newsgroup-async (gnus-request-asynchronous gnus-newsgroup-name))) + ;; Adjust and set lists of article marks. + (when info + (gnus-adjust-marked-articles info)) + + ;; Kludge to avoid having cached articles nixed out in virtual groups. + (when (gnus-virtual-group-p group) + (setq cached gnus-newsgroup-cached)) + + (setq gnus-newsgroup-unreads + (gnus-set-difference + (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) + gnus-newsgroup-dormant)) + + (setq gnus-newsgroup-processable nil) + (setq articles (gnus-articles-to-read group read-all)) ! (cond ! ((null articles) ! ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") 'quit) ((eq articles 0) nil) (t ;; Init the dependencies hash table. ! (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) ;; Retrieve the headers and read them in. ! (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) ! (setq gnus-newsgroup-headers ! (if (eq 'nov ! (setq gnus-headers-retrieved-by ! (gnus-retrieve-headers ! articles gnus-newsgroup-name ! ;; We might want to fetch old headers, but ! ;; not if there is only 1 article. ! (and gnus-fetch-old-headers ! (or (and ! (not (eq gnus-fetch-old-headers 'some)) ! (not (numberp gnus-fetch-old-headers))) ! (> (length articles) 1)))))) ! (gnus-get-newsgroup-headers-xover articles) (gnus-get-newsgroup-headers))) ! (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) ! ! ;; Kludge to avoid having cached articles nixed out in virtual groups. ! (when cached ! (setq gnus-newsgroup-cached cached)) ! ! ;; Set the initial limit. ! (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. (setq gnus-newsgroup-unreads ! (gnus-set-sorted-intersection gnus-newsgroup-unreads ! (setq fetched-articles ! (mapcar (lambda (headers) (mail-header-number headers)) ! gnus-newsgroup-headers)))) ! ;; Removed marked articles that do not exist. ! (gnus-update-missing-marks ! (gnus-sorted-complement fetched-articles articles)) ! ;; We might want to build some more threads first. ! (and gnus-fetch-old-headers ! (eq gnus-headers-retrieved-by 'nov) ! (gnus-build-old-threads)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire ! (gnus-group-auto-expirable-p group)) ! ;; Set up the article buffer now, if necessary. ! (unless gnus-single-article-buffer ! (gnus-article-setup-buffer)) ;; First and last article in this newsgroup. ! (when gnus-newsgroup-headers ! (setq gnus-newsgroup-begin ! (mail-header-number (car gnus-newsgroup-headers)) ! gnus-newsgroup-end ! (mail-header-number ! (gnus-last-element gnus-newsgroup-headers)))) (setq gnus-reffed-article-number -1) ;; GROUP is successfully selected. *************** If READ-ALL is non-nil, all articles in *** 6801,6812 **** ;; Find out what articles the user wants to read. (let* ((articles ! ;; Select all articles if `read-all' is non-nil, or if all the ! ;; unread articles are dormant articles. (if (or read-all ! (= (length gnus-newsgroup-unreads) ! (length gnus-newsgroup-dormant))) ! (gnus-uncompress-range ! (gnus-gethash group gnus-active-hashtb)) ! gnus-newsgroup-unreads)) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) --- 8900,8912 ---- ;; Find out what articles the user wants to read. (let* ((articles ! ;; Select all articles if `read-all' is non-nil, or if there ! ;; are no unread articles. (if (or read-all ! (and (zerop (length gnus-newsgroup-marked)) ! (zerop (length gnus-newsgroup-unreads)))) ! (gnus-uncompress-range (gnus-active group)) ! (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked ! (copy-sequence gnus-newsgroup-unreads)) ! '<))) (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) (scored (length scored-list)) *************** If READ-ALL is non-nil, all articles in *** 6815,6844 **** (length gnus-newsgroup-dormant))) (select ! (cond ((numberp read-all) read-all) (t (condition-case () ! (cond ((and (or (<= scored marked) ! (= scored number)) ! (numberp gnus-large-newsgroup) ! (> number gnus-large-newsgroup)) ! (let ((input ! (read-string ! (format ! "How many articles from %s (default %d): " ! gnus-newsgroup-name number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! ((and (> scored marked) (< scored number)) ! (let ((input ! (read-string ! (format ! "%s %s (%d scored, %d total): " ! "How many articles from" ! group scored number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! (t number)) (quit nil)))))) (setq select (if (stringp select) (string-to-number select) select)) --- 8915,8943 ---- (length gnus-newsgroup-dormant))) (select ! (cond ((numberp read-all) read-all) (t (condition-case () ! (cond ! ((and (or (<= scored marked) (= scored number)) ! (numberp gnus-large-newsgroup) ! (> number gnus-large-newsgroup)) ! (let ((input ! (read-string ! (format ! "How many articles from %s (default %d): " ! gnus-newsgroup-name number)))) ! (if (string-match "^[ \t]*$" input) number input))) ! ((and (> scored marked) (< scored number) ! (> (- scored number) 20)) ! (let ((input ! (read-string ! (format "%s %s (%d scored, %d total): " ! "How many articles from" ! group scored number)))) ! (if (string-match "^[ \t]*$" input) ! number input))) ! (t number)) (quit nil)))))) (setq select (if (stringp select) (string-to-number select) select)) *************** If READ-ALL is non-nil, all articles in *** 6852,6856 **** (if (< (abs select) number) ! (if (< select 0) ;; Select the N oldest articles. (setcdr (nthcdr (1- (abs select)) articles) nil) --- 8951,8955 ---- (if (< (abs select) number) ! (if (< select 0) ;; Select the N oldest articles. (setcdr (nthcdr (1- (abs select)) articles) nil) *************** If READ-ALL is non-nil, all articles in *** 6871,7123 **** out)) ! (defun gnus-adjust-marked-articles (info &optional active) ! "Remove all marked articles that are no longer legal." ! (let ((marked-lists (nth 3 info)) ! (active (or active (gnus-gethash (car info) gnus-active-hashtb))) ! m prev) ! ;; There are many types of marked articles. (while marked-lists ! (setq m (cdr (setq prev (car marked-lists)))) ! (cond ((or (eq 'tick (car prev)) (eq 'dormant (car prev))) ! ;; Make sure that all ticked articles are a subset of the ! ;; unread/unselected articles. ! ;;(while m ! ;; (if (or (memq (car m) gnus-newsgroup-unreads) ! ;; (memq (car m) gnus-newsgroup-unselected)) ! ;; (setq prev m) ! ;; (setcdr prev (cdr m))) ! ;; (setq m (cdr m))) ! ) ! ((eq 'score (car prev)) ! ;; Scored articles should be a subset of ! ;; unread/unselected articles. ! (while m ! (if (or (memq (car (car m)) gnus-newsgroup-unreads) ! (memq (car (car m)) gnus-newsgroup-unreads)) ! (setq prev m) ! (setcdr prev (cdr m))) ! (setq m (cdr m)))) ! ((eq 'bookmark (car prev)) ! ;; Bookmarks should be a subset of active articles. ! (while m ! (if (< (car (car m)) (car active)) ! (setcdr prev (cdr m)) ! (setq prev m)) ! (setq m (cdr m)))) ! ((eq 'killed (car prev)) ! ;; Articles that have been through the kill process are ! ;; to be a subset of active articles. ! (while (and m (< (or (and (numberp (car m)) (car m)) ! (cdr (car m))) ! (car active))) ! (setcdr prev (cdr m)) ! (setq m (cdr m))) ! (if (and m (< (or (and (numberp (car m)) (car m)) ! (car (car m))) ! (car active))) ! (setcar (if (numberp (car m)) m (car m)) (car active)))) ! ((or (eq 'reply (car prev)) (eq 'expire (car prev))) ! ;; The replied and expirable articles have to be articles ! ;; that are active. ! (while m ! (if (< (car m) (car active)) ! (setcdr prev (cdr m)) ! (setq prev m)) ! (setq m (cdr m))))) ! (setq marked-lists (cdr marked-lists))) ! ;; Remove all lists that are empty. ! (setq marked-lists (nth 3 info)) ! (if marked-lists ! (progn ! (while (= 1 (length (car marked-lists))) ! (setq marked-lists (cdr marked-lists))) ! (setq m (cdr (setq prev marked-lists))) (while m ! (if (= 1 (length (car m))) ! (setcdr prev (cdr m)) ! (setq prev m)) ! (setq m (cdr m))) ! (setcar (nthcdr 3 info) marked-lists))) ! ;; Finally, if there are no marked lists at all left, and if there ! ;; are no elements after the lists in the info list, we just chop ! ;; the info list off before the marked lists. ! (and (null marked-lists) ! (not (nthcdr 4 info)) ! (setcdr (nthcdr 2 info) nil))) ! info) ! (defun gnus-set-marked-articles ! (info ticked replied expirable killed dormant bookmark score) "Enter the various lists of marked articles into the newsgroup info list." ! (let (newmarked) ! (and ticked (setq newmarked (cons (cons 'tick ticked) nil))) ! (and replied (setq newmarked (cons (cons 'reply replied) newmarked))) ! (and expirable (setq newmarked (cons (cons 'expire expirable) ! newmarked))) ! (and killed (setq newmarked (cons (cons 'killed killed) newmarked))) ! (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked))) ! (and bookmark (setq newmarked (cons (cons 'bookmark bookmark) ! newmarked))) ! (and score (setq newmarked (cons (cons 'score score) newmarked))) ! (if (nthcdr 3 info) ! (progn (setcar (nthcdr 3 info) newmarked) ! (and (not newmarked) ! (not (nthcdr 4 info)) ! (setcdr (nthcdr 2 info) nil))) ! (if newmarked ! (setcdr (nthcdr 2 info) (list newmarked)))))) (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ! ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. ! (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) ! (setcdr (nthcdr 2 info) (list (list (cons type articles))))) (and (not (setq m (assq type (car marked)))) ! (setcar marked (cons (cons type articles) (car marked)))) (if force ! (setcdr m articles) ! (nconc m articles))))) ! (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ! (if (memq where gnus-updated-mode-lines) ! (let (mode-string) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let* ((mformat (if (eq where 'article) ! gnus-article-mode-line-format-spec ! gnus-summary-mode-line-format-spec)) ! (buffer-name (if (eq where 'article) ! (buffer-name ! (get-buffer gnus-article-buffer)) ! (buffer-name))) ! (group-name gnus-newsgroup-name) ! (article-number (or gnus-current-article 0)) ! (unread (- (length gnus-newsgroup-unreads) ! (length gnus-newsgroup-dormant))) ! (unread-and-unticked ! (- unread (length gnus-newsgroup-marked))) ! (unselected (length gnus-newsgroup-unselected)) ! (unread-and-unselected ! (cond ((and (zerop unread-and-unticked) ! (zerop unselected)) "") ! ((zerop unselected) ! (format "{%d more}" unread-and-unticked)) ! (t (format "{%d(+%d) more}" ! unread-and-unticked unselected)))) ! (subject ! (if gnus-current-headers ! (mail-header-subject gnus-current-headers) "")) ! (max-len (and gnus-mode-non-string-length ! (- (frame-width) gnus-mode-non-string-length))) ! header);; passed as argument to any user-format-funcs ! (setq mode-string (eval mformat)) ! (or (numberp max-len) ! (setq max-len (length mode-string))) ! (if (< max-len 4) (setq max-len 4)) ! (if (> (length mode-string) max-len) ! ;; modified by MORIOKA Tomohiko ! ;; function `substring' might cut on a middle ! ;; of multi-octet character. ! (setq mode-string ! (concat (gnus-truncate-string mode-string (- max-len 3)) ! "..."))) ! (setq mode-string (format (format "%%-%ds" max-len) ! mode-string)))) ! (setq mode-line-buffer-identification mode-string) ! (set-buffer-modified-p t)))) (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) "Go through the HEADERS list and add all Xrefs to a hash table. The resulting hash table is returned, or nil if no Xrefs were found." ! (let* ((from-method (gnus-find-method-for-group from-newsgroup)) ! (prefix (if (and ! (gnus-group-foreign-p from-newsgroup) ! (not (memq 'virtual ! (assoc (symbol-name (car from-method)) ! gnus-valid-select-methods)))) ! (gnus-group-real-prefix from-newsgroup))) (xref-hashtb (make-vector 63 0)) start group entry number xrefs header) (while headers ! (setq header (car headers)) ! (if (and (setq xrefs (mail-header-xref header)) ! (not (memq (mail-header-number header) unreads))) ! (progn ! (setq start 0) ! (while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start) ! (setq start (match-end 0)) ! (setq group (concat prefix (substring xrefs (match-beginning 1) ! (match-end 1)))) ! (setq number ! (string-to-int (substring xrefs (match-beginning 2) ! (match-end 2)))) ! (if (setq entry (gnus-gethash group xref-hashtb)) ! (setcdr entry (cons number (cdr entry))) ! (gnus-sethash group (cons number nil) xref-hashtb))))) ! (setq headers (cdr headers))) ! (if start xref-hashtb nil))) ! (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable) "Look through all the headers and mark the Xrefs as read." ! (let ((virtual (memq 'virtual ! (assoc (symbol-name (car (gnus-find-method-for-group ! from-newsgroup))) ! gnus-valid-select-methods))) ! name entry info xref-hashtb idlist method ! nth4) (save-excursion (set-buffer gnus-group-buffer) ! (if (setq xref-hashtb ! (gnus-create-xref-hashtb from-newsgroup headers unreads)) ! (mapatoms ! (lambda (group) ! (if (string= from-newsgroup (setq name (symbol-name group))) ! () ! (setq idlist (symbol-value group)) ! ;; Dead groups are not updated. ! (if (and (prog1 ! (setq entry (gnus-gethash name gnus-newsrc-hashtb) ! info (nth 2 entry)) ! (if (stringp (setq nth4 (nth 4 info))) ! (setq nth4 (gnus-server-to-method nth4)))) ! ;; Only do the xrefs if the group has the same ! ;; select method as the group we have just read. ! (or (gnus-methods-equal-p ! nth4 (gnus-find-method-for-group from-newsgroup)) ! virtual ! (equal nth4 ! (setq method (gnus-find-method-for-group ! from-newsgroup))) ! (and (equal (car nth4) (car method)) ! (equal (nth 1 nth4) (nth 1 method)))) ! gnus-use-cross-reference ! (or (not (eq gnus-use-cross-reference t)) ! virtual ! ;; Only do cross-references on subscribed ! ;; groups, if that is what is wanted. ! (<= (nth 1 info) gnus-level-subscribed))) ! (gnus-group-make-articles-read name idlist expirable)))) ! xref-hashtb))))) ! (defun gnus-group-make-articles-read (group articles expirable) (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! (active (gnus-gethash group gnus-active-hashtb)) ! exps expirable range) ;; First peel off all illegal article numbers. (if active (let ((ids articles) - (ticked (cdr (assq 'tick (nth 3 info)))) - (dormant (cdr (assq 'dormant (nth 3 info)))) id first) - (setq exps nil) (while ids (setq id (car ids)) --- 8970,9221 ---- out)) ! (defun gnus-uncompress-marks (marks) ! "Uncompress the mark ranges in MARKS." ! (let ((uncompressed '(score bookmark)) ! out) ! (while marks ! (if (memq (caar marks) uncompressed) ! (push (car marks) out) ! (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) ! (setq marks (cdr marks))) ! out)) ! ! (defun gnus-adjust-marked-articles (info) ! "Set all article lists and remove all marks that are no longer legal." ! (let* ((marked-lists (gnus-info-marks info)) ! (active (gnus-active (gnus-info-group info))) ! (min (car active)) ! (max (cdr active)) ! (types gnus-article-mark-lists) ! (uncompressed '(score bookmark killed)) ! marks var articles article mark) ! (while marked-lists ! (setq marks (pop marked-lists)) ! (set (setq var (intern (format "gnus-newsgroup-%s" ! (car (rassq (setq mark (car marks)) ! types))))) ! (if (memq (car marks) uncompressed) (cdr marks) ! (gnus-uncompress-range (cdr marks)))) ! ! (setq articles (symbol-value var)) ! ! ;; All articles have to be subsets of the active articles. ! (cond ! ;; Adjust "simple" lists. ! ((memq mark '(tick dormant expirable reply save)) ! (while articles ! (when (or (< (setq article (pop articles)) min) (> article max)) ! (set var (delq article (symbol-value var)))))) ! ;; Adjust assocs. ! ((memq mark uncompressed) ! (while articles ! (when (or (not (consp (setq article (pop articles)))) ! (< (car article) min) ! (> (car article) max)) ! (set var (delq article (symbol-value var)))))))))) ! ! (defun gnus-update-missing-marks (missing) ! "Go through the list of MISSING articles and remove them mark lists." ! (when missing ! (let ((types gnus-article-mark-lists) ! var m) ! ;; Go through all types. ! (while types ! (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) ! (when (symbol-value var) ! ;; This list has articles. So we delete all missing articles ! ;; from it. ! (setq m missing) (while m ! (set var (delq (pop m) (symbol-value var))))))))) ! (defun gnus-update-marks () "Enter the various lists of marked articles into the newsgroup info list." ! (let ((types gnus-article-mark-lists) ! (info (gnus-get-info gnus-newsgroup-name)) ! (uncompressed '(score bookmark killed)) ! type list newmarked symbol) ! (when info ! ;; Add all marks lists that are non-nil to the list of marks lists. ! (while types ! (setq type (pop types)) ! (when (setq list (symbol-value ! (setq symbol ! (intern (format "gnus-newsgroup-%s" ! (car type)))))) ! (push (cons (cdr type) ! (if (memq (cdr type) uncompressed) list ! (gnus-compress-sequence ! (set symbol (sort list '<)) t))) ! newmarked))) ! ! ;; Enter these new marks into the info of the group. ! (if (nthcdr 3 info) (setcar (nthcdr 3 info) newmarked) ! ;; Add the marks lists to the end of the info. ! (when newmarked ! (setcdr (nthcdr 2 info) (list newmarked)))) ! ! ;; Cut off the end of the info if there's nothing else there. ! (let ((i 5)) ! (while (and (> i 2) ! (not (nth i info))) ! (when (nthcdr (decf i) info) ! (setcdr (nthcdr i info) nil))))))) (defun gnus-add-marked-articles (group type articles &optional info force) ;; Add ARTICLES of TYPE to the info of GROUP. ! ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't ;; add, but replace marked articles of TYPE with ARTICLES. ! (let ((info (or info (gnus-get-info group))) ! (uncompressed '(score bookmark killed)) marked m) (or (not info) (and (not (setq marked (nthcdr 3 info))) ! (or (null articles) ! (setcdr (nthcdr 2 info) ! (list (list (cons type (gnus-compress-sequence ! articles t))))))) (and (not (setq m (assq type (car marked)))) ! (or (null articles) ! (setcar marked ! (cons (cons type (gnus-compress-sequence articles t) ) ! (car marked))))) (if force ! (if (null articles) ! (setcar (nthcdr 3 info) ! (delq (assq type (car marked)) (car marked))) ! (setcdr m (gnus-compress-sequence articles t))) ! (setcdr m (gnus-compress-sequence ! (sort (nconc (gnus-uncompress-range (cdr m)) ! (copy-sequence articles)) '<) t)))))) ! (defun gnus-set-mode-line (where) "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ! ;; Is this mode line one we keep updated? ! (when (memq where gnus-updated-mode-lines) ! (let (mode-string) ! (save-excursion ! ;; We evaluate this in the summary buffer since these ! ;; variables are buffer-local to that buffer. ! (set-buffer gnus-summary-buffer) ! ;; We bind all these variables that are used in the `eval' form ! ;; below. ! (let* ((mformat (symbol-value ! (intern ! (format "gnus-%s-mode-line-format-spec" where)))) ! (gnus-tmp-group-name gnus-newsgroup-name) ! (gnus-tmp-article-number (or gnus-current-article 0)) ! (gnus-tmp-unread gnus-newsgroup-unreads) ! (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) ! (gnus-tmp-unselected (length gnus-newsgroup-unselected)) ! (gnus-tmp-unread-and-unselected ! (cond ((and (zerop gnus-tmp-unread-and-unticked) ! (zerop gnus-tmp-unselected)) "") ! ((zerop gnus-tmp-unselected) ! (format "{%d more}" gnus-tmp-unread-and-unticked)) ! (t (format "{%d(+%d) more}" ! gnus-tmp-unread-and-unticked ! gnus-tmp-unselected)))) ! (gnus-tmp-subject ! (if (and gnus-current-headers ! (vectorp gnus-current-headers)) ! (gnus-mode-string-quote ! (mail-header-subject gnus-current-headers)) "")) ! max-len ! gnus-tmp-header);; passed as argument to any user-format-funcs ! (setq mode-string (eval mformat)) ! (setq max-len (max 4 (if gnus-mode-non-string-length ! (- (window-width) ! gnus-mode-non-string-length) ! (length mode-string)))) ! ;; We might have to chop a bit of the string off... ! (when (> (length mode-string) max-len) ! (setq mode-string ! (concat (gnus-truncate-string mode-string (- max-len 3)) ! "..."))) ! ;; 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 ! (gnus-mode-line-buffer-identification ! (list mode-string))) ! (set-buffer-modified-p t)))) (defun gnus-create-xref-hashtb (from-newsgroup headers unreads) "Go through the HEADERS list and add all Xrefs to a hash table. The resulting hash table is returned, or nil if no Xrefs were found." ! (let* ((virtual (gnus-virtual-group-p from-newsgroup)) ! (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) (xref-hashtb (make-vector 63 0)) start group entry number xrefs header) (while headers ! (setq header (pop headers)) ! (when (and (setq xrefs (mail-header-xref header)) ! (not (memq (setq number (mail-header-number header)) ! unreads))) ! (setq start 0) ! (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) ! (setq start (match-end 0)) ! (setq group (if prefix ! (concat prefix (substring xrefs (match-beginning 1) ! (match-end 1))) ! (substring xrefs (match-beginning 1) (match-end 1)))) ! (setq number ! (string-to-int (substring xrefs (match-beginning 2) ! (match-end 2)))) ! (if (setq entry (gnus-gethash group xref-hashtb)) ! (setcdr entry (cons number (cdr entry))) ! (gnus-sethash group (cons number nil) xref-hashtb))))) ! (and start xref-hashtb))) ! (defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) "Look through all the headers and mark the Xrefs as read." ! (let ((virtual (gnus-virtual-group-p from-newsgroup)) ! name entry info xref-hashtb idlist method nth4) (save-excursion (set-buffer gnus-group-buffer) ! (when (setq xref-hashtb ! (gnus-create-xref-hashtb from-newsgroup headers unreads)) ! (mapatoms ! (lambda (group) ! (unless (string= from-newsgroup (setq name (symbol-name group))) ! (setq idlist (symbol-value group)) ! ;; Dead groups are not updated. ! (and (prog1 ! (setq entry (gnus-gethash name gnus-newsrc-hashtb) ! info (nth 2 entry)) ! (if (stringp (setq nth4 (gnus-info-method info))) ! (setq nth4 (gnus-server-to-method nth4)))) ! ;; Only do the xrefs if the group has the same ! ;; select method as the group we have just read. ! (or (gnus-methods-equal-p ! nth4 (gnus-find-method-for-group from-newsgroup)) ! virtual ! (equal nth4 (setq method (gnus-find-method-for-group ! from-newsgroup))) ! (and (equal (car nth4) (car method)) ! (equal (nth 1 nth4) (nth 1 method)))) ! gnus-use-cross-reference ! (or (not (eq gnus-use-cross-reference t)) ! virtual ! ;; Only do cross-references on subscribed ! ;; groups, if that is what is wanted. ! (<= (gnus-info-level info) gnus-level-subscribed)) ! (gnus-group-make-articles-read name idlist)))) ! xref-hashtb))))) ! (defun gnus-group-make-articles-read (group articles) (let* ((num 0) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) ! (active (gnus-active group)) ! range) ;; First peel off all illegal article numbers. (if active (let ((ids articles) id first) (while ids (setq id (car ids)) *************** The resulting hash table is returned, or *** 7125,7165 **** (progn ;; We'll end up in this situation in one particular ! ;; obscure situation. If you re-scan a group and get ;; a new article that is cross-posted to a different ;; group that has not been re-scanned, you might get ;; crossposted article that has a higher number than ! ;; Gnus believes possible. So we re-activate this ! ;; group as well. This might mean doing the ;; crossposting thingy will *increase* the number ! ;; of articles in some groups. Tsk, tsk. (setq active (or (gnus-activate-group group) active)))) (if (or (> id (cdr active)) ! (< id (car active)) ! (memq id ticked) ! (memq id dormant)) (setq articles (delq id articles))) - (and (memq id expirable) - (setq exps (cons id exps))) (setq ids (cdr ids))))) ! ;; Update expirable articles. ! (gnus-add-marked-articles nil 'expirable exps info) (and active ! (null (nth 2 info)) (> (car active) 1) ! (setcar (nthcdr 2 info) (cons 1 (1- (car active))))) ! (setcar (nthcdr 2 info) ! (setq range ! (gnus-add-to-range ! (nth 2 info) ! (setq articles (sort articles '<))))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (if active (progn ! (cond ((not range) (setq num (- (1+ (cdr active)) (car active)))) ((not (listp (cdr range))) ! (setq num (- (cdr active) (- (1+ (cdr range)) (car range))))) (t --- 9223,9259 ---- (progn ;; We'll end up in this situation in one particular ! ;; obscure situation. If you re-scan a group and get ;; a new article that is cross-posted to a different ;; group that has not been re-scanned, you might get ;; crossposted article that has a higher number than ! ;; Gnus believes possible. So we re-activate this ! ;; group as well. This might mean doing the ;; crossposting thingy will *increase* the number ! ;; of articles in some groups. Tsk, tsk. (setq active (or (gnus-activate-group group) active)))) (if (or (> id (cdr active)) ! (< id (car active))) (setq articles (delq id articles))) (setq ids (cdr ids))))) ! ;; If the read list is nil, we init it. (and active ! (null (gnus-info-read info)) (> (car active) 1) ! (gnus-info-set-read info (cons 1 (1- (car active))))) ! ;; Then we add the read articles to the range. ! (gnus-info-set-read ! info ! (setq range ! (gnus-add-to-range ! (gnus-info-read info) (setq articles (sort articles '<))))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (if active (progn ! (cond ((not range) (setq num (- (1+ (cdr active)) (car active)))) ((not (listp (cdr range))) ! (setq num (- (cdr active) (- (1+ (cdr range)) (car range))))) (t *************** The resulting hash table is returned, or *** 7167,7181 **** (if (numberp (car range)) (setq num (1+ num)) ! (setq num (+ num (- (1+ (cdr (car range))) ! (car (car range)))))) (setq range (cdr range))) (setq num (- (cdr active) num)))) ;; Update the number of unread articles. ! (setcar ! entry ! (max 0 (- num ! (length (cdr (assq 'tick (nth 3 info)))) ! (length ! (cdr (assq 'dormant (nth 3 info))))))) ;; Update the group buffer. (gnus-group-update-group group t))))) --- 9261,9269 ---- (if (numberp (car range)) (setq num (1+ num)) ! (setq num (+ num (- (1+ (cdar range)) (caar range))))) (setq range (cdr range))) (setq num (- (cdr active) num)))) ;; Update the number of unread articles. ! (setcar entry num) ;; Update the group buffer. (gnus-group-update-group group t))))) *************** The resulting hash table is returned, or *** 7195,7317 **** (defvar gnus-newsgroup-none-id 0) ! (defun gnus-get-newsgroup-headers () ! (setq gnus-article-internal-prepare-hook nil) (let ((cur nntp-server-buffer) ! (dependencies gnus-newsgroup-dependencies) ! headers id dep end ref) (save-excursion (set-buffer nntp-server-buffer) - ;; Allow the user to mangle the headers before parsing them. (run-hooks 'gnus-parse-headers-hook) ! (goto-char (point-min)) ! ;; Search to the beginning of the next header. Error messages ! ;; do not begin with 2 or 3. ! (while (re-search-forward "^[23][0-9]+ " nil t) ! (let ((header (make-vector 9 nil)) ! (case-fold-search t) ! (p (point)) ! in-reply-to) (setq id nil ref nil) - (mail-header-set-number header (read cur)) ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually ! ;; about twice as fast, even though it looks messier. You ! ;; can't have everything, I guess. Speed and elegance ! ;; doesn't always come hand in hand. ! (save-restriction ! (narrow-to-region (point) (or (save-excursion ! (search-forward "\n.\n" nil t)) ! (point))) ! (if (search-forward "\nfrom: " nil t) ! (mail-header-set-from header (gnus-header-value)) ! (mail-header-set-from header "(nobody)")) ! (goto-char p) ! (if (search-forward "\nsubject: " nil t) ! (mail-header-set-subject header (gnus-header-value)) ! (mail-header-set-subject header "(none)")) ! (goto-char p) ! (and (search-forward "\nxref: " nil t) ! (mail-header-set-xref header (gnus-header-value))) ! (goto-char p) ! (or (numberp (and (search-forward "\nlines: " nil t) ! (mail-header-set-lines header (read cur)))) ! (mail-header-set-lines header 0)) ! (goto-char p) ! (and (search-forward "\ndate: " nil t) ! (mail-header-set-date header (gnus-header-value))) ! (goto-char p) ! (if (search-forward "\nmessage-id: " nil t) ! (mail-header-set-id header (setq id (gnus-header-value))) ! ;; If there was no message-id, we just fake one to make ! ;; subsequent routines simpler. ! (mail-header-set-id ! header ! (setq id (concat "none+" ! (int-to-string ! (setq gnus-newsgroup-none-id ! (1+ gnus-newsgroup-none-id))))))) ! (goto-char p) ! (if (search-forward "\nreferences: " nil t) ! (progn ! (mail-header-set-references header (gnus-header-value)) ! (setq end (match-end 0)) ! (save-excursion ! (setq ref ! (downcase ! (buffer-substring ! (progn ! (end-of-line) ! (search-backward ">" end t) ! (1+ (point))) ! (progn ! (search-backward "<" end t) ! (point))))))) ! ;; Get the references from the in-reply-to header if there ! ;; ware no references and the in-reply-to header looks ! ;; promising. ! (if (and (search-forward "\nin-reply-to: " nil t) ! (setq in-reply-to (gnus-header-value)) ! (string-match "<[^>]+>" in-reply-to)) (progn ! (mail-header-set-references ! header ! (setq ref (substring in-reply-to (match-beginning 0) ! (match-end 0)))) ! (setq ref (downcase ref))) ! (setq ref "none"))) ! ;; We do some threading while we read the headers. The ! ;; message-id and the last reference are both entered into ! ;; the same hash table. Some tippy-toeing around has to be ! ;; done in case an article has arrived before the article ! ;; which it refers to. ! (if (boundp (setq dep (intern (downcase id) dependencies))) ! (if (car (symbol-value dep)) ! ;; 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. ! (progn ! (mail-header-set-xref ! (car (symbol-value dep)) ! (concat (or (mail-header-xref ! (car (symbol-value dep))) "") ! (or (mail-header-xref header) ""))) ! (setq header nil)) ! (setcar (symbol-value dep) header)) ! (set dep (list header))) ! (if header ! (progn ! (if (boundp (setq dep (intern ref dependencies))) ! (setcdr (symbol-value dep) ! (cons header (cdr (symbol-value dep)))) ! (set dep (list nil header))) ! (setq headers (cons header headers)))) ! (goto-char (point-max)))))) ! (nreverse headers))) ;; The following macros and functions were written by Felix Lee ! ;; . (defmacro gnus-nov-read-integer () --- 9283,9422 ---- (defvar gnus-newsgroup-none-id 0) ! (defun gnus-get-newsgroup-headers (&optional dependencies force-new) (let ((cur nntp-server-buffer) ! (dependencies ! (or dependencies ! (save-excursion (set-buffer gnus-summary-buffer) ! gnus-newsgroup-dependencies))) ! headers id id-dep ref-dep end ref) (save-excursion (set-buffer nntp-server-buffer) (run-hooks 'gnus-parse-headers-hook) ! (let ((case-fold-search t) ! in-reply-to header p lines) ! (goto-char (point-min)) ! ;; Search to the beginning of the next header. Error messages ! ;; do not begin with 2 or 3. ! (while (re-search-forward "^[23][0-9]+ " nil t) (setq id nil ref nil) ;; This implementation of this function, with nine ;; search-forwards instead of the one re-search-forward and ;; a case (which basically was the old function) is actually ! ;; about twice as fast, even though it looks messier. You ! ;; can't have everything, I guess. Speed and elegance ! ;; doesn't always go hand in hand. ! (setq ! header ! (vector ! ;; Number. ! (prog1 ! (read cur) ! (end-of-line) ! (setq p (point)) ! (narrow-to-region (point) ! (or (and (search-forward "\n.\n" nil t) ! (- (point) 2)) ! (point)))) ! ;; Subject. ! (progn ! (goto-char p) ! (if (search-forward "\nsubject: " nil t) ! (gnus-header-value) "(none)")) ! ;; From. ! (progn ! (goto-char p) ! (if (search-forward "\nfrom: " nil t) ! (gnus-header-value) "(nobody)")) ! ;; Date. ! (progn ! (goto-char p) ! (if (search-forward "\ndate: " nil t) ! (gnus-header-value) "")) ! ;; Message-ID. ! (progn ! (goto-char p) ! (if (search-forward "\nmessage-id: " nil t) ! (setq id (gnus-header-value)) ! ;; If there was no message-id, we just fake one to make ! ;; subsequent routines simpler. ! (setq id (concat "none+" ! (int-to-string ! (setq gnus-newsgroup-none-id ! (1+ gnus-newsgroup-none-id))))))) ! ;; References. ! (progn ! (goto-char p) ! (if (search-forward "\nreferences: " nil t) (progn ! (setq end (point)) ! (prog1 ! (gnus-header-value) ! (setq ref ! (buffer-substring ! (progn ! (end-of-line) ! (search-backward ">" end t) ! (1+ (point))) ! (progn ! (search-backward "<" end t) ! (point)))))) ! ;; Get the references from the in-reply-to header if there ! ;; were no references and the in-reply-to header looks ! ;; promising. ! (if (and (search-forward "\nin-reply-to: " nil t) ! (setq in-reply-to (gnus-header-value)) ! (string-match "<[^>]+>" in-reply-to)) ! (setq ref (substring in-reply-to (match-beginning 0) ! (match-end 0))) ! (setq ref "")))) ! ;; Chars. ! 0 ! ;; Lines. ! (progn ! (goto-char p) ! (if (search-forward "\nlines: " nil t) ! (if (numberp (setq lines (read cur))) ! lines 0) ! 0)) ! ;; Xref. ! (progn ! (goto-char p) ! (and (search-forward "\nxref: " nil t) ! (gnus-header-value))))) ! ;; We do the threading while we read the headers. The ! ;; message-id and the last reference are both entered into ! ;; the same hash table. Some tippy-toeing around has to be ! ;; done in case an article has arrived before the article ! ;; which it refers to. ! (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). ! (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)) ! (setcar (symbol-value id-dep) header)) ! (set id-dep (list header))) ! (when header ! (if (boundp (setq ref-dep (intern ref dependencies))) ! (setcdr (symbol-value ref-dep) ! (nconc (cdr (symbol-value ref-dep)) ! (list (symbol-value id-dep)))) ! (set ref-dep (list nil (symbol-value id-dep)))) ! (setq headers (cons header headers))) ! (goto-char (point-max)) ! (widen)) ! (nreverse headers))))) ;; The following macros and functions were written by Felix Lee ! ;; . (defmacro gnus-nov-read-integer () *************** The resulting hash table is returned, or *** 7330,7334 **** ;; Goes through the xover lines and returns a list of vectors ! (defun gnus-get-newsgroup-headers-xover (sequence) "Parse the news overview data in the server buffer, and return a list of headers that match SEQUENCE (see `nntp-retrieve-headers')." --- 9435,9440 ---- ;; Goes through the xover lines and returns a list of vectors ! (defun gnus-get-newsgroup-headers-xover (sequence &optional ! force-new dependencies) "Parse the news overview data in the server buffer, and return a list of headers that match SEQUENCE (see `nntp-retrieve-headers')." *************** list of headers that match SEQUENCE (see *** 7337,7341 **** (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) (let ((cur nntp-server-buffer) ! (dependencies gnus-newsgroup-dependencies) number headers header) (save-excursion --- 9443,9447 ---- (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) (let ((cur nntp-server-buffer) ! (dependencies (or dependencies gnus-newsgroup-dependencies)) number headers header) (save-excursion *************** list of headers that match SEQUENCE (see *** 7348,7357 **** (while (and sequence (< (car sequence) number)) (setq sequence (cdr sequence))) ! (and sequence (eq number (car sequence)) (progn (setq sequence (cdr sequence)) ! (if (setq header ! (inline (gnus-nov-parse-line number dependencies))) (setq headers (cons header headers))))) (forward-line 1)) --- 9454,9464 ---- (while (and sequence (< (car sequence) number)) (setq sequence (cdr sequence))) ! (and sequence (eq number (car sequence)) (progn (setq sequence (cdr sequence)) ! (if (setq header ! (inline (gnus-nov-parse-line ! number dependencies force-new))) (setq headers (cons header headers))))) (forward-line 1)) *************** list of headers that match SEQUENCE (see *** 7361,7369 **** ;; This function has to be called with point after the article number ;; on the beginning of the line. ! (defun gnus-nov-parse-line (number dependencies) (let ((none 0) ! (eol (gnus-point-at-eol)) (buffer (current-buffer)) ! header ref id dep) ;; overview: [num subject from date id refs chars lines misc] --- 9468,9476 ---- ;; This function has to be called with point after the article number ;; on the beginning of the line. ! (defun gnus-nov-parse-line (number dependencies &optional force-new) (let ((none 0) ! (eol (gnus-point-at-eol)) (buffer (current-buffer)) ! header ref id id-dep ref-dep) ;; overview: [num subject from date id refs chars lines misc] *************** list of headers that match SEQUENCE (see *** 7373,7384 **** (condition-case nil (setq header ! (vector number ; number ! (gnus-nov-field) ; subject ! (gnus-nov-field) ; from (gnus-nov-field) ; date (setq id (or (gnus-nov-field) (concat "none+" ! (int-to-string (setq none (1+ none)))))) ; id (progn --- 9480,9491 ---- (condition-case nil (setq header ! (vector number ; number ! (gnus-nov-field) ; subject ! (gnus-nov-field) ; from (gnus-nov-field) ; date (setq id (or (gnus-nov-field) (concat "none+" ! (int-to-string (setq none (1+ none)))))) ; id (progn *************** list of headers that match SEQUENCE (see *** 7387,7397 **** (search-forward "\t" eol) (if (search-backward ">" beg t) ! (setq ref ! (downcase ! (buffer-substring ! (1+ (point)) ! (progn ! (search-backward "<" beg t) ! (point))))) (setq ref nil)))) (gnus-nov-field)) ; refs --- 9494,9501 ---- (search-forward "\t" eol) (if (search-backward ">" beg t) ! (setq ref ! (buffer-substring ! (1+ (point)) ! (search-backward "<" beg t))) (setq ref nil)))) (gnus-nov-field)) ; refs *************** list of headers that match SEQUENCE (see *** 7402,7408 **** (gnus-nov-field)) ; misc )) ! (error (progn ! (ding) ! (message "Strange nov line.") (setq header nil) (goto-char eol)))) --- 9506,9511 ---- (gnus-nov-field)) ; misc )) ! (error (progn ! (gnus-error 4 "Strange nov line") (setq header nil) (goto-char eol)))) *************** list of headers that match SEQUENCE (see *** 7411,7436 **** ;; We build the thread tree. ! (and header ! (if (boundp (setq dep (intern (downcase id) dependencies))) ! (if (car (symbol-value dep)) ! ;; 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. ! (progn ! (mail-header-set-xref ! (car (symbol-value dep)) ! (concat (or (mail-header-xref (car (symbol-value dep))) "") ! (or (mail-header-xref header) ""))) ! (setq header nil)) ! (setcar (symbol-value dep) header)) ! (set dep (list header)))) ! (if header ! (progn ! (if (boundp (setq dep (intern (or ref "none") ! dependencies))) ! (setcdr (symbol-value dep) ! (cons header (cdr (symbol-value dep)))) ! (set dep (list nil header))))) header)) --- 9514,9540 ---- ;; We build the thread tree. ! (when header ! (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. ! (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)) ! (setcar (symbol-value id-dep) header)) ! (set id-dep (list header)))) ! (when header ! (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) ! (setcdr (symbol-value ref-dep) ! (nconc (cdr (symbol-value ref-dep)) ! (list (symbol-value id-dep)))) ! (set ref-dep (list nil (symbol-value id-dep))))) header)) *************** This is meant to be called in `gnus-arti *** 7447,7451 **** xref) (save-restriction ! (gnus-narrow-to-headers) (goto-char (point-min)) (if (or (and (eq (downcase (following-char)) ?x) --- 9551,9555 ---- xref) (save-restriction ! (nnheader-narrow-to-headers) (goto-char (point-min)) (if (or (and (eq (downcase (following-char)) ?x) *************** This is meant to be called in `gnus-arti *** 7454,7534 **** (progn (goto-char (1+ (match-end 0))) ! (setq xref (buffer-substring (point) (progn (end-of-line) (point)))) (mail-header-set-xref headers xref)))))))) ! (defalias 'gnus-find-header-by-number 'gnus-get-header-by-number) ! (make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number) ! ! (defun gnus-make-headers-hashtable-by-number () ! "Make hashtable for the variable gnus-newsgroup-headers by number." ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((headers gnus-newsgroup-headers) ! header) ! (setq gnus-newsgroup-headers-hashtb-by-number ! (gnus-make-hashtable (length headers))) ! (while headers ! (setq header (car headers)) ! (gnus-sethash (int-to-string (mail-header-number header)) ! header gnus-newsgroup-headers-hashtb-by-number) ! (setq headers (cdr headers)))))) ! ! (defun gnus-more-header-backward () ! "Find new header backward." ! (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) ! (artnum gnus-newsgroup-begin) ! (header nil)) ! (while (and (not header) ! (> artnum first)) ! (setq artnum (1- artnum)) ! (setq header (gnus-read-header artnum))) ! header)) ! ! (defun gnus-more-header-forward (&optional backward) ! "Find new header forward. ! If BACKWARD, find new header backward instead." ! (if backward ! (gnus-more-header-backward) ! (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) ! (artnum gnus-newsgroup-end) ! (header nil)) ! (while (and (not header) ! (< artnum last)) ! (setq artnum (1+ artnum)) ! (setq header (gnus-read-header artnum))) ! header))) ! ! (defun gnus-extend-newsgroup (header &optional backward) ! "Extend newsgroup selection with HEADER. ! Optional argument BACKWARD means extend toward backward." ! (if header ! (let ((artnum (mail-header-number header))) ! (setq gnus-newsgroup-headers ! (if backward ! (cons header gnus-newsgroup-headers) ! (nconc gnus-newsgroup-headers (list header)))) ! (setq gnus-newsgroup-unselected ! (delq artnum gnus-newsgroup-unselected)) ! (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum)) ! (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))))) (defun gnus-summary-work-articles (n) ! "Return a list of articles to be worked upon. The prefix argument, the list of process marked articles, and the current article will be taken into consideration." ! (let (articles) ! (if (and n (numberp n)) ! (let ((backward (< n 0)) ! (n (abs n))) ! (save-excursion ! (while (and (> n 0) ! (setq articles (cons (gnus-summary-article-number) ! articles)) ! (gnus-summary-search-forward nil nil backward)) ! (setq n (1- n)))) ! (sort articles (function <))) ! (or (reverse gnus-newsgroup-processable) ! (list (gnus-summary-article-number)))))) (defun gnus-summary-search-group (&optional backward use-level) --- 9558,9645 ---- (progn (goto-char (1+ (match-end 0))) ! (setq xref (buffer-substring (point) (progn (end-of-line) (point)))) (mail-header-set-xref headers xref)))))))) ! (defun gnus-summary-insert-subject (id &optional old-header use-old-header) ! "Find article ID and insert the summary line for that article." ! (let ((header (if (and old-header use-old-header) ! old-header (gnus-read-header id))) ! (number (and (numberp id) id)) ! pos) ! (when header ! ;; Rebuild the thread that this article is part of and go to the ! ;; article we have fetched. ! (when (and (not gnus-show-threads) ! old-header) ! (when (setq pos (text-property-any ! (point-min) (point-max) 'gnus-number ! (mail-header-number old-header))) ! (goto-char pos) ! (gnus-delete-line) ! (gnus-data-remove (mail-header-number old-header)))) ! (when old-header ! (mail-header-set-number header (mail-header-number old-header))) ! (setq gnus-newsgroup-sparse ! (delq (setq number (mail-header-number header)) ! gnus-newsgroup-sparse)) ! (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) ! (gnus-rebuild-thread (mail-header-id header)) ! (gnus-summary-goto-subject number nil t)) ! (when (and (numberp number) ! (> number 0)) ! ;; We have to update the boundaries even if we can't fetch the ! ;; article if ID is a number -- so that the next `P' or `N' ! ;; command will fetch the previous (or next) article even ! ;; if the one we tried to fetch this time has been canceled. ! (and (> number gnus-newsgroup-end) ! (setq gnus-newsgroup-end number)) ! (and (< number gnus-newsgroup-begin) ! (setq gnus-newsgroup-begin number)) ! (setq gnus-newsgroup-unselected ! (delq number gnus-newsgroup-unselected))) ! ;; Report back a success? ! (and header (mail-header-number header)))) (defun gnus-summary-work-articles (n) ! "Return a list of articles to be worked upon. The prefix argument, the list of process marked articles, and the current article will be taken into consideration." ! (cond ! (n ! ;; A numerical prefix has been given. ! (let ((backward (< n 0)) ! (n (abs (prefix-numeric-value n))) ! articles article) ! (save-excursion ! (while ! (and (> n 0) ! (push (setq article (gnus-summary-article-number)) ! articles) ! (if backward ! (gnus-summary-find-prev nil article) ! (gnus-summary-find-next nil article))) ! (decf n))) ! (nreverse articles))) ! ((and (boundp 'transient-mark-mode) ! transient-mark-mode ! mark-active) ! ;; Work on the region between point and mark. ! (let ((max (max (point) (mark))) ! articles article) ! (save-excursion ! (goto-char (min (point) (mark))) ! (while ! (and ! (push (setq article (gnus-summary-article-number)) articles) ! (gnus-summary-find-next nil article) ! (< (point) max))) ! (nreverse articles)))) ! (gnus-newsgroup-processable ! ;; There are process-marked articles present. ! (reverse gnus-newsgroup-processable)) ! (t ! ;; Just return the current article. ! (list (gnus-summary-article-number))))) (defun gnus-summary-search-group (&optional backward use-level) *************** If optional argument BACKWARD is non-nil *** 7537,7541 **** (save-excursion (set-buffer gnus-group-buffer) ! (if (gnus-group-search-forward backward nil (if use-level (gnus-group-group-level) nil)) (gnus-group-group-name)))) --- 9648,9652 ---- (save-excursion (set-buffer gnus-group-buffer) ! (if (gnus-group-search-forward backward nil (if use-level (gnus-group-group-level) nil)) (gnus-group-group-name)))) *************** If EXCLUDE-GROUP, do not go to this grou *** 7549,7624 **** (gnus-group-best-unread-group exclude-group)))) ! (defun gnus-subject-equal (s1 s2) ! (cond ! ((null gnus-summary-gather-subject-limit) ! (equal (gnus-simplify-subject-re s1) ! (gnus-simplify-subject-re s2))) ! ((eq gnus-summary-gather-subject-limit 'fuzzy) ! (equal (gnus-simplify-subject-fuzzy s1) ! (gnus-simplify-subject-fuzzy s2))) ! ((numberp gnus-summary-gather-subject-limit) ! (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit) ! (gnus-limit-string s2 gnus-summary-gather-subject-limit))) ! (t ! (equal s1 s2)))) ! ! (defun gnus-summary-search-subject (&optional backward unread subject) ! "Search for article forward. ! If BACKWARD is non-nil, search backward. ! If UNREAD is non-nil, only unread articles are selected. ! If SUBJECT is non-nil, the article which has the same subject will be ! searched for." ! (let ((func (if backward 'previous-single-property-change ! 'next-single-property-change)) ! (beg (point)) ! (did t) ! pos psubject) ! (beginning-of-line) ! (and gnus-summary-check-current unread ! (eq (get-text-property (point) 'gnus-mark) gnus-unread-mark) ! (setq did nil)) ! (if (not did) ! () ! (forward-char (if backward (if (bobp) 0 -1) (if (eobp) 0 1))) ! (while ! (and ! (setq pos (funcall func (point) 'gnus-number)) ! (goto-char (if backward (1- pos) pos)) ! (setq did ! (not (and ! (or (not unread) ! (eq (get-text-property (point) 'gnus-mark) ! gnus-unread-mark)) ! (or (not subject) ! (and (setq psubject ! (inline (gnus-summary-subject-string))) ! (inline ! (gnus-subject-equal subject psubject))))))) ! (if backward (if (bobp) nil (forward-char -1) t) ! (if (eobp) nil (forward-char 1) t))))) ! (if did ! (progn (goto-char beg) nil) ! (prog1 ! (get-text-property (point) 'gnus-number) ! (gnus-summary-show-thread) ! (gnus-summary-position-cursor))))) ! ! (defun gnus-summary-pseudo-article () ! "The thread level of the article on the current line." ! (get-text-property (gnus-point-at-bol) 'gnus-pseudo)) ! ! (defalias 'gnus-summary-score 'gnus-summary-article-score) ! (make-obsolete 'gnus-summary-score 'gnus-summary-article-score) ! (defun gnus-summary-article-score () ! "Return current article score." ! (or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored)) ! gnus-summary-default-score 0)) (defun gnus-summary-recenter () "Center point in the summary window. If `gnus-auto-center-summary' is nil, or the article buffer isn't ! displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ! ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) --- 9660,9757 ---- (gnus-group-best-unread-group exclude-group)))) ! (defun gnus-summary-find-next (&optional unread article backward) ! (if backward (gnus-summary-find-prev) ! (let* ((dummy (gnus-summary-article-intangible-p)) ! (article (or article (gnus-summary-article-number))) ! (arts (gnus-data-find-list article)) ! result) ! (when (and (not dummy) ! (or (not gnus-summary-check-current) ! (not unread) ! (not (gnus-data-unread-p (car arts))))) ! (setq arts (cdr arts))) ! (when (setq result ! (if unread ! (progn ! (while arts ! (when (gnus-data-unread-p (car arts)) ! (setq result (car arts) ! arts nil)) ! (setq arts (cdr arts))) ! result) ! (car arts))) ! (goto-char (gnus-data-pos result)) ! (gnus-data-number result))))) ! ! (defun gnus-summary-find-prev (&optional unread article) ! (let* ((eobp (eobp)) ! (article (or article (gnus-summary-article-number))) ! (arts (gnus-data-find-list article (gnus-data-list 'rev))) ! result) ! (when (and (not eobp) ! (or (not gnus-summary-check-current) ! (not unread) ! (not (gnus-data-unread-p (car arts))))) ! (setq arts (cdr arts))) ! (if (setq result ! (if unread ! (progn ! (while arts ! (and (gnus-data-unread-p (car arts)) ! (setq result (car arts) ! arts nil)) ! (setq arts (cdr arts))) ! result) ! (car arts))) ! (progn ! (goto-char (gnus-data-pos result)) ! (gnus-data-number result))))) ! ! (defun gnus-summary-find-subject (subject &optional unread backward article) ! (let* ((simp-subject (gnus-simplify-subject-fully subject)) ! (article (or article (gnus-summary-article-number))) ! (articles (gnus-data-list backward)) ! (arts (gnus-data-find-list article articles)) ! result) ! (when (or (not gnus-summary-check-current) ! (not unread) ! (not (gnus-data-unread-p (car arts)))) ! (setq arts (cdr arts))) ! (while arts ! (and (or (not unread) ! (gnus-data-unread-p (car arts))) ! (vectorp (gnus-data-header (car arts))) ! (gnus-subject-equal ! simp-subject (mail-header-subject (gnus-data-header (car arts))) t) ! (setq result (car arts) ! arts nil)) ! (setq arts (cdr arts))) ! (and result ! (goto-char (gnus-data-pos result)) ! (gnus-data-number result)))) ! ! (defun gnus-summary-search-forward (&optional unread subject backward) ! "Search forward for an article. ! If UNREAD, look for unread articles. If SUBJECT, look for ! articles with that subject. If BACKWARD, search backward instead." ! (cond (subject (gnus-summary-find-subject subject unread backward)) ! (backward (gnus-summary-find-prev unread)) ! (t (gnus-summary-find-next unread)))) ! ! (defun gnus-recenter (&optional n) ! "Center point in window and redisplay frame. ! Also do horizontal recentering." ! (interactive "P") ! (when (and gnus-auto-center-summary ! (not (eq gnus-auto-center-summary 'vertical))) ! (gnus-horizontal-recenter)) ! (recenter n)) (defun gnus-summary-recenter () "Center point in the summary window. If `gnus-auto-center-summary' is nil, or the article buffer isn't ! displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ! ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) *************** displayed, no centering will be performe *** 7629,7647 **** (point))) (window (get-buffer-window (current-buffer)))) ! (and ! ;; The user has to want it, ! gnus-auto-center-summary ! ;; the article buffer must be displayed, ! (get-buffer-window gnus-article-buffer) ! ;; Set the window start to either `bottom', which is the biggest ! ;; possible valid number, or the second line from the top, ! ;; whichever is the least. ! (set-window-start ! window (min bottom (save-excursion (forward-line (- top)) (point))))))) ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." ! (let* ((name "") (foreign "") (depth -1) (skip 1) (levels (or levels (progn --- 9762,9815 ---- (point))) (window (get-buffer-window (current-buffer)))) ! ;; The user has to want it. ! (when gnus-auto-center-summary ! (when (get-buffer-window gnus-article-buffer) ! ;; Only do recentering when the article buffer is displayed, ! ;; Set the window start to either `bottom', which is the biggest ! ;; possible valid number, or the second line from the top, ! ;; whichever is the least. ! (set-window-start ! 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) ! (not (eq gnus-auto-center-summary 'vertical))) ! (let ((selected (selected-window))) ! (select-window (get-buffer-window (current-buffer) t)) ! (gnus-summary-position-point) ! (gnus-horizontal-recenter) ! (select-window selected)))))) ! ! (defun gnus-horizontal-recenter () ! "Recenter the current buffer horizontally." ! (if (< (current-column) (/ (window-width) 2)) ! (set-window-hscroll (get-buffer-window (current-buffer) t) 0) ! (let* ((orig (point)) ! (end (window-end (get-buffer-window (current-buffer) t))) ! (max 0)) ! ;; Find the longest line currently displayed in the window. ! (goto-char (window-start)) ! (while (and (not (eobp)) ! (< (point) end)) ! (end-of-line) ! (setq max (max max (current-column))) ! (forward-line 1)) ! (goto-char orig) ! ;; Scroll horizontally to center (sort of) the point. ! (if (> max (window-width)) ! (set-window-hscroll ! (get-buffer-window (current-buffer) t) ! (min (- (current-column) (/ (window-width) 3)) ! (+ 2 (- max (window-width))))) ! (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) ! max))) ;; Function written by Stainless Steel Rat . (defun gnus-short-group-name (group &optional levels) "Collapse GROUP name LEVELS." ! (let* ((name "") ! (foreign "") ! (depth 0) ! (skip 1) (levels (or levels (progn *************** displayed, no centering will be performe *** 7654,7658 **** group (substring group (match-end 0)))) (while group ! (if (and (string-match "\\." group) (> levels 0)) (setq name (concat name (substring group 0 1)) group (substring group (match-end 0)) --- 9822,9827 ---- group (substring group (match-end 0)))) (while group ! (if (and (string-match "\\." group) ! (> levels (- gnus-group-uncollapsed-levels 1))) (setq name (concat name (substring group 0 1)) group (substring group (match-end 0)) *************** displayed, no centering will be performe *** 7683,7711 **** ;; the range of active articles. (defun gnus-list-of-unread-articles (group) ! (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) ! (active (gnus-gethash group gnus-active-hashtb)) (last (cdr active)) first nlast unread) ! ;; If none are read, then all are unread. (if (not read) (setq first (car active)) ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ! ;; article. Sounds logical, doesn't it? (if (not (listp (cdr read))) (setq first (1+ (cdr read))) ;; `read' is a list of ranges. ! (if (/= (setq nlast (or (and (numberp (car read)) (car read)) ! (car (car read)))) 1) (setq first 1)) (while read ! (if first (while (< first nlast) (setq unread (cons first unread)) (setq first (1+ first)))) ! (setq first (1+ (if (atom (car read)) (car read) (cdr (car read))))) ! (setq nlast (if (atom (car (cdr read))) ! (car (cdr read)) ! (car (car (cdr read))))) (setq read (cdr read))))) ;; And add the last unread articles. --- 9852,9878 ---- ;; the range of active articles. (defun gnus-list-of-unread-articles (group) ! (let* ((read (gnus-info-read (gnus-get-info group))) ! (active (gnus-active group)) (last (cdr active)) first nlast unread) ! ;; If none are read, then all are unread. (if (not read) (setq first (car active)) ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ! ;; article. Sounds logical, doesn't it? (if (not (listp (cdr read))) (setq first (1+ (cdr read))) ;; `read' is a list of ranges. ! (if (/= (setq nlast (or (and (numberp (car read)) (car read)) ! (caar read))) 1) (setq first 1)) (while read ! (if first (while (< first nlast) (setq unread (cons first unread)) (setq first (1+ first)))) ! (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) ! (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) (setq read (cdr read))))) ;; And add the last unread articles. *************** displayed, no centering will be performe *** 7717,7743 **** (defun gnus-list-of-read-articles (group) ! (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) ! (active (gnus-gethash group gnus-active-hashtb))) (and info active ! (gnus-sorted-complement ! (gnus-uncompress-range active) ! (gnus-list-of-unread-articles group))))) ;; Various summary commands ! (defun gnus-summary-universal-argument () ! "Perform any operation on all articles marked with the process mark." ! (interactive) (gnus-set-global-variables) ! (let ((articles (reverse gnus-newsgroup-processable)) ! func) ! (or articles (error "No articles marked")) ! (or (setq func (key-binding (read-key-sequence "C-c C-u"))) ! (error "Undefined key")) ! (while articles ! (gnus-summary-goto-subject (car articles)) ! (command-execute func) ! (gnus-summary-remove-process-mark (car articles)) ! (setq articles (cdr articles))))) (defun gnus-summary-toggle-truncation (&optional arg) --- 9884,9924 ---- (defun gnus-list-of-read-articles (group) ! "Return a list of unread, unticked and non-dormant articles." ! (let* ((info (gnus-get-info group)) ! (marked (gnus-info-marks info)) ! (active (gnus-active group))) (and info active ! (gnus-set-difference ! (gnus-sorted-complement ! (gnus-uncompress-range active) ! (gnus-list-of-unread-articles group)) ! (append ! (gnus-uncompress-range (cdr (assq 'dormant marked))) ! (gnus-uncompress-range (cdr (assq 'tick marked)))))))) ;; Various summary commands ! (defun gnus-summary-universal-argument (arg) ! "Perform any operation on all articles that are process/prefixed." ! (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles arg)) ! func article) ! (if (eq ! (setq ! func ! (key-binding ! (read-key-sequence ! (substitute-command-keys ! "\\\\[gnus-summary-universal-argument]" ! )))) ! 'undefined) ! (gnus-error 1 "Undefined key") ! (save-excursion ! (while articles ! (gnus-summary-goto-subject (setq article (pop articles))) ! (command-execute func) ! (gnus-summary-remove-process-mark article))))) ! (gnus-summary-position-point)) (defun gnus-summary-toggle-truncation (&optional arg) *************** With arg, turn line truncation on iff ar *** 7750,7821 **** (redraw-display)) ! (defun gnus-summary-reselect-current-group (&optional all) ! "Once exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (gnus-set-global-variables) (let ((current-subject (gnus-summary-article-number)) (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) ! (gnus-summary-exit t) ;; We have to adjust the point of group mode buffer because the ;; current point was moved to the next unread newsgroup by ;; exiting. (gnus-summary-jump-to-group group) (gnus-group-read-group all t) ! (gnus-summary-goto-subject current-subject))) (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") ! (gnus-set-global-variables) ! ;; Fix by Ilja Weis . ! (let ((group gnus-newsgroup-name)) ! (gnus-summary-exit) ! (gnus-summary-jump-to-group group) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-get-new-news-this-group 1)) ! (gnus-summary-jump-to-group group) ! (gnus-group-read-group all))) (defun gnus-summary-update-info () (let* ((group gnus-newsgroup-name)) ! (if gnus-newsgroup-kill-headers ! (setq gnus-newsgroup-killed ! (gnus-compress-sequence ! (nconc ! (gnus-set-sorted-intersection ! (gnus-uncompress-range gnus-newsgroup-killed) ! (setq gnus-newsgroup-unselected ! (sort gnus-newsgroup-unselected '<))) ! (setq gnus-newsgroup-unreads ! (sort gnus-newsgroup-unreads '<))) t))) ! (or (listp (cdr gnus-newsgroup-killed)) ! (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers)) - (gnus-close-group group) (run-hooks 'gnus-exit-group-hook) ! (gnus-update-read-articles ! group gnus-newsgroup-unreads gnus-newsgroup-unselected ! gnus-newsgroup-marked ! t gnus-newsgroup-replied gnus-newsgroup-expirable ! gnus-newsgroup-killed gnus-newsgroup-dormant ! gnus-newsgroup-bookmarks ! (and gnus-save-score gnus-newsgroup-scored)) ! (and gnus-use-cross-reference ! (gnus-mark-xrefs-as-read ! group headers gnus-newsgroup-unreads gnus-newsgroup-expirable)) ;; Do adaptive scoring, and possibly save score files. ! (and gnus-newsgroup-adaptive ! (gnus-score-adaptive)) ! (and gnus-use-scoring ! (fboundp 'gnus-score-save) ! (funcall 'gnus-score-save)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group))))) ! (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. --- 9931,9996 ---- (redraw-display)) ! (defun gnus-summary-reselect-current-group (&optional all rescan) ! "Exit and then reselect the current newsgroup. The prefix argument ALL means to select all articles." (interactive "P") (gnus-set-global-variables) + (when (gnus-ephemeral-group-p gnus-newsgroup-name) + (error "Ephemeral groups can't be reselected")) (let ((current-subject (gnus-summary-article-number)) (group gnus-newsgroup-name)) (setq gnus-newsgroup-begin nil) ! (gnus-summary-exit) ;; We have to adjust the point of group mode buffer because the ;; current point was moved to the next unread newsgroup by ;; exiting. (gnus-summary-jump-to-group group) + (when rescan + (save-excursion + (gnus-group-get-new-news-this-group 1))) (gnus-group-read-group all t) ! (gnus-summary-goto-subject current-subject nil t))) (defun gnus-summary-rescan-group (&optional all) "Exit the newsgroup, ask for new articles, and select the newsgroup." (interactive "P") ! (gnus-summary-reselect-current-group all t)) (defun gnus-summary-update-info () (let* ((group gnus-newsgroup-name)) ! (when gnus-newsgroup-kill-headers ! (setq gnus-newsgroup-killed ! (gnus-compress-sequence ! (nconc ! (gnus-set-sorted-intersection ! (gnus-uncompress-range gnus-newsgroup-killed) ! (setq gnus-newsgroup-unselected ! (sort gnus-newsgroup-unselected '<))) ! (setq gnus-newsgroup-unreads ! (sort gnus-newsgroup-unreads '<))) t))) ! (unless (listp (cdr gnus-newsgroup-killed)) ! (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) (let ((headers gnus-newsgroup-headers)) (run-hooks 'gnus-exit-group-hook) ! (unless gnus-save-score ! (setq gnus-newsgroup-scored nil)) ! ;; Set the new ranges of read articles. ! (gnus-update-read-articles ! group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ! ;; Set the current article marks. ! (gnus-update-marks) ! ;; Do the cross-ref thing. ! (when gnus-use-cross-reference ! (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) ;; Do adaptive scoring, and possibly save score files. ! (when gnus-newsgroup-adaptive ! (gnus-score-adaptive)) ! (when gnus-use-scoring ! (gnus-score-save)) ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) (or (gnus-ephemeral-group-p gnus-newsgroup-name) (gnus-group-update-group group))))) ! (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. *************** gnus-exit-group-hook is called with no a *** 7829,7865 **** (buf (current-buffer))) (run-hooks 'gnus-summary-prepare-exit-hook) ;; Make all changes in this group permanent. ! (gnus-summary-update-info) ! (set-buffer buf) ! (and gnus-use-cache (gnus-cache-possibly-remove-articles)) ;; Make sure where I was, and go to next newsgroup. (set-buffer gnus-group-buffer) ! (or quit-config ! (progn ! (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1))) (if temporary nil ;Nothing to do. ! ;; We set all buffer-local variables to nil. It is unclear why ! ;; this is needed, but if we don't, buffer-local variables are ! ;; not garbage-collected, it seems. This would the lead to en ! ;; ever-growing Emacs. (set-buffer buf) ! (gnus-summary-clear-local-variables) ! ;; We clear the global counterparts of the buffer-local ! ;; variables as well, just to be on the safe side. ! (gnus-configure-windows 'group 'force) ! (gnus-summary-clear-local-variables) ! ;; Return to group mode buffer. ! (if (eq mode 'gnus-summary-mode) ! (gnus-kill-buffer buf)) ! (if (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) (if (not quit-config) (progn (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) --- 10004,10059 ---- (buf (current-buffer))) (run-hooks 'gnus-summary-prepare-exit-hook) + ;; If we have several article buffers, we kill them at exit. + (unless gnus-single-article-buffer + (gnus-kill-buffer gnus-original-article-buffer) + (setq gnus-article-current nil)) + (when gnus-use-cache + (gnus-cache-possibly-remove-articles) + (gnus-cache-save-buffers)) + (when gnus-use-trees + (gnus-tree-close group)) ;; Make all changes in this group permanent. ! (unless quit-config ! (gnus-summary-update-info)) ! (gnus-close-group group) ;; Make sure where I was, and go to next newsgroup. (set-buffer gnus-group-buffer) ! (unless quit-config ! (gnus-group-jump-to-group group)) ! (run-hooks 'gnus-summary-exit-hook) ! (unless quit-config ! (gnus-group-next-unread-group 1)) (if temporary nil ;Nothing to do. ! ;; If we have several article buffers, we kill them at exit. ! (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-article-buffer) ! (gnus-kill-buffer gnus-original-article-buffer) ! (setq gnus-article-current nil)) (set-buffer buf) ! (if (not gnus-kill-summary-on-exit) ! (gnus-deaden-summary) ! ;; We set all buffer-local variables to nil. It is unclear why ! ;; this is needed, but if we don't, buffer-local variables are ! ;; not garbage-collected, it seems. This would the lead to en ! ;; ever-growing Emacs. ! (gnus-summary-clear-local-variables) ! (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) + ;; We clear the global counterparts of the buffer-local + ;; variables as well, just to be on the safe side. + (gnus-configure-windows 'group 'force) + (gnus-summary-clear-local-variables) + ;; Return to group mode buffer. + (if (eq mode 'gnus-summary-mode) + (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) + ;; Clear the current group name. (if (not quit-config) (progn (gnus-group-jump-to-group group) ! (gnus-group-next-unread-group 1) ! (gnus-configure-windows 'group 'force)) (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) *************** gnus-exit-group-hook is called with no a *** 7868,7872 **** (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) ! (run-hooks 'gnus-summary-exit-hook)))) (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) --- 10062,10067 ---- (gnus-set-global-variables)) (gnus-configure-windows (cdr quit-config)))) ! (unless quit-config ! (setq gnus-newsgroup-name nil))))) (defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) *************** gnus-exit-group-hook is called with no a *** 7874,7911 **** "Quit reading current newsgroup without updating read article info." (interactive) ! (gnus-set-global-variables) ! (let* ((group gnus-newsgroup-name) ! (quit-config (gnus-group-quit-config group))) ! (if (or no-questions ! gnus-expert-user ! (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) ! (progn ! (gnus-close-group group) ! (gnus-summary-clear-local-variables) ! (set-buffer gnus-group-buffer) ! (gnus-summary-clear-local-variables) ! ;; Return to group selection mode. ! (gnus-configure-windows 'group 'force) ! (if (get-buffer gnus-summary-buffer) ! (kill-buffer gnus-summary-buffer)) ! (if (get-buffer gnus-article-buffer) ! (bury-buffer gnus-article-buffer)) ! (if (equal (gnus-group-group-name) group) ! (gnus-group-next-unread-group 1)) ! (if quit-config ! (progn ! (if (not (buffer-name (car quit-config))) ! (gnus-configure-windows 'group 'force) ! (set-buffer (car quit-config)) ! (and (eq major-mode 'gnus-summary-mode) ! (gnus-set-global-variables)) ! (gnus-configure-windows (cdr quit-config))))))))) ;; Suggested by Andrew Eskilsson . ! (defun gnus-summary-fetch-faq (group) ! "Fetch the FAQ for the current group." ! (interactive (list gnus-newsgroup-name)) (let (gnus-faq-buffer) ! (and (setq gnus-faq-buffer (gnus-group-fetch-faq group)) (gnus-configure-windows 'summary-faq)))) --- 10069,10209 ---- "Quit reading current newsgroup without updating read article info." (interactive) ! (gnus-set-global-variables) ! (let* ((group gnus-newsgroup-name) ! (quit-config (gnus-group-quit-config group))) ! (when (or no-questions ! gnus-expert-user ! (gnus-y-or-n-p "Do you really wanna quit reading this group? ")) ! ;; If we have several article buffers, we kill them at exit. ! (unless gnus-single-article-buffer ! (gnus-kill-buffer gnus-article-buffer) ! (gnus-kill-buffer gnus-original-article-buffer) ! (setq gnus-article-current nil)) ! (if (not gnus-kill-summary-on-exit) ! (gnus-deaden-summary) ! (gnus-close-group group) ! (gnus-summary-clear-local-variables) ! (set-buffer gnus-group-buffer) ! (gnus-summary-clear-local-variables) ! (when (get-buffer gnus-summary-buffer) ! (kill-buffer gnus-summary-buffer))) ! (unless gnus-single-article-buffer ! (setq gnus-article-current nil)) ! (when gnus-use-trees ! (gnus-tree-close group)) ! (when (get-buffer gnus-article-buffer) ! (bury-buffer gnus-article-buffer)) ! ;; Return to the group buffer. ! (gnus-configure-windows 'group 'force) ! ;; Clear the current group name. ! (setq gnus-newsgroup-name nil) ! (when (equal (gnus-group-group-name) group) ! (gnus-group-next-unread-group 1)) ! (when quit-config ! (if (not (buffer-name (car quit-config))) ! (gnus-configure-windows 'group 'force) ! (set-buffer (car quit-config)) ! (when (eq major-mode 'gnus-summary-mode) ! (gnus-set-global-variables)) ! (gnus-configure-windows (cdr quit-config))))))) ! ! ;;; Dead summaries. ! ! (defvar gnus-dead-summary-mode-map nil) ! ! (if gnus-dead-summary-mode-map ! nil ! (setq gnus-dead-summary-mode-map (make-keymap)) ! (suppress-keymap gnus-dead-summary-mode-map) ! (substitute-key-definition ! 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) ! (let ((keys '("\C-d" "\r" "\177"))) ! (while keys ! (define-key gnus-dead-summary-mode-map ! (pop keys) 'gnus-summary-wake-up-the-dead)))) ! ! (defvar gnus-dead-summary-mode nil ! "Minor mode for Gnus summary buffers.") ! ! (defun gnus-dead-summary-mode (&optional arg) ! "Minor mode for Gnus summary buffers." ! (interactive "P") ! (when (eq major-mode 'gnus-summary-mode) ! (make-local-variable 'gnus-dead-summary-mode) ! (setq gnus-dead-summary-mode ! (if (null arg) (not gnus-dead-summary-mode) ! (> (prefix-numeric-value arg) 0))) ! (when gnus-dead-summary-mode ! (unless (assq 'gnus-dead-summary-mode minor-mode-alist) ! (push '(gnus-dead-summary-mode " Dead") minor-mode-alist)) ! (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist) ! (push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map) ! minor-mode-map-alist))))) ! ! (defun gnus-deaden-summary () ! "Make the current summary buffer into a dead summary buffer." ! ;; Kill any previous dead summary buffer. ! (when (and gnus-dead-summary ! (buffer-name gnus-dead-summary)) ! (save-excursion ! (set-buffer gnus-dead-summary) ! (when gnus-dead-summary-mode ! (kill-buffer (current-buffer))))) ! ;; Make this the current dead summary. ! (setq gnus-dead-summary (current-buffer)) ! (gnus-dead-summary-mode 1) ! (let ((name (buffer-name))) ! (when (string-match "Summary" name) ! (rename-buffer ! (concat (substring name 0 (match-beginning 0)) "Dead " ! (substring name (match-beginning 0))) t)))) ! ! (defun gnus-kill-or-deaden-summary (buffer) ! "Kill or deaden the summary BUFFER." ! (when (and (buffer-name buffer) ! (not gnus-single-article-buffer)) ! (save-excursion ! (set-buffer buffer) ! (gnus-kill-buffer gnus-article-buffer) ! (gnus-kill-buffer gnus-original-article-buffer))) ! (cond (gnus-kill-summary-on-exit ! (when (and gnus-use-trees ! (and (get-buffer buffer) ! (buffer-name (get-buffer buffer)))) ! (save-excursion ! (set-buffer (get-buffer buffer)) ! (gnus-tree-close gnus-newsgroup-name))) ! (gnus-kill-buffer buffer)) ! ((and (get-buffer buffer) ! (buffer-name (get-buffer buffer))) ! (save-excursion ! (set-buffer buffer) ! (gnus-deaden-summary))))) ! ! (defun gnus-summary-wake-up-the-dead (&rest args) ! "Wake up the dead summary buffer." ! (interactive) ! (gnus-dead-summary-mode -1) ! (let ((name (buffer-name))) ! (when (string-match "Dead " name) ! (rename-buffer ! (concat (substring name 0 (match-beginning 0)) ! (substring name (match-end 0))) t))) ! (gnus-message 3 "This dead summary is now alive again")) ;; Suggested by Andrew Eskilsson . ! (defun gnus-summary-fetch-faq (&optional faq-dir) ! "Fetch the FAQ for the current group. ! If FAQ-DIR (the prefix), prompt for a directory to search for the faq ! in." ! (interactive ! (list ! (if current-prefix-arg ! (completing-read ! "Faq dir: " (and (listp gnus-group-faq-directory) ! gnus-group-faq-directory))))) (let (gnus-faq-buffer) ! (and (setq gnus-faq-buffer ! (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) (gnus-configure-windows 'summary-faq)))) *************** gnus-exit-group-hook is called with no a *** 7920,7924 **** (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. --- 10218,10222 ---- (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) ;; Walking around group mode buffer from summary mode. *************** gnus-exit-group-hook is called with no a *** 7927,7931 **** "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected ! initially. If NEXT-GROUP, go to this group. If BACKWARD, go to previous group instead." (interactive "P") --- 10225,10229 ---- "Exit current newsgroup and then select next unread newsgroup. If prefix argument NO-ARTICLE is non-nil, no article is selected ! initially. If NEXT-GROUP, go to this group. If BACKWARD, go to previous group instead." (interactive "P") *************** previous group instead." *** 7943,7949 **** (set-buffer gnus-group-buffer) (gnus-group-jump-to-group current-group) ! (setq target-group ! (or target-group ! (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) --- 10241,10247 ---- (set-buffer gnus-group-buffer) (gnus-group-jump-to-group current-group) ! (setq target-group ! (or target-group ! (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) (gnus-summary-search-group backward gnus-keep-same-level)))) *************** previous group instead." *** 7967,8031 **** target-group nil))))))) - (defun gnus-summary-next-group-old (&optional no-article group backward) - "Exit current newsgroup and then select next unread newsgroup. - If prefix argument NO-ARTICLE is non-nil, no article is selected initially. - If BACKWARD, go to previous group instead." - (interactive "P") - (gnus-set-global-variables) - (let ((ingroup gnus-newsgroup-name) - (sumbuf (current-buffer)) - num) - (set-buffer gnus-group-buffer) - (if (and group - (or (and (numberp (setq num (car (gnus-gethash - group gnus-newsrc-hashtb)))) - (< num 1)) - (null num))) - (progn - (gnus-group-jump-to-group group) - (setq group nil)) - (gnus-group-jump-to-group ingroup)) - (gnus-summary-search-group backward) - (let ((group (or group (gnus-summary-search-group backward)))) - (set-buffer sumbuf) - (gnus-summary-exit t) ;Update all information. - (if (null group) - (gnus-summary-exit-no-update t) - (gnus-group-jump-to-group ingroup) - (setq group (gnus-summary-search-group backward)) - (gnus-message 5 "Selecting %s..." group) - (set-buffer gnus-group-buffer) - ;; We are now in group mode buffer. - ;; Make sure group mode buffer point is on GROUP. - (gnus-group-jump-to-group group) - (if (not (eq gnus-auto-select-next 'quietly)) - (progn - (gnus-summary-read-group group nil no-article sumbuf) - (and (string= gnus-newsgroup-name ingroup) - (bufferp sumbuf) (buffer-name sumbuf) - (progn - (set-buffer (setq gnus-summary-buffer sumbuf)) - (gnus-summary-exit-no-update t)))) - (let ((prevgroup group)) - (gnus-group-jump-to-group ingroup) - (setq group (gnus-summary-search-group backward)) - (gnus-summary-read-group group nil no-article sumbuf) - (while (and (string= gnus-newsgroup-name ingroup) - (bufferp sumbuf) - (buffer-name sumbuf) - (not (string= prevgroup (gnus-group-group-name)))) - (set-buffer gnus-group-buffer) - (gnus-summary-read-group - (setq prevgroup (gnus-group-group-name)) - nil no-article sumbuf)) - (and (string= prevgroup (gnus-group-group-name)) - ;; We have reached the final group in the group - ;; buffer. - (progn - (if (buffer-name sumbuf) - (progn - (set-buffer sumbuf) - (gnus-summary-exit))))))))))) - (defun gnus-summary-prev-group (&optional no-article) "Exit current newsgroup and then select previous unread newsgroup. --- 10265,10268 ---- *************** If prefix argument NO-ARTICLE is non-nil *** 8039,8056 **** "Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. ! Returns nil if there are no unread articles." (interactive "P") (prog1 ! (cond ((not unread) ! (goto-char (point-min))) ! ((gnus-goto-char ! (text-property-any ! (point-min) (point-max) 'gnus-mark gnus-unread-mark)) ! t) ! (t ! ;; There are no unread articles. ! (gnus-message 3 "No more unread articles") ! nil)) ! (gnus-summary-position-cursor))) (defun gnus-summary-next-subject (n &optional unread dont-display) --- 10276,10306 ---- "Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. ! Returns the article selected or nil if there are no unread articles." (interactive "P") (prog1 ! (cond ! ;; Empty summary. ! ((null gnus-newsgroup-data) ! (gnus-message 3 "No articles in the group") ! nil) ! ;; Pick the first article. ! ((not unread) ! (goto-char (gnus-data-pos (car gnus-newsgroup-data))) ! (gnus-data-number (car gnus-newsgroup-data))) ! ;; No unread articles. ! ((null gnus-newsgroup-unreads) ! (gnus-message 3 "No more unread articles") ! nil) ! ;; Find the first unread article. ! (t ! (let ((data gnus-newsgroup-data)) ! (while (and data ! (not (gnus-data-unread-p (car data)))) ! (setq data (cdr data))) ! (if data ! (progn ! (goto-char (gnus-data-pos (car data))) ! (gnus-data-number (car data))))))) ! (gnus-summary-position-point))) (defun gnus-summary-next-subject (n &optional unread dont-display) *************** returned." *** 8064,8075 **** (n (abs n))) (while (and (> n 0) ! (gnus-summary-search-forward unread nil backward)) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ! (or dont-display ! (progn ! (gnus-summary-recenter) ! (gnus-summary-position-cursor))) n)) --- 10314,10326 ---- (n (abs n))) (while (and (> n 0) ! (if backward ! (gnus-summary-find-prev unread) ! (gnus-summary-find-next unread))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ! (unless dont-display ! (gnus-summary-recenter) ! (gnus-summary-position-point)) n)) *************** If optional argument UNREAD is non-nil, *** 8090,8120 **** (gnus-summary-next-subject (- n) t)) ! (defun gnus-summary-goto-subject (article) ! "Go the subject line of ARTICLE." ! (interactive ! (list ! (string-to-int ! (completing-read "Article number: " ! (mapcar ! (lambda (headers) ! (list ! (int-to-string (mail-header-number headers)))) ! gnus-newsgroup-headers) ! nil 'require-match)))) ! (or article (error "No article number")) ! (let ((b (point))) ! (if (not (gnus-goto-char (text-property-any (point-min) (point-max) ! 'gnus-number article))) ! () ! (gnus-summary-show-thread) ! ;; Skip dummy articles. ! (if (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (forward-line 1)) ! (prog1 ! (if (not (eobp)) ! article ! (goto-char b) ! nil) ! (gnus-summary-position-cursor))))) ;; Walking around summary lines with displaying articles. --- 10341,10362 ---- (gnus-summary-next-subject (- n) t)) ! (defun gnus-summary-goto-subject (article &optional force silent) ! "Go the subject line of ARTICLE. ! If FORCE, also allow jumping to articles not currently shown." ! (let ((b (point)) ! (data (gnus-data-find article))) ! ;; We read in the article if we have to. ! (and (not data) ! force ! (gnus-summary-insert-subject article (and (vectorp force) force) t) ! (setq data (gnus-data-find article))) ! (goto-char b) ! (if (not data) ! (progn ! (unless silent ! (gnus-message 3 "Can't find article %d" article)) ! nil) ! (goto-char (gnus-data-pos data)) ! article))) ;; Walking around summary lines with displaying articles. *************** Given a prefix, will force an `article' *** 8135,8152 **** nil (prog1 ! (gnus-article-prepare article all-header) ! (gnus-summary-show-thread) ! (if (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (progn ! (forward-line 1) ! (gnus-summary-position-cursor))) (run-hooks 'gnus-select-article-hook) (gnus-summary-recenter) ! (gnus-summary-goto-subject article) ;; Successfully display article. ! (gnus-summary-update-line) ! (gnus-article-set-window-start ! (cdr (assq article gnus-newsgroup-bookmarks))) ! t))) (defun gnus-summary-select-article (&optional all-headers force pseudo article) --- 10377,10393 ---- nil (prog1 ! (if gnus-summary-display-article-function ! (funcall gnus-summary-display-article-function article all-header) ! (gnus-article-prepare article all-header)) (run-hooks 'gnus-select-article-hook) + (unless (zerop gnus-current-article) + (gnus-summary-goto-subject gnus-current-article)) (gnus-summary-recenter) ! (when gnus-use-trees ! (gnus-possibly-generate-tree article) ! (gnus-highlight-selected-tree article)) ;; Successfully display article. ! (gnus-article-set-window-start ! (cdr (assq article gnus-newsgroup-bookmarks)))))) (defun gnus-summary-select-article (&optional all-headers force pseudo article) *************** non-nil, the article will be re-fetched *** 8156,8182 **** the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed." ! (and (not pseudo) (gnus-summary-pseudo-article) ! (error "This is a pseudo-article.")) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. ! did) (prog1 (save-excursion (set-buffer gnus-summary-buffer) ! (if (or (null gnus-current-article) ! (null gnus-article-current) ! (null (get-buffer gnus-article-buffer)) ! (not (eq article (cdr gnus-article-current))) ! (not (equal (car gnus-article-current) gnus-newsgroup-name)) force) ;; The requested article is different from the current article. ! (progn ! (gnus-summary-display-article article all-headers) (setq did article)) ! (if (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) ! nil)) ! (if did ! (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))))))) --- 10397,10433 ---- the article buffer. If PSEUDO is non-nil, pseudo-articles will also be displayed." ! ;; Make sure we are in the summary buffer to work around bbdb bug. ! (unless (eq major-mode 'gnus-summary-mode) ! (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. ! gnus-summary-display-article-function ! did) ! (and (not pseudo) ! (gnus-summary-article-pseudo-p article) ! (error "This is a pseudo-article.")) (prog1 (save-excursion (set-buffer gnus-summary-buffer) ! (if (or (and gnus-single-article-buffer ! (or (null gnus-current-article) ! (null gnus-article-current) ! (null (get-buffer gnus-article-buffer)) ! (not (eq article (cdr gnus-article-current))) ! (not (equal (car gnus-article-current) ! gnus-newsgroup-name)))) ! (and (not gnus-single-article-buffer) ! (or (null gnus-current-article) ! (not (eq gnus-current-article article)))) force) ;; The requested article is different from the current article. ! (prog1 ! (gnus-summary-display-article article all-headers) (setq did article)) ! (if (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) ! 'old)) ! (if did ! (gnus-article-set-window-start (cdr (assq article gnus-newsgroup-bookmarks))))))) *************** be displayed." *** 8185,8189 **** nil) ! (defun gnus-summary-next-article (&optional unread subject backward) "Select the next article. If UNREAD, only unread articles are selected. --- 10436,10440 ---- nil) ! (defun gnus-summary-next-article (&optional unread subject backward push) "Select the next article. If UNREAD, only unread articles are selected. *************** If BACKWARD, the previous article is sel *** 8192,8279 **** (interactive "P") (gnus-set-global-variables) ! (let (header) ! (cond ! ;; Is there such an article? ! ((and (gnus-summary-search-forward unread subject backward) ! (or (gnus-summary-display-article (gnus-summary-article-number)) ! (eq (gnus-summary-article-mark) gnus-canceled-mark))) ! (gnus-summary-position-cursor)) ! ;; If not, we try the first unread, if that is wanted. ! ((and subject ! gnus-auto-select-same ! (or (gnus-summary-first-unread-article) ! (eq (gnus-summary-article-mark) gnus-canceled-mark))) ! (gnus-summary-position-cursor) ! (gnus-message 6 "Wrapped")) ! ;; Try to get next/previous article not displayed in this group. ! ((and gnus-auto-extend-newsgroup ! (not unread) (not subject) ! (setq header (gnus-more-header-forward backward))) ! (gnus-extend-newsgroup header backward) ! (let ((buffer-read-only nil)) ! (goto-char (if backward (point-min) (point-max))) ! (gnus-summary-prepare-threads (list header))) ! (gnus-summary-goto-article (if backward gnus-newsgroup-begin ! gnus-newsgroup-end))) ! ;; Go to next/previous group. ! (t ! (or (gnus-ephemeral-group-p gnus-newsgroup-name) ! (gnus-summary-jump-to-group gnus-newsgroup-name)) ! (let ((cmd last-command-char) ! (group ! (if (eq gnus-keep-same-level 'best) ! (gnus-summary-best-group gnus-newsgroup-name) ! (gnus-summary-search-group backward gnus-keep-same-level)))) ! ;; For some reason, the group window gets selected. We change ! ;; it back. ! (select-window (get-buffer-window (current-buffer))) ! ;; Keep just the event type of CMD. ! ;(and (listp cmd) (setq cmd (car cmd))) ! ;; Select next unread newsgroup automagically. ! (cond ! ((not gnus-auto-select-next) ! (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ! ((eq gnus-auto-select-next 'quietly) ! ;; Select quietly. ! (if (gnus-ephemeral-group-p gnus-newsgroup-name) ! (gnus-summary-exit) ! (gnus-message 7 "No more%s articles (%s)..." ! (if unread " unread" "") ! (if group (concat "selecting " group) ! "exiting")) ! (gnus-summary-next-group nil group backward))) ! (t ! (let ((keystrokes '(?\C-n ?\C-p)) ! key) ! (while (or (null key) (memq key keystrokes)) ! (gnus-message ! 7 "No more%s articles%s" (if unread " unread" "") ! (if (and group ! (not (gnus-ephemeral-group-p gnus-newsgroup-name))) ! (format " (Type %s for %s [%s])" ! (single-key-description cmd) group ! (car (gnus-gethash group gnus-newsrc-hashtb))) ! (format " (Type %s to exit %s)" ! (single-key-description cmd) ! gnus-newsgroup-name))) ! ;; Confirm auto selection. ! (let* ((event (read-char))) ! (setq key (if (listp event) (car event) event)) ! (if (memq key keystrokes) ! (let ((obuf (current-buffer))) ! (switch-to-buffer gnus-group-buffer) ! (and group ! (gnus-group-jump-to-group group)) ! (condition-case () ! (execute-kbd-macro (char-to-string key)) ! (error (ding) nil)) ! (setq group (gnus-group-group-name)) ! (switch-to-buffer obuf))))) ! (if (equal key cmd) ! (if (or (not group) ! (gnus-ephemeral-group-p gnus-newsgroup-name)) ! (gnus-summary-exit) ! (gnus-summary-next-group nil group backward)) ! (execute-kbd-macro (char-to-string key))))))))))) (defun gnus-summary-next-unread-article () --- 10443,10545 ---- (interactive "P") (gnus-set-global-variables) ! (cond ! ;; Is there such an article? ! ((and (gnus-summary-search-forward unread subject backward) ! (or (gnus-summary-display-article (gnus-summary-article-number)) ! (eq (gnus-summary-article-mark) gnus-canceled-mark))) ! (gnus-summary-position-point)) ! ;; If not, we try the first unread, if that is wanted. ! ((and subject ! gnus-auto-select-same ! (gnus-summary-first-unread-article)) ! (gnus-summary-position-point) ! (gnus-message 6 "Wrapped")) ! ;; Try to get next/previous article not displayed in this group. ! ((and gnus-auto-extend-newsgroup ! (not unread) (not subject)) ! (gnus-summary-goto-article ! (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) ! nil t)) ! ;; Go to next/previous group. ! (t ! (or (gnus-ephemeral-group-p gnus-newsgroup-name) ! (gnus-summary-jump-to-group gnus-newsgroup-name)) ! (let ((cmd last-command-char) ! (group ! (if (eq gnus-keep-same-level 'best) ! (gnus-summary-best-group gnus-newsgroup-name) ! (gnus-summary-search-group backward gnus-keep-same-level)))) ! ;; For some reason, the group window gets selected. We change ! ;; it back. ! (select-window (get-buffer-window (current-buffer))) ! ;; Select next unread newsgroup automagically. ! (cond ! ((or (not gnus-auto-select-next) ! (not cmd)) ! (gnus-message 7 "No more%s articles" (if unread " unread" ""))) ! ((or (eq gnus-auto-select-next 'quietly) ! (and (eq gnus-auto-select-next 'slightly-quietly) ! push) ! (and (eq gnus-auto-select-next 'almost-quietly) ! (gnus-summary-last-article-p))) ! ;; Select quietly. ! (if (gnus-ephemeral-group-p gnus-newsgroup-name) ! (gnus-summary-exit) ! (gnus-message 7 "No more%s articles (%s)..." ! (if unread " unread" "") ! (if group (concat "selecting " group) ! "exiting")) ! (gnus-summary-next-group nil group backward))) ! (t ! (gnus-summary-walk-group-buffer ! gnus-newsgroup-name cmd unread backward))))))) ! ! (defun gnus-summary-walk-group-buffer (from-group cmd unread backward) ! (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) ! (?\C-p (gnus-group-prev-unread-group 1)))) ! keve key group ended) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-summary-jump-to-group from-group) ! (setq group ! (if (eq gnus-keep-same-level 'best) ! (gnus-summary-best-group gnus-newsgroup-name) ! (gnus-summary-search-group backward gnus-keep-same-level)))) ! (while (not ended) ! (gnus-message ! 5 "No more%s articles%s" (if unread " unread" "") ! (if (and group ! (not (gnus-ephemeral-group-p gnus-newsgroup-name))) ! (format " (Type %s for %s [%s])" ! (single-key-description cmd) group ! (car (gnus-gethash group gnus-newsrc-hashtb))) ! (format " (Type %s to exit %s)" ! (single-key-description cmd) ! gnus-newsgroup-name))) ! ;; Confirm auto selection. ! (setq key (car (setq keve (gnus-read-event-char)))) ! (setq ended t) ! (cond ! ((assq key keystrokes) ! (let ((obuf (current-buffer))) ! (switch-to-buffer gnus-group-buffer) ! (and group ! (gnus-group-jump-to-group group)) ! (eval (cadr (assq key keystrokes))) ! (setq group (gnus-group-group-name)) ! (switch-to-buffer obuf)) ! (setq ended nil)) ! ((equal key cmd) ! (if (or (not group) ! (gnus-ephemeral-group-p gnus-newsgroup-name)) ! (gnus-summary-exit) ! (gnus-summary-next-group nil group backward))) ! (t ! (push (cdr keve) unread-command-events)))))) ! ! (defun gnus-read-event-char () ! "Get the next event." ! (let ((event (read-event))) ! (cons (and (numberp event) event) event))) (defun gnus-summary-next-unread-article () *************** If BACKWARD, the previous article is sel *** 8281,8285 **** (interactive) (gnus-summary-next-article t (and gnus-auto-select-same ! (gnus-summary-subject-string)))) (defun gnus-summary-prev-article (&optional unread subject) --- 10547,10551 ---- (interactive) (gnus-summary-next-article t (and gnus-auto-select-same ! (gnus-summary-article-subject)))) (defun gnus-summary-prev-article (&optional unread subject) *************** If UNREAD is non-nil, only unread articl *** 8293,8305 **** (interactive) (gnus-summary-prev-article t (and gnus-auto-select-same ! (gnus-summary-subject-string)))) (defun gnus-summary-next-page (&optional lines circular) ! "Show next page of selected article. ! If end of article, select next article. ! Argument LINES specifies lines to be scrolled up. ! If CIRCULAR is non-nil, go to the start of the article instead of ! instead of selecting the next article when reaching the end of the ! current article." (interactive "P") (setq gnus-summary-buffer (current-buffer)) --- 10559,10572 ---- (interactive) (gnus-summary-prev-article t (and gnus-auto-select-same ! (gnus-summary-article-subject)))) (defun gnus-summary-next-page (&optional lines circular) ! "Show next page of the selected article. ! If at the end of the current article, select the next article. ! LINES says how many lines should be scrolled up. ! ! If CIRCULAR is non-nil, go to the start of the article instead of ! selecting the next article when reaching the end of the current ! article." (interactive "P") (setq gnus-summary-buffer (current-buffer)) *************** current article." *** 8308,8329 **** (endp nil)) (gnus-configure-windows 'article) ! (if (or (null gnus-current-article) ! (null gnus-article-current) ! (/= article (cdr gnus-article-current)) ! (not (equal (car gnus-article-current) gnus-newsgroup-name))) ! ;; Selected subject is different from current article's. ! (gnus-summary-display-article article) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (setq endp (gnus-article-next-page lines))) ! (if endp ! (cond (circular ! (gnus-summary-beginning-of-article)) ! (lines ! (gnus-message 3 "End of message")) ! ((null lines) ! (gnus-summary-next-unread-article))))) (gnus-summary-recenter) ! (gnus-summary-position-cursor))) (defun gnus-summary-prev-page (&optional lines) --- 10575,10603 ---- (endp nil)) (gnus-configure-windows 'article) ! (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) ! (if (and (eq gnus-summary-goto-unread 'never) ! (not (gnus-summary-last-article-p article))) ! (gnus-summary-next-article) ! (gnus-summary-next-unread-article)) ! (if (or (null gnus-current-article) ! (null gnus-article-current) ! (/= article (cdr gnus-article-current)) ! (not (equal (car gnus-article-current) gnus-newsgroup-name))) ! ;; Selected subject is different from current article's. ! (gnus-summary-display-article article) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (setq endp (gnus-article-next-page lines))) ! (if endp ! (cond (circular ! (gnus-summary-beginning-of-article)) ! (lines ! (gnus-message 3 "End of message")) ! ((null lines) ! (if (and (eq gnus-summary-goto-unread 'never) ! (not (gnus-summary-last-article-p article))) ! (gnus-summary-next-article) ! (gnus-summary-next-unread-article))))))) (gnus-summary-recenter) ! (gnus-summary-position-point))) (defun gnus-summary-prev-page (&optional lines) *************** Argument LINES specifies lines to be scr *** 8342,8347 **** (gnus-summary-recenter) (gnus-eval-in-buffer-window gnus-article-buffer ! (gnus-article-prev-page lines)))) ! (gnus-summary-position-cursor)) (defun gnus-summary-scroll-up (lines) --- 10616,10621 ---- (gnus-summary-recenter) (gnus-eval-in-buffer-window gnus-article-buffer ! (gnus-article-prev-page lines)))) ! (gnus-summary-position-point)) (defun gnus-summary-scroll-up (lines) *************** Argument LINES specifies lines to be scr *** 8351,8364 **** (gnus-set-global-variables) (gnus-configure-windows 'article) ! (or (gnus-summary-select-article nil nil 'pseudo) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (cond ((> lines 0) ! (if (gnus-article-next-page lines) ! (gnus-message 3 "End of message"))) ! ((< lines 0) ! (gnus-article-prev-page (- lines)))))) (gnus-summary-recenter) ! (gnus-summary-position-cursor)) (defun gnus-summary-next-same-subject () --- 10625,10638 ---- (gnus-set-global-variables) (gnus-configure-windows 'article) ! (gnus-summary-show-thread) ! (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (cond ((> lines 0) ! (if (gnus-article-next-page lines) ! (gnus-message 3 "End of message"))) ! ((< lines 0) ! (gnus-article-prev-page (- lines)))))) (gnus-summary-recenter) ! (gnus-summary-position-point)) (defun gnus-summary-next-same-subject () *************** Argument LINES specifies lines to be scr *** 8366,8370 **** (interactive) (gnus-set-global-variables) ! (gnus-summary-next-article nil (gnus-summary-subject-string))) (defun gnus-summary-prev-same-subject () --- 10640,10644 ---- (interactive) (gnus-set-global-variables) ! (gnus-summary-next-article nil (gnus-summary-article-subject))) (defun gnus-summary-prev-same-subject () *************** Argument LINES specifies lines to be scr *** 8372,8376 **** (interactive) (gnus-set-global-variables) ! (gnus-summary-prev-article nil (gnus-summary-subject-string))) (defun gnus-summary-next-unread-same-subject () --- 10646,10650 ---- (interactive) (gnus-set-global-variables) ! (gnus-summary-prev-article nil (gnus-summary-article-subject))) (defun gnus-summary-next-unread-same-subject () *************** Argument LINES specifies lines to be scr *** 8378,8382 **** (interactive) (gnus-set-global-variables) ! (gnus-summary-next-article t (gnus-summary-subject-string))) (defun gnus-summary-prev-unread-same-subject () --- 10652,10656 ---- (interactive) (gnus-set-global-variables) ! (gnus-summary-next-article t (gnus-summary-article-subject))) (defun gnus-summary-prev-unread-same-subject () *************** Argument LINES specifies lines to be scr *** 8384,8391 **** (interactive) (gnus-set-global-variables) ! (gnus-summary-prev-article t (gnus-summary-subject-string))) (defun gnus-summary-first-unread-article () ! "Select the first unread article. Return nil if there are no unread articles." (interactive) --- 10658,10665 ---- (interactive) (gnus-set-global-variables) ! (gnus-summary-prev-article t (gnus-summary-article-subject))) (defun gnus-summary-first-unread-article () ! "Select the first unread article. Return nil if there are no unread articles." (interactive) *************** Return nil if there are no unread articl *** 8397,8401 **** (gnus-summary-first-subject t) (gnus-summary-display-article (gnus-summary-article-number)))) ! (gnus-summary-position-cursor))) (defun gnus-summary-best-unread-article () --- 10671,10675 ---- (gnus-summary-first-subject t) (gnus-summary-display-article (gnus-summary-article-number)))) ! (gnus-summary-position-point))) (defun gnus-summary-best-unread-article () *************** Return nil if there are no unread articl *** 8404,8425 **** (gnus-set-global-variables) (let ((best -1000000) article score) ! (save-excursion ! (or (gnus-summary-first-subject t) (error "No unread articles")) ! (while ! (and ! (progn ! (and (> (setq score (gnus-summary-article-score)) best) ! (setq best score ! article (gnus-summary-article-number))) ! t) ! (gnus-summary-search-subject nil t)))) ! (if (not article) ! (error "No unread articles") ! (gnus-summary-goto-article article)) ! (gnus-summary-position-cursor))) ! (defun gnus-summary-goto-article (article &optional all-headers) "Fetch ARTICLE and display it if it exists. If ALL-HEADERS is non-nil, no header lines are hidden." --- 10678,10704 ---- (gnus-set-global-variables) (let ((best -1000000) + (data gnus-newsgroup-data) article score) ! (while data ! (and (gnus-data-unread-p (car data)) ! (> (setq score ! (gnus-summary-article-score (gnus-data-number (car data)))) ! best) ! (setq best score ! article (gnus-data-number (car data)))) ! (setq data (cdr data))) ! (prog1 ! (if article ! (gnus-summary-goto-article article) (error "No unread articles")) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-last-subject () ! "Go to the last displayed subject line in the group." ! (let ((article (gnus-data-number (car (gnus-data-list t))))) ! (when article ! (gnus-summary-goto-subject article)))) ! (defun gnus-summary-goto-article (article &optional all-headers force) "Fetch ARTICLE and display it if it exists. If ALL-HEADERS is non-nil, no header lines are hidden." *************** If ALL-HEADERS is non-nil, no header lin *** 8427,8440 **** (list (string-to-int ! (completing-read "Article number: " ! (mapcar (lambda (headers) ! (list (int-to-string (mail-header-number headers)))) ! gnus-newsgroup-headers) ! nil 'require-match)))) (prog1 ! (and (gnus-summary-goto-subject article) ! (gnus-summary-display-article article all-headers)) ! (gnus-summary-position-cursor))) (defun gnus-summary-goto-last-article () --- 10706,10720 ---- (list (string-to-int ! (completing-read "Article number: " ! (mapcar (lambda (number) (list (int-to-string number))) ! gnus-newsgroup-limit))) ! current-prefix-arg ! t)) (prog1 ! (if (gnus-summary-goto-subject article force) ! (gnus-summary-display-article article all-headers) ! (gnus-message 4 "Couldn't go to article %s" article) nil) ! (gnus-summary-position-point))) (defun gnus-summary-goto-last-article () *************** If ALL-HEADERS is non-nil, no header lin *** 8444,8448 **** (and gnus-last-article (gnus-summary-goto-article gnus-last-article)) ! (gnus-summary-position-cursor))) (defun gnus-summary-pop-article (number) --- 10724,10728 ---- (and gnus-last-article (gnus-summary-goto-article gnus-last-article)) ! (gnus-summary-position-point))) (defun gnus-summary-pop-article (number) *************** NUMBER articles will be popped off." *** 8456,8460 **** (gnus-summary-goto-article (car to)) (error "Article history empty"))) ! (gnus-summary-position-cursor)) ;; Summary article oriented commands --- 10736,11100 ---- (gnus-summary-goto-article (car to)) (error "Article history empty"))) ! (gnus-summary-position-point)) ! ! ;; Summary commands and functions for limiting the summary buffer. ! ! (defun gnus-summary-limit-to-articles (n) ! "Limit the summary buffer to the next N articles. ! If not given a prefix, use the process marked articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (prog1 ! (let ((articles (gnus-summary-work-articles n))) ! (setq gnus-newsgroup-processable nil) ! (gnus-summary-limit articles)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-pop-limit (&optional total) ! "Restore the previous limit. ! If given a prefix, remove all limits." ! (interactive "P") ! (gnus-set-global-variables) ! (when total ! (setq gnus-newsgroup-limits ! (list (mapcar (lambda (h) (mail-header-number h)) ! gnus-newsgroup-headers)))) ! (unless gnus-newsgroup-limits ! (error "No limit to pop")) ! (prog1 ! (gnus-summary-limit nil 'pop) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-to-subject (subject &optional header) ! "Limit the summary buffer to articles that have subjects that match a regexp." ! (interactive "sRegexp: ") ! (unless header ! (setq header "subject")) ! (when (not (equal "" subject)) ! (prog1 ! (let ((articles (gnus-summary-find-matching ! (or header "subject") subject 'all))) ! (or articles (error "Found no matches for \"%s\"" subject)) ! (gnus-summary-limit articles)) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-limit-to-author (from) ! "Limit the summary buffer to articles that have authors that match a regexp." ! (interactive "sRegexp: ") ! (gnus-summary-limit-to-subject from "from")) ! ! (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) ! (make-obsolete ! 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) ! ! (defun gnus-summary-limit-to-unread (&optional all) ! "Limit the summary buffer to articles that are not marked as read. ! If ALL is non-nil, limit strictly to unread articles." ! (interactive "P") ! (if all ! (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) ! (gnus-summary-limit-to-marks ! ;; Concat all the marks that say that an article is read and have ! ;; those removed. ! (list gnus-del-mark gnus-read-mark gnus-ancient-mark ! gnus-killed-mark gnus-kill-file-mark ! gnus-low-score-mark gnus-expirable-mark ! gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark) ! 'reverse))) ! ! (defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) ! (make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks) ! ! (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, limit the summary buffer to articles that are not marked ! with MARKS. MARKS can either be a string of marks or a list of marks. ! Returns how many articles were removed." ! (interactive "sMarks: ") ! (gnus-set-global-variables) ! (prog1 ! (let ((data gnus-newsgroup-data) ! (marks (if (listp marks) marks ! (append marks nil))) ; Transform to list. ! articles) ! (while data ! (and (if reverse (not (memq (gnus-data-mark (car data)) marks)) ! (memq (gnus-data-mark (car data)) marks)) ! (setq articles (cons (gnus-data-number (car data)) articles))) ! (setq data (cdr data))) ! (gnus-summary-limit articles)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-to-score (&optional score) ! "Limit to articles with score at or above SCORE." ! (interactive "P") ! (gnus-set-global-variables) ! (setq score (if score ! (prefix-numeric-value score) ! (or gnus-summary-default-score 0))) ! (let ((data gnus-newsgroup-data) ! articles) ! (while data ! (when (>= (gnus-summary-article-score (gnus-data-number (car data))) ! score) ! (push (gnus-data-number (car data)) articles)) ! (setq data (cdr data))) ! (prog1 ! (gnus-summary-limit articles) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-limit-include-dormant () ! "Display all the hidden articles that are marked as dormant." ! (interactive) ! (gnus-set-global-variables) ! (or gnus-newsgroup-dormant ! (error "There are no dormant articles in this group")) ! (prog1 ! (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-exclude-dormant () ! "Hide all dormant articles." ! (interactive) ! (gnus-set-global-variables) ! (prog1 ! (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) ! (gnus-summary-position-point))) ! ! (defun gnus-summary-limit-exclude-childless-dormant () ! "Hide all dormant articles that have no children." ! (interactive) ! (gnus-set-global-variables) ! (let ((data (gnus-data-list t)) ! articles d children) ! ;; Find all articles that are either not dormant or have ! ;; children. ! (while (setq d (pop data)) ! (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) ! (and (setq children ! (gnus-article-children (gnus-data-number d))) ! (let (found) ! (while children ! (when (memq (car children) articles) ! (setq children nil ! found t)) ! (pop children)) ! found))) ! (push (gnus-data-number d) articles))) ! ;; Do the limiting. ! (prog1 ! (gnus-summary-limit articles) ! (gnus-summary-position-point)))) ! ! (defun gnus-summary-limit-mark-excluded-as-read (&optional all) ! "Mark all unread excluded articles as read. ! If ALL, mark even excluded ticked and dormants as read." ! (interactive "P") ! (let ((articles (gnus-sorted-complement ! (sort ! (mapcar (lambda (h) (mail-header-number h)) ! gnus-newsgroup-headers) ! '<) ! (sort gnus-newsgroup-limit '<))) ! article) ! (setq gnus-newsgroup-unreads nil) ! (if all ! (setq gnus-newsgroup-dormant nil ! gnus-newsgroup-marked nil ! gnus-newsgroup-reads ! (nconc ! (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) ! gnus-newsgroup-reads)) ! (while (setq article (pop articles)) ! (unless (or (memq article gnus-newsgroup-dormant) ! (memq article gnus-newsgroup-marked)) ! (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) ! ! (defun gnus-summary-limit (articles &optional pop) ! (if pop ! ;; We pop the previous limit off the stack and use that. ! (setq articles (car gnus-newsgroup-limits) ! gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) ! ;; We use the new limit, so we push the old limit on the stack. ! (setq gnus-newsgroup-limits ! (cons gnus-newsgroup-limit gnus-newsgroup-limits))) ! ;; Set the limit. ! (setq gnus-newsgroup-limit articles) ! (let ((total (length gnus-newsgroup-data)) ! (data (gnus-data-find-list (gnus-summary-article-number))) ! (gnus-summary-mark-below nil) ; Inhibit this. ! found) ! ;; This will do all the work of generating the new summary buffer ! ;; according to the new limit. ! (gnus-summary-prepare) ! ;; Hide any threads, possibly. ! (and gnus-show-threads ! gnus-thread-hide-subtree ! (gnus-summary-hide-all-threads)) ! ;; Try to return to the article you were at, or one in the ! ;; neighborhood. ! (if data ! ;; We try to find some article after the current one. ! (while data ! (and (gnus-summary-goto-subject ! (gnus-data-number (car data)) nil t) ! (setq data nil ! found t)) ! (setq data (cdr data)))) ! (or found ! ;; If there is no data, that means that we were after the last ! ;; article. The same goes when we can't find any articles ! ;; after the current one. ! (progn ! (goto-char (point-max)) ! (gnus-summary-find-prev))) ! ;; We return how many articles were removed from the summary ! ;; buffer as a result of the new limit. ! (- total (length gnus-newsgroup-data)))) ! ! (defsubst gnus-invisible-cut-children (threads) ! (let ((num 0)) ! (while threads ! (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) ! (incf num)) ! (pop threads)) ! (< num 2))) ! ! (defsubst gnus-cut-thread (thread) ! "Go forwards in the thread until we find an article that we want to display." ! (when (or (eq gnus-fetch-old-headers 'some) ! (eq gnus-build-sparse-threads 'some) ! (eq gnus-build-sparse-threads 'more)) ! ;; Deal with old-fetched headers and sparse threads. ! (while (and ! thread ! (or ! (memq (mail-header-number (car thread)) gnus-newsgroup-sparse) ! (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)) ! (or (<= (length (cdr thread)) 1) ! (gnus-invisible-cut-children (cdr thread)))) ! (setq thread (cadr thread)))) ! thread) ! ! (defun gnus-cut-threads (threads) ! "Cut off all uninteresting articles from the beginning of threads." ! (when (or (eq gnus-fetch-old-headers 'some) ! (eq gnus-build-sparse-threads 'some) ! (eq gnus-build-sparse-threads 'more)) ! (let ((th threads)) ! (while th ! (setcar th (gnus-cut-thread (car th))) ! (setq th (cdr th))))) ! ;; Remove nixed out threads. ! (delq nil threads)) ! ! (defun gnus-summary-initial-limit (&optional show-if-empty) ! "Figure out what the initial limit is supposed to be on group entry. ! This entails weeding out unwanted dormants, low-scored articles, ! fetch-old-headers verbiage, and so on." ! ;; Most groups have nothing to remove. ! (if (or gnus-inhibit-limiting ! (and (null gnus-newsgroup-dormant) ! (not (eq gnus-fetch-old-headers 'some)) ! (null gnus-summary-expunge-below) ! (not (eq gnus-build-sparse-threads 'some)) ! (not (eq gnus-build-sparse-threads 'more)) ! (null gnus-thread-expunge-below) ! (not gnus-use-nocem))) ! () ; Do nothing. ! (push gnus-newsgroup-limit gnus-newsgroup-limits) ! (setq gnus-newsgroup-limit nil) ! (mapatoms ! (lambda (node) ! (unless (car (symbol-value node)) ! ;; These threads have no parents -- they are roots. ! (let ((nodes (cdr (symbol-value node))) ! thread) ! (while nodes ! (if (and gnus-thread-expunge-below ! (< (gnus-thread-total-score (car nodes)) ! gnus-thread-expunge-below)) ! (gnus-expunge-thread (pop nodes)) ! (setq thread (pop nodes)) ! (gnus-summary-limit-children thread)))))) ! gnus-newsgroup-dependencies) ! ;; If this limitation resulted in an empty group, we might ! ;; pop the previous limit and use it instead. ! (when (and (not gnus-newsgroup-limit) ! show-if-empty) ! (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) ! gnus-newsgroup-limit)) ! ! (defun gnus-summary-limit-children (thread) ! "Return 1 if this subthread is visible and 0 if it is not." ! ;; First we get the number of visible children to this thread. This ! ;; is done by recursing down the thread using this function, so this ! ;; will really go down to a leaf article first, before slowly ! ;; working its way up towards the root. ! (when thread ! (let ((children ! (if (cdr thread) ! (apply '+ (mapcar 'gnus-summary-limit-children ! (cdr thread))) ! 0)) ! (number (mail-header-number (car thread))) ! score) ! (if (or ! ;; If this article is dormant and has absolutely no visible ! ;; children, then this article isn't visible. ! (and (memq number gnus-newsgroup-dormant) ! (= children 0)) ! ;; If this is "fetch-old-headered" and there is only one ! ;; visible child (or less), then we don't want this article. ! (and (eq gnus-fetch-old-headers 'some) ! (memq number gnus-newsgroup-ancient) ! (zerop children)) ! ;; If this is a sparsely inserted article with no children, ! ;; we don't want it. ! (and (eq gnus-build-sparse-threads 'some) ! (memq number gnus-newsgroup-sparse) ! (zerop children)) ! ;; If we use expunging, and this article is really ! ;; low-scored, then we don't want this article. ! (when (and gnus-summary-expunge-below ! (< (setq score ! (or (cdr (assq number gnus-newsgroup-scored)) ! gnus-summary-default-score)) ! gnus-summary-expunge-below)) ! ;; We increase the expunge-tally here, but that has ! ;; nothing to do with the limits, really. ! (incf gnus-newsgroup-expunged-tally) ! ;; We also mark as read here, if that's wanted. ! (when (and gnus-summary-mark-below ! (< score gnus-summary-mark-below)) ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (push number gnus-newsgroup-expirable) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! t) ! (and gnus-use-nocem ! (gnus-nocem-unwanted-article-p (mail-header-id (car thread))))) ! ;; Nope, invisible article. ! 0 ! ;; Ok, this article is to be visible, so we add it to the limit ! ;; and return 1. ! (setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit)) ! 1)))) ! ! (defun gnus-expunge-thread (thread) ! "Mark all articles in THREAD as read." ! (let* ((number (mail-header-number (car thread)))) ! (incf gnus-newsgroup-expunged-tally) ! ;; We also mark as read here, if that's wanted. ! (setq gnus-newsgroup-unreads ! (delq number gnus-newsgroup-unreads)) ! (if gnus-newsgroup-auto-expire ! (push number gnus-newsgroup-expirable) ! (push (cons number gnus-low-score-mark) ! gnus-newsgroup-reads))) ! ;; Go recursively through all subthreads. ! (mapcar 'gnus-expunge-thread (cdr thread))) ;; Summary article oriented commands *************** The difference between N and the number *** 8465,8580 **** (interactive "p") (gnus-set-global-variables) ! (while ! (and (> n 0) ! (let ((ref (mail-header-references (gnus-get-header-by-num ! (gnus-summary-article-number))))) ! (if (and ref (not (equal ref "")) ! (string-match "<[^<>]*>[ \t]*$" ref)) ! (gnus-summary-refer-article ! (substring ref (match-beginning 0) (match-end 0))) (gnus-message 1 "No references in article %d" (gnus-summary-article-number)) nil))) (setq n (1- n))) ! (gnus-summary-position-cursor) n) ! (defun gnus-summary-refer-article (message-id) ! "Refer article specified by MESSAGE-ID. ! NOTE: This command only works with newsgroups that use real or simulated NNTP." (interactive "sMessage-ID: ") ! (if (or (not (stringp message-id)) ! (zerop (length message-id))) ! () ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. ! (or (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (or (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) ! (let ((header (car (gnus-gethash (downcase message-id) ! gnus-newsgroup-dependencies)))) (if header - (or (gnus-summary-goto-article (mail-header-number header)) - ;; The header has been read, but the article had been - ;; expunged, so we insert it again. - (progn - (gnus-summary-insert-line - nil header 0 nil gnus-read-mark nil nil - (mail-header-subject header)) - (forward-line -1) - (mail-header-number header))) - (let ((gnus-override-method gnus-refer-article-method) - (gnus-ancient-mark gnus-read-mark) - (tmp-point (window-start - (get-buffer-window gnus-article-buffer))) - number tmp-buf) - (and gnus-refer-article-method - (gnus-check-server gnus-refer-article-method)) - ;; Save the old article buffer. - (save-excursion - (set-buffer (gnus-article-setup-buffer)) - (gnus-kill-buffer " *temp Article*") - (setq tmp-buf (rename-buffer " *temp Article*"))) (prog1 ! (if (gnus-article-prepare ! message-id nil (gnus-read-header message-id)) ! (progn ! (setq number (mail-header-number gnus-current-headers)) ! (gnus-rebuild-thread message-id) ! (gnus-summary-goto-subject number) ! (if (null gnus-use-full-window) ! (progn ! (delete-windows-on tmp-buf) ! (gnus-configure-windows 'article 'force))) ! (gnus-summary-recenter) ! (gnus-article-set-window-start ! (cdr (assq number gnus-newsgroup-bookmarks))) ! (and gnus-visual ! (run-hooks 'gnus-visual-mark-article-hook)) ! message-id) ! ;; We restore the old article buffer. ! (save-excursion ! (kill-buffer gnus-article-buffer) ! (set-buffer tmp-buf) ! (rename-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (and tmp-point ! (set-window-start (get-buffer-window (current-buffer)) ! tmp-point))))))))))) ! (defun gnus-summary-enter-digest-group () "Enter a digest group based on the current article." ! (interactive) (gnus-set-global-variables) (gnus-summary-select-article) ! ;; We do not want a narrowed article. ! (gnus-summary-stop-page-breaking) ! (let ((name (format "%s-%d" ! (gnus-group-prefixed-name ! gnus-newsgroup-name (list 'nndoc "")) gnus-current-article)) (ogroup gnus-newsgroup-name) ! (buf (current-buffer))) ! (if (gnus-group-read-ephemeral-group ! name (list 'nndoc name ! (list 'nndoc-address (get-buffer gnus-article-buffer)) ! '(nndoc-article-type digest)) ! t) ! (setcdr (nthcdr 4 (nth 2 (gnus-gethash name gnus-newsrc-hashtb))) ! (list (list (cons 'to-group ogroup)))) ! (switch-to-buffer buf) ! (gnus-set-global-variables) ! (gnus-configure-windows 'summary) ! (gnus-message 3 "Article not a digest?")))) ! ! (defun gnus-summary-isearch-article () ! "Do incremental search forward on current article." ! (interactive) (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-eval-in-buffer-window ! gnus-article-buffer (isearch-forward))) (defun gnus-summary-search-article-forward (regexp &optional backward) --- 11105,11243 ---- (interactive "p") (gnus-set-global-variables) ! (while ! (and (> n 0) ! (let* ((header (gnus-summary-article-header)) ! (ref ! ;; If we try to find the parent of the currently ! ;; displayed article, then we take a look at the actual ! ;; References header, since this is slightly more ! ;; reliable than the References field we got from the ! ;; server. ! (if (and (eq (mail-header-number header) ! (cdr gnus-article-current)) ! (equal gnus-newsgroup-name ! (car gnus-article-current))) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (nnheader-narrow-to-headers) ! (prog1 ! (message-fetch-field "references") ! (widen))) ! ;; It's not the current article, so we take a bet on ! ;; the value we got from the server. ! (mail-header-references header)))) ! (if (setq ref (or ref (mail-header-references header))) ! (or (gnus-summary-refer-article (gnus-parent-id ref)) ! (gnus-message 1 "Couldn't find parent")) (gnus-message 1 "No references in article %d" (gnus-summary-article-number)) nil))) (setq n (1- n))) ! (gnus-summary-position-point) n) ! ! (defun gnus-summary-refer-references () ! "Fetch all articles mentioned in the References header. ! Return how many articles were fetched." ! (interactive) ! (gnus-set-global-variables) ! (let ((ref (mail-header-references (gnus-summary-article-header))) ! (current (gnus-summary-article-number)) ! (n 0)) ! ;; For each Message-ID in the References header... ! (while (string-match "<[^>]*>" ref) ! (incf n) ! ;; ... fetch that article. ! (gnus-summary-refer-article ! (prog1 (match-string 0 ref) ! (setq ref (substring ref (match-end 0)))))) ! (gnus-summary-goto-subject current) ! (gnus-summary-position-point) ! n)) ! (defun gnus-summary-refer-article (message-id) ! "Fetch an article specified by MESSAGE-ID." (interactive "sMessage-ID: ") ! (when (and (stringp message-id) ! (not (zerop (length message-id)))) ;; Construct the correct Message-ID if necessary. ;; Suggested by tale@pawl.rpi.edu. ! (unless (string-match "^<" message-id) ! (setq message-id (concat "<" message-id))) ! (unless (string-match ">$" message-id) ! (setq message-id (concat message-id ">"))) ! (let* ((header (gnus-id-to-header message-id)) ! (sparse (and header ! (memq (mail-header-number header) ! gnus-newsgroup-sparse)))) (if header (prog1 ! ;; The article is present in the buffer, to we just go to it. ! (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 ! (and (gnus-news-group-p gnus-newsgroup-name) ! gnus-refer-article-method)) ! number) ! ;; Start the special refer-article method, if necessary. ! (when (and gnus-refer-article-method ! (gnus-news-group-p gnus-newsgroup-name)) ! (gnus-check-server gnus-refer-article-method)) ! ;; Fetch the header, and display the article. ! (if (setq number (gnus-summary-insert-subject message-id)) ! (gnus-summary-select-article nil nil nil number) ! (gnus-message 3 "Couldn't fetch article %s" message-id))))))) ! (defun gnus-summary-enter-digest-group (&optional force) "Enter a digest group based on the current article." ! (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (let ((name (format "%s-%d" ! (gnus-group-prefixed-name ! gnus-newsgroup-name (list 'nndoc "")) gnus-current-article)) (ogroup gnus-newsgroup-name) ! (case-fold-search t) ! (buf (current-buffer)) ! dig) ! (save-excursion ! (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) ! (insert-buffer-substring gnus-original-article-buffer) ! (narrow-to-region ! (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point))) ! (goto-char (point-min)) ! (delete-matching-lines "^\\(Path\\):\\|^From ") ! (widen)) ! (unwind-protect ! (if (gnus-group-read-ephemeral-group ! name `(nndoc ,name (nndoc-address ! ,(get-buffer dig)) ! (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)) ! (list (cons 'to-group ogroup))) ! ;; Couldn't select this doc group. ! (switch-to-buffer buf) ! (gnus-set-global-variables) ! (gnus-configure-windows 'summary) ! (gnus-message 3 "Article couldn't be entered?")) ! (kill-buffer dig)))) ! ! (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." ! (interactive "P") (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (goto-char (point-min)) ! (isearch-forward regexp-p))) (defun gnus-summary-search-article-forward (regexp &optional backward) *************** If BACKWARD, search backward instead." *** 8593,8599 **** (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) ! (if (gnus-summary-search-article regexp backward) ! (gnus-article-set-window-start ! (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks))) (error "Search failed: \"%s\"" regexp))) --- 11256,11260 ---- (setq regexp (or gnus-last-search-regexp "")) (setq gnus-last-search-regexp regexp)) ! (unless (gnus-summary-search-article regexp backward) (error "Search failed: \"%s\"" regexp))) *************** If BACKWARD, search backward instead." *** 8611,8670 **** "Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. ! gnus-select-article-hook is not called during the search." (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-mark-article-hook nil) ;Inhibit marking as read. (re-search (if backward ! (function re-search-backward) (function re-search-forward))) ! (found nil) ! (last nil)) ! ;; Hidden thread subtrees must be searched for ,too. ! (gnus-summary-show-all-threads) ! (if (eobp) (forward-line -1)) ! ;; First of all, search current article. ! ;; We don't want to read article again from NNTP server nor reset ! ;; current point. ! (gnus-summary-select-article) ! (gnus-message 9 "Searching article: %d..." gnus-current-article) ! (setq last gnus-current-article) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-restriction ! (widen) ! ;; Begin search from current point. ! (setq found (funcall re-search regexp nil t)))) ! ;; Then search next articles. ! (while (and (not found) ! (gnus-summary-display-article ! (gnus-summary-search-subject backward nil nil))) ! (gnus-message 9 "Searching article: %d..." gnus-current-article) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-restriction ! (widen) ! (goto-char (if backward (point-max) (point-min))) ! (setq found (funcall re-search regexp nil t))))) ! (message "") ! ;; Adjust article pointer. ! (or (eq last gnus-current-article) ! (setq gnus-last-article last)) ! ;; Return T if found such article. ! found)) (defun gnus-summary-execute-command (header regexp command &optional backward) "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. If HEADER is an empty string (or nil), the match is done on the entire ! article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) ! (completing-read "Header name: " (mapcar (lambda (string) (list string)) '("Number" "Subject" "From" "Lines" "Date" ! "Message-ID" "Xref" "References")) nil 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) (gnus-set-global-variables) ;; Hidden thread subtrees must be searched as well. --- 11272,11365 ---- "Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. ! `gnus-select-article-hook' is not called during the search." (let ((gnus-select-article-hook nil) ;Disable hook. + (gnus-article-display-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (re-search (if backward ! 're-search-backward 're-search-forward)) ! (sum (current-buffer)) ! (found nil)) ! (gnus-save-hidden-threads ! (gnus-summary-select-article) ! (set-buffer gnus-article-buffer) ! (when backward ! (forward-line -1)) ! (while (not found) ! (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) ! (if (if backward ! (re-search-backward regexp nil t) ! (re-search-forward regexp nil t)) ! ;; We found the regexp. ! (progn ! (setq found 'found) ! (beginning-of-line) ! (set-window-start ! (get-buffer-window (current-buffer)) ! (point)) ! (forward-line 1) ! (set-buffer sum)) ! ;; We didn't find it, so we go to the next article. ! (set-buffer sum) ! (if (not (if backward (gnus-summary-find-prev) ! (gnus-summary-find-next))) ! ;; No more articles. ! (setq found t) ! ;; Select the next article and adjust point. ! (gnus-summary-select-article) ! (set-buffer gnus-article-buffer) ! (widen) ! (goto-char (if backward (point-max) (point-min)))))) ! (gnus-message 7 "")) ! ;; Return whether we found the regexp. ! (when (eq found 'found) ! (gnus-summary-show-thread) ! (gnus-summary-goto-subject gnus-current-article) ! (gnus-summary-position-point) ! t))) ! ! (defun gnus-summary-find-matching (header regexp &optional backward unread ! not-case-fold) ! "Return a list of all articles that match REGEXP on HEADER. ! The search stars on the current article and goes forwards unless ! BACKWARD is non-nil. If BACKWARD is `all', do all articles. ! If UNREAD is non-nil, only unread articles will ! be taken into consideration. If NOT-CASE-FOLD, case won't be folded ! in the comparisons." ! (let ((data (if (eq backward 'all) gnus-newsgroup-data ! (gnus-data-find-list ! (gnus-summary-article-number) (gnus-data-list backward)))) ! (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) ! (case-fold-search (not not-case-fold)) ! articles d) ! (or (fboundp (intern (concat "mail-header-" header))) ! (error "%s is not a valid header" header)) ! (while data ! (setq d (car data)) ! (and (or (not unread) ; We want all articles... ! (gnus-data-unread-p d)) ; Or just unreads. ! (vectorp (gnus-data-header d)) ; It's not a pseudo. ! (string-match regexp (funcall func (gnus-data-header d))) ; Match. ! (setq articles (cons (gnus-data-number d) articles))) ; Success! ! (setq data (cdr data))) ! (nreverse articles))) (defun gnus-summary-execute-command (header regexp command &optional backward) "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. If HEADER is an empty string (or nil), the match is done on the entire ! article. If BACKWARD (the prefix) is non-nil, search backward instead." (interactive (list (let ((completion-ignore-case t)) ! (completing-read "Header name: " (mapcar (lambda (string) (list string)) '("Number" "Subject" "From" "Lines" "Date" ! "Message-ID" "Xref" "References" "Body")) nil 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") current-prefix-arg)) + (when (equal header "Body") + (setq header "")) (gnus-set-global-variables) ;; Hidden thread subtrees must be searched as well. *************** article. If BACKWARD (the prefix) is non *** 8676,8681 **** ;; We'd like to execute COMMAND interactively so as to give arguments. (gnus-execute header regexp ! (` (lambda () ! (call-interactively '(, (key-binding command))))) backward) (gnus-message 6 "Executing %s...done" (key-description command))))) --- 11371,11375 ---- ;; We'd like to execute COMMAND interactively so as to give arguments. (gnus-execute header regexp ! `(lambda () (call-interactively ',(key-binding command))) backward) (gnus-message 6 "Executing %s...done" (key-description command))))) *************** article. If BACKWARD (the prefix) is non *** 8687,8695 **** (gnus-summary-select-article) (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (widen) ! (goto-char (point-min)) ! (and gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () --- 11381,11388 ---- (gnus-summary-select-article) (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (widen) ! (goto-char (point-min)) ! (and gnus-break-pages (gnus-narrow-to-page)))) (defun gnus-summary-end-of-article () *************** article. If BACKWARD (the prefix) is non *** 8699,8716 **** (gnus-summary-select-article) (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (widen) ! (goto-char (point-max)) ! (recenter -3) ! (and gnus-break-pages (gnus-narrow-to-page)))) ! (defun gnus-summary-show-article () ! "Force re-fetching of the current article." ! (interactive) (gnus-set-global-variables) ! (gnus-summary-select-article nil 'force) ! (gnus-configure-windows 'article) ! (gnus-summary-position-cursor)) (defun gnus-summary-verbose-headers (&optional arg) --- 11392,11420 ---- (gnus-summary-select-article) (gnus-configure-windows 'article) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (widen) ! (goto-char (point-max)) ! (recenter -3) ! (and gnus-break-pages (gnus-narrow-to-page)))) ! (defun gnus-summary-show-article (&optional arg) ! "Force re-fetching of the current article. ! If ARG (the prefix) is non-nil, show the raw article without any ! article massaging functions being run." ! (interactive "P") (gnus-set-global-variables) ! (if (not arg) ! ;; Select the article the normal way. ! (gnus-summary-select-article nil 'force) ! ;; Bind the article treatment functions to nil. ! (let ((gnus-have-all-headers t) ! gnus-article-display-hook ! gnus-article-prepare-hook ! gnus-break-pages ! gnus-visual) ! (gnus-summary-select-article nil 'force))) ! (gnus-summary-goto-subject gnus-current-article) ! ; (gnus-configure-windows 'article) ! (gnus-summary-position-point)) (defun gnus-summary-verbose-headers (&optional arg) *************** If ARG is a negative number, hide the un *** 8736,8760 **** (save-excursion (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (if (numberp arg) ! (if (> arg 0) (remove-text-properties (point-min) (point-max) ! gnus-hidden-properties) ! (if (< arg 0) (run-hooks 'gnus-article-display-hook))) ! (if (text-property-any (point-min) (point-max) 'invisible t) ! (remove-text-properties ! (point-min) (point-max) gnus-hidden-properties) ! ;; We hide the headers. This song and dance act below is ! ;; done because `gnus-have-all-headers' is buffer-local to ! ;; the summary buffer, and we only want to temporarily ! ;; change it in that buffer. Ugh. ! (let ((have gnus-have-all-headers)) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (setq gnus-have-all-headers nil) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (run-hooks 'gnus-article-display-hook)) ! (setq gnus-have-all-headers have))))) ! (set-window-point (get-buffer-window (current-buffer)) (point-min))))) (defun gnus-summary-show-all-headers () --- 11440,11462 ---- (save-excursion (set-buffer gnus-article-buffer) ! (let* ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (hidden (text-property-any ! (goto-char (point-min)) (search-forward "\n\n") ! 'invisible t)) ! e) ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (delete-region (point-min) (1- (point)))) ! (goto-char (point-min)) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (goto-char (point-min)) ! (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) ! (insert-buffer-substring gnus-original-article-buffer 1 e) ! (let ((gnus-inhibit-hiding t)) ! (run-hooks 'gnus-article-display-hook)) ! (if (or (not hidden) (and (numberp arg) (< arg 0))) ! (gnus-article-hide-headers))))) (defun gnus-summary-show-all-headers () *************** forward." *** 8782,8792 **** (gnus-summary-select-article) (let ((mail-header-separator "")) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-restriction ! (widen) ! (let ((start (window-start))) ! (news-caesar-buffer-body arg) ! (set-window-start (get-buffer-window (current-buffer)) start)))))) (defun gnus-summary-stop-page-breaking () --- 11484,11494 ---- (gnus-summary-select-article) (let ((mail-header-separator "")) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (save-restriction ! (widen) ! (let ((start (window-start)) ! buffer-read-only) ! (message-caesar-buffer-body arg) ! (set-window-start (get-buffer-window (current-buffer)) start)))))) (defun gnus-summary-stop-page-breaking () *************** forward." *** 8795,8803 **** (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-eval-in-buffer-window gnus-article-buffer (widen))) ! ! ;; Suggested by Brian Edmonds . ! (defun gnus-summary-move-article (&optional n to-newsgroup select-method) "Move the current article to a different newsgroup. If N is a positive number, move the N next articles. --- 11497,11504 ---- (gnus-set-global-variables) (gnus-summary-select-article) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (widen))) ! (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. *************** If N is a negative number, move the N pr *** 8805,8909 **** If N is nil and any articles have been marked with the process mark, move those articles instead. ! If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is symbol, do not move to a specific newsgroup, but re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' ! and `request-accept' functions. (Ie. mail newsgroups at present.)" (interactive "P") (gnus-set-global-variables) ! (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) ! (error "The current newsgroup does not support article moving")) (let ((articles (gnus-summary-work-articles n)) (prefix (gnus-group-real-prefix gnus-newsgroup-name)) ! art-group to-method sel-met) ! (if (and (not to-newsgroup) (not select-method)) ! (setq to-newsgroup ! (completing-read ! (format "Where do you want to move %s? %s" ! (if (> (length articles) 1) ! (format "these %d articles" (length articles)) ! "this article") ! (if gnus-current-move-group ! (format "(%s default) " gnus-current-move-group) ! "")) ! gnus-active-hashtb nil nil prefix))) ! (if to-newsgroup ! (progn ! (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) ! (setq to-newsgroup (or gnus-current-move-group ""))) ! (or (gnus-gethash to-newsgroup gnus-active-hashtb) ! (gnus-activate-group to-newsgroup) ! (error "No such group: %s" to-newsgroup)) ! (setq gnus-current-move-group to-newsgroup))) ! (setq to-method (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) ! (gnus-message 6 "Moving to %s: %s..." ! (or select-method to-newsgroup) articles) (while articles ! (if (setq art-group ! (gnus-request-move-article ! (car articles) ; Article to move ! gnus-newsgroup-name ; From newsgroup ! (nth 1 (gnus-find-method-for-group ! gnus-newsgroup-name)) ; Server ! (list 'gnus-request-accept-article ! (if select-method ! (list 'quote select-method) ! to-newsgroup) ! (not (cdr articles))) ; Accept form ! (not (cdr articles)))) ; Only save nov last time ! (let* ((buffer-read-only nil) ! (entry ! (or ! (gnus-gethash (car art-group) gnus-newsrc-hashtb) ! (gnus-gethash ! (gnus-group-prefixed-name ! (car art-group) ! (if select-method (list select-method "") (gnus-find-method-for-group to-newsgroup))) ! gnus-newsrc-hashtb))) ! (info (nth 2 entry)) ! (article (car articles))) ! (gnus-summary-goto-subject article) ! (beginning-of-line) ! (delete-region (point) (progn (forward-line 1) (point))) ! ;; Update the group that has been moved to. ! (if (not info) ! () ; This group does not exist yet. ! (if (not (memq article gnus-newsgroup-unreads)) ! (setcar (cdr (cdr info)) ! (gnus-add-to-range (nth 2 info) ! (list (cdr art-group))))) ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (car info) (car (car marks)) (list to-article) info)) ! (setq marks (cdr marks))))) ! ;; Update marks. ! (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) ! (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) ! (setq gnus-newsgroup-dormant ! (delq article gnus-newsgroup-dormant)) ! (setq gnus-newsgroup-reads ! (cons (cons article gnus-canceled-mark) ! gnus-newsgroup-reads))) ! (gnus-message 1 "Couldn't move article %s" (car articles))) ! (gnus-summary-remove-process-mark (car articles)) ! (setq articles (cdr articles))) (gnus-set-mode-line 'summary))) ! (defun gnus-summary-respool-article (&optional n respool-method) "Respool the current article. The article will be squeezed through the mail spooling process again, --- 11506,11697 ---- If N is nil and any articles have been marked with the process mark, move those articles instead. ! If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but re-spool using this method. + For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' ! and `request-accept' functions." (interactive "P") + (unless action (setq action 'move)) (gnus-set-global-variables) ! ;; Check whether the source group supports the required functions. ! (cond ((and (eq action 'move) ! (not (gnus-check-backend-function ! 'request-move-article gnus-newsgroup-name))) ! (error "The current group does not support article moving")) ! ((and (eq action 'crosspost) ! (not (gnus-check-backend-function ! 'request-replace-article gnus-newsgroup-name))) ! (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (gnus-group-real-prefix gnus-newsgroup-name)) ! (names '((move "Move" "Moving") ! (copy "Copy" "Copying") ! (crosspost "Crosspost" "Crossposting"))) ! (copy-buf (save-excursion ! (nnheader-set-temp-buffer " *copy article*"))) ! art-group to-method new-xref article to-groups) ! (unless (assq action names) ! (error "Unknown action %s" action)) ! ;; Read the newsgroup name. ! (when (and (not to-newsgroup) ! (not select-method)) ! (setq to-newsgroup ! (gnus-read-move-group-name ! (cadr (assq action names)) ! (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 ! (gnus-group-name-to-method to-newsgroup))) ! ;; Check the method we are to move this article to... (or (gnus-check-backend-function 'request-accept-article (car to-method)) (error "%s does not support article copying" (car to-method))) (or (gnus-check-server to-method) (error "Can't open server %s" (car to-method))) ! (gnus-message 6 "%s to %s: %s..." ! (caddr (assq action names)) ! (or (car select-method) to-newsgroup) articles) (while articles ! (setq article (pop articles)) ! (setq ! art-group ! (cond ! ;; Move the article. ! ((eq action 'move) ! (gnus-request-move-article ! article ; Article to move ! gnus-newsgroup-name ; From newsgrouo ! (nth 1 (gnus-find-method-for-group ! gnus-newsgroup-name)) ; Server ! (list 'gnus-request-accept-article ! to-newsgroup (list 'quote select-method) ! (not articles)) ; Accept form ! (not articles))) ; Only save nov last time ! ;; Copy the article. ! ((eq action 'copy) ! (save-excursion ! (set-buffer copy-buf) ! (gnus-request-article-this-buffer article gnus-newsgroup-name) ! (gnus-request-accept-article ! to-newsgroup select-method (not articles)))) ! ;; Crosspost the article. ! ((eq action 'crosspost) ! (let ((xref (mail-header-xref (gnus-summary-article-header article)))) ! (setq new-xref (concat gnus-newsgroup-name ":" article)) ! (if (and xref (not (string= xref ""))) ! (progn ! (when (string-match "^Xref: " xref) ! (setq xref (substring xref (match-end 0)))) ! (setq new-xref (concat xref " " new-xref))) ! (setq new-xref (concat (system-name) " " new-xref))) ! (save-excursion ! (set-buffer copy-buf) ! (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))))))) ! (if (not art-group) ! (gnus-message 1 "Couldn't %s article %s" ! (cadr (assq action names)) article) ! (let* ((entry ! (or ! (gnus-gethash (car art-group) gnus-newsrc-hashtb) ! (gnus-gethash ! (gnus-group-prefixed-name ! (car art-group) ! (or select-method (gnus-find-method-for-group to-newsgroup))) ! gnus-newsrc-hashtb))) ! (info (nth 2 entry)) ! (to-group (gnus-info-group info))) ! ;; Update the group that has been moved to. ! (when (and info ! (memq action '(move copy))) ! (unless (member to-group to-groups) ! (push to-group to-groups)) ! ! (unless (memq article gnus-newsgroup-unreads) ! (gnus-info-set-read ! info (gnus-add-to-range (gnus-info-read info) ! (list (cdr art-group))))) ! ! ;; Copy any marks over to the new group. ! (let ((marks gnus-article-mark-lists) ! (to-article (cdr art-group))) ! ! ;; See whether the article is to be put in the cache. ! (when gnus-use-cache ! (gnus-cache-possibly-enter-article ! to-group to-article ! (let ((header (copy-sequence ! (gnus-summary-article-header article)))) ! (mail-header-set-number header to-article) ! header) ! (memq article gnus-newsgroup-marked) ! (memq article gnus-newsgroup-dormant) ! (memq article gnus-newsgroup-unreads))) ! ! (while marks ! (when (memq article (symbol-value ! (intern (format "gnus-newsgroup-%s" ! (caar marks))))) ! ;; If the other group is the same as this group, ! ;; then we have to add the mark to the list. ! (when (equal to-group gnus-newsgroup-name) ! (set (intern (format "gnus-newsgroup-%s" (caar marks))) ! (cons to-article ! (symbol-value ! (intern (format "gnus-newsgroup-%s" ! (caar marks))))))) ! ;; Copy mark to other group. ! (gnus-add-marked-articles ! to-group (cdar marks) (list to-article) info)) ! (setq marks (cdr marks))))) ! ! ;; Update the Xref header in this article to point to ! ;; the new crossposted article we have just created. ! (when (eq action 'crosspost) ! (save-excursion ! (set-buffer copy-buf) ! (gnus-request-article-this-buffer article gnus-newsgroup-name) ! (nnheader-replace-header ! "xref" (concat new-xref " " (gnus-group-prefixed-name ! (car art-group) to-method) ! ":" (cdr art-group))) ! (gnus-request-replace-article ! article gnus-newsgroup-name (current-buffer))))) ! ! (gnus-summary-goto-subject article) ! (when (eq action 'move) ! (gnus-summary-mark-article article gnus-canceled-mark))) ! (gnus-summary-remove-process-mark article)) ! ;; 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))) ! (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) ! "Move the current article to a different newsgroup. ! If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but ! re-spool using this method." ! (interactive "P") ! (gnus-summary-move-article n nil select-method 'copy)) ! ! (defun gnus-summary-crosspost-article (&optional n) ! "Crosspost the current article to some other group." ! (interactive "P") ! (gnus-summary-move-article n nil nil 'crosspost)) ! ! (defvar gnus-summary-respool-default-method nil ! "Default method for respooling an article. ! If nil, use to the current newsgroup method.") ! ! (defun gnus-summary-respool-article (&optional n method) "Respool the current article. The article will be squeezed through the mail spooling process again, *************** In the former case, the articles in ques *** 8919,9035 **** current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((respool-methods (gnus-methods-using 'respool)) ! (methname ! (symbol-name (car (gnus-find-method-for-group gnus-newsgroup-name))))) ! (or respool-method ! (setq respool-method ! (completing-read ! "What method do you want to use when respooling? " ! respool-methods nil t methname))) ! (or (string= respool-method "") ! (if (assoc (symbol-name ! (car (gnus-find-method-for-group gnus-newsgroup-name))) ! respool-methods) ! (gnus-summary-move-article n nil (intern respool-method)) ! (gnus-summary-copy-article n nil (intern respool-method)))))) ! ! ;; Suggested by gregj@unidata.com (Gregory J. Grubbs). ! (defun gnus-summary-copy-article (&optional n to-newsgroup select-method) ! "Move the current article to a different newsgroup. ! If N is a positive number, move the N next articles. ! If N is a negative number, move the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! move those articles instead. ! If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. ! If SELECT-METHOD is symbol, do not move to a specific newsgroup, but ! re-spool using this method. ! For this function to work, the newsgroup that you want to move to have ! to support the `request-move' and `request-accept' ! functions. (Ie. mail newsgroups at present.)" ! (interactive "P") ! (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n)) ! (copy-buf (get-buffer-create "*copy work*")) ! (prefix (gnus-group-real-prefix gnus-newsgroup-name)) ! art-group to-method) ! (buffer-disable-undo copy-buf) ! (if (and (not to-newsgroup) (not select-method)) ! (setq to-newsgroup ! (completing-read ! (format "Where do you want to copy %s? %s" ! (if (> (length articles) 1) ! (format "these %d articles" (length articles)) ! "this article") ! (if gnus-current-move-group ! (format "(%s default) " gnus-current-move-group) ! "")) ! gnus-active-hashtb nil nil prefix))) ! (if to-newsgroup ! (progn ! (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) ! (setq to-newsgroup (or gnus-current-move-group ""))) ! (or (gnus-gethash to-newsgroup gnus-active-hashtb) ! (gnus-activate-group to-newsgroup) ! (error "No such group: %s" to-newsgroup)) ! (setq gnus-current-move-group to-newsgroup))) ! (setq to-method (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) ! (or (gnus-check-backend-function 'request-accept-article (car to-method)) ! (error "%s does not support article copying" (car to-method))) ! (or (gnus-check-server to-method) ! (error "Can't open server %s" (car to-method))) ! (while articles ! (gnus-message 6 "Copying to %s: %s..." ! (or select-method to-newsgroup) articles) ! (if (setq art-group ! (save-excursion ! (set-buffer copy-buf) ! (gnus-request-article-this-buffer ! (car articles) gnus-newsgroup-name) ! (gnus-request-accept-article ! (if select-method (list 'quote select-method) to-newsgroup) ! (not (cdr articles))))) ! (let* ((entry ! (or ! (gnus-gethash (car art-group) gnus-newsrc-hashtb) ! (gnus-gethash ! (gnus-group-prefixed-name ! (car art-group) ! (if select-method (list select-method "") ! (gnus-find-method-for-group to-newsgroup))) ! gnus-newsrc-hashtb))) ! (info (nth 2 entry)) ! (article (car articles))) ! ;; We copy the info over to the new group. ! (if (not info) ! () ; This group does not exist (yet). ! (if (not (memq article gnus-newsgroup-unreads)) ! (setcar (cdr (cdr info)) ! (gnus-add-to-range (nth 2 info) ! (list (cdr art-group))))) ! ;; Copy any marks over to the new group. ! (let ((marks '((tick . gnus-newsgroup-marked) ! (dormant . gnus-newsgroup-dormant) ! (expire . gnus-newsgroup-expirable) ! (bookmark . gnus-newsgroup-bookmarks) ! (reply . gnus-newsgroup-replied))) ! (to-article (cdr art-group))) ! (while marks ! (if (memq article (symbol-value (cdr (car marks)))) ! (gnus-add-marked-articles ! (car info) (car (car marks)) (list to-article) info)) ! (setq marks (cdr marks)))))) ! (gnus-message 1 "Couldn't copy article %s" (car articles))) ! (gnus-summary-remove-process-mark (car articles)) ! (setq articles (cdr articles))) ! (kill-buffer copy-buf))) (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." (interactive "fImport file: ") (let ((group gnus-newsgroup-name) ! atts) (or (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) --- 11707,11747 ---- current group into whatever groups they are destined to. In the latter case, they will be copied into the relevant groups." ! (interactive ! (list current-prefix-arg ! (let* ((methods (gnus-methods-using 'respool)) ! (methname ! (symbol-name (or gnus-summary-respool-default-method ! (car (gnus-find-method-for-group ! gnus-newsgroup-name))))) ! (method ! (gnus-completing-read ! methname "What backend do you want to use when respooling?" ! methods nil t nil 'gnus-method-history)) ! ms) ! (cond ! ((zerop (length (setq ms (gnus-servers-using-backend method)))) ! (list (intern method) "")) ! ((= 1 (length ms)) ! (car ms)) ! (t ! (cdr (completing-read ! "Server name: " ! (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t))))))) ! (gnus-set-global-variables) ! (unless method ! (error "No method given for respooling")) ! (if (assoc (symbol-name ! (car (gnus-find-method-for-group gnus-newsgroup-name))) ! (gnus-methods-using 'respool)) ! (gnus-summary-move-article n nil method) ! (gnus-summary-copy-article n nil method))) (defun gnus-summary-import-article (file) "Import a random file into a mail newsgroup." (interactive "fImport file: ") + (gnus-set-global-variables) (let ((group gnus-newsgroup-name) ! (now (current-time)) ! atts lines) (or (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) *************** functions. (Ie. mail newsgroups at prese *** 9043,9085 **** (insert-file-contents file) (goto-char (point-min)) ! (if (nnheader-article-p) ! () ! (setq atts (file-attributes file)) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" ! "Date: " (current-time-string (nth 5 atts)) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) ! (gnus-request-accept-article group t) (kill-buffer (current-buffer))))) ! (defun gnus-summary-expire-articles () "Expire all articles that are marked as expirable in the current group." (interactive) ! (if (not (gnus-check-backend-function ! 'request-expire-articles gnus-newsgroup-name)) ! () ! (let* ((info (nth 2 (gnus-gethash gnus-newsgroup-name ! gnus-newsrc-hashtb))) ! (total (memq 'total-expire (nth 5 info))) (expirable (if total (gnus-list-of-read-articles gnus-newsgroup-name) (setq gnus-newsgroup-expirable (sort gnus-newsgroup-expirable '<)))) es) ! (if (not expirable) ! () (gnus-message 6 "Expiring articles...") ;; The list of articles that weren't expired is returned. ! (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name)) (or total (setq gnus-newsgroup-expirable es)) ;; We go through the old list of expirable, and mark all ;; really expired articles as nonexistent. ! (or (eq es expirable) ;If nothing was expired, we don't mark. ! (let ((gnus-use-cache nil)) ! (while expirable ! (or (memq (car expirable) es) ! (gnus-summary-mark-article ! (car expirable) gnus-canceled-mark)) ! (setq expirable (cdr expirable))))) (gnus-message 6 "Expiring articles...done"))))) --- 11755,11813 ---- (insert-file-contents file) (goto-char (point-min)) ! (unless (nnheader-article-p) ! ;; This doesn't look like an article, so we fudge some headers. ! (setq atts (file-attributes file) ! lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" ! "Date: " (timezone-make-date-arpa-standard ! (current-time-string (nth 5 atts)) ! (current-time-zone now) ! (current-time-zone now)) "\n" ! "Message-ID: " (message-make-message-id) "\n" ! "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) ! (gnus-request-accept-article group nil t) (kill-buffer (current-buffer))))) ! (defun gnus-summary-expire-articles (&optional now) "Expire all articles that are marked as expirable in the current group." (interactive) ! (gnus-set-global-variables) ! (when (gnus-check-backend-function ! 'request-expire-articles gnus-newsgroup-name) ! ;; This backend supports expiry. ! (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) (expirable (if total (gnus-list-of-read-articles gnus-newsgroup-name) (setq gnus-newsgroup-expirable (sort gnus-newsgroup-expirable '<)))) + (expiry-wait (if now 'immediate + (gnus-group-get-parameter + gnus-newsgroup-name 'expiry-wait))) es) ! (when expirable ! ;; There are expirable articles in this group, so we run them ! ;; through the expiry process. (gnus-message 6 "Expiring articles...") ;; The list of articles that weren't expired is returned. ! (if expiry-wait ! (let ((nnmail-expiry-wait-function nil) ! (nnmail-expiry-wait expiry-wait)) ! (setq es (gnus-request-expire-articles ! expirable gnus-newsgroup-name))) ! (setq es (gnus-request-expire-articles ! expirable gnus-newsgroup-name))) (or total (setq gnus-newsgroup-expirable es)) ;; We go through the old list of expirable, and mark all ;; really expired articles as nonexistent. ! (unless (eq es expirable) ;If nothing was expired, we don't mark. ! (let ((gnus-use-cache nil)) ! (while expirable ! (unless (memq (car expirable) es) ! (when (gnus-data-find (car expirable)) ! (gnus-summary-mark-article ! (car expirable) gnus-canceled-mark))) ! (setq expirable (cdr expirable))))) (gnus-message 6 "Expiring articles...done"))))) *************** This means that *all* articles that are *** 9089,9111 **** deleted forever, right now." (interactive) (or gnus-expert-user (gnus-y-or-n-p ! "Are you really, really, really sure you want to expunge? ") (error "Phew!")) ! (let ((nnmail-expiry-wait -1) ! (nnmail-expiry-wait-function nil)) ! (gnus-summary-expire-articles))) ;; Suggested by Jack Vinson . (defun gnus-summary-delete-article (&optional n) "Delete the N next (mail) articles. ! This command actually deletes articles. This is not a marking ! command. The article will disappear forever from you life, never to ! return. If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, delete these instead." (interactive "P") ! (or (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion.")) --- 11817,11839 ---- deleted forever, right now." (interactive) + (gnus-set-global-variables) (or gnus-expert-user (gnus-y-or-n-p ! "Are you really, really, really sure you want to delete all these messages? ") (error "Phew!")) ! (gnus-summary-expire-articles t)) ;; Suggested by Jack Vinson . (defun gnus-summary-delete-article (&optional n) "Delete the N next (mail) articles. ! This command actually deletes articles. This is not a marking ! command. The article will disappear forever from your life, never to ! return. If N is negative, delete backwards. If N is nil and articles have been marked with the process mark, delete these instead." (interactive "P") ! (gnus-set-global-variables) ! (or (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion.")) *************** delete these instead." *** 9114,9133 **** not-deleted) (if (and gnus-novice-user ! (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " ! (if (> (length articles) 1) "these articles" "this article"))))) () ;; Delete the articles. ! (setq not-deleted (gnus-request-expire-articles articles gnus-newsgroup-name 'force)) (while articles ! (gnus-summary-remove-process-mark (car articles)) ;; The backend might not have been able to delete the article ! ;; after all. (or (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (setq articles (cdr articles)))) ! (gnus-summary-position-cursor) (gnus-set-mode-line 'summary) not-deleted)) --- 11842,11862 ---- not-deleted) (if (and gnus-novice-user ! (not (gnus-y-or-n-p (format "Do you really want to delete %s forever? " ! (if (> (length articles) 1) ! (format "these %s articles" (length articles)) "this article"))))) () ;; Delete the articles. ! (setq not-deleted (gnus-request-expire-articles articles gnus-newsgroup-name 'force)) (while articles ! (gnus-summary-remove-process-mark (car articles)) ;; The backend might not have been able to delete the article ! ;; after all. (or (memq (car articles) not-deleted) (gnus-summary-mark-article (car articles) gnus-canceled-mark)) (setq articles (cdr articles)))) ! (gnus-summary-position-point) (gnus-set-mode-line 'summary) not-deleted)) *************** If FORCE is non-nil, allow editing of ar *** 9139,9157 **** groups." (interactive "P") ! (or force ! (not (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing.")) ! (gnus-summary-select-article t) ! (gnus-configure-windows 'article) ! (select-window (get-buffer-window gnus-article-buffer)) ! (gnus-message 6 "C-c C-c to end edits") ! (setq buffer-read-only nil) ! (text-mode) ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) ! (buffer-enable-undo) ! (widen) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t)) (defun gnus-summary-edit-article-done () --- 11868,11889 ---- groups." (interactive "P") ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (gnus-set-global-variables) ! (when (and (not force) ! (gnus-group-read-only-p)) (error "The current newsgroup does not support article editing.")) ! (gnus-summary-select-article t nil t) ! (gnus-configure-windows 'article) ! (select-window (get-buffer-window gnus-article-buffer)) ! (gnus-message 6 "C-c C-c to end edits") ! (setq buffer-read-only nil) ! (text-mode) ! (use-local-map (copy-keymap (current-local-map))) ! (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) ! (buffer-enable-undo) ! (widen) ! (goto-char (point-min)) ! (search-forward "\n\n" nil t))) (defun gnus-summary-edit-article-done () *************** groups." *** 9160,9171 **** (if (gnus-group-read-only-p) (progn ! (gnus-summary-edit-article-postpone) ! (message "The current newsgroup does not support article editing.") ! (ding)) ! (let ((buf (buffer-substring-no-properties (point-min) (point-max)))) (erase-buffer) (insert buf) ! (if (not (gnus-request-replace-article ! (cdr gnus-article-current) (car gnus-article-current) (current-buffer))) (error "Couldn't replace article.") --- 11892,11905 ---- (if (gnus-group-read-only-p) (progn ! (let ((beep (not (eq major-mode 'text-mode)))) ! (gnus-summary-edit-article-postpone) ! (when beep ! (gnus-error ! 3 "The current newsgroup does not support article editing.")))) ! (let ((buf (format "%s" (buffer-string)))) (erase-buffer) (insert buf) ! (if (not (gnus-request-replace-article ! (cdr gnus-article-current) (car gnus-article-current) (current-buffer))) (error "Couldn't replace article.") *************** groups." *** 9174,9294 **** (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary)) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))))) (defun gnus-summary-edit-article-postpone () "Postpone changes to the current article." ! (interactive) ! (gnus-article-mode) ! (use-local-map gnus-article-mode-map) ! (setq buffer-read-only t) ! (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))) ! ! (defun gnus-summary-fancy-query () ! "Query where the fancy respool algorithm would put this article." ! (interactive) ! (gnus-summary-select-article) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (goto-char (point-min)) ! (search-forward "\n\n") ! (narrow-to-region (point-min) (point)) ! (pp-eval-expression (list 'quote (nnmail-split-fancy)))))) ! ! ;; Summary score commands. ! ! ;; Suggested by boubaker@cenatls.cena.dgac.fr. ! ! (defun gnus-summary-raise-score (n) ! "Raise the score of the current article by N." ! (interactive "p") ! (gnus-summary-set-score (+ (gnus-summary-article-score) n))) ! ! (defun gnus-summary-set-score (n) ! "Set the score of the current article to N." ! (interactive "p") ! ;; Skip dummy header line. ! (save-excursion ! (gnus-summary-show-thread) ! (if (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (forward-line 1)) ! (let ((buffer-read-only nil)) ! ;; Set score. ! (gnus-summary-update-mark ! (if (= n (or gnus-summary-default-score 0)) ? ! (if (< n (or gnus-summary-default-score 0)) ! gnus-score-below-mark gnus-score-over-mark)) 'score)) ! (let* ((article (gnus-summary-article-number)) ! (score (assq article gnus-newsgroup-scored))) ! (if score (setcdr score n) ! (setq gnus-newsgroup-scored ! (cons (cons article n) gnus-newsgroup-scored)))) ! (gnus-summary-update-line))) ! ! (defun gnus-summary-current-score () ! "Return the score of the current article." ! (interactive) ! (message "%s" (gnus-summary-article-score))) ! ! ;; Summary marking commands. ! ! (defun gnus-summary-raise-same-subject-and-select (score) ! "Raise articles which has the same subject with SCORE and select the next." ! (interactive "p") ! (let ((subject (gnus-summary-subject-string))) ! (gnus-summary-raise-score score) ! (while (gnus-summary-search-subject nil nil subject) ! (gnus-summary-raise-score score)) ! (gnus-summary-next-article t))) ! ! (defun gnus-summary-raise-same-subject (score) ! "Raise articles which has the same subject with SCORE." ! (interactive "p") ! (let ((subject (gnus-summary-subject-string))) ! (gnus-summary-raise-score score) ! (while (gnus-summary-search-subject nil nil subject) ! (gnus-summary-raise-score score)) ! (gnus-summary-next-subject 1 t))) ! ! (defun gnus-score-default (level) ! (if level (prefix-numeric-value level) ! gnus-score-interactive-default-score)) ! ! (defun gnus-summary-raise-thread (&optional score) ! "Raise the score of the articles in the current thread with SCORE." ! (interactive "P") ! (setq score (gnus-score-default score)) ! (let (e) ! (save-excursion ! (let ((level (gnus-summary-thread-level))) ! (gnus-summary-raise-score score) ! (while (and (zerop (gnus-summary-next-subject 1 nil t)) ! (> (gnus-summary-thread-level) level)) ! (gnus-summary-raise-score score)) ! (setq e (point)))) ! (let ((gnus-summary-check-current t)) ! (or (zerop (gnus-summary-next-subject 1 t)) ! (goto-char e)))) ! (gnus-summary-recenter) ! (gnus-summary-position-cursor) ! (gnus-set-mode-line 'summary)) ! ! (defun gnus-summary-lower-same-subject-and-select (score) ! "Raise articles which has the same subject with SCORE and select the next." ! (interactive "p") ! (gnus-summary-raise-same-subject-and-select (- score))) ! (defun gnus-summary-lower-same-subject (score) ! "Raise articles which has the same subject with SCORE." ! (interactive "p") ! (gnus-summary-raise-same-subject (- score))) ! (defun gnus-summary-lower-thread (&optional score) ! "Lower score of articles in the current thread with SCORE." ! (interactive "P") ! (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) (defun gnus-summary-kill-same-subject-and-select (&optional unmark) --- 11908,11955 ---- (setq buffer-read-only t) (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary) ! (gnus-summary-update-article (cdr gnus-article-current)) ! (when gnus-use-cache ! (gnus-cache-update-article ! (car gnus-article-current) (cdr gnus-article-current))) ! (when gnus-keep-backlog ! (gnus-backlog-remove-article ! (car gnus-article-current) (cdr gnus-article-current)))) ! (save-excursion ! (when (get-buffer gnus-original-article-buffer) ! (set-buffer gnus-original-article-buffer) ! (setq gnus-original-article nil))) ! (setq gnus-article-current nil ! gnus-current-article nil) ! (run-hooks 'gnus-article-display-hook) ! (and (gnus-visual-p 'summary-highlight 'highlight) ! (run-hooks 'gnus-visual-mark-article-hook))))) (defun gnus-summary-edit-article-postpone () "Postpone changes to the current article." ! (interactive) ! (gnus-article-mode) ! (use-local-map gnus-article-mode-map) ! (setq buffer-read-only t) ! (buffer-disable-undo (current-buffer)) ! (gnus-configure-windows 'summary) ! (and (gnus-visual-p 'summary-highlight 'highlight) ! (run-hooks 'gnus-visual-mark-article-hook))) ! (defun gnus-summary-respool-query () ! "Query where the respool algorithm would put this article." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-select-article) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (goto-char (point-min)) ! (search-forward "\n\n") ! (narrow-to-region (point-min) (point)) ! (pp-eval-expression ! (list 'quote (mapcar 'car (nnmail-article-group 'identity))))))) ! ;; Summary marking commands. (defun gnus-summary-kill-same-subject-and-select (&optional unmark) *************** If UNMARK is positive, remove any kind o *** 9297,9309 **** If UNMARK is negative, tick articles." (interactive "P") (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject ! (gnus-summary-subject-string) unmark))) ! ;; Select next unread article. If auto-select-same mode, should ;; select the first unread article. (gnus-summary-next-article t (and gnus-auto-select-same ! (gnus-summary-subject-string))) (gnus-message 7 "%d article%s marked as %s" count (if (= count 1) " is" "s are") --- 11958,11971 ---- If UNMARK is negative, tick articles." (interactive "P") + (gnus-set-global-variables) (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject ! (gnus-summary-article-subject) unmark))) ! ;; Select next unread article. If auto-select-same mode, should ;; select the first unread article. (gnus-summary-next-article t (and gnus-auto-select-same ! (gnus-summary-article-subject))) (gnus-message 7 "%d article%s marked as %s" count (if (= count 1) " is" "s are") *************** If UNMARK is negative, tick articles." *** 9311,9323 **** (defun gnus-summary-kill-same-subject (&optional unmark) ! "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject ! (gnus-summary-subject-string) unmark))) ;; If marked as read, go to next unread subject. (if (null unmark) --- 11973,11986 ---- (defun gnus-summary-kill-same-subject (&optional unmark) ! "Mark articles which has the same subject as read. If UNMARK is positive, remove any kind of mark. If UNMARK is negative, tick articles." (interactive "P") + (gnus-set-global-variables) (if unmark (setq unmark (prefix-numeric-value unmark))) (let ((count (gnus-summary-mark-same-subject ! (gnus-summary-article-subject) unmark))) ;; If marked as read, go to next unread subject. (if (null unmark) *************** If optional argument UNMARK is negative, *** 9333,9343 **** (let ((count 1)) (save-excursion ! (cond ((null unmark) ; Mark as read. ! (while (and (progn (gnus-summary-mark-article-as-read gnus-killed-mark) (gnus-summary-show-thread) t) ! (gnus-summary-search-forward nil subject)) (setq count (1+ count)))) ((> unmark 0) ; Tick. --- 11996,12006 ---- (let ((count 1)) (save-excursion ! (cond ((null unmark) ; Mark as read. ! (while (and (progn (gnus-summary-mark-article-as-read gnus-killed-mark) (gnus-summary-show-thread) t) ! (gnus-summary-find-subject subject)) (setq count (1+ count)))) ((> unmark 0) ; Tick. *************** If optional argument UNMARK is negative, *** 9346,9350 **** (gnus-summary-mark-article-as-unread gnus-ticked-mark) (gnus-summary-show-thread) t) ! (gnus-summary-search-forward nil subject)) (setq count (1+ count)))) (t ; Mark as unread. --- 12009,12013 ---- (gnus-summary-mark-article-as-unread gnus-ticked-mark) (gnus-summary-show-thread) t) ! (gnus-summary-find-subject subject)) (setq count (1+ count)))) (t ; Mark as unread. *************** If optional argument UNMARK is negative, *** 9353,9357 **** (gnus-summary-mark-article-as-unread gnus-unread-mark) (gnus-summary-show-thread) t) ! (gnus-summary-search-forward nil subject)) (setq count (1+ count))))) (gnus-set-mode-line 'summary) --- 12016,12020 ---- (gnus-summary-mark-article-as-unread gnus-unread-mark) (gnus-summary-show-thread) t) ! (gnus-summary-find-subject subject)) (setq count (1+ count))))) (gnus-set-mode-line 'summary) *************** the process mark instead. The differenc *** 9365,9371 **** number of articles marked is returned." (interactive "p") (let ((backward (< n 0)) (n (abs n))) ! (while (and (> n 0) (if unmark --- 12028,12035 ---- number of articles marked is returned." (interactive "p") + (gnus-set-global-variables) (let ((backward (< n 0)) (n (abs n))) ! (while (and (> n 0) (if unmark *************** number of articles marked is returned." *** 9377,9381 **** (if (/= 0 n) (gnus-message 7 "No more articles")) (gnus-summary-recenter) ! (gnus-summary-position-cursor) n)) --- 12041,12045 ---- (if (/= 0 n) (gnus-message 7 "No more articles")) (gnus-summary-recenter) ! (gnus-summary-position-point) n)) *************** If N is negative, mark backward instead. *** 9385,9388 **** --- 12049,12053 ---- the actual number of articles marked is returned." (interactive "p") + (gnus-set-global-variables) (gnus-summary-mark-as-processable n t)) *************** the actual number of articles marked is *** 9390,9403 **** "Remove the process mark from all articles." (interactive) (save-excursion (while gnus-newsgroup-processable (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) ! (gnus-summary-position-cursor)) (defun gnus-summary-mark-as-expirable (n) "Mark N articles forward as expirable. ! If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-expirable-mark)) --- 12055,12070 ---- "Remove the process mark from all articles." (interactive) + (gnus-set-global-variables) (save-excursion (while gnus-newsgroup-processable (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) ! (gnus-summary-position-point)) (defun gnus-summary-mark-as-expirable (n) "Mark N articles forward as expirable. ! If N is negative, mark backward instead. The difference between N and the actual number of articles marked is returned." (interactive "p") + (gnus-set-global-variables) (gnus-summary-mark-forward n gnus-expirable-mark)) *************** the actual number of articles marked is *** 9406,9417 **** (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) (let ((buffer-read-only nil)) ! (if (gnus-summary-goto-subject article) ! (progn ! (gnus-summary-update-mark gnus-replied-mark 'replied) ! t)))) (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." (interactive (list (gnus-summary-article-number))) (if (or (not (get-buffer gnus-article-buffer)) (not gnus-current-article) --- 12073,12083 ---- (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) (let ((buffer-read-only nil)) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-update-secondary-mark article)))) (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." (interactive (list (gnus-summary-article-number))) + (gnus-set-global-variables) (if (or (not (get-buffer gnus-article-buffer)) (not gnus-current-article) *************** the actual number of articles marked is *** 9421,9431 **** ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)))) ! ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). ! (setq gnus-newsgroup-bookmarks ! (cons ! (cons article (save-excursion (set-buffer gnus-article-buffer) --- 12087,12097 ---- ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)))) ! ;; Set the new bookmark, which is on the form ;; (article-number . line-number-in-body). ! (setq gnus-newsgroup-bookmarks ! (cons ! (cons article (save-excursion (set-buffer gnus-article-buffer) *************** the actual number of articles marked is *** 9443,9451 **** "Remove the bookmark from the current article." (interactive (list (gnus-summary-article-number))) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (progn ! (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)) (gnus-message 6 "Removed bookmark.")) --- 12109,12118 ---- "Remove the bookmark from the current article." (interactive (list (gnus-summary-article-number))) + (gnus-set-global-variables) ;; Remove old bookmark, if one exists. (let ((old (assq article gnus-newsgroup-bookmarks))) ! (if old (progn ! (setq gnus-newsgroup-bookmarks (delq old gnus-newsgroup-bookmarks)) (gnus-message 6 "Removed bookmark.")) *************** If N is negative, mark backward instead. *** 9458,9496 **** the actual number of articles marked is returned." (interactive "p") (gnus-summary-mark-forward n gnus-dormant-mark)) (defun gnus-summary-set-process-mark (article) "Set the process mark on ARTICLE and update the summary line." ! (setq gnus-newsgroup-processable ! (cons article (delq article gnus-newsgroup-processable))) ! (let ((buffer-read-only nil)) ! (if (gnus-summary-goto-subject article) ! (progn ! (gnus-summary-show-thread) ! (and (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (forward-line 1)) ! (gnus-summary-update-mark gnus-process-mark 'replied) ! t)))) (defun gnus-summary-remove-process-mark (article) "Remove the process mark from ARTICLE and update the summary line." (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) ! (let ((buffer-read-only nil)) ! (if (gnus-summary-goto-subject article) ! (progn ! (gnus-summary-show-thread) ! (and (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (forward-line 1)) ! (gnus-summary-update-mark ? 'replied) ! (if (memq article gnus-newsgroup-replied) ! (gnus-summary-update-mark gnus-replied-mark 'replied)) ! t)))) (defun gnus-summary-mark-forward (n &optional mark no-expire) "Mark N articles as read forwards. ! If N is negative, mark backwards instead. ! Mark with MARK. If MARK is ? , ?! or ??, articles will be ! marked as unread. The difference between N and the actual number of articles marked is returned." --- 12125,12156 ---- the actual number of articles marked is returned." (interactive "p") + (gnus-set-global-variables) (gnus-summary-mark-forward n gnus-dormant-mark)) (defun gnus-summary-set-process-mark (article) "Set the process mark on ARTICLE and update the summary line." ! (setq gnus-newsgroup-processable ! (cons article (delq article gnus-newsgroup-processable))) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-show-thread) ! (gnus-summary-update-secondary-mark article))) (defun gnus-summary-remove-process-mark (article) "Remove the process mark from ARTICLE and update the summary line." (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-show-thread) ! (gnus-summary-update-secondary-mark article))) ! ! (defun gnus-summary-set-saved-mark (article) ! "Set the process mark on ARTICLE and update the summary line." ! (push article gnus-newsgroup-saved) ! (when (gnus-summary-goto-subject article) ! (gnus-summary-update-secondary-mark article))) (defun gnus-summary-mark-forward (n &optional mark no-expire) "Mark N articles as read forwards. ! If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is returned." *************** returned." *** 9500,9503 **** --- 12160,12164 ---- (gnus-summary-goto-unread (and gnus-summary-goto-unread + (not (eq gnus-summary-goto-unread 'never)) (not (memq mark (list gnus-unread-mark gnus-ticked-mark gnus-dormant-mark))))) *************** returned." *** 9506,9515 **** (while (and (> n 0) (gnus-summary-mark-article nil mark no-expire) ! (zerop (gnus-summary-next-subject ! (if backward -1 1) gnus-summary-goto-unread t))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) (gnus-summary-recenter) ! (gnus-summary-position-cursor) (gnus-set-mode-line 'summary) n)) --- 12167,12179 ---- (while (and (> n 0) (gnus-summary-mark-article nil mark no-expire) ! (zerop (gnus-summary-next-subject ! (if backward -1 1) ! (and gnus-summary-goto-unread ! (not (eq gnus-summary-goto-unread 'never))) ! t))) (setq n (1- n))) (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) (gnus-summary-recenter) ! (gnus-summary-position-point) (gnus-set-mode-line 'summary) n)) *************** returned." *** 9523,9539 **** (setq gnus-newsgroup-reads (cons (cons article mark) gnus-newsgroup-reads)) ! ;; Possibly remove from cache, if that is used. (and gnus-use-cache (gnus-cache-enter-remove-article article)) ! (and gnus-newsgroup-auto-expire ! (or (= mark gnus-killed-mark) (= mark gnus-del-mark) ! (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-read-mark)) ! (progn ! (setq mark gnus-expirable-mark) ! (setq gnus-newsgroup-expirable ! (cons article gnus-newsgroup-expirable)))) ! (while (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (forward-line 1)) ! ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)) --- 12187,12203 ---- (setq gnus-newsgroup-reads (cons (cons article mark) gnus-newsgroup-reads)) ! ;; Possibly remove from cache, if that is used. (and gnus-use-cache (gnus-cache-enter-remove-article article)) ! ;; Allow the backend to change the mark. ! (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) ! ;; Check for auto-expiry. ! (when (and gnus-newsgroup-auto-expire ! (or (= mark gnus-killed-mark) (= mark gnus-del-mark) ! (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-ancient-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark))) ! (setq mark gnus-expirable-mark) ! (push article gnus-newsgroup-expirable)) ! ;; Set the mark in the buffer. (gnus-summary-update-mark mark 'unread) t)) *************** returned." *** 9542,9597 **** "Mark the current article quickly as unread with MARK." (let ((article (gnus-summary-article-number))) ! (or (memq article gnus-newsgroup-unreads) ! (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads))) ! (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) ! (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) ! (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) ! (setq gnus-newsgroup-reads ! (delq (assq article gnus-newsgroup-reads) ! gnus-newsgroup-reads)) ! (if (= mark gnus-ticked-mark) ! (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked))) ! (if (= mark gnus-dormant-mark) ! (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant))) ! ! ;; See whether the article is to be put in the cache. ! (and gnus-use-cache ! (vectorp (gnus-get-header-by-num article)) ! (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article ! (gnus-get-header-by-num article) ! (= mark gnus-ticked-mark) ! (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) ! (while (eq (gnus-summary-article-mark) gnus-dummy-mark) ! (forward-line 1)) ! ;; Fix the mark. ! (gnus-summary-update-mark mark 'unread) t)) (defun gnus-summary-mark-article (&optional article mark no-expire) "Mark ARTICLE with MARK. MARK can be any character. ! Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' ! (dormant) and `?E' (expirable). If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be ! marked." (and (stringp mark) (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. (and (not no-expire) ! gnus-newsgroup-auto-expire (or (not mark) ! (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-read-mark)))) (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) (or article (error "No article on current line")) ! (if (or (= mark gnus-unread-mark) ! (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) --- 12206,12263 ---- "Mark the current article quickly as unread with MARK." (let ((article (gnus-summary-article-number))) ! (if (< article 0) ! (gnus-error 1 "Unmarkable article") ! (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) ! (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) ! (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) ! (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) ! (cond ((= mark gnus-ticked-mark) ! (push article gnus-newsgroup-marked)) ! ((= mark gnus-dormant-mark) ! (push article gnus-newsgroup-dormant)) ! (t ! (push article gnus-newsgroup-unreads))) ! (setq gnus-newsgroup-reads ! (delq (assq article gnus-newsgroup-reads) ! gnus-newsgroup-reads)) ! ! ;; See whether the article is to be put in the cache. ! (and gnus-use-cache ! (vectorp (gnus-summary-article-header article)) ! (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article ! (gnus-summary-article-header article) ! (= mark gnus-ticked-mark) ! (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) ! ;; Fix the mark. ! (gnus-summary-update-mark mark 'unread)) t)) (defun gnus-summary-mark-article (&optional article mark no-expire) "Mark ARTICLE with MARK. MARK can be any character. ! Four MARK strings are reserved: `? ' (unread), `?!' (ticked), ! `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?D' is used. If ARTICLE is nil, then the article on the current line will be ! marked." ! ;; The mark might be a string. (and (stringp mark) (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. (and (not no-expire) ! gnus-newsgroup-auto-expire (or (not mark) ! (and (numberp mark) (or (= mark gnus-killed-mark) (= mark gnus-del-mark) (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) ! (= mark gnus-read-mark) (= mark gnus-souped-mark)))) (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) (article (or article (gnus-summary-article-number)))) (or article (error "No article on current line")) ! (if (or (= mark gnus-unread-mark) ! (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)) (gnus-mark-article-as-unread article mark) *************** marked." *** 9601,9638 **** (and gnus-use-cache (not (= mark gnus-canceled-mark)) ! (vectorp (gnus-get-header-by-num article)) (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article ! (gnus-get-header-by-num article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) ! (if (gnus-summary-goto-subject article) (let ((buffer-read-only nil)) (gnus-summary-show-thread) - (and (eq (gnus-summary-article-mark) gnus-dummy-mark) - (forward-line 1)) ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)))) (defun gnus-summary-update-mark (mark type) (beginning-of-line) (let ((forward (cdr (assq type gnus-summary-mark-positions))) ! (buffer-read-only nil) ! plist) ! (if (not forward) ! () ! (forward-char forward) ! (setq plist (text-properties-at (point))) ! (delete-char 1) ! (insert mark) ! (and plist (add-text-properties (1- (point)) (point) plist)) ! (and (eq type 'unread) ! (progn ! (add-text-properties (1- (point)) (point) (list 'gnus-mark mark)) ! (gnus-summary-update-line (eq mark gnus-unread-mark))))))) ! (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." --- 12267,12318 ---- (and gnus-use-cache (not (= mark gnus-canceled-mark)) ! (vectorp (gnus-summary-article-header article)) (save-excursion ! (gnus-cache-possibly-enter-article ! gnus-newsgroup-name article ! (gnus-summary-article-header article) (= mark gnus-ticked-mark) (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) ! (if (gnus-summary-goto-subject article nil t) (let ((buffer-read-only nil)) (gnus-summary-show-thread) ;; Fix the mark. (gnus-summary-update-mark mark 'unread) t)))) + (defun gnus-summary-update-secondary-mark (article) + "Update the secondary (read, process, cache) mark." + (gnus-summary-update-mark + (cond ((memq article gnus-newsgroup-processable) + gnus-process-mark) + ((memq article gnus-newsgroup-cached) + gnus-cached-mark) + ((memq article gnus-newsgroup-replied) + gnus-replied-mark) + ((memq article gnus-newsgroup-saved) + gnus-saved-mark) + (t gnus-unread-mark)) + 'replied) + (when (gnus-visual-p 'summary-highlight 'highlight) + (run-hooks 'gnus-summary-update-hook)) + t) + (defun gnus-summary-update-mark (mark type) (beginning-of-line) (let ((forward (cdr (assq type gnus-summary-mark-positions))) ! (buffer-read-only nil)) ! (when (and forward ! (<= (+ forward (point)) (point-max))) ! ;; Go to the right position on the line. ! (goto-char (+ forward (point))) ! ;; Replace the old mark with the new mark. ! (subst-char-in-region (point) (1+ (point)) (following-char) mark) ! ;; Optionally update the marks by some user rule. ! (when (eq type 'unread) ! (gnus-data-set-mark ! (gnus-data-find (gnus-summary-article-number)) mark) ! (gnus-summary-update-line (eq mark gnus-unread-mark)))))) ! (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." *************** marked." *** 9646,9674 **** (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) ! (setq gnus-newsgroup-reads ! (cons (cons article mark) gnus-newsgroup-reads)) ! ;; Possibly remove from cache, if that is used. ! (and gnus-use-cache (gnus-cache-enter-remove-article article)))) (defun gnus-mark-article-as-unread (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." (let ((mark (or mark gnus-ticked-mark))) - ;; Add to unread list. - (or (memq article gnus-newsgroup-unreads) - (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads))) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) ! gnus-newsgroup-reads)) ! (if (= mark gnus-ticked-mark) ! (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked))) ! (if (= mark gnus-dormant-mark) ! (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant))))) ! (defalias 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) ! (make-obsolete 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (defun gnus-summary-tick-article-forward (n) --- 12326,12354 ---- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) ! (push (cons article mark) gnus-newsgroup-reads) ! ;; Possibly remove from cache, if that is used. ! (when gnus-use-cache ! (gnus-cache-enter-remove-article article)))) (defun gnus-mark-article-as-unread (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." (let ((mark (or mark gnus-ticked-mark))) (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) + (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) + (cond ((= mark gnus-ticked-mark) + (push article gnus-newsgroup-marked)) + ((= mark gnus-dormant-mark) + (push article gnus-newsgroup-dormant)) + (t + (push article gnus-newsgroup-unreads))) (setq gnus-newsgroup-reads (delq (assq article gnus-newsgroup-reads) ! gnus-newsgroup-reads)))) ! (defalias 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) ! (make-obsolete 'gnus-summary-mark-as-unread-forward 'gnus-summary-tick-article-forward) (defun gnus-summary-tick-article-forward (n) *************** The difference between N and the number *** 9679,9685 **** (gnus-summary-mark-forward n gnus-ticked-mark)) ! (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) ! (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (defun gnus-summary-tick-article-backward (n) --- 12359,12365 ---- (gnus-summary-mark-forward n gnus-ticked-mark)) ! (defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) ! (make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) (defun gnus-summary-tick-article-backward (n) *************** The difference between N and the number *** 9695,9698 **** --- 12375,12379 ---- Optional 1st argument ARTICLE specifies article number to be marked as unread. Optional 2nd argument CLEAR-MARK remove any kinds of mark." + (interactive) (gnus-summary-mark-article article (if clear-mark gnus-unread-mark gnus-ticked-mark))) *************** The difference between N and the number *** 9734,9741 **** (defun gnus-summary-mark-unread-as-read () "Intended to be used by `gnus-summary-mark-article-hook'." ! (or (memq gnus-current-article gnus-newsgroup-marked) ! (memq gnus-current-article gnus-newsgroup-dormant) ! (memq gnus-current-article gnus-newsgroup-expirable) ! (gnus-summary-mark-article gnus-current-article gnus-read-mark))) (defun gnus-summary-mark-region-as-read (point mark all) --- 12415,12427 ---- (defun gnus-summary-mark-unread-as-read () "Intended to be used by `gnus-summary-mark-article-hook'." ! (when (memq gnus-current-article gnus-newsgroup-unreads) ! (gnus-summary-mark-article gnus-current-article gnus-read-mark))) ! ! (defun gnus-summary-mark-read-and-unread-as-read () ! "Intended to be used by `gnus-summary-mark-article-hook'." ! (let ((mark (gnus-summary-article-mark))) ! (when (or (gnus-unread-mark-p mark) ! (gnus-read-mark-p mark)) ! (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) (defun gnus-summary-mark-region-as-read (point mark all) *************** even ticked and dormant ones." *** 9745,9848 **** (interactive "r\nP") (save-excursion ! (goto-char point) ! (beginning-of-line) ! (while (and ! (< (point) mark) ! (progn ! (and ! (or all ! (and ! (not (memq (gnus-summary-article-number) ! gnus-newsgroup-marked)) ! (not (memq (gnus-summary-article-number) ! gnus-newsgroup-dormant)))) ! (gnus-summary-mark-article ! (gnus-summary-article-number) gnus-del-mark)) ! t) ! (zerop (forward-line 1)))))) ! ! ;; Fix by Per Abrahamsen . ! (defalias 'gnus-summary-delete-marked-as-read ! 'gnus-summary-remove-lines-marked-as-read) ! (make-obsolete 'gnus-summary-delete-marked-as-read ! 'gnus-summary-remove-lines-marked-as-read) ! (defun gnus-summary-remove-lines-marked-as-read () ! "Remove lines that are marked as read." ! (interactive) ! (gnus-summary-remove-lines-marked-with ! (concat (mapconcat ! (lambda (char) (char-to-string (symbol-value char))) ! '(gnus-del-mark gnus-read-mark gnus-ancient-mark ! gnus-killed-mark gnus-kill-file-mark ! gnus-low-score-mark gnus-expirable-mark ! gnus-canceled-mark gnus-catchup-mark) ! "")))) ! ! (defalias 'gnus-summary-delete-marked-with ! 'gnus-summary-remove-lines-marked-with) ! (make-obsolete 'gnus-summary-delete-marked-with ! 'gnus-summary-remove-lines-marked-with) ! ;; Rewrite by Daniel Quinlan . ! (defun gnus-summary-remove-lines-marked-with (marks) ! "Remove lines that are marked with MARKS (e.g. \"DK\")." ! (interactive "sMarks: ") ! ;; Fix by Sudish Joseph . ! (gnus-set-global-variables) ! (let ((buffer-read-only nil) ! (orig-article ! (let ((gnus-summary-check-current t)) ! (gnus-summary-search-forward t) ! (gnus-summary-article-number))) ! (marks (concat "^[" marks "]"))) ! (goto-char (point-min)) ! (if gnus-newsgroup-adaptive ! (gnus-score-remove-lines-adaptive marks) ! (while (re-search-forward marks nil t) ! (gnus-delete-line))) ! ;; If we use dummy roots, we have to do an additional sweep over ! ;; the buffer. ! (if (not (eq gnus-summary-make-false-root 'dummy)) ! () ! (goto-char (point-min)) ! (setq marks (concat "^[" (char-to-string gnus-dummy-mark) "]")) ! (while (re-search-forward marks nil t) ! (if (gnus-subject-equal ! (gnus-summary-subject-string) ! (progn ! (forward-line 1) ! (gnus-summary-subject-string))) ! () ! (forward-line -1) ! (gnus-delete-line)))) ! (or (zerop (buffer-size)) ! (gnus-summary-goto-subject orig-article) ! (if (eobp) ! (gnus-summary-prev-subject 1) ! (gnus-summary-position-cursor))))) ! ! (defun gnus-summary-expunge-below (&optional score) ! "Remove articles with score less than SCORE." ! (interactive "P") ! (gnus-set-global-variables) ! (setq score (if score ! (prefix-numeric-value score) ! (or gnus-summary-default-score 0))) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (goto-char (point-min)) ! (let ((buffer-read-only nil) ! beg) ! (while (not (eobp)) ! (if (< (gnus-summary-article-score) score) ! (progn ! (setq beg (point)) ! (forward-line 1) ! (delete-region beg (point))) ! (forward-line 1))) ! ;; Adjust point. ! (or (zerop (buffer-size)) ! (if (eobp) ! (gnus-summary-prev-subject 1) ! (gnus-summary-position-cursor)))))) (defun gnus-summary-mark-below (score mark) --- 12431,12446 ---- (interactive "r\nP") (save-excursion ! (let (article) ! (goto-char point) ! (beginning-of-line) ! (while (and ! (< (point) mark) ! (progn ! (when (or all ! (memq (setq article (gnus-summary-article-number)) ! gnus-newsgroup-unreads)) ! (gnus-summary-mark-article article gnus-del-mark)) ! t) ! (gnus-summary-find-next)))))) (defun gnus-summary-mark-below (score mark) *************** even ticked and dormant ones." *** 9856,9863 **** (set-buffer gnus-summary-buffer) (goto-char (point-min)) ! (while (not (eobp)) ! (and (< (gnus-summary-article-score) score) ! (gnus-summary-mark-article nil mark)) ! (forward-line 1)))) (defun gnus-summary-kill-below (&optional score) --- 12454,12462 ---- (set-buffer gnus-summary-buffer) (goto-char (point-min)) ! (while ! (progn ! (and (< (gnus-summary-article-score) score) ! (gnus-summary-mark-article nil mark)) ! (gnus-summary-find-next))))) (defun gnus-summary-kill-below (&optional score) *************** even ticked and dormant ones." *** 9889,9901 **** (set-buffer gnus-summary-buffer) (goto-char (point-min)) ! (while (not (eobp)) ! (if (> (gnus-summary-article-score) score) ! (progn ! (gnus-summary-mark-article nil mark) ! (forward-line 1)) ! (forward-line 1))))) ! ;; Suggested by Daniel Quinlan . ! (defun gnus-summary-show-all-expunged () "Display all the hidden articles that were expunged for low scores." (interactive) --- 12488,12500 ---- (set-buffer gnus-summary-buffer) (goto-char (point-min)) ! (while (and (progn ! (if (> (gnus-summary-article-score) score) ! (gnus-summary-mark-article nil mark)) ! t) ! (gnus-summary-find-next))))) ! ;; Suggested by Daniel Quinlan . ! (defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) ! (defun gnus-summary-limit-include-expunged () "Display all the hidden articles that were expunged for low scores." (interactive) *************** even ticked and dormant ones." *** 9905,9953 **** headers h) (while scored ! (or (gnus-summary-goto-subject (car (car scored))) ! (and (setq h (gnus-get-header-by-num (car (car scored)))) ! (< (cdr (car scored)) gnus-summary-expunge-below) (setq headers (cons h headers)))) (setq scored (cdr scored))) (or headers (error "No expunged articles hidden.")) (goto-char (point-min)) ! (save-excursion ! (gnus-summary-update-lines ! (point) ! (progn ! (gnus-summary-prepare-unthreaded (nreverse headers)) ! (point))))) ! (goto-char (point-min)) ! (gnus-summary-position-cursor))) ! ! (defun gnus-summary-show-all-dormant () ! "Display all the hidden articles that are marked as dormant." ! (interactive) ! (gnus-set-global-variables) ! (let ((buffer-read-only nil)) ! (let ((dormant gnus-newsgroup-dormant) ! headers h) ! (while dormant ! (or (gnus-summary-goto-subject (car dormant)) ! (and (setq h (gnus-get-header-by-num (car dormant))) ! (setq headers (cons h headers)))) ! (setq dormant (cdr dormant))) ! (or headers (error "No dormant articles hidden.")) ! (goto-char (point-min)) ! (save-excursion ! (gnus-summary-update-lines ! (point) ! (progn ! (gnus-summary-prepare-unthreaded (nreverse headers)) ! (point))))) (goto-char (point-min)) ! (gnus-summary-position-cursor))) ! ! (defun gnus-summary-hide-all-dormant () ! "Hide all dormant articles." ! (interactive) ! (gnus-set-global-variables) ! (gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark)) ! (gnus-summary-position-cursor)) (defun gnus-summary-catchup (&optional all quietly to-here not-mark) --- 12504,12517 ---- headers h) (while scored ! (or (gnus-summary-goto-subject (caar scored)) ! (and (setq h (gnus-summary-article-header (caar scored))) ! (< (cdar scored) gnus-summary-expunge-below) (setq headers (cons h headers)))) (setq scored (cdr scored))) (or headers (error "No expunged articles hidden.")) (goto-char (point-min)) ! (gnus-summary-prepare-unthreaded (nreverse headers))) (goto-char (point-min)) ! (gnus-summary-position-point))) (defun gnus-summary-catchup (&optional all quietly to-here not-mark) *************** even ticked and dormant ones." *** 9955,9959 **** If prefix argument ALL is non-nil, all articles are 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 articles before this point will be marked as read. The number of articles marked as read is returned." --- 12519,12523 ---- If prefix argument ALL is non-nil, all articles are 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 articles before this point will be marked as read. The number of articles marked as read is returned." *************** The number of articles marked as read is *** 9968,9996 **** "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) ! (if (and not-mark (not gnus-newsgroup-adaptive) (not gnus-newsgroup-auto-expire)) (progn ! (and all (setq gnus-newsgroup-marked nil ! gnus-newsgroup-dormant nil)) ! (setq gnus-newsgroup-unreads ! (append gnus-newsgroup-marked gnus-newsgroup-dormant))) ;; We actually mark all articles as canceled, which we ! ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) (if (gnus-summary-first-subject (not all)) ! (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) ! (gnus-summary-search-subject nil (not all))))) ! (or to-here ! (setq gnus-newsgroup-unreads ! (append gnus-newsgroup-marked ! gnus-newsgroup-dormant))))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (and (not to-here) (eq 'nnvirtual (car method))) (nnvirtual-catchup-group (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) ! (gnus-summary-position-cursor))) (defun gnus-summary-catchup-to-here (&optional all) --- 12532,12559 ---- "Mark absolutely all articles as read? " "Mark all unread articles as read? "))) ! (if (and not-mark (not gnus-newsgroup-adaptive) (not gnus-newsgroup-auto-expire)) (progn ! (when all ! (setq gnus-newsgroup-marked nil ! gnus-newsgroup-dormant nil)) ! (setq gnus-newsgroup-unreads nil)) ;; We actually mark all articles as canceled, which we ! ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) (if (gnus-summary-first-subject (not all)) ! (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) ! (gnus-summary-find-next (not all))))) ! (unless to-here ! (setq gnus-newsgroup-unreads nil)) ! (gnus-set-mode-line 'summary))) (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) (if (and (not to-here) (eq 'nnvirtual (car method))) (nnvirtual-catchup-group (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all))) ! (gnus-summary-position-point))) (defun gnus-summary-catchup-to-here (&optional all) *************** If ALL is non-nil, also mark ticked and *** 10000,10009 **** (gnus-set-global-variables) (save-excursion ! (and (zerop (forward-line -1)) ! (progn ! (end-of-line) ! (gnus-summary-catchup all t (point)) ! (gnus-set-mode-line 'summary)))) ! (gnus-summary-position-cursor)) (defun gnus-summary-catchup-all (&optional quietly) --- 12563,12572 ---- (gnus-set-global-variables) (save-excursion ! (gnus-save-hidden-threads ! (let ((beg (point))) ! ;; We check that there are unread articles. ! (when (or all (gnus-summary-find-prev)) ! (gnus-summary-catchup all t beg))))) ! (gnus-summary-position-point)) (defun gnus-summary-catchup-all (&optional quietly) *************** If prefix argument ALL is non-nil, all a *** 10020,10025 **** (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. ! (if (and (eq gnus-auto-select-next 'quietly) ! (not (gnus-ephemeral-group-p gnus-newsgroup-name))) (gnus-summary-next-group nil) (gnus-summary-exit))) --- 12583,12587 ---- (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. ! (if (eq gnus-auto-select-next 'quietly) (gnus-summary-next-group nil) (gnus-summary-exit))) *************** If prefix argument ALL is non-nil, all a *** 10035,10046 **** "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as ! read." (interactive "P") (gnus-set-global-variables) ! (gnus-summary-catchup all) ! (gnus-summary-next-group)) ;; Thread-based commands. (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. --- 12597,12705 ---- "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as ! read." (interactive "P") (gnus-set-global-variables) ! (save-excursion ! (gnus-summary-catchup all)) ! (gnus-summary-next-article t nil nil t)) ;; Thread-based commands. + (defun gnus-summary-articles-in-thread (&optional article) + "Return a list of all articles in the current thread. + If ARTICLE is non-nil, return all articles in the thread that starts + with that article." + (let* ((article (or article (gnus-summary-article-number))) + (data (gnus-data-find-list article)) + (top-level (gnus-data-level (car data))) + (top-subject + (cond ((null gnus-thread-operation-ignore-subject) + (gnus-simplify-subject-re + (mail-header-subject (gnus-data-header (car data))))) + ((eq gnus-thread-operation-ignore-subject 'fuzzy) + (gnus-simplify-subject-fuzzy + (mail-header-subject (gnus-data-header (car data))))) + (t nil))) + (end-point (save-excursion + (if (gnus-summary-go-to-next-thread) + (point) (point-max)))) + articles) + (while (and data + (< (gnus-data-pos (car data)) end-point)) + (when (or (not top-subject) + (string= top-subject + (if (eq gnus-thread-operation-ignore-subject 'fuzzy) + (gnus-simplify-subject-fuzzy + (mail-header-subject + (gnus-data-header (car data)))) + (gnus-simplify-subject-re + (mail-header-subject + (gnus-data-header (car data))))))) + (push (gnus-data-number (car data)) articles)) + (unless (and (setq data (cdr data)) + (> (gnus-data-level (car data)) top-level)) + (setq data nil))) + ;; Return the list of articles. + (nreverse articles))) + + (defun gnus-summary-rethread-current () + "Rethread the thread the current article is part of." + (interactive) + (gnus-set-global-variables) + (let* ((gnus-show-threads t) + (article (gnus-summary-article-number)) + (id (mail-header-id (gnus-summary-article-header))) + (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) + (unless id + (error "No article on the current line")) + (gnus-rebuild-thread id) + (gnus-summary-goto-subject article))) + + (defun gnus-summary-reparent-thread () + "Make current article child of the marked (or previous) article. + + Note that the re-threading will only work if `gnus-thread-ignore-subject' + is non-nil or the Subject: of both articles are the same." + (interactive) + (or (not (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing.")) + (or (<= (length gnus-newsgroup-processable) 1) + (error "No more than one article may be marked.")) + (save-window-excursion + (let ((gnus-article-buffer " *reparent*") + (current-article (gnus-summary-article-number)) + ; first grab the marked article, otherwise one line up. + (parent-article (if (not (null gnus-newsgroup-processable)) + (car gnus-newsgroup-processable) + (save-excursion + (if (eq (forward-line -1) 0) + (gnus-summary-article-number) + (error "Beginning of summary buffer.")))))) + (or (not (eq current-article parent-article)) + (error "An article may not be self-referential.")) + (let ((message-id (mail-header-id + (gnus-summary-article-header parent-article)))) + (or (and message-id (not (equal message-id ""))) + (error "No message-id in desired parent.")) + (gnus-summary-select-article t t nil current-article) + (set-buffer gnus-article-buffer) + (setq buffer-read-only nil) + (let ((buf (format "%s" (buffer-string)))) + (erase-buffer) + (insert buf)) + (goto-char (point-min)) + (if (search-forward-regexp "^References: " nil t) + (insert message-id " " ) + (insert "References: " message-id "\n")) + (or (gnus-request-replace-article current-article + (car gnus-article-current) + gnus-article-buffer) + (error "Couldn't replace article.")) + (set-buffer gnus-summary-buffer) + (gnus-summary-unmark-all-processable) + (gnus-summary-rethread-current) + (gnus-message 3 "Article %d is now the child of article %d." + current-article parent-article))))) + (defun gnus-summary-toggle-threads (&optional arg) "Toggle showing conversation threads. *************** If ARG is positive number, turn showing *** 10054,10058 **** (gnus-summary-prepare) (gnus-summary-goto-subject current) ! (gnus-summary-position-cursor))) (defun gnus-summary-show-all-threads () --- 12713,12717 ---- (gnus-summary-prepare) (gnus-summary-goto-subject current) ! (gnus-summary-position-point))) (defun gnus-summary-show-all-threads () *************** If ARG is positive number, turn showing *** 10063,10067 **** (let ((buffer-read-only nil)) (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) ! (gnus-summary-position-cursor)) (defun gnus-summary-show-thread () --- 12722,12726 ---- (let ((buffer-read-only nil)) (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) ! (gnus-summary-position-point)) (defun gnus-summary-show-thread () *************** Returns nil if no thread was there to be *** 10071,10075 **** (gnus-set-global-variables) (let ((buffer-read-only nil) ! (orig (prog1 (point) (gnus-summary-hide-thread))) ;; first goto end then to beg, to have point at beg after let (end (progn (end-of-line) (point))) --- 12730,12734 ---- (gnus-set-global-variables) (let ((buffer-read-only nil) ! (orig (point)) ;; first goto end then to beg, to have point at beg after let (end (progn (end-of-line) (point))) *************** Returns nil if no thread was there to be *** 10080,10084 **** (subst-char-in-region beg end ?\^M ?\n t) (goto-char orig) ! (gnus-summary-position-cursor)))) (defun gnus-summary-hide-all-threads () --- 12739,12743 ---- (subst-char-in-region beg end ?\^M ?\n t) (goto-char orig) ! (gnus-summary-position-point)))) (defun gnus-summary-hide-all-threads () *************** Returns nil if no thread was there to be *** 10089,10095 **** (goto-char (point-min)) (gnus-summary-hide-thread) ! (while (and (not (eobp)) (zerop (forward-line 1))) (gnus-summary-hide-thread))) ! (gnus-summary-position-cursor)) (defun gnus-summary-hide-thread () --- 12748,12754 ---- (goto-char (point-min)) (gnus-summary-hide-thread) ! (while (zerop (gnus-summary-next-thread 1 t)) (gnus-summary-hide-thread))) ! (gnus-summary-position-point)) (defun gnus-summary-hide-thread () *************** Returns nil if no threads were there to *** 10100,10119 **** (let ((buffer-read-only nil) (start (point)) ! (level (gnus-summary-thread-level)) ! (end (point))) ;; Go forward until either the buffer ends or the subthread ! ;; ends. ! (if (eobp) ! () ! (while (and (zerop (forward-line 1)) ! (> (gnus-summary-thread-level) level)) ! (setq end (point))) (prog1 ! (save-excursion ! (goto-char end) ! (search-backward "\n" start t)) ! (subst-char-in-region start end ?\n ?\^M t) ! (forward-line -1) ! (gnus-summary-position-cursor))))) (defun gnus-summary-go-to-next-thread (&optional previous) --- 12759,12779 ---- (let ((buffer-read-only nil) (start (point)) ! (article (gnus-summary-article-number))) ! (goto-char start) ;; Go forward until either the buffer ends or the subthread ! ;; ends. ! (when (and (not (eobp)) ! (or (zerop (gnus-summary-next-thread 1 t)) ! (goto-char (point-max)))) (prog1 ! (if (and (> (point) start) ! (search-backward "\n" start t)) ! (progn ! (subst-char-in-region start (point) ?\n ?\^M) ! (gnus-summary-goto-subject article)) ! (goto-char start) ! nil) ! ;;(gnus-summary-position-point) ! )))) (defun gnus-summary-go-to-next-thread (&optional previous) *************** If PREVIOUS is non-nil, go to previous t *** 10122,10153 **** Return the article number moved to, or nil if moving was impossible." (let ((level (gnus-summary-thread-level)) ! (article (gnus-summary-article-number))) ! (if previous ! (while (and (zerop (forward-line -1)) ! (> (gnus-summary-thread-level) level))) ! (while (and (save-excursion ! (forward-line 1) ! (not (eobp))) ! (zerop (forward-line 1)) ! (> (gnus-summary-thread-level) level)))) ! (gnus-summary-recenter) ! (gnus-summary-position-cursor) ! (let ((oart (gnus-summary-article-number))) ! (and (/= oart article) oart)))) ! (defun gnus-summary-next-thread (n) "Go to the same level next N'th thread. If N is negative, search backward instead. Returns the difference between N and the number of skips actually ! done." (interactive "p") (gnus-set-global-variables) (let ((backward (< n 0)) ! (n (abs n))) (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) ! (setq n (1- n))) ! (gnus-summary-position-cursor) ! (if (/= 0 n) (gnus-message 7 "No more threads")) n)) --- 12782,12847 ---- Return the article number moved to, or nil if moving was impossible." (let ((level (gnus-summary-thread-level)) ! (way (if previous -1 1)) ! (beg (point))) ! (forward-line way) ! (while (and (not (eobp)) ! (< level (gnus-summary-thread-level))) ! (forward-line way)) ! (if (eobp) ! (progn ! (goto-char beg) ! nil) ! (setq beg (point)) ! (prog1 ! (gnus-summary-article-number) ! (goto-char beg))))) ! ! (defun gnus-summary-go-to-next-thread-old (&optional previous) ! "Go to the same level (or less) next thread. ! If PREVIOUS is non-nil, go to previous thread instead. ! Return the article number moved to, or nil if moving was impossible." ! (if (and (eq gnus-summary-make-false-root 'dummy) ! (gnus-summary-article-intangible-p)) ! (let ((beg (point))) ! (while (and (zerop (forward-line 1)) ! (not (gnus-summary-article-intangible-p)) ! (not (zerop (save-excursion ! (gnus-summary-thread-level)))))) ! (if (eobp) ! (progn ! (goto-char beg) ! nil) ! (point))) ! (let* ((level (gnus-summary-thread-level)) ! (article (gnus-summary-article-number)) ! (data (cdr (gnus-data-find-list article (gnus-data-list previous)))) ! oart) ! (while data ! (if (<= (gnus-data-level (car data)) level) ! (setq oart (gnus-data-number (car data)) ! data nil) ! (setq data (cdr data)))) ! (and oart ! (gnus-summary-goto-subject oart))))) ! (defun gnus-summary-next-thread (n &optional silent) "Go to the same level next N'th thread. If N is negative, search backward instead. Returns the difference between N and the number of skips actually ! done. ! ! If SILENT, don't output messages." (interactive "p") (gnus-set-global-variables) (let ((backward (< n 0)) ! (n (abs n)) ! old dum int) (while (and (> n 0) (gnus-summary-go-to-next-thread backward)) ! (decf n)) ! (unless silent ! (gnus-summary-position-point)) ! (when (and (not silent) (/= 0 n)) ! (gnus-message 7 "No more threads")) n)) *************** done." *** 10160,10185 **** (gnus-summary-next-thread (- n))) ! (defun gnus-summary-go-down-thread (&optional same) ! "Go down one level in the current thread. ! If SAME is non-nil, also move to articles of the same level." ! (let ((level (gnus-summary-thread-level)) ! (start (point))) ! (if (and (zerop (forward-line 1)) ! (> (gnus-summary-thread-level) level)) ! t ! (goto-char start) ! nil))) (defun gnus-summary-go-up-thread () "Go up one level in the current thread." ! (let ((level (gnus-summary-thread-level)) ! (start (point))) ! (while (and (zerop (forward-line -1)) ! (>= (gnus-summary-thread-level) level))) ! (if (>= (gnus-summary-thread-level) level) ! (progn ! (goto-char start) ! nil) ! t))) (defun gnus-summary-down-thread (n) --- 12854,12868 ---- (gnus-summary-next-thread (- n))) ! (defun gnus-summary-go-down-thread () ! "Go down one level in the current thread." ! (let ((children (gnus-summary-article-children))) ! (and children ! (gnus-summary-goto-subject (car children))))) (defun gnus-summary-go-up-thread () "Go up one level in the current thread." ! (let ((parent (gnus-summary-article-parent))) ! (and parent ! (gnus-summary-goto-subject parent)))) (defun gnus-summary-down-thread (n) *************** taken." *** 10196,10200 **** (gnus-summary-go-down-thread))) (setq n (1- n))) ! (gnus-summary-position-cursor) (if (/= 0 n) (gnus-message 7 "Can't go further")) n)) --- 12879,12883 ---- (gnus-summary-go-down-thread))) (setq n (1- n))) ! (gnus-summary-position-point) (if (/= 0 n) (gnus-message 7 "Can't go further")) n)) *************** taken." *** 10209,10212 **** --- 12892,12902 ---- (gnus-summary-down-thread (- n))) + (defun gnus-summary-top-thread () + "Go to the top of the thread." + (interactive) + (gnus-set-global-variables) + (while (gnus-summary-go-up-thread)) + (gnus-summary-article-number)) + (defun gnus-summary-kill-thread (&optional unmark) "Mark articles under current thread as read. *************** If the prefix argument is negative, tick *** 10215,10237 **** (interactive "P") (gnus-set-global-variables) ! (if unmark ! (setq unmark (prefix-numeric-value unmark))) ! (let ((killing t) ! (level (gnus-summary-thread-level))) (save-excursion ;; Expand the thread. (gnus-summary-show-thread) ! (while killing ! ;; Mark the article... ! (cond ((null unmark) (gnus-summary-mark-article-as-read ! gnus-killed-mark)) ! ((> unmark 0) (gnus-summary-mark-article-as-unread ! gnus-unread-mark)) ! (t (gnus-summary-mark-article-as-unread gnus-ticked-mark))) ! ;; ...and go forward until either the buffer ends or the subtree ! ;; ends. ! (if (not (and (zerop (forward-line 1)) ! (> (gnus-summary-thread-level) level))) ! (setq killing nil)))) ;; Hide killed subtrees. (and (null unmark) --- 12905,12924 ---- (interactive "P") (gnus-set-global-variables) ! (when unmark ! (setq unmark (prefix-numeric-value unmark))) ! (let ((articles (gnus-summary-articles-in-thread))) (save-excursion ;; Expand the thread. (gnus-summary-show-thread) ! ;; Mark all the articles. ! (while articles ! (gnus-summary-goto-subject (car articles)) ! (cond ((null unmark) ! (gnus-summary-mark-article-as-read gnus-killed-mark)) ! ((> unmark 0) ! (gnus-summary-mark-article-as-unread gnus-unread-mark)) ! (t ! (gnus-summary-mark-article-as-unread gnus-ticked-mark))) ! (setq articles (cdr articles)))) ;; Hide killed subtrees. (and (null unmark) *************** If the prefix argument is negative, tick *** 10250,10259 **** Argument REVERSE means reverse order." (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-sort ! ;; `gnus-summary-article-number' is a macro, and `sort-subr' wants ! ;; a function, so we wrap it. ! (cons (lambda () (gnus-summary-article-number)) ! 'gnus-thread-sort-by-number) reverse)) (defun gnus-summary-sort-by-author (&optional reverse) --- 12937,12941 ---- Argument REVERSE means reverse order." (interactive "P") ! (gnus-summary-sort 'number reverse)) (defun gnus-summary-sort-by-author (&optional reverse) *************** If case-fold-search is non-nil, case of *** 10262,10280 **** Argument REVERSE means reverse order." (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-sort ! (cons ! (lambda () ! (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) ! extract) ! (if (not (vectorp header)) ! "" ! (setq extract (funcall gnus-extract-address-components ! (mail-header-from header))) ! (concat (or (car extract) (cdr extract)) ! "\r" (int-to-string (mail-header-number header)) ! "\r" (mail-header-subject header))))) ! 'gnus-thread-sort-by-author) ! reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) --- 12944,12948 ---- Argument REVERSE means reverse order." (interactive "P") ! (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) *************** If case-fold-search is non-nil, case of *** 10283,10302 **** Argument REVERSE means reverse order." (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-sort ! (cons ! (lambda () ! (let* ((header (gnus-get-header-by-num (gnus-summary-article-number))) ! extract) ! (if (not (vectorp header)) ! "" ! (setq extract (funcall gnus-extract-address-components ! (mail-header-from header))) ! (concat ! (downcase (gnus-simplify-subject (gnus-summary-subject-string) t)) ! "\r" (int-to-string (mail-header-number header)) ! "\r" (or (car extract) (cdr extract)))))) ! 'gnus-thread-sort-by-subject) ! reverse)) (defun gnus-summary-sort-by-date (&optional reverse) --- 12951,12955 ---- Argument REVERSE means reverse order." (interactive "P") ! (gnus-summary-sort 'subject reverse)) (defun gnus-summary-sort-by-date (&optional reverse) *************** Argument REVERSE means reverse order." *** 10304,10316 **** Argument REVERSE means reverse order." (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-sort ! (cons ! (lambda () ! (gnus-sortable-date ! (mail-header-date ! (gnus-get-header-by-num (gnus-summary-article-number))))) ! 'gnus-thread-sort-by-date) ! reverse)) (defun gnus-summary-sort-by-score (&optional reverse) --- 12957,12961 ---- Argument REVERSE means reverse order." (interactive "P") ! (gnus-summary-sort 'date reverse)) (defun gnus-summary-sort-by-score (&optional reverse) *************** Argument REVERSE means reverse order." *** 10318,10375 **** Argument REVERSE means reverse order." (interactive "P") ! (gnus-set-global-variables) ! (gnus-summary-sort ! (cons (lambda () (gnus-summary-article-score)) ! 'gnus-thread-sort-by-score) ! (not reverse))) - (defvar gnus-summary-already-sorted nil) (defun gnus-summary-sort (predicate reverse) ! ;; Sort summary buffer by PREDICATE. REVERSE means reverse order. ! (if gnus-summary-already-sorted ! () ! (let (buffer-read-only) ! (if (not gnus-show-threads) ! ;; We do untreaded sorting... ! (progn ! (goto-char (point-min)) ! (sort-subr reverse 'forward-line 'end-of-line (car predicate))) ! ;; ... or we do threaded sorting. ! (let ((gnus-thread-sort-functions (list (cdr predicate))) ! (gnus-summary-prepare-hook nil) ! (gnus-summary-already-sorted nil)) ! ;; We do that by simply regenerating the threads. ! (gnus-summary-prepare) ! (and gnus-show-threads ! gnus-thread-hide-subtree ! (gnus-summary-hide-all-threads)) ! ;; If in async mode, we send some info to the backend. ! (and gnus-newsgroup-async ! (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads)) ! (gnus-request-asynchronous ! gnus-newsgroup-name ! (if (and gnus-asynchronous-article-function ! (fboundp gnus-asynchronous-article-function)) ! (funcall gnus-asynchronous-article-function ! gnus-newsgroup-threads) ! gnus-newsgroup-threads)))))))) - (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." ! (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S] ! (year (aref date 0)) ! (month (aref date 1)) ! (day (aref date 2))) ! (timezone-make-sortable-date ! year month day ! (timezone-make-time-string ! (aref date 3) (aref date 4) (aref date 5))))) ! ! ;; Summary saving commands. ! (defun gnus-summary-save-article (&optional n) "Save the current article using the default saver function. If N is a positive number, save the N next articles. --- 12963,13016 ---- Argument REVERSE means reverse order." (interactive "P") ! (gnus-summary-sort 'score reverse)) (defun gnus-summary-sort (predicate reverse) ! "Sort summary buffer by PREDICATE. REVERSE means reverse order." ! (gnus-set-global-variables) ! (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) ! (article (intern (format "gnus-article-sort-by-%s" predicate))) ! (gnus-thread-sort-functions ! (list ! (if (not reverse) ! thread ! `(lambda (t1 t2) ! (,thread t2 t1))))) ! (gnus-article-sort-functions ! (list ! (if (not reverse) ! article ! `(lambda (t1 t2) ! (,article t2 t1))))) ! (buffer-read-only) ! (gnus-summary-prepare-hook nil)) ! ;; We do the sorting by regenerating the threads. ! (gnus-summary-prepare) ! ;; Hide subthreads if needed. ! (when (and gnus-show-threads gnus-thread-hide-subtree) ! (gnus-summary-hide-all-threads))) ! ;; If in async mode, we send some info to the backend. ! (when gnus-newsgroup-async ! (gnus-request-asynchronous ! gnus-newsgroup-name gnus-newsgroup-data))) (defun gnus-sortable-date (date) "Make sortable string by string-lessp from DATE. Timezone package is used." ! (condition-case () ! (progn ! (setq date (inline (timezone-fix-time ! date nil ! (aref (inline (timezone-parse-date date)) 4)))) ! (inline ! (timezone-make-sortable-date ! (aref date 0) (aref date 1) (aref date 2) ! (inline ! (timezone-make-time-string ! (aref date 3) (aref date 4) (aref date 5)))))) ! (error ""))) ! ;; Summary saving commands. ! (defun gnus-summary-save-article (&optional n not-saved) "Save the current article using the default saver function. If N is a positive number, save the N next articles. *************** The variable `gnus-default-article-saver *** 10380,10415 **** (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n))) (while articles ! (let ((header (gnus-get-header-by-num (car articles)))) ! (if (vectorp header) ! (progn ! (save-window-excursion ! (gnus-summary-select-article t nil nil (car articles))) ! (or gnus-save-all-headers ! (gnus-article-hide-headers t)) ! ;; Remove any X-Gnus lines. ! (save-excursion ! (save-restriction ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (goto-char (point-min)) ! (narrow-to-region (point) (or (search-forward "\n\n" nil t) ! (point-max))) ! (while (re-search-forward "^X-Gnus" nil t) ! (beginning-of-line) ! (delete-region (point) ! (progn (forward-line 1) (point)))) ! (widen)))) ! (save-window-excursion ! (if gnus-default-article-saver ! (funcall gnus-default-article-saver) ! (error "No default saver is defined.")))) (if (assq 'name header) (gnus-copy-file (cdr (assq 'name header))) ! (gnus-message 1 "Article %d is unsavable" (car articles))))) ! (gnus-summary-remove-process-mark (car articles)) ! (setq articles (cdr articles))) ! (gnus-summary-position-cursor) n)) --- 13021,13071 ---- (interactive "P") (gnus-set-global-variables) ! (let ((articles (gnus-summary-work-articles n)) ! (save-buffer (save-excursion ! (nnheader-set-temp-buffer " *Gnus Save*"))) ! file header article) (while articles ! (setq header (gnus-summary-article-header ! (setq article (pop articles)))) ! (if (not (vectorp header)) ! ;; This is a pseudo-article. (if (assq 'name header) (gnus-copy-file (cdr (assq 'name header))) ! (gnus-message 1 "Article %d is unsaveable" article)) ! ;; This is a real article. ! (save-window-excursion ! (gnus-summary-select-article t nil nil article)) ! (save-excursion ! (set-buffer save-buffer) ! (erase-buffer) ! (insert-buffer-substring gnus-original-article-buffer)) ! (unless gnus-save-all-headers ! ;; Remove headers accoring to `gnus-saved-headers'. ! (let ((gnus-visible-headers ! (or gnus-saved-headers gnus-visible-headers)) ! (gnus-article-buffer save-buffer)) ! (gnus-article-hide-headers 1 t))) ! (save-window-excursion ! (if (not gnus-default-article-saver) ! (error "No default saver is defined.") ! ;; !!! Magic! The saving functions all save ! ;; `gnus-original-article-buffer' (or so they think), ! ;; but we bind that variable to our save-buffer. ! (set-buffer gnus-article-buffer) ! (let ((gnus-original-article-buffer save-buffer)) ! (set-buffer gnus-summary-buffer) ! (setq file (funcall ! gnus-default-article-saver ! (cond ! ((not gnus-prompt-before-saving) ! 'default) ! ((eq gnus-prompt-before-saving 'always) ! nil) ! (t file))))))) ! (gnus-summary-remove-process-mark article) ! (unless not-saved ! (gnus-summary-set-saved-mark article)))) ! (gnus-kill-buffer save-buffer) ! (gnus-summary-position-point) n)) *************** pipe those articles instead." *** 10423,10427 **** (gnus-set-global-variables) (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) ! (gnus-summary-save-article arg)) (gnus-configure-windows 'pipe)) --- 13079,13083 ---- (gnus-set-global-variables) (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) ! (gnus-summary-save-article arg t)) (gnus-configure-windows 'pipe)) *************** save those articles instead." *** 10459,10505 **** (gnus-summary-save-article arg))) ! (defun gnus-read-save-file-name (prompt default-name) ! (let ((methods gnus-split-methods) ! split-name) ! (if (not gnus-split-methods) ! () (save-excursion ! (set-buffer gnus-article-buffer) ! (gnus-narrow-to-headers) ! (while methods ! (goto-char (point-min)) ! (and (condition-case () ! (re-search-forward (car (car methods)) nil t) ! (error nil)) ! (setq split-name (cons (nth 1 (car methods)) split-name))) ! (setq methods (cdr methods))) ! (widen))) ! (cond ((null split-name) ! (read-file-name ! (concat prompt " (default " ! (file-name-nondirectory default-name) ") ") ! (file-name-directory default-name) ! default-name)) ! ((= 1 (length split-name)) ! (read-file-name ! (concat prompt " (default " (car split-name) ") ") ! gnus-article-save-directory ! (concat gnus-article-save-directory (car split-name)))) ! (t ! (setq split-name (mapcar (lambda (el) (list el)) ! (nreverse split-name))) ! (let ((result (completing-read ! (concat prompt " ") ! split-name nil nil))) ! (concat gnus-article-save-directory ! (if (string= result "") ! (car (car split-name)) ! result))))))) (defun gnus-summary-save-in-rmail (&optional filename) "Append this article to Rmail file. Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory' which ! is initialized from the SAVEDIR environment variable." (interactive) (gnus-set-global-variables) --- 13115,13269 ---- (gnus-summary-save-article arg))) ! (defun gnus-summary-save-article-body-file (&optional arg) ! "Append the current article body to a file. ! If N is a positive number, save the N next articles. ! If N is a negative number, save the N previous articles. ! If N is nil and any articles have been marked with the process mark, ! save those articles instead." ! (interactive "P") ! (gnus-set-global-variables) ! (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) ! (gnus-summary-save-article arg))) ! ! (defun gnus-get-split-value (methods) ! "Return a value based on the split METHODS." ! (let (split-name method result match) ! (when methods (save-excursion ! (set-buffer gnus-original-article-buffer) ! (save-restriction ! (nnheader-narrow-to-headers) ! (while methods ! (goto-char (point-min)) ! (setq method (pop methods)) ! (setq match (car method)) ! (when (cond ! ((stringp match) ! ;; Regular expression. ! (condition-case () ! (re-search-forward match nil t) ! (error nil))) ! ((gnus-functionp match) ! ;; Function. ! (save-restriction ! (widen) ! (setq result (funcall match gnus-newsgroup-name)))) ! ((consp match) ! ;; Form. ! (save-restriction ! (widen) ! (setq result (eval match))))) ! (setq split-name (append (cdr method) split-name)) ! (cond ((stringp result) ! (push result split-name)) ! ((consp result) ! (setq split-name (append result split-name))))))))) ! split-name)) ! ! (defun gnus-read-move-group-name (prompt default articles prefix) ! "Read a group name." ! (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) ! (minibuffer-confirm-incomplete nil) ; XEmacs ! group-map ! (dum (mapatoms ! (lambda (g) ! (and (boundp g) ! (symbol-name g) ! (memq 'respool ! (assoc (symbol-name ! (car (gnus-find-method-for-group ! (symbol-name g)))) ! gnus-valid-select-methods)) ! (push (list (symbol-name g)) group-map))) ! gnus-active-hashtb)) ! (prom ! (format "%s %s to:" ! prompt ! (if (> (length articles) 1) ! (format "these %d articles" (length articles)) ! "this article"))) ! (to-newsgroup ! (cond ! ((null split-name) ! (gnus-completing-read default prom ! group-map nil nil prefix ! 'gnus-group-history)) ! ((= 1 (length split-name)) ! (gnus-completing-read (car split-name) prom group-map ! nil nil nil ! 'gnus-group-history)) ! (t ! (gnus-completing-read nil prom ! (mapcar (lambda (el) (list el)) ! (nreverse split-name)) ! nil nil nil ! 'gnus-group-history))))) ! (when to-newsgroup ! (if (or (string= to-newsgroup "") ! (string= to-newsgroup prefix)) ! (setq to-newsgroup (or default ""))) ! (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 ! to-newsgroup (gnus-group-name-to-method to-newsgroup)) ! (gnus-activate-group to-newsgroup nil nil ! (gnus-group-name-to-method ! to-newsgroup))) ! (error "Couldn't create group %s" to-newsgroup))) ! (error "No such group: %s" to-newsgroup))) ! to-newsgroup)) ! ! (defun gnus-read-save-file-name (prompt default-name) ! (let* ((split-name (gnus-get-split-value gnus-split-methods)) ! (file ! ;; Let the split methods have their say. ! (cond ! ;; No split name was found. ! ((null split-name) ! (read-file-name ! (concat prompt " (default " ! (file-name-nondirectory default-name) ") ") ! (file-name-directory default-name) ! default-name)) ! ;; A single split name was found ! ((= 1 (length split-name)) ! (let* ((name (car split-name)) ! (dir (cond ((file-directory-p name) ! (file-name-as-directory name)) ! ((file-exists-p name) name) ! (t gnus-article-save-directory)))) ! (read-file-name ! (concat prompt " (default " name ") ") ! dir name))) ! ;; A list of splits was found. ! (t ! (setq split-name (nreverse split-name)) ! (let (result) ! (let ((file-name-history (nconc split-name file-name-history))) ! (setq result ! (read-file-name ! (concat prompt " (`M-p' for defaults) ") ! gnus-article-save-directory ! (car split-name)))) ! (car (push result file-name-history))))))) ! ;; If we have read a directory, we append the default file name. ! (when (file-directory-p file) ! (setq file (concat (file-name-as-directory file) ! (file-name-nondirectory default-name)))) ! ;; Possibly translate some charaters. ! (nnheader-translate-file-chars file))) ! ! (defun gnus-article-archive-name (group) ! "Return the first instance of an \"Archive-name\" in the current buffer." ! (let ((case-fold-search t)) ! (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) ! (match-string 1)))) (defun gnus-summary-save-in-rmail (&optional filename) "Append this article to Rmail file. Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory'." (interactive) (gnus-set-global-variables) *************** is initialized from the SAVEDIR environm *** 10507,10520 **** (funcall gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail))) ! (or filename ! (setq filename (gnus-read-save-file-name ! "Save in rmail file:" default-name))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (gnus-output-to-rmail filename)))) ;; Remember the directory name to save articles (setq gnus-newsgroup-last-rmail filename))) --- 13271,13286 ---- (funcall gnus-rmail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-rmail))) ! (setq filename ! (cond ((eq filename 'default) ! default-name) ! (filename filename) ! (t (gnus-read-save-file-name ! "Save in rmail file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (gnus-output-to-rmail filename)))) ;; Remember the directory name to save articles (setq gnus-newsgroup-last-rmail filename))) *************** is initialized from the SAVEDIR environm *** 10523,10528 **** "Append this article to Unix mail file. Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory' which ! is initialized from the SAVEDIR environment variable." (interactive) (gnus-set-global-variables) --- 13289,13293 ---- "Append this article to Unix mail file. Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory'." (interactive) (gnus-set-global-variables) *************** is initialized from the SAVEDIR environm *** 10530,10536 **** (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail))) ! (or filename ! (setq filename (gnus-read-save-file-name ! "Save in Unix mail file:" default-name))) (setq filename (expand-file-name filename --- 13295,13304 ---- (funcall gnus-mail-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-mail))) ! (setq filename ! (cond ((eq filename 'default) ! default-name) ! (filename filename) ! (t (gnus-read-save-file-name ! "Save in Unix mail file:" default-name)))) (setq filename (expand-file-name filename *************** is initialized from the SAVEDIR environm *** 10538,10549 **** (file-name-directory default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (if (and (file-readable-p filename) (mail-file-babyl-p filename)) ! (gnus-output-to-rmail filename) ! (rmail-output filename 1 t t))))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-mail filename))) --- 13306,13317 ---- (file-name-directory default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (if (and (file-readable-p filename) (mail-file-babyl-p filename)) ! (gnus-output-to-rmail filename) ! (let ((mail-use-rfc822 t)) ! (rmail-output filename 1 t t)))))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-mail filename))) *************** is initialized from the SAVEDIR environm *** 10552,10557 **** "Append this article to file. Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory' which ! is initialized from the SAVEDIR environment variable." (interactive) (gnus-set-global-variables) --- 13320,13348 ---- "Append this article to file. Optional argument FILENAME specifies file name. ! Directory to save to is default to `gnus-article-save-directory'." ! (interactive) ! (gnus-set-global-variables) ! (let ((default-name ! (funcall gnus-file-save-name gnus-newsgroup-name ! gnus-current-headers gnus-newsgroup-last-file))) ! (setq filename ! (cond ((eq filename 'default) ! default-name) ! (filename filename) ! (t (gnus-read-save-file-name ! "Save in file:" default-name)))) ! (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (gnus-output-to-file filename)))) ! ;; Remember the directory name to save articles. ! (setq gnus-newsgroup-last-file filename))) ! ! (defun gnus-summary-save-body-in-file (&optional filename) ! "Append this article body to a file. ! Optional argument FILENAME specifies file name. ! The directory to save in defaults to `gnus-article-save-directory'." (interactive) (gnus-set-global-variables) *************** is initialized from the SAVEDIR environm *** 10559,10572 **** (funcall gnus-file-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-file))) ! (or filename ! (setq filename (gnus-read-save-file-name ! "Save in file:" default-name))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (gnus-output-to-file filename)))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-file filename))) --- 13350,13368 ---- (funcall gnus-file-save-name gnus-newsgroup-name gnus-current-headers gnus-newsgroup-last-file))) ! (setq filename ! (cond ((eq filename 'default) ! default-name) ! (filename filename) ! (t (gnus-read-save-file-name ! "Save body in file:" default-name)))) (gnus-make-directory (file-name-directory filename)) ! (gnus-eval-in-buffer-window gnus-original-article-buffer ! (save-excursion ! (save-restriction ! (widen) ! (goto-char (point-min)) ! (and (search-forward "\n\n" nil t) ! (narrow-to-region (point) (point-max))) ! (gnus-output-to-file filename)))) ;; Remember the directory name to save articles. (setq gnus-newsgroup-last-file filename))) *************** is initialized from the SAVEDIR environm *** 10576,10589 **** (interactive) (gnus-set-global-variables) ! (let ((command (read-string "Shell command on article: " ! gnus-last-shell-command))) ! (if (string-equal command "") ! (setq command gnus-last-shell-command)) ! (gnus-eval-in-buffer-window ! gnus-article-buffer ! (save-restriction ! (widen) ! (shell-command-on-region (point-min) (point-max) command nil))) ! (setq gnus-last-shell-command command))) ;; Summary extract commands --- 13372,13388 ---- (interactive) (gnus-set-global-variables) ! (setq command ! (cond ((eq command 'default) ! gnus-last-shell-command) ! (command command) ! (t (read-string "Shell command on article: " ! gnus-last-shell-command)))) ! (if (string-equal command "") ! (setq command gnus-last-shell-command)) ! (gnus-eval-in-buffer-window gnus-article-buffer ! (save-restriction ! (widen) ! (shell-command-on-region (point-min) (point-max) command nil))) ! (setq gnus-last-shell-command command)) ;; Summary extract commands *************** is initialized from the SAVEDIR environm *** 10592,10601 **** (let ((buffer-read-only nil) (article (gnus-summary-article-number)) ! b) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) ! (gnus-summary-position-cursor) ;; If all commands are to be bunched up on one line, we collect ! ;; them here. (if gnus-view-pseudos-separately () --- 13391,13400 ---- (let ((buffer-read-only nil) (article (gnus-summary-article-number)) ! after-article b e) (or (gnus-summary-goto-subject article) (error (format "No such article: %d" article))) ! (gnus-summary-position-point) ;; If all commands are to be bunched up on one line, we collect ! ;; them here. (if gnus-view-pseudos-separately () *************** is initialized from the SAVEDIR environm *** 10607,10613 **** (while (and ps (cdr ps) (string= (or action "1") ! (or (cdr (assq 'action (car (cdr ps)))) "2"))) ! (setq files (cons (cdr (assq 'name (car (cdr ps)))) files)) ! (setcdr ps (cdr (cdr ps)))) (if (not files) () --- 13406,13412 ---- (while (and ps (cdr ps) (string= (or action "1") ! (or (cdr (assq 'action (cadr ps))) "2"))) ! (setq files (cons (cdr (assq 'name (cadr ps))) files)) ! (setcdr ps (cddr ps))) (if (not files) () *************** is initialized from the SAVEDIR environm *** 10619,10623 **** (funcall (if (string-match "%s" action) 'format 'concat) ! action (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) --- 13418,13422 ---- (funcall (if (string-match "%s" action) 'format 'concat) ! action (mapconcat (lambda (f) f) files " "))))) (setq ps (cdr ps))))) *************** is initialized from the SAVEDIR environm *** 10630,10650 **** (save-excursion (while pslist ! (gnus-summary-goto-subject (or (cdr (assq 'article (car pslist))) ! (gnus-summary-article-number))) (forward-line 1) (setq b (point)) ! (insert " " (file-name-nondirectory (cdr (assq 'name (car pslist)))) ": " (or (cdr (assq 'execute (car pslist))) "") "\n") ! (add-text-properties ! b (1+ b) (list 'gnus-number gnus-reffed-article-number ! 'gnus-mark gnus-unread-mark ! 'gnus-level 0 ! 'gnus-pseudo (car pslist))) ! (forward-line -1) ! (gnus-sethash (int-to-string gnus-reffed-article-number) ! (car pslist) gnus-newsgroup-headers-hashtb-by-number) ! (setq gnus-newsgroup-unreads ! (cons gnus-reffed-article-number gnus-newsgroup-unreads)) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) --- 13429,13449 ---- (save-excursion (while pslist ! (setq after-article (or (cdr (assq 'article (car pslist))) ! (gnus-summary-article-number))) ! (gnus-summary-goto-subject after-article) (forward-line 1) (setq b (point)) ! (insert " " (file-name-nondirectory (cdr (assq 'name (car pslist)))) ": " (or (cdr (assq 'execute (car pslist))) "") "\n") ! (setq e (point)) ! (forward-line -1) ; back to `b' ! (gnus-add-text-properties ! b (1- e) (list 'gnus-number gnus-reffed-article-number ! gnus-mouse-face-prop gnus-mouse-face)) ! (gnus-data-enter ! after-article gnus-reffed-article-number ! gnus-unread-mark b (car pslist) 0 (- e b)) ! (push gnus-reffed-article-number gnus-newsgroup-unreads) (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) (setq pslist (cdr pslist))))))) *************** is initialized from the SAVEDIR environm *** 10665,10675 **** (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((command (if automatic command (read-string "Command: " command))) ! (buffer-read-only nil)) (erase-buffer) (insert "$ " command "\n\n") (if gnus-view-pseudo-asynchronously ! (start-process "gnus-execute" nil "sh" "-c" command) ! (call-process "sh" nil t nil "-c" command))))) (defun gnus-copy-file (file &optional to) --- 13464,13481 ---- (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) + (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 ! ;; this `let'. ! ;; (buffer-read-only nil) ! ) (erase-buffer) (insert "$ " command "\n\n") (if gnus-view-pseudo-asynchronously ! (start-process "gnus-execute" nil shell-file-name ! shell-command-switch command) ! (call-process shell-file-name nil t nil ! shell-command-switch command))))) (defun gnus-copy-file (file &optional to) *************** is initialized from the SAVEDIR environm *** 10680,10684 **** (gnus-set-global-variables) (or to (setq to (read-file-name "Copy file to: " default-directory))) ! (and (file-directory-p to) (setq to (concat (file-name-as-directory to) (file-name-nondirectory file)))) --- 13486,13490 ---- (gnus-set-global-variables) (or to (setq to (read-file-name "Copy file to: " default-directory))) ! (and (file-directory-p to) (setq to (concat (file-name-as-directory to) (file-name-nondirectory file)))) *************** is initialized from the SAVEDIR environm *** 10697,10706 **** (interactive) (gnus-set-global-variables) ! (setq gnus-current-headers ! (gnus-gethash ! (int-to-string (gnus-summary-article-number)) ! gnus-newsgroup-headers-hashtb-by-number)) (gnus-set-global-variables) ! (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) --- 13503,13509 ---- (interactive) (gnus-set-global-variables) ! (setq gnus-current-headers (gnus-summary-article-header)) (gnus-set-global-variables) ! (gnus-group-edit-local-kill (gnus-summary-article-number) gnus-newsgroup-name)) *************** is initialized from the SAVEDIR environm *** 10712,10773 **** (put 'gnus-article-mode 'mode-class 'special) - (defvar gnus-bugaboo nil) - (if gnus-article-mode-map nil (setq gnus-article-mode-map (make-keymap)) (suppress-keymap gnus-article-mode-map) - (define-key gnus-article-mode-map " " 'gnus-article-next-page) - (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page) - (define-key gnus-article-mode-map "\C-c^" 'gnus-article-refer-article) - (define-key gnus-article-mode-map "h" 'gnus-article-show-summary) - (define-key gnus-article-mode-map "s" 'gnus-article-show-summary) - (define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail) - (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly) - (define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button) - (define-key gnus-article-mode-map "\r" 'gnus-article-press-button) - (define-key gnus-article-mode-map "\t" 'gnus-article-next-button) - (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug) - - ;; Duplicate almost all summary keystrokes in the article mode map. - (let ((commands - (list - "p" "N" "P" "\M-\C-n" "\M-\C-p" - "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j" - "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k" - "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h" - "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w" - "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a" - "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s" - "\M-g" "w" "\C-c\C-r" "\M-t" "C" - "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d" - "\C-c\C-i" "x" "X" "t" "g" "?" "l" - "\C-c\C-v\C-v" "\C-d" "v" - ;; "Mt" "M!" "Md" "Mr" - ;; "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r" - ;; "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK" - ;; "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p" - ;; "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT" - ;; "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap" - ;; "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am" - ;; "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t" - ;; "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi" - ;; "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or" - ;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve" - ;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi" - ))) - (while (and gnus-bugaboo commands) ; disabled - (define-key gnus-article-mode-map (car commands) - 'gnus-article-summary-command) - (setq commands (cdr commands)))) - - (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" - ;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "n" "^" "\M-^"))) - (while (and gnus-bugaboo commands) ; disabled - (define-key gnus-article-mode-map (car commands) - 'gnus-article-summary-command-nosave) - (setq commands (cdr commands))))) (defun gnus-article-mode () --- 13515,13543 ---- (put 'gnus-article-mode 'mode-class 'special) (if gnus-article-mode-map nil (setq gnus-article-mode-map (make-keymap)) (suppress-keymap gnus-article-mode-map) + (gnus-define-keys gnus-article-mode-map + " " gnus-article-goto-next-page + "\177" gnus-article-goto-prev-page + [delete] gnus-article-goto-prev-page + "\C-c^" gnus-article-refer-article + "h" gnus-article-show-summary + "s" gnus-article-show-summary + "\C-c\C-m" gnus-article-mail + "?" gnus-article-describe-briefly + gnus-mouse-2 gnus-article-push-button + "\r" gnus-article-press-button + "\t" gnus-article-next-button + "\M-\t" gnus-article-prev-button + "<" beginning-of-buffer + ">" end-of-buffer + "\C-c\C-i" gnus-info-find-node + "\C-c\C-b" gnus-bug) + + (substitute-key-definition + 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)) (defun gnus-article-mode () *************** The following commands are available: *** 10787,10791 **** \\[gnus-info-find-node]\t Go to the Gnus info node" (interactive) ! (if gnus-visual (gnus-article-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) --- 13557,13563 ---- \\[gnus-info-find-node]\t Go to the Gnus info node" (interactive) ! (when (and menu-bar-mode ! (gnus-visual-p 'article-menu 'menu)) ! (gnus-article-make-menu-bar)) (kill-all-local-variables) (gnus-simplify-mode-line) *************** The following commands are available: *** 10804,10829 **** (defun gnus-article-setup-buffer () ! "Initialize article mode buffer." ! ;; Returns the article buffer. ! (if (get-buffer gnus-article-buffer) (save-excursion ! (set-buffer gnus-article-buffer) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) (gnus-add-current-to-buffer-list) ! (or (eq major-mode 'gnus-article-mode) ! (gnus-article-mode)) ! (current-buffer)) ! (save-excursion ! (set-buffer (get-buffer-create gnus-article-buffer)) ! (gnus-add-current-to-buffer-list) ! (gnus-article-mode) ! (current-buffer)))) ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) ! (set-window-start ! (get-buffer-window gnus-article-buffer) (save-excursion (set-buffer gnus-article-buffer) --- 13576,13622 ---- (defun gnus-article-setup-buffer () ! "Initialize the article buffer." ! (let* ((name (if gnus-single-article-buffer "*Article*" ! (concat "*Article " gnus-newsgroup-name "*"))) ! (original ! (progn (string-match "\\*Article" name) ! (concat " *Original Article" ! (substring name (match-end 0)))))) ! (setq gnus-article-buffer name) ! (setq gnus-original-article-buffer original) ! ;; This might be a variable local to the summary buffer. ! (unless gnus-single-article-buffer (save-excursion ! (set-buffer gnus-summary-buffer) ! (setq gnus-article-buffer name) ! (setq gnus-original-article-buffer original) ! (gnus-set-global-variables)) ! (make-local-variable 'gnus-summary-buffer)) ! ;; Init original article buffer. ! (save-excursion ! (set-buffer (get-buffer-create gnus-original-article-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq major-mode 'gnus-original-article-mode) ! (make-local-variable 'gnus-original-article)) ! (if (get-buffer name) ! (save-excursion ! (set-buffer name) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list) ! (or (eq major-mode 'gnus-article-mode) ! (gnus-article-mode)) ! (current-buffer)) ! (save-excursion ! (set-buffer (get-buffer-create name)) (gnus-add-current-to-buffer-list) ! (gnus-article-mode) ! (current-buffer))))) ;; Set article window start at LINE, where LINE is the number of lines ;; from the head of the article. (defun gnus-article-set-window-start (&optional line) ! (set-window-start ! (get-buffer-window gnus-article-buffer t) (save-excursion (set-buffer gnus-article-buffer) *************** The following commands are available: *** 10836,10923 **** (point))))) (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." ! (setq group (or group gnus-newsgroup-name)) ! ! ;; Open server if it has closed. ! (gnus-check-server (gnus-find-method-for-group group)) ! ;; Using `gnus-request-article' directly will insert the article into ! ;; `nntp-server-buffer' - so we'll save some time by not having to ! ;; copy it from the server buffer into the article buffer. ! ! ;; We only request an article by message-id when we do not have the ! ;; headers for it, so we'll have to get those. ! (and (stringp article) ! (let ((gnus-override-method gnus-refer-article-method)) ! (gnus-read-header article))) ! ! ;; If the article number is negative, that means that this article ! ;; doesn't belong in this newsgroup (possibly), so we find its ! ;; message-id and request it by id instead of number. ! (if (not (numberp article)) ! () ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((header (gnus-get-header-by-num article))) ! (if (< article 0) ! (if (vectorp header) ! ;; It's a real article. ! (setq article (mail-header-id header)) ! ;; It is an extracted pseudo-article. ! (setq article 'pseudo) ! (gnus-request-pseudo-article header))) ! (let ((method (gnus-find-method-for-group gnus-newsgroup-name))) ! (if (not (eq (car method) 'nneething)) ! () ! (let ((dir (concat (file-name-as-directory (nth 1 method)) ! (mail-header-subject header)))) ! (if (file-directory-p dir) (progn ! (setq article 'nneething) ! (gnus-group-enter-directory dir))))))))) ! ! ;; Check the cache. ! (if (and gnus-use-cache ! (numberp article) ! (gnus-cache-request-article article group)) ! 'article ! ;; Get the article and put into the article buffer. ! (if (or (stringp article) (numberp article)) ! (progn ! (erase-buffer) ! ;; There may be some overlays that we have to kill... ! (insert "i") ! (let ((overlays (and (fboundp 'overlays-at) ! (overlays-at (point-min))))) ! (while overlays ! (delete-overlay (car overlays)) ! (setq overlays (cdr overlays)))) ! (erase-buffer) ! (let ((gnus-override-method ! (and (stringp article) gnus-refer-article-method))) ! (and (gnus-request-article article group (current-buffer)) ! 'article))) ! article))) ! (defun gnus-read-header (id) "Read the headers of article ID and enter them into the Gnus system." ! (let (header) ! (if (not (setq header ! (car (if (let ((gnus-nov-is-evil t)) ! (gnus-retrieve-headers ! (list id) gnus-newsgroup-name)) ! (gnus-get-newsgroup-headers))))) ! nil ! (if (stringp id) ! (mail-header-set-number header gnus-reffed-article-number)) ! (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)) ! (gnus-sethash (int-to-string (mail-header-number header)) header ! gnus-newsgroup-headers-hashtb-by-number) ! (if (stringp id) ! (setq gnus-reffed-article-number (1- gnus-reffed-article-number))) ! (setq gnus-current-headers header) ! header))) (defun gnus-article-prepare (article &optional all-headers header) --- 13629,13843 ---- (point))))) + (defun gnus-kill-all-overlays () + "Delete all overlays in the current buffer." + (when (fboundp 'overlay-lists) + (let* ((overlayss (overlay-lists)) + (buffer-read-only nil) + (overlays (nconc (car overlayss) (cdr overlayss)))) + (while overlays + (delete-overlay (pop overlays)))))) + (defun gnus-request-article-this-buffer (article group) "Get an article and insert it into this buffer." ! (let (do-update-line) ! (prog1 ! (save-excursion ! (erase-buffer) ! (gnus-kill-all-overlays) ! (setq group (or group gnus-newsgroup-name)) ! ;; Open server if it has closed. ! (gnus-check-server (gnus-find-method-for-group group)) ! ;; Using `gnus-request-article' directly will insert the article into ! ;; `nntp-server-buffer' - so we'll save some time by not having to ! ;; copy it from the server buffer into the article buffer. ! ! ;; We only request an article by message-id when we do not have the ! ;; headers for it, so we'll have to get those. ! (when (stringp article) ! (let ((gnus-override-method gnus-refer-article-method)) ! (gnus-read-header article))) ! ! ;; If the article number is negative, that means that this article ! ;; doesn't belong in this newsgroup (possibly), so we find its ! ;; message-id and request it by id instead of number. ! (when (and (numberp article) ! gnus-summary-buffer ! (get-buffer gnus-summary-buffer) ! (buffer-name (get-buffer gnus-summary-buffer))) ! (save-excursion ! (set-buffer gnus-summary-buffer) ! (let ((header (gnus-summary-article-header article))) ! (if (< article 0) ! (cond ! ((memq article gnus-newsgroup-sparse) ! ;; This is a sparse gap article. ! (setq do-update-line article) ! (setq article (mail-header-id header)) ! (let ((gnus-override-method gnus-refer-article-method)) ! (gnus-read-header article)) ! (setq gnus-newsgroup-sparse ! (delq article gnus-newsgroup-sparse))) ! ((vectorp header) ! ;; It's a real article. ! (setq article (mail-header-id header))) ! (t ! ;; It is an extracted pseudo-article. ! (setq article 'pseudo) ! (gnus-request-pseudo-article header)))) ! ! (let ((method (gnus-find-method-for-group ! gnus-newsgroup-name))) ! (if (not (eq (car method) 'nneething)) ! () ! (let ((dir (concat (file-name-as-directory (nth 1 method)) ! (mail-header-subject header)))) ! (if (file-directory-p dir) ! (progn ! (setq article 'nneething) ! (gnus-group-enter-directory dir))))))))) ! ! (cond ! ;; Refuse to select canceled articles. ! ((and (numberp article) ! gnus-summary-buffer ! (get-buffer gnus-summary-buffer) ! (buffer-name (get-buffer gnus-summary-buffer)) ! (eq (cdr (save-excursion ! (set-buffer gnus-summary-buffer) ! (assq article gnus-newsgroup-reads))) ! gnus-canceled-mark)) ! nil) ! ;; We first check `gnus-original-article-buffer'. ! ((and (get-buffer gnus-original-article-buffer) ! (numberp article) ! (save-excursion ! (set-buffer gnus-original-article-buffer) ! (and (equal (car gnus-original-article) group) ! (eq (cdr gnus-original-article) article)))) ! (insert-buffer-substring gnus-original-article-buffer) ! 'article) ! ;; Check the backlog. ! ((and gnus-keep-backlog ! (gnus-backlog-request-article group article (current-buffer))) ! 'article) ! ;; Check the cache. ! ((and gnus-use-cache ! (numberp article) ! (gnus-cache-request-article article group)) ! 'article) ! ;; Get the article and put into the article buffer. ! ((or (stringp article) (numberp article)) ! (let ((gnus-override-method ! (and (stringp article) gnus-refer-article-method)) ! (buffer-read-only nil)) ! (erase-buffer) ! (gnus-kill-all-overlays) ! (if (gnus-request-article article group (current-buffer)) (progn ! (and gnus-keep-backlog ! (numberp article) ! (gnus-backlog-enter-article ! group article (current-buffer))) ! 'article)))) ! ;; It was a pseudo. ! (t article))) ! ! ;; Take the article from the original article buffer ! ;; and place it in the buffer it's supposed to be in. ! (when (and (get-buffer gnus-article-buffer) ! ;;(numberp article) ! (equal (buffer-name (current-buffer)) ! (buffer-name (get-buffer gnus-article-buffer)))) ! (save-excursion ! (if (get-buffer gnus-original-article-buffer) ! (set-buffer (get-buffer gnus-original-article-buffer)) ! (set-buffer (get-buffer-create gnus-original-article-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq major-mode 'gnus-original-article-mode) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list)) ! (let (buffer-read-only) ! (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) ! (stringp article))) ! (let ((buf (current-buffer))) ! (set-buffer gnus-summary-buffer) ! (gnus-summary-update-article do-update-line) ! (gnus-summary-goto-subject do-update-line nil t) ! (set-window-point (get-buffer-window (current-buffer) t) ! (point)) ! (set-buffer buf)))))) ! (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 ! (and (gnus-news-group-p gnus-newsgroup-name) ! gnus-refer-article-method)) ! where) ! ;; First we check to see whether the header in question is already ! ;; fetched. ! (if (stringp id) ! ;; This is a Message-ID. ! (setq header (or header (gnus-id-to-header id))) ! ;; This is an article number. ! (setq header (or header (gnus-summary-article-header id)))) ! (if (and header ! (not (memq (mail-header-number header) gnus-newsgroup-sparse))) ! ;; We have found the header. ! header ! ;; We have to really fetch the header to this article. ! (when (setq where (gnus-request-head id group)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-max)) ! (insert ".\n") ! (goto-char (point-min)) ! (insert "211 ") ! (princ (cond ! ((numberp id) id) ! ((cdr where) (cdr where)) ! (header (mail-header-number header)) ! (t gnus-reffed-article-number)) ! (current-buffer)) ! (insert " Article retrieved.\n")) ! ;(when (and header ! ; (memq (mail-header-number header) gnus-newsgroup-sparse)) ! ; (setcar (gnus-id-to-thread id) nil)) ! (if (not (setq header (car (gnus-get-newsgroup-headers)))) ! () ; Malformed head. ! (unless (memq (mail-header-number header) gnus-newsgroup-sparse) ! (if (and (stringp id) ! (not (string= (gnus-group-real-name group) ! (car where)))) ! ;; If we fetched by Message-ID and the article came ! ;; from a different group, we fudge some bogus article ! ;; numbers for this article. ! (mail-header-set-number header gnus-reffed-article-number)) ! (decf gnus-reffed-article-number) ! (gnus-remove-header (mail-header-number header)) ! (push header gnus-newsgroup-headers) ! (setq gnus-current-headers header) ! (push (mail-header-number header) gnus-newsgroup-limit)) ! header))))) ! ! (defun gnus-remove-header (number) ! "Remove header NUMBER from `gnus-newsgroup-headers'." ! (if (and gnus-newsgroup-headers ! (= number (mail-header-number (car gnus-newsgroup-headers)))) ! (pop gnus-newsgroup-headers) ! (let ((headers gnus-newsgroup-headers)) ! (while (and (cdr headers) ! (not (= number (mail-header-number (cadr headers))))) ! (pop headers)) ! (when (cdr headers) ! (setcdr headers (cddr headers)))))) (defun gnus-article-prepare (article &optional all-headers header) *************** If ALL-HEADERS is non-nil, no headers ar *** 10928,10940 **** (save-excursion ;; Make sure we start in a summary buffer. ! (or (eq major-mode 'gnus-summary-mode) ! (set-buffer gnus-summary-buffer)) (setq gnus-summary-buffer (current-buffer)) ;; Make sure the connection to the server is alive. ! (or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name)) ! (progn ! (gnus-check-server ! (gnus-find-method-for-group gnus-newsgroup-name)) ! (gnus-request-group gnus-newsgroup-name t))) (let* ((article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) --- 13848,13859 ---- (save-excursion ;; Make sure we start in a summary buffer. ! (unless (eq major-mode 'gnus-summary-mode) ! (set-buffer gnus-summary-buffer)) (setq gnus-summary-buffer (current-buffer)) ;; Make sure the connection to the server is alive. ! (unless (gnus-server-opened ! (gnus-find-method-for-group gnus-newsgroup-name)) ! (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) ! (gnus-request-group gnus-newsgroup-name t)) (let* ((article (if header (mail-header-number header) article)) (summary-buffer (current-buffer)) *************** If ALL-HEADERS is non-nil, no headers ar *** 10945,10963 **** (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (if (not (setq result (let ((buffer-read-only nil)) ! (gnus-request-article-this-buffer article group)))) ;; There is no such article. (save-excursion ! (if (not (numberp article)) ! () ! (setq gnus-article-current (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) (gnus-summary-mark-article article gnus-canceled-mark)) ! (gnus-message 1 "No such article (may be canceled)") ! (ding) ! nil) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn --- 13864,13886 ---- (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) + ;; Deactivate active regions. + (when (and (boundp 'transient-mark-mode) + transient-mark-mode) + (setq mark-active nil)) (if (not (setq result (let ((buffer-read-only nil)) ! (gnus-request-article-this-buffer article group)))) ;; There is no such article. (save-excursion ! (when (and (numberp article) ! (not (memq article gnus-newsgroup-sparse))) ! (setq gnus-article-current (cons gnus-newsgroup-name article)) (set-buffer gnus-summary-buffer) (setq gnus-current-article article) (gnus-summary-mark-article article gnus-canceled-mark)) ! (unless (memq article gnus-newsgroup-sparse) ! (gnus-error ! 1 "No such article (may have expired or been canceled)"))) (if (or (eq result 'pseudo) (eq result 'nneething)) (progn *************** If ALL-HEADERS is non-nil, no headers ar *** 10988,10999 **** gnus-newsgroup-history) gnus-current-article article ! gnus-current-headers ! (gnus-get-header-by-num gnus-current-article) ! gnus-article-current (cons gnus-newsgroup-name gnus-current-article)) (gnus-summary-show-thread) (run-hooks 'gnus-mark-article-hook) (gnus-set-mode-line 'summary) ! (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)) ;; Set the global newsgroup variables here. --- 13911,13924 ---- gnus-newsgroup-history) gnus-current-article article ! gnus-current-headers ! (gnus-summary-article-header gnus-current-article) ! gnus-article-current (cons gnus-newsgroup-name gnus-current-article)) + (unless (vectorp gnus-current-headers) + (setq gnus-current-headers nil)) (gnus-summary-show-thread) (run-hooks 'gnus-mark-article-hook) (gnus-set-mode-line 'summary) ! (and (gnus-visual-p 'article-highlight 'highlight) (run-hooks 'gnus-visual-mark-article-hook)) ;; Set the global newsgroup variables here. *************** If ALL-HEADERS is non-nil, no headers ar *** 11001,11029 **** ;; . (gnus-set-global-variables) ! (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)) ! (and gnus-use-cache ! (vectorp (gnus-get-header-by-number article)) (gnus-cache-possibly-enter-article group article ! (gnus-get-header-by-number article) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))))) ! ;; Hooks for getting information from the article. ! ;; This hook must be called before being narrowed. ! (let (buffer-read-only) ! (run-hooks 'internal-hook) ! (run-hooks 'gnus-article-prepare-hook) ! ;; Decode MIME message. ! (if (and gnus-show-mime ! (or (not gnus-strict-mime) ! (gnus-fetch-field "Mime-Version"))) ! (funcall gnus-show-mime-method)) ! ;; Perform the article display hooks. ! (run-hooks 'gnus-article-display-hook)) ! ;; Do page break. ! (goto-char (point-min)) ! (and gnus-break-pages (gnus-narrow-to-page)) (gnus-set-mode-line 'article) (gnus-configure-windows 'article) --- 13926,13957 ---- ;; . (gnus-set-global-variables) ! (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)) ! (and gnus-use-cache ! (vectorp (gnus-summary-article-header article)) (gnus-cache-possibly-enter-article group article ! (gnus-summary-article-header article) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))))) ! (when (or (numberp article) ! (stringp article)) ! ;; Hooks for getting information from the article. ! ;; This hook must be called before being narrowed. ! (let (buffer-read-only) ! (run-hooks 'internal-hook) ! (run-hooks 'gnus-article-prepare-hook) ! ;; Decode MIME message. ! (if gnus-show-mime ! (if (or (not gnus-strict-mime) ! (gnus-fetch-field "Mime-Version")) ! (funcall gnus-show-mime-method) ! (funcall gnus-decode-encoded-word-method))) ! ;; Perform the article display hooks. ! (run-hooks 'gnus-article-display-hook)) ! ;; Do page break. ! (goto-char (point-min)) ! (and gnus-break-pages (gnus-narrow-to-page))) (gnus-set-mode-line 'article) (gnus-configure-windows 'article) *************** If ALL-HEADERS is non-nil, no headers ar *** 11033,11042 **** (defun gnus-article-show-all-headers () "Show all article headers in article mode buffer." ! (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) ! (remove-text-properties (point-min) (point-max) ! gnus-hidden-properties)))) (defun gnus-article-hide-headers-if-wanted () --- 13961,13969 ---- (defun gnus-article-show-all-headers () "Show all article headers in article mode buffer." ! (save-excursion (gnus-article-setup-buffer) (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) ! (gnus-unhide-text (point-min) (point-max))))) (defun gnus-article-hide-headers-if-wanted () *************** If ALL-HEADERS is non-nil, no headers ar *** 11044,11118 **** Provided for backwards compatibility." (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) (gnus-article-hide-headers))) ! (defun gnus-article-hide-headers (&optional delete) ! "Hide unwanted headers and possibly sort them as well." ! (interactive "P") (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((sorted gnus-sorted-header-list) ! (buffer-read-only nil) ! want-list beg want-l) ! ;; First we narrow to just the headers. ! (widen) ! (goto-char (point-min)) ! ;; Hide any "From " lines at the beginning of (mail) articles. ! (while (looking-at "From ") ! (forward-line 1)) ! (or (bobp) ! (add-text-properties (point-min) (point) gnus-hidden-properties)) ! ;; Then treat the rest of the header lines. ! (narrow-to-region ! (point) ! (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) ! ;; Then we use the two regular expressions ! ;; `gnus-ignored-headers' and `gnus-visible-headers' to ! ;; select which header lines is to remain visible in the ! ;; article buffer. ! (goto-char (point-min)) ! (while (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) ! ;; We add the headers we want to keep to a list and delete ! ;; them from the buffer. ! (if (or (and (stringp gnus-visible-headers) ! (looking-at gnus-visible-headers)) ! (and (not (stringp gnus-visible-headers)) ! (stringp gnus-ignored-headers) ! (not (looking-at gnus-ignored-headers)))) ! (progn ! (setq beg (point)) ! (forward-line 1) ! ;; Be sure to get multi-line headers... ! (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) ! (setq want-list ! (cons (buffer-substring beg (point)) want-list)) ! (delete-region beg (point)) ! (goto-char beg)) ! (forward-line 1))) ! ;; Next we perform the sorting by looking at ! ;; `gnus-sorted-header-list'. ! (goto-char (point-min)) ! (while (and sorted want-list) ! (setq want-l want-list) ! (while (and want-l ! (not (string-match (car sorted) (car want-l)))) ! (setq want-l (cdr want-l))) ! (if want-l ! (progn ! (insert (car want-l)) ! (setq want-list (delq (car want-l) want-list)))) ! (setq sorted (cdr sorted))) ! ;; Any headers that were not matched by the sorted list we ! ;; just tack on the end of the visible header list. ! (while want-list ! (insert (car want-list)) ! (setq want-list (cdr want-list))) ! ;; And finally we make the unwanted headers invisible. ! (if delete ! (delete-region (point) (point-max)) ! ;; Suggested by Sudish Joseph . ! (add-text-properties (point) (point-max) gnus-hidden-properties)))))) ;; Written by Per Abrahamsen . --- 13971,14129 ---- Provided for backwards compatibility." (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) + gnus-inhibit-hiding (gnus-article-hide-headers))) ! (defsubst gnus-article-header-rank () ! "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." ! (let ((list gnus-sorted-header-list) ! (i 0)) ! (while list ! (when (looking-at (car list)) ! (setq list nil)) ! (setq list (cdr list)) ! (incf i)) ! i)) ! ! (defun gnus-article-hide-headers (&optional arg delete) ! "Toggle whether to hide unwanted headers and possibly sort them as well. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-hidden-arg)) ! (if (gnus-article-check-hidden-text 'headers arg) ! ;; Show boring headers as well. ! (gnus-article-show-hidden-text 'boring-headers) ! ;; This function might be inhibited. ! (unless gnus-inhibit-hiding ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((buffer-read-only nil) ! (props (nconc (list 'gnus-type 'headers) ! gnus-hidden-properties)) ! (max (1+ (length gnus-sorted-header-list))) ! (ignored (when (not (stringp gnus-visible-headers)) ! (cond ((stringp gnus-ignored-headers) ! gnus-ignored-headers) ! ((listp gnus-ignored-headers) ! (mapconcat 'identity gnus-ignored-headers ! "\\|"))))) ! (visible ! (cond ((stringp gnus-visible-headers) ! gnus-visible-headers) ! ((and gnus-visible-headers ! (listp gnus-visible-headers)) ! (mapconcat 'identity gnus-visible-headers "\\|")))) ! (inhibit-point-motion-hooks t) ! want-list beg) ! ;; First we narrow to just the headers. ! (widen) ! (goto-char (point-min)) ! ;; Hide any "From " lines at the beginning of (mail) articles. ! (while (looking-at "From ") ! (forward-line 1)) ! (unless (bobp) ! (if delete ! (delete-region (point-min) (point)) ! (gnus-hide-text (point-min) (point) props))) ! ;; Then treat the rest of the header lines. ! (narrow-to-region ! (point) ! (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) ! ;; Then we use the two regular expressions ! ;; `gnus-ignored-headers' and `gnus-visible-headers' to ! ;; select which header lines is to remain visible in the ! ;; article buffer. ! (goto-char (point-min)) ! (while (re-search-forward "^[^ \t]*:" nil t) ! (beginning-of-line) ! ;; We add the headers we want to keep to a list and delete ! ;; them from the buffer. ! (gnus-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) ! (+ 2 max))) ! (forward-line 1)) ! (message-sort-headers-1) ! (when (setq beg (text-property-any ! (point-min) (point-max) 'message-rank (+ 2 max))) ! ;; We make the unwanted headers invisible. ! (if delete ! (delete-region beg (point-max)) ! ;; Suggested by Sudish Joseph . ! (gnus-hide-text-type beg (point-max) 'headers)) ! ;; Work around XEmacs lossage. ! (gnus-put-text-property (point-min) beg 'invisible nil)))))))) ! ! (defun gnus-article-hide-boring-headers (&optional arg) ! "Toggle hiding of headers that aren't very interesting. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'boring-headers arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((buffer-read-only nil) ! (list gnus-boring-article-headers) ! (inhibit-point-motion-hooks t) ! elem) ! (nnheader-narrow-to-headers) ! (while list ! (setq elem (pop list)) ! (goto-char (point-min)) ! (cond ! ;; Hide empty headers. ! ((eq elem 'empty) ! (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t) ! (forward-line -1) ! (gnus-hide-text-type ! (progn (beginning-of-line) (point)) ! (progn ! (end-of-line) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (point-max))) ! 'boring-headers))) ! ;; Hide boring Newsgroups header. ! ((eq elem 'newsgroups) ! (when (equal (message-fetch-field "newsgroups") ! (gnus-group-real-name gnus-newsgroup-name)) ! (gnus-article-hide-header "newsgroups"))) ! ((eq elem 'followup-to) ! (when (equal (message-fetch-field "followup-to") ! (message-fetch-field "newsgroups")) ! (gnus-article-hide-header "followup-to"))) ! ((eq elem 'reply-to) ! (let ((from (message-fetch-field "from")) ! (reply-to (message-fetch-field "reply-to"))) ! (when (and ! from reply-to ! (equal ! (nth 1 (funcall gnus-extract-address-components from)) ! (nth 1 (funcall gnus-extract-address-components ! reply-to)))) ! (gnus-article-hide-header "reply-to")))) ! ((eq elem 'date) ! (let ((date (message-fetch-field "date"))) ! (when (and date ! (< (gnus-days-between date (current-time-string)) ! 4)) ! (gnus-article-hide-header "date"))))))))))) ! ! (defun gnus-article-hide-header (header) (save-excursion ! (goto-char (point-min)) ! (when (re-search-forward (concat "^" header ":") nil t) ! (gnus-hide-text-type ! (progn (beginning-of-line) (point)) ! (progn ! (end-of-line) ! (if (re-search-forward "^[^ \t]" nil t) ! (match-beginning 0) ! (point-max))) ! 'boring-headers)))) ;; Written by Per Abrahamsen . *************** Provided for backwards compatibility." *** 11126,11144 **** (let ((next (following-char)) (previous (char-after (- (point) 2)))) ! (cond ((eq next previous) ! (put-text-property (- (point) 2) (point) ! 'invisible t) ! (put-text-property (point) (1+ (point)) ! 'face 'bold)) ! ((eq next ?_) ! (put-text-property (1- (point)) (1+ (point)) ! 'invisible t) ! (put-text-property (1- (point)) (point) ! 'face 'underline)) ! ((eq previous ?_) ! (put-text-property (- (point) 2) (point) ! 'invisible t) ! (put-text-property (point) (1+ (point)) ! 'face 'underline)))))))) (defun gnus-article-word-wrap () --- 14137,14152 ---- (let ((next (following-char)) (previous (char-after (- (point) 2)))) ! (cond ! ((eq next previous) ! (gnus-put-text-property (- (point) 2) (point) 'invisible t) ! (gnus-put-text-property (point) (1+ (point)) 'face 'bold)) ! ((eq next ?_) ! (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t) ! (gnus-put-text-property ! (- (point) 2) (1- (point)) 'face 'underline)) ! ((eq previous ?_) ! (gnus-put-text-property (- (point) 2) (point) 'invisible t) ! (gnus-put-text-property ! (point) (1+ (point)) 'face 'underline)))))))) (defun gnus-article-word-wrap () *************** Provided for backwards compatibility." *** 11148,11151 **** --- 14156,14160 ---- (set-buffer gnus-article-buffer) (let ((buffer-read-only nil)) + (widen) (goto-char (point-min)) (search-forward "\n\n" nil t) *************** Provided for backwards compatibility." *** 11170,11173 **** --- 14179,14197 ---- (replace-match "" t t))))) + (defun gnus-article-remove-trailing-blank-lines () + "Remove all trailing blank lines from the article." + (interactive) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (delete-region + (point) + (progn + (while (looking-at "^[ \t]*$") + (forward-line -1)) + (forward-line 1) + (point)))))) + (defun gnus-article-display-x-face (&optional force) "Look for an X-Face header and display it if present." *************** Provided for backwards compatibility." *** 11175,11206 **** (save-excursion (set-buffer gnus-article-buffer) (let ((inhibit-point-motion-hooks t) (case-fold-search nil) from) (save-restriction (goto-char (point-min)) ! (search-forward "\n\n") ! (narrow-to-region (point-min) (point)) ! (goto-char (point-min)) ! (setq from (mail-fetch-field "from")) ! (if (not (and gnus-article-x-face-command ! (or force ! (not gnus-article-x-face-too-ugly) ! (and gnus-article-x-face-too-ugly from ! (not (string-match gnus-article-x-face-too-ugly ! from)))) ! (progn ! (goto-char (point-min)) ! (re-search-forward "^X-Face: " nil t)))) ! nil (let ((beg (point)) (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) (if (symbolp gnus-article-x-face-command) ! (and (or (fboundp gnus-article-x-face-command) ! (error "%s is not a function" ! gnus-article-x-face-command)) ! (funcall gnus-article-x-face-command beg end)) ! (call-process-region beg end "sh" nil 0 nil ! "-c" gnus-article-x-face-command)))))))) (defun gnus-article-de-quoted-unreadable (&optional force) --- 14199,14262 ---- (save-excursion (set-buffer gnus-article-buffer) + ;; Delete the old process, if any. + (when (process-status "gnus-x-face") + (delete-process "gnus-x-face")) (let ((inhibit-point-motion-hooks t) (case-fold-search nil) from) (save-restriction + (nnheader-narrow-to-headers) + (setq from (message-fetch-field "from")) (goto-char (point-min)) ! (when (and gnus-article-x-face-command ! (or force ! ;; Check whether this face is censored. ! (not gnus-article-x-face-too-ugly) ! (and gnus-article-x-face-too-ugly from ! (not (string-match gnus-article-x-face-too-ugly ! from)))) ! ;; Has to be present. ! (re-search-forward "^X-Face: " nil t)) ! ;; We now have the area of the buffer where the X-Face is stored. (let ((beg (point)) (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) + ;; We display the face. (if (symbolp gnus-article-x-face-command) ! ;; The command is a lisp function, so we call it. ! (if (gnus-functionp gnus-article-x-face-command) ! (funcall gnus-article-x-face-command beg end) ! (error "%s is not a function" gnus-article-x-face-command)) ! ;; The command is a string, so we interpret the command ! ;; as a, well, command, and fork it off. ! (let ((process-connection-type nil)) ! (process-kill-without-query ! (start-process ! "gnus-x-face" nil shell-file-name shell-command-switch ! gnus-article-x-face-command)) ! (process-send-region "gnus-x-face" beg end) ! (process-send-eof "gnus-x-face"))))))))) ! ! (defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522) ! (defun gnus-decode-rfc1522 () ! "Hack to remove QP encoding from headers." ! (let ((case-fold-search t) ! (inhibit-point-motion-hooks t) ! (buffer-read-only nil) ! string) ! (save-restriction ! (narrow-to-region ! (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point-max))) ! ! (while (re-search-forward ! "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) ! (setq string (match-string 1)) ! (narrow-to-region (match-beginning 0) (match-end 0)) ! (delete-region (point-min) (point-max)) ! (insert string) ! (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max)) ! (subst-char-in-region (point-min) (point-max) ?_ ? ) ! (widen) ! (goto-char (point-min)))))) (defun gnus-article-de-quoted-unreadable (&optional force) *************** processing, but is simply a stop-gap mea *** 11210,11214 **** written. If FORCE, decode the article whether it is marked as quoted-printable ! or not." (interactive (list 'force)) (save-excursion --- 14266,14270 ---- written. If FORCE, decode the article whether it is marked as quoted-printable ! or not." (interactive (list 'force)) (save-excursion *************** or not." *** 11217,11340 **** (buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding"))) ! (if (or force (and type (string-match "quoted-printable" type))) ! (progn ! (goto-char (point-min)) ! (search-forward "\n\n" nil 'move) ! (gnus-mime-decode-quoted-printable (point) (point-max))))))) (defun gnus-mime-decode-quoted-printable (from to) ! ;; Decode quoted-printable from region between FROM and TO. (save-excursion ! (goto-char from) ! (while (search-forward "=" to t) ! (cond ((eq (following-char) ?\n) ! (delete-char -1) ! (delete-char 1)) ! ((looking-at "[0-9A-F][0-9A-F]") ! (delete-char -1) ! (insert (hexl-hex-string-to-integer ! (buffer-substring (point) (+ 2 (point))))) ! (delete-char 2)) ! ((looking-at "=") ! (delete-char 1)) ! ((gnus-message 3 "Malformed MIME quoted-printable message")))))) (defvar gnus-article-time-units ! (list (cons 'year (* 365.25 24 60 60)) ! (cons 'week (* 7 24 60 60)) ! (cons 'day (* 24 60 60)) ! (cons 'hour (* 60 60)) ! (cons 'minute 60) ! (cons 'second 1))) ! (defun gnus-article-date-ut (&optional type) "Convert DATE date to universal time in the current article. If TYPE is `local', convert to local time; if it is `lapsed', output how much time has lapsed since DATE." ! (interactive (list 'ut)) ! (let ((date (mail-header-date (or gnus-current-headers ! (gnus-get-header-by-number ! (gnus-summary-article-number))""))) ! (date-regexp "^Date: \\|^X-Sent: ")) ! (if (or (not date) ! (string= date "")) ! () (save-excursion (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil)) ! (goto-char (point-min)) ! (if (and (re-search-forward date-regexp nil t) ! (progn ! (beginning-of-line) ! (looking-at date-regexp))) ! (delete-region (gnus-point-at-bol) ! (progn (end-of-line) (1+ (point)))) ! (goto-char (point-min)) ! (goto-char (- (search-forward "\n\n") 2))) ! (insert ! (cond ! ((eq type 'local) ! (concat "Date: " (condition-case () ! (timezone-make-date-arpa-standard date) ! (error date)) ! "\n")) ! ((eq type 'ut) ! (concat "Date: " ! (condition-case () ! (timezone-make-date-arpa-standard date nil "UT") (error date)) ! "\n")) ! ((eq type 'lapsed) ! ;; If the date is seriously mangled, the timezone ! ;; functions are liable to bug out, so we condition-case ! ;; the entire thing. ! (let* ((real-sec (condition-case () ! (- (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! (current-time-string) ! (current-time-zone) "UT")) ! (gnus-seconds-since-epoch ! (timezone-make-date-arpa-standard ! date nil "UT"))) ! (error 0))) ! (sec (abs real-sec)) ! num prev) ! (if (zerop sec) ! "X-Sent: Now\n" ! (concat ! "X-Sent: " ! (mapconcat ! (lambda (unit) ! (if (zerop (setq num (ffloor (/ sec (cdr unit))))) ! "" ! (setq sec (- sec (* num (cdr unit)))) ! (prog1 ! (concat (if prev ", " "") (int-to-string ! (floor num)) ! " " (symbol-name (car unit)) ! (if (> num 1) "s" "")) ! (setq prev t)))) ! gnus-article-time-units "") ! (if (> real-sec 0) ! " ago\n" ! " in the future\n"))))) ! (t ! (error "Unknown conversion type: %s" type))))))))) ! (defun gnus-article-date-local () "Convert the current article date to the local timezone." ! (interactive) ! (gnus-article-date-ut 'local)) ! (defun gnus-article-date-lapsed () "Convert the current article date to time lapsed since it was sent." ! (interactive) ! (gnus-article-date-ut 'lapsed)) (defun gnus-article-maybe-highlight () "Do some article highlighting if `gnus-visual' is non-nil." ! (if gnus-visual (gnus-article-highlight-some))) ! ;; Article savers. (defun gnus-output-to-rmail (file-name) --- 14273,14594 ---- (buffer-read-only nil) (type (gnus-fetch-field "content-transfer-encoding"))) ! (gnus-decode-rfc1522) ! (when (or force ! (and type (string-match "quoted-printable" (downcase type)))) ! (goto-char (point-min)) ! (search-forward "\n\n" nil 'move) ! (gnus-mime-decode-quoted-printable (point) (point-max)))))) (defun gnus-mime-decode-quoted-printable (from to) ! "Decode Quoted-Printable in the region between FROM and TO." ! (interactive "r") ! (goto-char from) ! (while (search-forward "=" to t) ! (cond ((eq (following-char) ?\n) ! (delete-char -1) ! (delete-char 1)) ! ((looking-at "[0-9A-F][0-9A-F]") ! (subst-char-in-region ! (1- (point)) (point) ?= ! (hexl-hex-string-to-integer ! (buffer-substring (point) (+ 2 (point))))) ! (delete-char 2)) ! ((looking-at "=") ! (delete-char 1)) ! ((gnus-message 3 "Malformed MIME quoted-printable message"))))) ! ! (defun gnus-article-hide-pgp (&optional arg) ! "Toggle hiding of any PGP headers and signatures in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'pgp arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties)) ! buffer-read-only beg end) ! (widen) ! (goto-char (point-min)) ! ;; Hide the "header". ! (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) ! (gnus-hide-text (match-beginning 0) (match-end 0) props)) ! (setq beg (point)) ! ;; Hide the actual signature. ! (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) ! (setq end (1+ (match-beginning 0))) ! (gnus-hide-text ! end ! (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) ! (match-end 0) ! ;; Perhaps we shouldn't hide to the end of the buffer ! ;; if there is no end to the signature? ! (point-max)) ! props)) ! ;; Hide "- " PGP quotation markers. ! (when (and beg end) ! (narrow-to-region beg end) ! (goto-char (point-min)) ! (while (re-search-forward "^- " nil t) ! (gnus-hide-text (match-beginning 0) (match-end 0) props)) ! (widen)))))) ! ! (defun gnus-article-hide-signature (&optional arg) ! "Hide the signature in the current article. ! If given a negative prefix, always show; if given a positive prefix, ! always hide." ! (interactive (gnus-hidden-arg)) ! (unless (gnus-article-check-hidden-text 'signature arg) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (save-restriction ! (let ((buffer-read-only nil)) ! (when (gnus-narrow-to-signature) ! (gnus-hide-text-type (point-min) (point-max) 'signature))))))) ! ! (defun gnus-article-strip-leading-blank-lines () ! "Remove all blank lines from the beginning of the article." ! (interactive) ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let (buffer-read-only) ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (while (looking-at "[ \t]$") ! (gnus-delete-line)))))) ! ! (defvar mime::preview/content-list) ! (defvar mime::preview-content-info/point-min) ! (defun gnus-narrow-to-signature () ! "Narrow to the signature." ! (widen) ! (if (and (boundp 'mime::preview/content-list) ! mime::preview/content-list) ! (let ((pcinfo (car (last mime::preview/content-list)))) ! (condition-case () ! (narrow-to-region ! (funcall (intern "mime::preview-content-info/point-min") pcinfo) ! (point-max)) ! (error nil)))) ! (goto-char (point-max)) ! (when (re-search-backward gnus-signature-separator nil t) ! (forward-line 1) ! (when (or (null gnus-signature-limit) ! (and (numberp gnus-signature-limit) ! (< (- (point-max) (point)) gnus-signature-limit)) ! (and (gnus-functionp gnus-signature-limit) ! (funcall gnus-signature-limit)) ! (and (stringp gnus-signature-limit) ! (not (re-search-forward gnus-signature-limit nil t)))) ! (narrow-to-region (point) (point-max)) ! t))) ! ! (defun gnus-hidden-arg () ! "Return the current prefix arg as a number, or 0 if no prefix." ! (list (if current-prefix-arg ! (prefix-numeric-value current-prefix-arg) ! 0))) ! ! (defun gnus-article-check-hidden-text (type arg) ! "Return nil if hiding is necessary. ! Arg can be nil or a number. Nil and positive means hide, negative ! means show, 0 means toggle." ! (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((hide (gnus-article-hidden-text-p type))) ! (cond ! ((or (null arg) ! (> arg 0)) ! nil) ! ((< arg 0) ! (gnus-article-show-hidden-text type)) ! (t ! (if (eq hide 'hidden) ! (gnus-article-show-hidden-text type) ! nil)))))) ! ! (defun gnus-article-hidden-text-p (type) ! "Say whether the current buffer contains hidden text of type TYPE." ! (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type))) ! (when pos ! (if (get-text-property pos 'invisible) ! 'hidden ! 'shown)))) ! ! (defun gnus-article-hide (&optional arg force) ! "Hide all the gruft in the current article. ! This means that PGP stuff, signatures, cited text and (some) ! headers will be hidden. ! If given a prefix, show the hidden text instead." ! (interactive (list current-prefix-arg 'force)) ! (gnus-article-hide-headers arg) ! (gnus-article-hide-pgp arg) ! (gnus-article-hide-citation-maybe arg force) ! (gnus-article-hide-signature arg)) ! ! (defun gnus-article-show-hidden-text (type &optional hide) ! "Show all hidden text of type TYPE. ! If HIDE, hide the text instead." (save-excursion ! (set-buffer gnus-article-buffer) ! (let ((buffer-read-only nil) ! (inhibit-point-motion-hooks t) ! (beg (point-min))) ! (while (gnus-goto-char (text-property-any ! beg (point-max) 'gnus-type type)) ! (setq beg (point)) ! (forward-char) ! (if hide ! (gnus-hide-text beg (point) gnus-hidden-properties) ! (gnus-unhide-text beg (point))) ! (setq beg (point))) ! t))) (defvar gnus-article-time-units ! `((year . ,(* 365.25 24 60 60)) ! (week . ,(* 7 24 60 60)) ! (day . ,(* 24 60 60)) ! (hour . ,(* 60 60)) ! (minute . 60) ! (second . 1)) ! "Mapping from time units to seconds.") ! (defun gnus-article-date-ut (&optional type highlight) "Convert DATE date to universal time in the current article. 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 gnus-current-headers ! (gnus-summary-article-header) "")) ! (date (and (vectorp header) (mail-header-date header))) ! (date-regexp "^Date: \\|^X-Sent: ") ! (now (current-time)) ! (inhibit-point-motion-hooks t) ! bface eface) ! (when (and date (not (string= date ""))) (save-excursion (set-buffer gnus-article-buffer) ! (save-restriction ! (nnheader-narrow-to-headers) ! (let ((buffer-read-only nil)) ! ;; Delete any old Date headers. ! (if (re-search-forward date-regexp nil t) ! (progn ! (setq bface (get-text-property (gnus-point-at-bol) 'face) ! eface (get-text-property (1- (gnus-point-at-eol)) ! 'face)) ! (message-remove-header date-regexp t) ! (beginning-of-line)) ! (goto-char (point-max))) ! (insert (gnus-make-date-line date type)) ! ;; Do highlighting. ! (forward-line -1) ! (when (and (gnus-visual-p 'article-highlight 'highlight) ! (looking-at "\\([^:]+\\): *\\(.*\\)$")) ! (gnus-put-text-property (match-beginning 1) (match-end 1) ! 'face bface) ! (gnus-put-text-property (match-beginning 2) (match-end 2) ! 'face eface)))))))) ! ! (defun gnus-make-date-line (date type) ! "Return a DATE line of TYPE." ! (cond ! ;; Convert to the local timezone. We have to slap a ! ;; `condition-case' round the calls to the timezone ! ;; functions since they aren't particularly resistant to ! ;; buggy dates. ! ((eq type 'local) ! (concat "Date: " (condition-case () ! (timezone-make-date-arpa-standard date) (error date)) ! "\n")) ! ;; Convert to Universal Time. ! ((eq type 'ut) ! (concat "Date: " ! (condition-case () ! (timezone-make-date-arpa-standard date nil "UT") ! (error date)) ! "\n")) ! ;; Get the original date from the article. ! ((eq type 'original) ! (concat "Date: " date "\n")) ! ;; Do an X-Sent lapsed format. ! ((eq type 'lapsed) ! ;; If the date is seriously mangled, the timezone ! ;; functions are liable to bug out, so we condition-case ! ;; the entire thing. ! (let* ((now (current-time)) ! (real-time ! (condition-case () ! (gnus-time-minus ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! (current-time-string now) ! (current-time-zone now) "UT")) ! (gnus-encode-date ! (timezone-make-date-arpa-standard ! date nil "UT"))) ! (error '(0 0)))) ! (real-sec (+ (* (float (car real-time)) 65536) ! (cadr real-time))) ! (sec (abs real-sec)) ! num prev) ! (cond ! ((equal real-time '(0 0)) ! "X-Sent: Unknown\n") ! ((zerop sec) ! "X-Sent: Now\n") ! (t ! (concat ! "X-Sent: " ! ;; This is a bit convoluted, but basically we go ! ;; through the time units for years, weeks, etc, ! ;; and divide things to see whether that results ! ;; in positive answers. ! (mapconcat ! (lambda (unit) ! (if (zerop (setq num (ffloor (/ sec (cdr unit))))) ! ;; The (remaining) seconds are too few to ! ;; be divided into this time unit. ! "" ! ;; It's big enough, so we output it. ! (setq sec (- sec (* num (cdr unit)))) ! (prog1 ! (concat (if prev ", " "") (int-to-string ! (floor num)) ! " " (symbol-name (car unit)) ! (if (> num 1) "s" "")) ! (setq prev t)))) ! gnus-article-time-units "") ! ;; If dates are odd, then it might appear like the ! ;; article was sent in the future. ! (if (> real-sec 0) ! " ago\n" ! " in the future\n")))))) ! (t ! (error "Unknown conversion type: %s" type)))) ! (defun gnus-article-date-local (&optional highlight) "Convert the current article date to the local timezone." ! (interactive (list t)) ! (gnus-article-date-ut 'local highlight)) ! (defun gnus-article-date-original (&optional highlight) ! "Convert the current article date to what it was originally. ! This is only useful if you have used some other date conversion ! function and want to see what the date was before converting." ! (interactive (list t)) ! (gnus-article-date-ut 'original highlight)) ! ! (defun gnus-article-date-lapsed (&optional highlight) "Convert the current article date to time lapsed since it was sent." ! (interactive (list t)) ! (gnus-article-date-ut 'lapsed highlight)) (defun gnus-article-maybe-highlight () "Do some article highlighting if `gnus-visual' is non-nil." ! (if (gnus-visual-p 'article-highlight 'highlight) ! (gnus-article-highlight-some))) ! ;;; Article savers. (defun gnus-output-to-rmail (file-name) *************** how much time has lapsed since DATE." *** 11391,11401 **** (defun gnus-output-to-file (file-name) "Append the current article to a file named FILE-NAME." ! (setq file-name (expand-file-name file-name)) ! (let ((artbuf (current-buffer)) ! (tmpbuf (get-buffer-create " *Gnus-output*"))) ! (save-excursion ! (set-buffer tmpbuf) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then --- 14645,14650 ---- (defun gnus-output-to-file (file-name) "Append the current article to a file named FILE-NAME." ! (let ((artbuf (current-buffer))) ! (nnheader-temp-write nil (insert-buffer-substring artbuf) ;; Append newline at end of the buffer as separator, and then *************** how much time has lapsed since DATE." *** 11403,11408 **** (goto-char (point-max)) (insert "\n") ! (append-to-file (point-min) (point-max) file-name)) ! (kill-buffer tmpbuf))) (defun gnus-convert-article-to-rmail () --- 14652,14656 ---- (goto-char (point-max)) (insert "\n") ! (append-to-file (point-min) (point-max) file-name)))) (defun gnus-convert-article-to-rmail () *************** how much time has lapsed since DATE." *** 11419,11482 **** (defun gnus-narrow-to-page (&optional arg) ! "Make text outside current page invisible except for page delimiter. ! A numeric arg specifies to move forward or backward by that many pages, ! thus showing a page other than the one point was originally in." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) 0)) (save-excursion ! (forward-page -1) ;Beginning of current page. (widen) ! (if (> arg 0) ! (forward-page arg) ! (if (< arg 0) ! (forward-page (1- arg)))) ! ;; Find the end of the page. ! (forward-page) ! ;; If we stopped due to end of buffer, stay there. ! ;; If we stopped after a page delimiter, put end of restriction ! ;; at the beginning of that line. ! ;; These are commented out. ! ;; (if (save-excursion (beginning-of-line) ! ;; (looking-at page-delimiter)) ! ;; (beginning-of-line)) ! (narrow-to-region (point) ! (progn ! ;; Find the top of the page. ! (forward-page -1) ! ;; If we found beginning of buffer, stay there. ! ;; If extra text follows page delimiter on same line, ! ;; include it. ! ;; Otherwise, show text starting with following line. ! (if (and (eolp) (not (bobp))) ! (forward-line 1)) ! (point))))) ! ! (defun gnus-gmt-to-local () ! "Rewrite Date header described in GMT to local in current buffer. ! Intended to be used with gnus-article-prepare-hook." ! (save-excursion ! (save-restriction ! (widen) ! (goto-char (point-min)) ! (narrow-to-region (point-min) ! (progn (search-forward "\n\n" nil 'move) (point))) ! (goto-char (point-min)) ! (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t) ! (let ((buffer-read-only nil) ! (date (buffer-substring-no-properties ! (match-beginning 1) (match-end 1)))) ! (delete-region (match-beginning 1) (match-end 1)) ! (insert ! (timezone-make-date-arpa-standard ! date nil (current-time-zone)))))))) ! ;; Article mode commands (defun gnus-article-next-page (&optional lines) ! "Show next page of current article. ! If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." ! (interactive "P") (move-to-window-line -1) ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) --- 14667,14723 ---- (defun gnus-narrow-to-page (&optional arg) ! "Narrow the article buffer to a page. ! If given a numerical ARG, move forward ARG pages." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) 0)) (save-excursion ! (set-buffer gnus-article-buffer) ! (goto-char (point-min)) (widen) ! (when (gnus-visual-p 'page-marker) ! (let ((buffer-read-only nil)) ! (gnus-remove-text-with-property 'gnus-prev) ! (gnus-remove-text-with-property 'gnus-next))) ! (when ! (cond ((< arg 0) ! (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) ! ((> arg 0) ! (re-search-forward page-delimiter nil 'move arg))) ! (goto-char (match-end 0))) ! (narrow-to-region ! (point) ! (if (re-search-forward page-delimiter nil 'move) ! (match-beginning 0) ! (point))) ! (when (and (gnus-visual-p 'page-marker) ! (not (= (point-min) 1))) ! (save-excursion ! (goto-char (point-min)) ! (gnus-insert-prev-page-button))) ! (when (and (gnus-visual-p 'page-marker) ! (not (= (1- (point-max)) (buffer-size)))) ! (save-excursion ! (goto-char (point-max)) ! (gnus-insert-next-page-button))))) ;; Article mode commands + (defun gnus-article-goto-next-page () + "Show the next page of the article." + (interactive) + (when (gnus-article-next-page) + (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) + + (defun gnus-article-goto-prev-page () + "Show the next page of the article." + (interactive) + (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)) + (gnus-article-prev-page nil))) + (defun gnus-article-next-page (&optional lines) ! "Show the next page of the current article. ! If end of article, return non-nil. Otherwise return nil. Argument LINES specifies lines to be scrolled up." ! (interactive "p") (move-to-window-line -1) ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) *************** Argument LINES specifies lines to be scr *** 11499,11502 **** --- 14740,14744 ---- ;; Long lines may cause an end-of-buffer error. (goto-char (point-max)))) + (move-to-window-line 0) nil)) *************** Argument LINES specifies lines to be scr *** 11504,11508 **** "Show previous page of current article. Argument LINES specifies lines to be scrolled down." ! (interactive "P") (move-to-window-line 0) (if (and gnus-break-pages --- 14746,14750 ---- "Show previous page of current article. Argument LINES specifies lines to be scrolled down." ! (interactive "p") (move-to-window-line 0) (if (and gnus-break-pages *************** Argument LINES specifies lines to be scr *** 11513,11528 **** (goto-char (point-max)) (recenter -1)) ! (scroll-down lines))) (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) ! (search-forward ">" nil t) ;Move point to end of "<....>". ! (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) ! (let ((message-id ! (buffer-substring (match-beginning 1) (match-end 1)))) ! (set-buffer gnus-summary-buffer) ! (gnus-summary-refer-article message-id)) ! (error "No references around point"))) (defun gnus-article-show-summary () --- 14755,14776 ---- (goto-char (point-max)) (recenter -1)) ! (prog1 ! (condition-case () ! (scroll-down lines) ! (error nil)) ! (move-to-window-line 0)))) (defun gnus-article-refer-article () "Read article specified by message-id around point." (interactive) ! (let ((point (point))) ! (search-forward ">" nil t) ;Move point to end of "<....>". ! (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) ! (let ((message-id (match-string 1))) ! (goto-char point) ! (set-buffer gnus-summary-buffer) ! (gnus-summary-refer-article message-id)) ! (goto-char (point)) ! (error "No references around point")))) (defun gnus-article-show-summary () *************** Argument LINES specifies lines to be scr *** 11536,11540 **** (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-summary-command () --- 14784,14788 ---- (interactive) (gnus-message 6 ! (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) (defun gnus-article-summary-command () *************** Argument LINES specifies lines to be scr *** 11559,11564 **** (call-interactively func))) ! ;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti) ;;;###autoload --- 14807,14859 ---- (call-interactively func))) + (defun gnus-article-read-summary-keys (&optional arg key not-restore-window) + "Read a summary buffer key sequence and execute it from the article buffer." + (interactive "P") + (let ((nosaves + '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" + "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" + "=" "^" "\M-^" "|")) + (nosave-but-article + '("A\r")) + keys) + (save-excursion + (set-buffer gnus-summary-buffer) + (push (or key last-command-event) unread-command-events) + (setq keys (read-key-sequence nil))) + (message "") + + (if (or (member keys nosaves) + (member keys nosave-but-article)) + (let (func) + (save-window-excursion + (pop-to-buffer gnus-summary-buffer 'norecord) + (setq func (lookup-key (current-local-map) keys))) + (if (not func) + (ding) + (set-buffer gnus-summary-buffer) + (call-interactively func)) + (when (member keys nosave-but-article) + (pop-to-buffer gnus-article-buffer 'norecord))) + (let ((obuf (current-buffer)) + (owin (current-window-configuration)) + (opoint (point)) + func in-buffer) + (if not-restore-window + (pop-to-buffer gnus-summary-buffer 'norecord) + (switch-to-buffer gnus-summary-buffer 'norecord)) + (setq in-buffer (current-buffer)) + (if (setq func (lookup-key (current-local-map) keys)) + (call-interactively func) + (ding)) + (when (eq in-buffer (current-buffer)) + (set-buffer obuf) + (unless not-restore-window + (set-window-configuration owin)) + (set-window-point (get-buffer-window (current-buffer)) opoint)))))) + ! ;;; ! ;;; Kill file handling. ! ;;; ;;;###autoload *************** Argument LINES specifies lines to be scr *** 11569,11573 **** Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score ! the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." (interactive) --- 14864,14868 ---- Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score ! the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." (interactive) *************** score the alt hierarchy, you'd say \"!al *** 11592,11596 **** (setq newsrc (cdr gnus-newsrc-alist)) (while newsrc ! (setq group (car (car newsrc))) (setq entry (gnus-gethash group gnus-newsrc-hashtb)) (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) --- 14887,14891 ---- (setq newsrc (cdr gnus-newsrc-alist)) (while newsrc ! (setq group (caar newsrc)) (setq entry (gnus-gethash group gnus-newsrc-hashtb)) (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed) *************** score the alt hierarchy, you'd say \"!al *** 11601,11605 **** (or (null no) (not (string-match no group)))) (progn ! (gnus-summary-read-group group nil t) (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) (gnus-summary-exit)))) --- 14896,14900 ---- (or (null no) (not (string-match no group)))) (progn ! (gnus-summary-read-group group nil t nil t) (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) (gnus-summary-exit)))) *************** Returns the number of articles marked as *** 11618,11628 **** (defun gnus-kill-save-kill-buffer () ! (save-excursion ! (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) ! (if (get-file-buffer file) ! (progn ! (set-buffer (get-file-buffer file)) ! (and (buffer-modified-p) (save-buffer)) ! (kill-buffer (current-buffer))))))) (defvar gnus-kill-file-name "KILL" --- 14913,14922 ---- (defun gnus-kill-save-kill-buffer () ! (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) ! (when (get-file-buffer file) ! (save-excursion ! (set-buffer (get-file-buffer file)) ! (and (buffer-modified-p) (save-buffer)) ! (kill-buffer (current-buffer)))))) (defvar gnus-kill-file-name "KILL" *************** Returns the number of articles marked as *** 11632,11650 **** "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." ! (cond ((or (null newsgroup) ! (string-equal newsgroup "")) ! ;; The global KILL file is placed at top of the directory. ! (expand-file-name gnus-kill-file-name ! (or gnus-kill-files-directory "~/News"))) ! ((gnus-use-long-file-name 'not-kill) ! ;; Append ".KILL" to newsgroup name. ! (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) ! "." gnus-kill-file-name) ! (or gnus-kill-files-directory "~/News"))) ! (t ! ;; Place "KILL" under the hierarchical directory. ! (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) ! "/" gnus-kill-file-name) ! (or gnus-kill-files-directory "~/News"))))) --- 14926,14945 ---- "Return the name of a kill file name for NEWSGROUP. If NEWSGROUP is nil, return the global kill file name instead." ! (cond ! ;; The global KILL file is placed at top of the directory. ! ((or (null newsgroup) ! (string-equal newsgroup "")) ! (expand-file-name gnus-kill-file-name ! gnus-kill-files-directory)) ! ;; Append ".KILL" to newsgroup name. ! ((gnus-use-long-file-name 'not-kill) ! (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) ! "." gnus-kill-file-name) ! gnus-kill-files-directory)) ! ;; Place "KILL" under the hierarchical directory. ! (t ! (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) ! "/" gnus-kill-file-name) ! gnus-kill-files-directory)))) *************** If NEWSGROUP is nil, return the global k *** 11657,11663 **** (defun gnus-dribble-file-name () ! (concat gnus-current-startup-file "-dribble")) (defun gnus-dribble-enter (string) (if (and (not gnus-dribble-ignore) gnus-dribble-buffer --- 14952,14965 ---- (defun gnus-dribble-file-name () ! "Return the dribble file for the current .newsrc." ! (concat ! (if gnus-dribble-directory ! (concat (file-name-as-directory gnus-dribble-directory) ! (file-name-nondirectory gnus-current-startup-file)) ! gnus-current-startup-file) ! "-dribble")) (defun gnus-dribble-enter (string) + "Enter STRING into the dribble buffer." (if (and (not gnus-dribble-ignore) gnus-dribble-buffer *************** If NEWSGROUP is nil, return the global k *** 11667,11700 **** (insert string "\n") (set-window-point (get-buffer-window (current-buffer)) (point-max)) (set-buffer obuf)))) (defun gnus-dribble-read-file () (let ((dribble-file (gnus-dribble-file-name))) ! (save-excursion ! (set-buffer (setq gnus-dribble-buffer ! (get-buffer-create (file-name-nondirectory dribble-file)))) (gnus-add-current-to-buffer-list) (erase-buffer) ! (set-visited-file-name dribble-file) (buffer-disable-undo (current-buffer)) (bury-buffer (current-buffer)) (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) ! (gnus-dribble-ignore t)) ! (if (or (file-exists-p auto) (file-exists-p dribble-file)) ! (progn ! (if (file-newer-than-file-p auto dribble-file) ! (setq dribble-file auto)) ! (insert-file-contents dribble-file) ! (if (not (zerop (buffer-size))) ! (set-buffer-modified-p t)) ! (if (gnus-y-or-n-p ! "Auto-save file exists. Do you want to read it? ") ! (setq gnus-dribble-eval-file t)))))))) (defun gnus-dribble-eval-file () ! (if (not gnus-dribble-eval-file) ! () (setq gnus-dribble-eval-file nil) (save-excursion --- 14969,15012 ---- (insert string "\n") (set-window-point (get-buffer-window (current-buffer)) (point-max)) + (bury-buffer gnus-dribble-buffer) (set-buffer obuf)))) (defun gnus-dribble-read-file () + "Read the dribble file from disk." (let ((dribble-file (gnus-dribble-file-name))) ! (save-excursion ! (set-buffer (setq gnus-dribble-buffer ! (get-buffer-create (file-name-nondirectory dribble-file)))) (gnus-add-current-to-buffer-list) (erase-buffer) ! (setq buffer-file-name dribble-file) ! (auto-save-mode t) (buffer-disable-undo (current-buffer)) (bury-buffer (current-buffer)) (set-buffer-modified-p nil) (let ((auto (make-auto-save-file-name)) ! (gnus-dribble-ignore t) ! modes) ! (when (or (file-exists-p auto) (file-exists-p dribble-file)) ! ;; Load whichever file is newest -- the auto save file ! ;; or the "real" file. ! (if (file-newer-than-file-p auto dribble-file) ! (insert-file-contents auto) ! (insert-file-contents dribble-file)) ! (unless (zerop (buffer-size)) ! (set-buffer-modified-p t)) ! ;; Set the file modes to reflect the .newsrc file modes. ! (save-buffer) ! (when (and (file-exists-p gnus-current-startup-file) ! (setq modes (file-modes gnus-current-startup-file))) ! (set-file-modes dribble-file modes)) ! ;; Possibly eval the file later. ! (when (gnus-y-or-n-p ! "Auto-save file exists. Do you want to read it? ") ! (setq gnus-dribble-eval-file t))))))) (defun gnus-dribble-eval-file () ! (when gnus-dribble-eval-file (setq gnus-dribble-eval-file nil) (save-excursion *************** If NEWSGROUP is nil, return the global k *** 11704,11734 **** (defun gnus-dribble-delete-file () ! (if (file-exists-p (gnus-dribble-file-name)) ! (delete-file (gnus-dribble-file-name))) ! (if gnus-dribble-buffer ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (let ((auto (make-auto-save-file-name))) ! (if (file-exists-p auto) ! (delete-file auto)) ! (erase-buffer) ! (set-buffer-modified-p nil))))) (defun gnus-dribble-save () ! (if (and gnus-dribble-buffer ! (buffer-name gnus-dribble-buffer)) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (save-buffer)))) (defun gnus-dribble-clear () ! (save-excursion ! (if (gnus-buffer-exists-p gnus-dribble-buffer) ! (progn ! (set-buffer gnus-dribble-buffer) ! (erase-buffer) ! (set-buffer-modified-p nil) ! (setq buffer-saved-size (buffer-size)))))) ;;; ;;; Server Communication --- 15016,15046 ---- (defun gnus-dribble-delete-file () ! (when (file-exists-p (gnus-dribble-file-name)) ! (delete-file (gnus-dribble-file-name))) ! (when gnus-dribble-buffer ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (let ((auto (make-auto-save-file-name))) ! (if (file-exists-p auto) ! (delete-file auto)) ! (erase-buffer) ! (set-buffer-modified-p nil))))) (defun gnus-dribble-save () ! (when (and gnus-dribble-buffer ! (buffer-name gnus-dribble-buffer)) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (save-buffer)))) (defun gnus-dribble-clear () ! (when (gnus-buffer-exists-p gnus-dribble-buffer) ! (save-excursion ! (set-buffer gnus-dribble-buffer) ! (erase-buffer) ! (set-buffer-modified-p nil) ! (setq buffer-saved-size (buffer-size))))) + ;;; ;;; Server Communication *************** If CONFIRM is non-nil, the user will be *** 11754,11758 **** nil nil gnus-nntp-server)))) ! (if (and gnus-nntp-server (stringp gnus-nntp-server) (not (string= gnus-nntp-server ""))) --- 15066,15070 ---- nil nil gnus-nntp-server)))) ! (if (and gnus-nntp-server (stringp gnus-nntp-server) (not (string= gnus-nntp-server ""))) *************** If CONFIRM is non-nil, the user will be *** 11762,11767 **** (list 'nnspool (system-name))) ((string-match "^:" gnus-nntp-server) ! (list 'nnmh gnus-nntp-server ! (list 'nnmh-directory (file-name-as-directory (expand-file-name --- 15074,15079 ---- (list 'nnspool (system-name))) ((string-match "^:" gnus-nntp-server) ! (list 'nnmh gnus-nntp-server ! (list 'nnmh-directory (file-name-as-directory (expand-file-name *************** If CONFIRM is non-nil, the user will be *** 11783,11970 **** (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) ! (or ;; gnus-open-server-hook might have opened it ! (gnus-server-opened gnus-select-method) (gnus-open-server gnus-select-method) (gnus-y-or-n-p (format ! "%s open error: '%s'. Continue? " ! (nth 1 gnus-select-method) (gnus-status-message gnus-select-method))) ! (progn ! (gnus-message 1 "Couldn't open server on %s" ! (nth 1 gnus-select-method)) ! (ding) ! nil))))) ! ! (defun gnus-check-server (&optional method) ! "If the news server is down, start it up again." ! (let ((method (if method method gnus-select-method))) ! (and (stringp method) ! (setq method (gnus-server-to-method method))) (if (gnus-server-opened method) ! ;; Stream is already opened. t ! ;; Open server. ! (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method)) (run-hooks 'gnus-open-server-hook) (prog1 (gnus-open-server method) ! (message ""))))) ! (defun gnus-nntp-message (&optional message) ! "Check the status of the NNTP server. ! If the status of the server is clear and MESSAGE is non-nil, MESSAGE ! is returned insted of the status string." ! (let ((status (gnus-status-message (gnus-find-method-for-group ! gnus-newsgroup-name))) ! (message (or message ""))) ! (if (and (stringp status) (> (length status) 0)) ! status message))) ! ! (defun gnus-get-function (method function) ! (and (stringp method) ! (setq method (gnus-server-to-method method))) (let ((func (intern (format "%s-%s" (car method) function)))) ! (if (not (fboundp func)) ! (progn ! (require (car method)) ! (if (not (fboundp func)) ! (error "No such function: %s" func)))) func)) ;;; Interface functions to the backends. (defun gnus-open-server (method) ! (funcall (gnus-get-function method 'open-server) ! (nth 1 method) (nthcdr 2 method))) (defun gnus-close-server (method) (funcall (gnus-get-function method 'close-server) (nth 1 method))) (defun gnus-request-list (method) (funcall (gnus-get-function method 'request-list) (nth 1 method))) (defun gnus-request-list-newsgroups (method) (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) (defun gnus-request-newgroups (date method) ! (funcall (gnus-get-function method 'request-newgroups) date (nth 1 method))) (defun gnus-server-opened (method) (funcall (gnus-get-function method 'server-opened) (nth 1 method))) (defun gnus-status-message (method) (let ((method (if (stringp method) (gnus-find-method-for-group method) method))) (funcall (gnus-get-function method 'status-message) (nth 1 method)))) ! (defun gnus-request-group (group &optional dont-check) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-group) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-request-asynchronous (group &optional articles) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-asynchronous) (gnus-group-real-name group) (nth 1 method) articles))) (defun gnus-list-active-group (group) (let ((method (gnus-find-method-for-group group)) (func 'list-active-group)) ! (and (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) ! (gnus-group-real-name group) (nth 1 method))))) (defun gnus-request-group-description (group) (let ((method (gnus-find-method-for-group group)) (func 'request-group-description)) ! (and (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) ! (gnus-group-real-name group) (nth 1 method))))) (defun gnus-close-group (group) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) ! (defun gnus-retrieve-headers (articles group) (let ((method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) ! (gnus-cache-retrieve-headers articles group) ! (funcall (gnus-get-function method 'retrieve-headers) ! articles (gnus-group-real-name group) (nth 1 method))))) (defun gnus-retrieve-groups (groups method) (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) (defun gnus-request-article (article group &optional buffer) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-article) article (gnus-group-real-name group) (nth 1 method) buffer))) (defun gnus-request-head (article group) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-head) ! article (gnus-group-real-name group) (nth 1 method)))) (defun gnus-request-body (article group) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-body) article (gnus-group-real-name group) (nth 1 method)))) ! ;; Fix by Sudish Joseph . ! (defun gnus-request-post-buffer (post group subject header artbuf ! info follow-to respect-poster) ! (let* ((info (or info (and group (nth 2 (gnus-gethash ! group gnus-newsrc-hashtb))))) ! (method ! (if (and gnus-post-method ! ;; Fix by Sudish Joseph . ! (memq 'post (assoc ! (format "%s" (car (gnus-find-method-for-group ! gnus-newsgroup-name))) ! gnus-valid-select-methods))) ! gnus-post-method ! (gnus-find-method-for-group gnus-newsgroup-name)))) ! (or (gnus-check-server method) ! (error "Can't open server %s:%s" (car method) (nth 1 method))) ! (let ((mail-self-blind nil) ! (mail-archive-file-name nil)) ! (funcall (gnus-get-function method 'request-post-buffer) ! post group subject header artbuf info follow-to ! respect-poster)))) ! ! (defun gnus-request-post (method &optional force) ! (and (stringp method) ! (setq method (gnus-server-to-method method))) ! (and (not force) gnus-post-method ! (memq 'post (assoc (format "%s" (car method)) ! gnus-valid-select-methods)) ! (setq method gnus-post-method)) ! (funcall (gnus-get-function method 'request-post) ! (nth 1 method))) (defun gnus-request-expire-articles (articles group &optional force) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 method) force))) ! (defun gnus-request-move-article (article group server accept-function &optional last) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-move-article) ! article (gnus-group-real-name group) (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group &optional last) (goto-char (point-max)) ! (or (bolp) (insert "\n")) ! (let ((func (if (symbolp group) group ! (car (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) last))) --- 15095,15371 ---- (setq gnus-current-select-method gnus-select-method) (run-hooks 'gnus-open-server-hook) ! (or ;; gnus-open-server-hook might have opened it ! (gnus-server-opened gnus-select-method) (gnus-open-server gnus-select-method) (gnus-y-or-n-p (format ! "%s (%s) open error: '%s'. Continue? " ! (car gnus-select-method) (cadr gnus-select-method) (gnus-status-message gnus-select-method))) ! (gnus-error 1 "Couldn't open server on %s" ! (nth 1 gnus-select-method)))))) ! ! (defun gnus-check-group (group) ! "Try to make sure that the server where GROUP exists is alive." ! (let ((method (gnus-find-method-for-group group))) ! (or (gnus-server-opened method) ! (gnus-open-server method)))) ! ! (defun gnus-check-server (&optional method silent) ! "Check whether the connection to METHOD is down. ! If METHOD is nil, use `gnus-select-method'. ! If it is down, start it up (again)." ! (let ((method (or method gnus-select-method))) ! ;; Transform virtual server names into select methods. ! (when (stringp method) ! (setq method (gnus-server-to-method method))) (if (gnus-server-opened method) ! ;; The stream is already opened. t ! ;; Open the server. ! (unless silent ! (gnus-message 5 "Opening %s server%s..." (car method) ! (if (equal (nth 1 method) "") "" ! (format " on %s" (nth 1 method))))) (run-hooks 'gnus-open-server-hook) (prog1 (gnus-open-server method) ! (unless silent ! (message "")))))) ! (defun gnus-get-function (method function &optional noerror) ! "Return a function symbol based on METHOD and FUNCTION." ! ;; Translate server names into methods. ! (unless method ! (error "Attempted use of a nil select method")) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) (let ((func (intern (format "%s-%s" (car method) function)))) ! ;; If the functions isn't bound, we require the backend in ! ;; question. ! (unless (fboundp func) ! (require (car method)) ! (when (and (not (fboundp func)) ! (not noerror)) ! ;; This backend doesn't implement this function. ! (error "No such function: %s" func))) func)) + + ;;; ;;; Interface functions to the backends. + ;;; (defun gnus-open-server (method) ! "Open a connection to METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((elem (assoc method gnus-opened-servers))) ! ;; If this method was previously denied, we just return nil. ! (if (eq (nth 1 elem) 'denied) ! (progn ! (gnus-message 1 "Denied server") ! nil) ! ;; Open the server. ! (let ((result ! (funcall (gnus-get-function method 'open-server) ! (nth 1 method) (nthcdr 2 method)))) ! ;; If this hasn't been opened before, we add it to the list. ! (unless elem ! (setq elem (list method nil) ! gnus-opened-servers (cons elem gnus-opened-servers))) ! ;; Set the status of this server. ! (setcar (cdr elem) (if result 'ok 'denied)) ! ;; Return the result from the "open" call. ! result)))) (defun gnus-close-server (method) + "Close the connection to METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) (funcall (gnus-get-function method 'close-server) (nth 1 method))) (defun gnus-request-list (method) + "Request the active file from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) (funcall (gnus-get-function method 'request-list) (nth 1 method))) (defun gnus-request-list-newsgroups (method) + "Request the newsgroups file from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) (defun gnus-request-newgroups (date method) ! "Request all new groups since DATE from METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-newgroups) date (nth 1 method))) (defun gnus-server-opened (method) + "Check whether a connection to METHOD has been opened." + (when (stringp method) + (setq method (gnus-server-to-method method))) (funcall (gnus-get-function method 'server-opened) (nth 1 method))) (defun gnus-status-message (method) + "Return the status message from METHOD. + If METHOD is a string, it is interpreted as a group name. The method + this group uses will be queried." (let ((method (if (stringp method) (gnus-find-method-for-group method) method))) (funcall (gnus-get-function method 'status-message) (nth 1 method)))) ! (defun gnus-request-group (group &optional dont-check method) ! "Request GROUP. If DONT-CHECK, no information is required." ! (let ((method (or method (gnus-find-method-for-group group)))) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-group) (gnus-group-real-name group) (nth 1 method) dont-check))) (defun gnus-request-asynchronous (group &optional articles) + "Request that GROUP behave asynchronously. + ARTICLES is the `data' of the group." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-asynchronous) (gnus-group-real-name group) (nth 1 method) articles))) (defun gnus-list-active-group (group) + "Request active information on GROUP." (let ((method (gnus-find-method-for-group group)) (func 'list-active-group)) ! (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) ! (gnus-group-real-name group) (nth 1 method))))) (defun gnus-request-group-description (group) + "Request a description of GROUP." (let ((method (gnus-find-method-for-group group)) (func 'request-group-description)) ! (when (gnus-check-backend-function func group) ! (funcall (gnus-get-function method func) ! (gnus-group-real-name group) (nth 1 method))))) (defun gnus-close-group (group) + "Request the GROUP be closed." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'close-group) (gnus-group-real-name group) (nth 1 method)))) ! (defun gnus-retrieve-headers (articles group &optional fetch-old) ! "Request headers for ARTICLES in GROUP. ! If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." (let ((method (gnus-find-method-for-group group))) (if (and gnus-use-cache (numberp (car articles))) ! (gnus-cache-retrieve-headers articles group fetch-old) ! (funcall (gnus-get-function method 'retrieve-headers) ! articles (gnus-group-real-name group) (nth 1 method) ! fetch-old)))) (defun gnus-retrieve-groups (groups method) + "Request active information on GROUPS from METHOD." + (when (stringp method) + (setq method (gnus-server-to-method method))) (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) + (defun gnus-request-type (group &optional article) + "Return the type (`post' or `mail') of GROUP (and ARTICLE)." + (let ((method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function 'request-type (car method))) + 'unknown + (funcall (gnus-get-function method 'request-type) + (gnus-group-real-name group) article)))) + + (defun gnus-request-update-mark (group article mark) + "Return the type (`post' or `mail') of GROUP (and ARTICLE)." + (let ((method (gnus-find-method-for-group group))) + (if (not (gnus-check-backend-function 'request-update-mark (car method))) + mark + (funcall (gnus-get-function method 'request-update-mark) + (gnus-group-real-name group) article mark)))) + (defun gnus-request-article (article group &optional buffer) + "Request the ARTICLE in GROUP. + ARTICLE can either be an article number or an article Message-ID. + If BUFFER, insert the article in that group." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-article) article (gnus-group-real-name group) (nth 1 method) buffer))) (defun gnus-request-head (article group) ! "Request the head of ARTICLE in GROUP." ! (let* ((method (gnus-find-method-for-group group)) ! (head (gnus-get-function method 'request-head t))) ! (if (fboundp head) ! (funcall head article (gnus-group-real-name group) (nth 1 method)) ! (let ((res (gnus-request-article article group))) ! (when res ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (delete-region (1- (point)) (point-max))) ! (nnheader-fold-continuation-lines))) ! res)))) (defun gnus-request-body (article group) + "Request the body of ARTICLE in GROUP." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-body) article (gnus-group-real-name group) (nth 1 method)))) ! (defun gnus-request-post (method) ! "Post the current buffer using METHOD." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (funcall (gnus-get-function method 'request-post) (nth 1 method))) ! ! (defun gnus-request-scan (group method) ! "Request a SCAN being performed in GROUP from METHOD. ! If GROUP is nil, all groups on METHOD are scanned." ! (let ((method (if group (gnus-find-method-for-group group) method))) ! (funcall (gnus-get-function method 'request-scan) ! (and group (gnus-group-real-name group)) (nth 1 method)))) ! ! (defsubst gnus-request-update-info (info method) ! "Request that METHOD update INFO." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (when (gnus-check-backend-function 'request-update-info (car method)) ! (funcall (gnus-get-function method 'request-update-info) ! (gnus-group-real-name (gnus-info-group info)) ! info (nth 1 method)))) (defun gnus-request-expire-articles (articles group &optional force) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-expire-articles) articles (gnus-group-real-name group) (nth 1 method) force))) ! (defun gnus-request-move-article (article group server accept-function &optional last) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-move-article) ! article (gnus-group-real-name group) (nth 1 method) accept-function last))) ! (defun gnus-request-accept-article (group method &optional last) ! ;; Make sure there's a newline at the end of the article. ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (when (and (not method) ! (stringp group)) ! (setq method (gnus-group-name-to-method group))) (goto-char (point-max)) ! (unless (bolp) ! (insert "\n")) ! (let ((func (car (or method (gnus-find-method-for-group group))))) (funcall (intern (format "%s-request-accept-article" func)) (if (stringp group) (gnus-group-real-name group) group) + (cadr method) last))) *************** is returned insted of the status string. *** 11974,12005 **** article (gnus-group-real-name group) buffer))) ! (defun gnus-request-create-group (group) (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-create-group) (gnus-group-real-name group) (nth 1 method)))) (defun gnus-member-of-valid (symbol group) (memq symbol (assoc ! (format "%s" (car (gnus-find-method-for-group group))) gnus-valid-select-methods))) ! (defun gnus-secondary-method-p (method) ! (let ((methods gnus-secondary-select-methods) ! (gmethod (gnus-server-get-method nil method))) ! (while (and methods ! (not (equal (gnus-server-get-method nil (car methods)) ! gmethod))) ! (setq methods (cdr methods))) ! methods)) (defun gnus-find-method-for-group (group &optional info) (or gnus-override-method (and (not group) gnus-select-method) ! (let ((info (or info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) method) (if (or (not info) ! (not (setq method (nth 4 info)))) ! (setq method gnus-select-method) (setq method (cond ((stringp method) --- 15375,15457 ---- article (gnus-group-real-name group) buffer))) ! (defun gnus-request-associate-buffer (group) ! (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-associate-buffer) ! (gnus-group-real-name group)))) ! ! (defun gnus-request-restore-buffer (article group) ! "Request a new buffer restored to the state of ARTICLE." (let ((method (gnus-find-method-for-group group))) ! (funcall (gnus-get-function method 'request-restore-buffer) ! article (gnus-group-real-name group) (nth 1 method)))) ! ! (defun gnus-request-create-group (group &optional method) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (let ((method (or method (gnus-find-method-for-group group)))) ! (funcall (gnus-get-function method 'request-create-group) (gnus-group-real-name group) (nth 1 method)))) + (defun gnus-request-delete-group (group &optional force) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-delete-group) + (gnus-group-real-name group) force (nth 1 method)))) + + (defun gnus-request-rename-group (group new-name) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-rename-group) + (gnus-group-real-name group) + (gnus-group-real-name new-name) (nth 1 method)))) + (defun gnus-member-of-valid (symbol group) + "Find out if GROUP has SYMBOL as part of its \"valid\" spec." (memq symbol (assoc ! (symbol-name (car (gnus-find-method-for-group group))) gnus-valid-select-methods))) ! (defun gnus-method-option-p (method option) ! "Return non-nil if select METHOD has OPTION as a parameter." ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ! (memq option (assoc (format "%s" (car method)) ! gnus-valid-select-methods))) ! ! (defun gnus-server-extend-method (group method) ! ;; This function "extends" a virtual server. If the server is ! ;; "hello", and the select method is ("hello" (my-var "something")) ! ;; in the group "alt.alt", this will result in a new virtual server ! ;; called "hello+alt.alt". ! (let ((entry ! (gnus-copy-sequence ! (if (equal (car method) "native") gnus-select-method ! (cdr (assoc (car method) gnus-server-alist)))))) ! (setcar (cdr entry) (concat (nth 1 entry) "+" group)) ! (nconc entry (cdr method)))) ! ! (defun gnus-server-status (method) ! "Return the status of METHOD." ! (nth 1 (assoc method gnus-opened-servers))) ! ! (defun gnus-group-name-to-method (group) ! "Return a select method suitable for GROUP." ! (if (string-match ":" group) ! (let ((server (substring group 0 (match-beginning 0)))) ! (if (string-match "\\+" server) ! (list (intern (substring server 0 (match-beginning 0))) ! (substring server (match-end 0))) ! (list (intern server) ""))) ! gnus-select-method)) (defun gnus-find-method-for-group (group &optional info) + "Find the select method that GROUP uses." (or gnus-override-method (and (not group) gnus-select-method) ! (let ((info (or info (gnus-get-info group))) method) (if (or (not info) ! (not (setq method (gnus-info-method info))) ! (equal method "native")) ! gnus-select-method (setq method (cond ((stringp method) *************** is returned insted of the status string. *** 12008,12077 **** (gnus-server-extend-method group method)) (t ! method)))) ! (gnus-server-add-address method)))) (defun gnus-check-backend-function (func group) (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) group))) (fboundp (intern (format "%s-%s" method func))))) ! (defun gnus-methods-using (method) (let ((valids gnus-valid-select-methods) outs) (while valids ! (if (memq method (car valids)) (setq outs (cons (car valids) outs))) (setq valids (cdr valids))) outs)) ! ;;; ;;; Active & Newsrc File Handling ;;; ! ;; Newsrc related functions. ! ;; Gnus internal format of gnus-newsrc-alist: ! ;; (("alt.general" 3 (1 . 1)) ! ;; ("alt.misc" 3 ((1 . 10) (12 . 15))) ! ;; ("alt.test" 7 (1 . 99) (45 57 93)) ...) ! ;; The first item is the group name; the second is the subscription ! ;; level; the third is either a range of a list of ranges of read ! ;; articles, the optional fourth element is a list of marked articles, ! ;; the optional fifth element is the select method. ! ;; ! ;; Gnus internal format of gnus-newsrc-hashtb: ! ;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...) ! ;; This is the entry for "alt.misc". The first element is the number ! ;; of unread articles in "alt.misc". The cdr of this entry is the ! ;; element *before* "alt.misc" in gnus-newsrc-alist, which makes is ! ;; trivial to remove or add new elements into gnus-newsrc-alist ! ;; without scanning the entire list. So, to get the actual information ! ;; of "alt.misc", you'd say something like ! ;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb)) ! ;; ! ;; Gnus internal format of gnus-active-hashtb: ! ;; ((1 . 1)) ! ;; (5 . 10)) ! ;; (67 . 99)) ...) ! ;; The only element in each entry in this hash table is a range of ! ;; (possibly) available articles. (Articles in this range may have ! ;; been expired or canceled.) ! ;; ! ;; Gnus internal format of gnus-killed-list and gnus-zombie-list: ! ;; ("alt.misc" "alt.test" "alt.general" ...) ! ! (defun gnus-setup-news (&optional rawfile level) "Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. 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))))) - ;; Clear some variables to re-initialize news information. - (if init (setq gnus-newsrc-alist nil - gnus-active-hashtb nil)) ! ;; Read the newsrc file and create `gnus-newsrc-hashtb'. ! (if init (gnus-read-newsrc-file rawfile)) ;; If we don't read the complete active file, we fill in the ! ;; hashtb here. (if (or (null gnus-read-active-file) (eq gnus-read-active-file 'some)) --- 15460,15512 ---- (gnus-server-extend-method group method)) (t ! method))) ! (cond ((equal (cadr method) "") ! method) ! ((null (cadr method)) ! (list (car method) "")) ! (t ! (gnus-server-add-address method))))))) (defun gnus-check-backend-function (func group) + "Check whether GROUP supports function FUNC." (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) group))) (fboundp (intern (format "%s-%s" method func))))) ! (defun gnus-methods-using (feature) ! "Find all methods that have FEATURE." (let ((valids gnus-valid-select-methods) outs) (while valids ! (if (memq feature (car valids)) (setq outs (cons (car valids) outs))) (setq valids (cdr valids))) outs)) ! ! ;;; ;;; Active & Newsrc File Handling ;;; ! (defun gnus-setup-news (&optional rawfile level dont-connect) "Setup news information. If RAWFILE is non-nil, the .newsrc file will also be read. 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 ! ;; Clear some variables to re-initialize news information. ! (setq gnus-newsrc-alist nil ! gnus-active-hashtb nil) ! ;; Read the newsrc file and create `gnus-newsrc-hashtb'. ! (gnus-read-newsrc-file rawfile)) ! ! (when (and (not (assoc "archive" gnus-server-alist)) ! (gnus-archive-server-wanted-p)) ! (push (cons "archive" gnus-message-archive-method) ! gnus-server-alist)) ;; If we don't read the complete active file, we fill in the ! ;; hashtb here. (if (or (null gnus-read-active-file) (eq gnus-read-active-file 'some)) *************** If LEVEL is non-nil, the news will be se *** 12080,12086 **** ;; Read the active file and create `gnus-active-hashtb'. ;; If `gnus-read-active-file' is nil, then we just create an empty ! ;; hash table. The partial filling out of the hash table will be ;; done in `gnus-get-unread-articles'. ! (and gnus-read-active-file (not level) (gnus-read-active-file)) --- 15515,15521 ---- ;; Read the active file and create `gnus-active-hashtb'. ;; If `gnus-read-active-file' is nil, then we just create an empty ! ;; hash table. The partial filling out of the hash table will be ;; done in `gnus-get-unread-articles'. ! (and gnus-read-active-file (not level) (gnus-read-active-file)) *************** If LEVEL is non-nil, the news will be se *** 12089,12126 **** (setq gnus-active-hashtb (make-vector 4095 0))) ;; Possibly eval the dribble file. ! (and init gnus-use-dribble-file (gnus-dribble-eval-file)) (gnus-update-format-specifications) ;; Find new newsgroups and treat them. ! (if (and init gnus-check-new-newsgroups gnus-read-active-file (not level) (gnus-check-server gnus-select-method)) (gnus-find-new-newsgroups)) ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) ! (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))) ! (if (and init gnus-check-bogus-newsgroups gnus-read-active-file (not level) (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)))) ! (defun gnus-find-new-newsgroups () "Search for new newsgroups and add them. Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' ! The `-n' option line from .newsrc is respected." ! (interactive) ! (or (gnus-check-first-time-used) ! (if (or (consp gnus-check-new-newsgroups) ! (eq gnus-check-new-newsgroups 'ask-server)) (gnus-ask-server-for-new-groups) (let ((groups 0) group new-newsgroups) (gnus-message 5 "Looking for new newsgroups...") ! (or gnus-have-read-active-file (gnus-read-active-file)) (setq gnus-newsrc-last-checked-date (current-time-string)) ! (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. --- 15524,15592 ---- (setq gnus-active-hashtb (make-vector 4095 0))) + ;; Initialize the cache. + (when gnus-use-cache + (gnus-cache-open)) + ;; Possibly eval the dribble file. ! (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file)) ! ! ;; Slave Gnusii should then clear the dribble buffer. ! (when (and init gnus-slave) ! (gnus-dribble-clear)) (gnus-update-format-specifications) + ;; See whether we need to read the description file. + (if (and (string-match "%[-,0-9]*D" gnus-group-line-format) + (not gnus-description-hashtb) + (not dont-connect) + gnus-read-active-file) + (gnus-read-all-descriptions-files)) + ;; Find new newsgroups and treat them. ! (if (and init gnus-check-new-newsgroups (not level) (gnus-check-server gnus-select-method)) (gnus-find-new-newsgroups)) + ;; We might read in new NoCeM messages here. + (when (and gnus-use-nocem + (not level) + (not dont-connect)) + (gnus-nocem-scan-groups)) + ;; Find the number of unread articles in each non-dead group. (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) ! (gnus-get-unread-articles level)) ! (if (and init gnus-check-bogus-newsgroups gnus-read-active-file (not level) (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)))) ! (defun gnus-find-new-newsgroups (&optional arg) "Search for new newsgroups and add them. Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' ! The `-n' option line from .newsrc is respected. ! If ARG (the prefix), use the `ask-server' method to query ! the server for new groups." ! (interactive "P") ! (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) ! (null gnus-read-active-file) ! (eq gnus-read-active-file 'some)) ! 'ask-server gnus-check-new-newsgroups))) ! (unless (gnus-check-first-time-used) ! (if (or (consp check) ! (eq check 'ask-server)) ! ;; Ask the server for new groups. (gnus-ask-server-for-new-groups) + ;; Go through the active hashtb and look for new groups. (let ((groups 0) group new-newsgroups) (gnus-message 5 "Looking for new newsgroups...") ! (unless gnus-have-read-active-file ! (gnus-read-active-file)) (setq gnus-newsrc-last-checked-date (current-time-string)) ! (unless gnus-killed-hashtb ! (gnus-make-hashtable-from-killed)) ;; Go though every newsgroup in `gnus-active-hashtb' and compare ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. *************** The `-n' option line from .newsrc is res *** 12128,12131 **** --- 15594,15598 ---- (lambda (sym) (if (or (null (setq group (symbol-name sym))) + (not (boundp sym)) (null (symbol-value sym)) (gnus-gethash group gnus-killed-hashtb) *************** The `-n' option line from .newsrc is res *** 12133,12137 **** () (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) --- 15600,15604 ---- () (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) (setq groups (1+ groups)) *************** The `-n' option line from .newsrc is res *** 12147,12157 **** (funcall gnus-subscribe-newsgroup-method group))))))) gnus-active-hashtb) ! (if new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups)) ;; Suggested by Per Abrahamsen . (if (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has")) ! (gnus-message 6 "No new newsgroups.")))))) (defun gnus-matches-options-n (group) --- 15614,15624 ---- (funcall gnus-subscribe-newsgroup-method group))))))) gnus-active-hashtb) ! (when new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups)) ;; Suggested by Per Abrahamsen . (if (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." groups (if (> groups 1) "s have" " has")) ! (gnus-message 6 "No new newsgroups."))))))) (defun gnus-matches-options-n (group) *************** The `-n' option line from .newsrc is res *** 12165,12240 **** (string-match gnus-options-subscribe group)) 'subscribe) ((and gnus-options-not-subscribe (string-match gnus-options-not-subscribe group)) 'ignore) ;; Then we go through the list that was retrieved from the .newsrc ! ;; file. This list has elements on the form ! ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list ;; is in the reverse order of the options line) is returned. (t (let ((regs gnus-newsrc-options-n)) (while (and regs ! (not (string-match (car (car regs)) group))) (setq regs (cdr regs))) ! (and regs (cdr (car regs))))))) (defun gnus-ask-server-for-new-groups () (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) ! (methods (cons gnus-select-method ! (append ! (and (consp gnus-check-new-newsgroups) ! gnus-check-new-newsgroups) ! gnus-secondary-select-methods))) (groups 0) (new-date (current-time-string)) ! (hashtb (gnus-make-hashtable 100)) ! group new-newsgroups got-new method) ! ;; Go through both primary and secondary select methods and ! ;; request new newsgroups. ! (while methods ! (setq method (gnus-server-get-method nil (car methods))) ! (and (gnus-check-server method) ! (gnus-request-newgroups date method) ! (save-excursion ! (setq got-new t) ! (set-buffer nntp-server-buffer) ! ;; Enter all the new groups in a hashtable. ! (gnus-active-to-gnus-format method hashtb 'ignore))) ! (setq methods (cdr methods))) ! (and got-new (setq gnus-newsrc-last-checked-date new-date)) ! ;; Now all new groups from all select methods are in `hashtb'. ! (mapatoms ! (lambda (group-sym) ! (setq group (symbol-name group-sym)) ! (if (or (null group) ! (null (symbol-value group-sym)) ! (gnus-gethash group gnus-newsrc-hashtb) ! (member group gnus-zombie-list) ! (member group gnus-killed-list)) ! ;; The group is already known. ! () ! (and (symbol-value group-sym) ! (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)) ! (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (funcall ! gnus-subscribe-options-newsgroup-method group)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (setq groups (1+ groups)) ! (gnus-sethash group group gnus-killed-hashtb) ! (if gnus-subscribe-hierarchical-interactive ! (setq new-newsgroups (cons group new-newsgroups)) ! (funcall gnus-subscribe-newsgroup-method group))))))) ! hashtb) ! (if new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups)) ;; Suggested by Per Abrahamsen . ! (if (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." ! groups (if (> groups 1) "s have" " has"))) got-new)) --- 15632,15716 ---- (string-match gnus-options-subscribe group)) 'subscribe) + ((and gnus-auto-subscribed-groups + (string-match gnus-auto-subscribed-groups group)) + 'subscribe) ((and gnus-options-not-subscribe (string-match gnus-options-not-subscribe group)) 'ignore) ;; Then we go through the list that was retrieved from the .newsrc ! ;; file. This list has elements on the form ! ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list ;; is in the reverse order of the options line) is returned. (t (let ((regs gnus-newsrc-options-n)) (while (and regs ! (not (string-match (caar regs) group))) (setq regs (cdr regs))) ! (and regs (cdar regs)))))) (defun gnus-ask-server-for-new-groups () (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) ! (methods (cons gnus-select-method ! (nconc ! (when (gnus-archive-server-wanted-p) ! (list "archive")) ! (append ! (and (consp gnus-check-new-newsgroups) ! gnus-check-new-newsgroups) ! gnus-secondary-select-methods)))) (groups 0) (new-date (current-time-string)) ! group new-newsgroups got-new method hashtb ! gnus-override-subscribe-method) ! ;; Go through both primary and secondary select methods and ! ;; request new newsgroups. ! (while (setq method (gnus-server-get-method nil (pop methods))) ! (setq new-newsgroups nil) ! (setq gnus-override-subscribe-method method) ! (when (and (gnus-check-server method) ! (gnus-request-newgroups date method)) ! (save-excursion ! (setq got-new t) ! (setq hashtb (gnus-make-hashtable 100)) ! (set-buffer nntp-server-buffer) ! ;; Enter all the new groups into a hashtable. ! (gnus-active-to-gnus-format method hashtb 'ignore)) ! ;; Now all new groups from `method' are in `hashtb'. ! (mapatoms ! (lambda (group-sym) ! (if (or (null (setq group (symbol-name group-sym))) ! (not (boundp group-sym)) ! (null (symbol-value group-sym)) ! (gnus-gethash group gnus-newsrc-hashtb) ! (member group gnus-zombie-list) ! (member group gnus-killed-list)) ! ;; The group is already known. ! () ! ;; Make this group active. ! (when (symbol-value group-sym) ! (gnus-set-active group (symbol-value group-sym))) ! ;; Check whether we want it or not. ! (let ((do-sub (gnus-matches-options-n group))) ! (cond ! ((eq do-sub 'subscribe) ! (incf groups) ! (gnus-sethash group group gnus-killed-hashtb) ! (funcall gnus-subscribe-options-newsgroup-method group)) ! ((eq do-sub 'ignore) ! nil) ! (t ! (incf groups) ! (gnus-sethash group group gnus-killed-hashtb) ! (if gnus-subscribe-hierarchical-interactive ! (push group new-newsgroups) ! (funcall gnus-subscribe-newsgroup-method group))))))) ! hashtb)) ! (when new-newsgroups ! (gnus-subscribe-hierarchical-interactive new-newsgroups))) ;; Suggested by Per Abrahamsen . ! (when (> groups 0) ! (gnus-message 6 "%d new newsgroup%s arrived." ! groups (if (> groups 1) "s have" " has"))) ! (and got-new (setq gnus-newsrc-last-checked-date new-date)) got-new)) *************** The `-n' option line from .newsrc is res *** 12246,12250 **** nil (gnus-message 6 "First time user; subscribing you to default groups") ! (or gnus-have-read-active-file (gnus-read-active-file)) (setq gnus-newsrc-last-checked-date (current-time-string)) (let ((groups gnus-default-subscribed-newsgroups) --- 15722,15727 ---- nil (gnus-message 6 "First time user; subscribing you to default groups") ! (unless (gnus-read-active-file-p) ! (gnus-read-active-file)) (setq gnus-newsrc-last-checked-date (current-time-string)) (let ((groups gnus-default-subscribed-newsgroups) *************** The `-n' option line from .newsrc is res *** 12258,12262 **** () (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) (gnus-sethash group group gnus-killed-hashtb) --- 15735,15739 ---- () (let ((do-sub (gnus-matches-options-n group))) ! (cond ((eq do-sub 'subscribe) (gnus-sethash group group gnus-killed-hashtb) *************** The `-n' option line from .newsrc is res *** 12268,12273 **** gnus-active-hashtb) (while groups ! (if (gnus-gethash (car groups) gnus-active-hashtb) ! (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) --- 15745,15750 ---- gnus-active-hashtb) (while groups ! (if (gnus-active (car groups)) ! (gnus-group-change-level (car groups) gnus-level-default-subscribed gnus-level-killed)) (setq groups (cdr groups))) *************** The `-n' option line from .newsrc is res *** 12277,12302 **** (defun gnus-subscribe-group (group previous &optional method) ! (gnus-group-change-level (if method (list t group gnus-level-default-subscribed nil nil method) ! group) gnus-level-default-subscribed gnus-level-killed previous t)) ;; `gnus-group-change-level' is the fundamental function for changing ! ;; subscription levels of newsgroups. This might mean just changing ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back ;; again, which subscribes/unsubscribes a group, which is equally ! ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and ;; from 8-9 to 1-7 means that you remove the group from the list of ;; killed (or zombie) groups and add them to the (kinda) subscribed ! ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, ;; which is trivial. ;; ENTRY can either be a string (newsgroup name) or a list (if ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' ! ;; entries. ;; LEVEL is the new level of the group, OLDLEVEL is the old level and ;; PREVIOUS is the group (in hashtb entry format) to insert this group ! ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) --- 15754,15779 ---- (defun gnus-subscribe-group (group previous &optional method) ! (gnus-group-change-level (if method (list t group gnus-level-default-subscribed nil nil method) ! group) gnus-level-default-subscribed gnus-level-killed previous t)) ;; `gnus-group-change-level' is the fundamental function for changing ! ;; subscription levels of newsgroups. This might mean just changing ;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back ;; again, which subscribes/unsubscribes a group, which is equally ! ;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and ;; from 8-9 to 1-7 means that you remove the group from the list of ;; killed (or zombie) groups and add them to the (kinda) subscribed ! ;; groups. And last but not least, moving from 8 to 9 and 9 to 8, ;; which is trivial. ;; ENTRY can either be a string (newsgroup name) or a list (if ;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), ;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' ! ;; entries. ;; LEVEL is the new level of the group, OLDLEVEL is the old level and ;; PREVIOUS is the group (in hashtb entry format) to insert this group ! ;; after. (defun gnus-group-change-level (entry level &optional oldlevel previous fromkilled) *************** The `-n' option line from .newsrc is res *** 12308,12317 **** (setq group entry)) (if (and (stringp entry) ! oldlevel (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) (consp entry)) ! (setq oldlevel (car (cdr (nth 2 entry))))) (if (stringp previous) (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) --- 15785,15795 ---- (setq group entry)) (if (and (stringp entry) ! oldlevel (< oldlevel gnus-level-zombie)) (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) (if (and (not oldlevel) (consp entry)) ! (setq oldlevel (gnus-info-level (nth 2 entry))) ! (setq oldlevel (or oldlevel 9))) (if (stringp previous) (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) *************** The `-n' option line from .newsrc is res *** 12320,12408 **** (gnus-gethash group gnus-newsrc-hashtb)) ;; We are trying to subscribe a group that is already ! ;; subscribed. ! () ; Do nothing. (or (gnus-ephemeral-group-p group) (gnus-dribble-enter ! (format "(gnus-group-change-level %S %S %S %S %S)" group level oldlevel (car (nth 2 previous)) fromkilled))) ! ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie ! ;; list. If not, and it is in fact going to be killed, we remove ;; it from the newsrc hash table and assoc. ! (cond ((>= oldlevel gnus-level-zombie) ! (if (= oldlevel gnus-level-zombie) ! (setq gnus-zombie-list (delete group gnus-zombie-list)) ! (setq gnus-killed-list (delete group gnus-killed-list)))) ! (t ! (if (and (>= level gnus-level-zombie) ! entry) ! (progn ! (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) ! (if (nth 3 entry) ! (setcdr (gnus-gethash (car (nth 3 entry)) ! gnus-newsrc-hashtb) ! (cdr entry))) ! (setcdr (cdr entry) (cdr (cdr (cdr entry)))))))) ;; 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 ((>= level gnus-level-zombie) ! ;; Remove from the hash table. ! (gnus-sethash group nil gnus-newsrc-hashtb) ! (or (gnus-group-foreign-p group) ! ;; We do not enter foreign groups into the list of dead ! ;; groups. ! (if (= level gnus-level-zombie) ! (setq gnus-zombie-list (cons group gnus-zombie-list)) ! (setq gnus-killed-list (cons group gnus-killed-list))))) ! (t ! ;; If the list is to be entered into the newsrc assoc, and ! ;; it was killed, we have to create an entry in the newsrc ! ;; hashtb format and fix the pointers in the newsrc assoc. ! (if (>= oldlevel gnus-level-zombie) ! (progn ! (if (listp entry) ! (progn ! (setq info (cdr entry)) ! (setq num (car entry))) ! (setq active (gnus-gethash group gnus-active-hashtb)) ! (setq num ! (if active (- (1+ (cdr active)) (car active)) t)) ! ;; Check whether the group is foreign. If so, the ! ;; foreign select method has to be entered into the ! ;; info. ! (let ((method (gnus-group-method-name group))) ! (if (eq method gnus-select-method) ! (setq info (list group level nil)) ! (setq info (list group level nil nil method))))) ! (or previous ! (setq previous ! (let ((p gnus-newsrc-alist)) ! (while (cdr (cdr p)) ! (setq p (cdr p))) ! p))) ! (setq entry (cons info (cdr (cdr previous)))) ! (if (cdr previous) ! (progn ! (setcdr (cdr previous) entry) ! (gnus-sethash group (cons num (cdr previous)) ! gnus-newsrc-hashtb)) ! (setcdr previous entry) ! (gnus-sethash group (cons num previous) ! gnus-newsrc-hashtb)) ! (if (cdr entry) ! (setcdr (gnus-gethash (car (car (cdr entry))) ! gnus-newsrc-hashtb) ! entry))) ! ;; It was alive, and it is going to stay alive, so we ! ;; just change the level and don't change any pointers or ! ;; hash table entries. ! (setcar (cdr (car (cdr (cdr entry)))) level))))))) (defun gnus-kill-newsgroup (newsgroup) ! "Obsolete function. Kills a newsgroup." (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) --- 15798,15887 ---- (gnus-gethash group gnus-newsrc-hashtb)) ;; We are trying to subscribe a group that is already ! ;; subscribed. ! () ; Do nothing. (or (gnus-ephemeral-group-p group) (gnus-dribble-enter ! (format "(gnus-group-change-level %S %S %S %S %S)" group level oldlevel (car (nth 2 previous)) fromkilled))) ! ;; Then we remove the newgroup from any old structures, if needed. ;; If the group was killed, we remove it from the killed or zombie ! ;; list. If not, and it is in fact going to be killed, we remove ;; it from the newsrc hash table and assoc. ! (cond ! ((>= oldlevel gnus-level-zombie) ! (if (= oldlevel gnus-level-zombie) ! (setq gnus-zombie-list (delete group gnus-zombie-list)) ! (setq gnus-killed-list (delete group gnus-killed-list)))) ! (t ! (if (and (>= level gnus-level-zombie) ! entry) ! (progn ! (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) ! (if (nth 3 entry) ! (setcdr (gnus-gethash (car (nth 3 entry)) ! gnus-newsrc-hashtb) ! (cdr entry))) ! (setcdr (cdr entry) (cdddr entry)))))) ;; 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 ! ((>= level gnus-level-zombie) ! ;; Remove from the hash table. ! (gnus-sethash group nil gnus-newsrc-hashtb) ! ;; We do not enter foreign groups into the list of dead ! ;; groups. ! (unless (gnus-group-foreign-p group) ! (if (= level gnus-level-zombie) ! (setq gnus-zombie-list (cons group gnus-zombie-list)) ! (setq gnus-killed-list (cons group gnus-killed-list))))) ! (t ! ;; If the list is to be entered into the newsrc assoc, and ! ;; it was killed, we have to create an entry in the newsrc ! ;; hashtb format and fix the pointers in the newsrc assoc. ! (if (< oldlevel gnus-level-zombie) ! ;; It was alive, and it is going to stay alive, so we ! ;; just change the level and don't change any pointers or ! ;; hash table entries. ! (setcar (cdaddr entry) level) ! (if (listp entry) ! (setq info (cdr entry) ! num (car entry)) ! (setq active (gnus-active group)) ! (setq num ! (if active (- (1+ (cdr active)) (car active)) t)) ! ;; Check whether the group is foreign. If so, the ! ;; foreign select method has to be entered into the ! ;; info. ! (let ((method (or gnus-override-subscribe-method ! (gnus-group-method group)))) ! (if (eq method gnus-select-method) ! (setq info (list group level nil)) ! (setq info (list group level nil nil method))))) ! (unless previous ! (setq previous ! (let ((p gnus-newsrc-alist)) ! (while (cddr p) ! (setq p (cdr p))) ! p))) ! (setq entry (cons info (cddr previous))) ! (if (cdr previous) ! (progn ! (setcdr (cdr previous) entry) ! (gnus-sethash group (cons num (cdr previous)) ! gnus-newsrc-hashtb)) ! (setcdr previous entry) ! (gnus-sethash group (cons num previous) ! gnus-newsrc-hashtb)) ! (when (cdr entry) ! (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))))) ! (when gnus-group-change-level-function ! (funcall gnus-group-change-level-function group level oldlevel))))) (defun gnus-kill-newsgroup (newsgroup) ! "Obsolete function. Kills a newsgroup." (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) *************** The `-n' option line from .newsrc is res *** 12411,12455 **** "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every ! newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) ! bogus group entry) (gnus-message 5 "Checking bogus newsgroups...") ! (or gnus-have-read-active-file (gnus-read-active-file)) ! ;; Find all bogus newsgroup that are subscribed. ! (while newsrc ! (setq group (car (car newsrc))) ! (if (or (gnus-gethash group gnus-active-hashtb) ; Active ! (nth 4 (car newsrc)) ; Foreign ! (and confirm ! (not (gnus-y-or-n-p ! (format "Remove bogus newsgroup: %s " group))))) ! ;; Don't remove. ! () ! ;; Found a bogus newsgroup. ! (setq bogus (cons group bogus))) ! (setq newsrc (cdr newsrc))) ! ;; Remove all bogus subscribed groups by first killing them, and ! ;; then removing them from the list of killed groups. ! (while bogus ! (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb)) ! (progn ! (gnus-group-change-level entry gnus-level-killed) ! (setq gnus-killed-list (delete (car bogus) gnus-killed-list)))) ! (setq bogus (cdr bogus))) ! ;; Then we remove all bogus groups from the list of killed and ! ;; zombie groups. They are are removed without confirmation. ! (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) ! killed) ! (while dead-lists ! (setq killed (symbol-value (car dead-lists))) ! (while killed ! (setq group (car killed)) ! (or (gnus-gethash group gnus-active-hashtb) ;; The group is bogus. (set (car dead-lists) ! (delete group (symbol-value (car dead-lists))))) ! (setq killed (cdr killed))) ! (setq dead-lists (cdr dead-lists)))) ! (gnus-message 5 "Checking bogus newsgroups...done"))) (defun gnus-check-duplicate-killed-groups () --- 15890,15932 ---- "Remove bogus newsgroups. If CONFIRM is non-nil, the user has to confirm the deletion of every ! newsgroup." (let ((newsrc (cdr gnus-newsrc-alist)) ! bogus group entry info) (gnus-message 5 "Checking bogus newsgroups...") ! (unless (gnus-read-active-file-p) ! (gnus-read-active-file)) ! (when (gnus-read-active-file-p) ! ;; Find all bogus newsgroup that are subscribed. ! (while newsrc ! (setq info (pop newsrc) ! group (gnus-info-group info)) ! (unless (or (gnus-active group) ; Active ! (gnus-info-method info) ; Foreign ! (and confirm ! (not (gnus-y-or-n-p ! (format "Remove bogus newsgroup: %s " group))))) ! ;; Found a bogus newsgroup. ! (push group bogus))) ! ;; Remove all bogus subscribed groups by first killing them, and ! ;; then removing them from the list of killed groups. ! (while bogus ! (when (setq entry (gnus-gethash (setq group (pop bogus)) ! gnus-newsrc-hashtb)) ! (gnus-group-change-level entry gnus-level-killed) ! (setq gnus-killed-list (delete group gnus-killed-list)))) ! ;; Then we remove all bogus groups from the list of killed and ! ;; zombie groups. They are are removed without confirmation. ! (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) ! killed) ! (while dead-lists ! (setq killed (symbol-value (car dead-lists))) ! (while killed ! (unless (gnus-active (setq group (pop killed))) ;; The group is bogus. + ;; !!!Slow as hell. (set (car dead-lists) ! (delete group (symbol-value (car dead-lists)))))) ! (setq dead-lists (cdr dead-lists)))) ! (gnus-message 5 "Checking bogus newsgroups...done")))) (defun gnus-check-duplicate-killed-groups () *************** newsgroup." *** 12462,12473 **** (setq killed (cdr killed))))) ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. ! (defun gnus-get-unread-articles (&optional level) (let* ((newsrc (cdr gnus-newsrc-alist)) ! (level (or level (1+ gnus-level-subscribed))) (foreign-level ! (min ! (cond ((and gnus-activate-foreign-newsgroups (not (numberp gnus-activate-foreign-newsgroups))) (1+ gnus-level-subscribed)) --- 15939,16038 ---- (setq killed (cdr killed))))) + ;; We want to inline a function from gnus-cache, so we cheat here: + (eval-when-compile + (provide 'gnus) + (setq gnus-directory (or (getenv "SAVEDIR") "~/News/")) + (require 'gnus-cache)) + + (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 + (gnus-request-update-info + info (gnus-find-method-for-group (gnus-info-group info)))) + (gnus-activate-group (gnus-info-group info) nil t)) + (let* ((range (gnus-info-read info)) + (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 + (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 + ;; number to the group hash table entry. + (cond + ((zerop (cdr active)) + (setq num 0)) + ((not range) + (setq num (- (1+ (cdr active)) (car active)))) + ((not (listp (cdr range))) + ;; Fix a single (num . num) range according to the + ;; active hash table. + ;; Fix by Carsten Bormann . + (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) + (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) + ;; Compute number of unread articles. + (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) + (t + ;; The read list is a list of ranges. Fix them according to + ;; the active hash table. + ;; First peel off any elements that are below the lower + ;; active limit. + (while (and (cdr range) + (>= (car active) + (or (and (atom (cadr range)) (cadr range)) + (caadr range)))) + (if (numberp (car range)) + (setcar range + (cons (car range) + (or (and (numberp (cadr range)) + (cadr range)) + (cdadr range)))) + (setcdr (car range) + (or (and (numberp (nth 1 range)) (nth 1 range)) + (cdadr range)))) + (setcdr range (cddr range))) + ;; Adjust the first element to be the same as the lower limit. + (if (and (not (atom (car range))) + (< (cdar range) (car active))) + (setcdr (car range) (1- (car active)))) + ;; Then we want to peel off any elements that are higher + ;; than the upper active limit. + (let ((srange range)) + ;; Go past all legal elements. + (while (and (cdr srange) + (<= (or (and (atom (cadr srange)) + (cadr srange)) + (caadr srange)) (cdr active))) + (setq srange (cdr srange))) + (if (cdr srange) + ;; Nuke all remaining illegal elements. + (setcdr srange nil)) + + ;; Adjust the final element. + (if (and (not (atom (car srange))) + (> (cdar srange) (cdr active))) + (setcdr (car srange) (cdr active)))) + ;; Compute the number of unread articles. + (while range + (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) + (cdar range))) + (or (and (atom (car range)) (car range)) + (caar range))))) + (setq range (cdr range))) + (setq num (max 0 (- (cdr active) num))))) + ;; Set the number of unread articles. + (when info + (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) + num))) + ;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' ;; and compute how many unread articles there are in each group. ! (defun gnus-get-unread-articles (&optional level) (let* ((newsrc (cdr gnus-newsrc-alist)) ! (level (or level gnus-activate-level (1+ gnus-level-subscribed))) (foreign-level ! (min ! (cond ((and gnus-activate-foreign-newsgroups (not (numberp gnus-activate-foreign-newsgroups))) (1+ gnus-level-subscribed)) *************** newsgroup." *** 12476,12537 **** (t 0)) level)) ! info group active virtuals method) (gnus-message 5 "Checking new news...") (while newsrc ! (setq info (car newsrc) ! group (car info) ! active (gnus-gethash group gnus-active-hashtb)) ! ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't ;; be reached) we just set the number of unread articles in this ! ;; newsgroup to t. This means that Gnus thinks that there are ;; unread articles, but it has no idea how many. ! (if (and (setq method (nth 4 info)) ! (not (gnus-server-equal gnus-select-method ! (gnus-server-get-method nil method))) (not (gnus-secondary-method-p method))) ! ;; These groups are foreign. Check the level. ! (if (<= (nth 1 info) foreign-level) ! (if (eq (car (if (stringp method) ! (gnus-server-to-method method) ! (nth 4 info))) 'nnvirtual) ! ;; We have to activate the virtual groups after all ! ;; the others, so we just pop them on a list for ! ;; now. ! (setq virtuals (cons info virtuals)) ! (and (setq active (gnus-activate-group (car info))) ! ;; Close the groups as we look at them! ! (gnus-close-group group)))) ! ! ;; These groups are native or secondary. ! (if (and (not gnus-read-active-file) ! (<= (nth 1 info) level)) ! (progn ! (or gnus-read-active-file (gnus-check-server method)) ! (setq active (gnus-activate-group (car info)))))) ! (if active ! (gnus-get-unread-articles-in-group info active) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. ! (gnus-sethash group nil gnus-active-hashtb) ! (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) ! ! (setq newsrc (cdr newsrc))) ! ! ;; Activate the virtual groups. This has to be done after all the ! ;; other groups. ! ;; !!! If one virtual group contains another virtual group, even ! ;; doing it this way might cause problems. ! (while virtuals ! (and (setq active (gnus-activate-group (car (car virtuals)))) ! (gnus-get-unread-articles-in-group (car virtuals) active)) ! (setq virtuals (cdr virtuals))) (gnus-message 5 "Checking new news...done"))) ! ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () --- 16041,16086 ---- (t 0)) level)) ! info group active method) (gnus-message 5 "Checking new news...") (while newsrc ! (setq active (gnus-active (setq group (gnus-info-group ! (setq info (pop newsrc)))))) ! ;; Check newsgroups. If the user doesn't want to check them, or ;; they can't be checked (for instance, if the news server can't ;; be reached) we just set the number of unread articles in this ! ;; newsgroup to t. This means that Gnus thinks that there are ;; unread articles, but it has no idea how many. ! (if (and (setq method (gnus-info-method info)) ! (not (gnus-server-equal ! gnus-select-method ! (setq method (gnus-server-get-method nil method)))) (not (gnus-secondary-method-p method))) ! ;; These groups are foreign. Check the level. ! (when (<= (gnus-info-level info) foreign-level) ! (setq active (gnus-activate-group group 'scan)) ! (unless (inline (gnus-virtual-group-p group)) ! (inline (gnus-close-group group))) ! (when (fboundp (intern (concat (symbol-name (car method)) ! "-request-update-info"))) ! (inline (gnus-request-update-info info method)))) ! ;; These groups are native or secondary. ! (when (and (<= (gnus-info-level info) level) ! (not gnus-read-active-file)) ! (setq active (gnus-activate-group group 'scan)) ! (inline (gnus-close-group group)))) ! ! ;; Get the number of unread articles in the group. (if active ! (inline (gnus-get-unread-articles-in-group info active)) ;; The group couldn't be reached, so we nix out the number of ;; unread articles and stuff. ! (gnus-set-active group nil) ! (setcar (gnus-gethash group gnus-newsrc-hashtb) t))) (gnus-message 5 "Checking new news...done"))) ! ;; Create a hash table out of the newsrc alist. The `car's of the ;; alist elements are used as keys. (defun gnus-make-hashtable-from-newsrc-alist () *************** newsgroup." *** 12540,12554 **** prev) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) ! (setq alist ! (setq prev (setq gnus-newsrc-alist ! (if (equal (car (car gnus-newsrc-alist)) "dummy.group") gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist ! (gnus-sethash (car (car alist)) ! (cons (and ohashtb (car (gnus-gethash ! (car (car alist)) ohashtb))) ! prev) gnus-newsrc-hashtb) (setq prev alist alist (cdr alist))))) --- 16089,16104 ---- prev) (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) ! (setq alist ! (setq prev (setq gnus-newsrc-alist ! (if (equal (caar gnus-newsrc-alist) "dummy.group") gnus-newsrc-alist (cons (list "dummy.group" 0 nil) alist))))) (while alist ! (gnus-sethash ! (caar alist) ! (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) ! prev) ! gnus-newsrc-hashtb) (setq prev alist alist (cdr alist))))) *************** newsgroup." *** 12558,12669 **** (let ((lists '(gnus-killed-list gnus-zombie-list)) list) ! (setq gnus-killed-hashtb ! (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) ! (while lists ! (setq list (symbol-value (car lists))) ! (setq lists (cdr lists)) (while list ! (gnus-sethash (car list) (car list) gnus-killed-hashtb) ! (setq list (cdr list)))))) ! ! (defun gnus-get-unread-articles-in-group (info active) ! (let* ((range (nth 2 info)) ! (num 0) ! (marked (nth 3 info))) ! ;; If a cache is present, we may have to alter the active info. ! (and gnus-use-cache ! (gnus-cache-possibly-alter-active (car info) active)) ! ;; Modify the list of read articles according to what articles ! ;; are available; then tally the unread articles and add the ! ;; number to the group hash table entry. ! (cond ! ((zerop (cdr active)) ! (setq num 0)) ! ((not range) ! (setq num (- (1+ (cdr active)) (car active)))) ! ((not (listp (cdr range))) ! ;; Fix a single (num . num) range according to the ! ;; active hash table. ! ;; Fix by Carsten Bormann . ! (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) ! (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) ! ;; Compute number of unread articles. ! (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) ! (t ! ;; The read list is a list of ranges. Fix them according to ! ;; the active hash table. ! ;; First peel off any elements that are below the lower ! ;; active limit. ! (while (and (cdr range) ! (>= (car active) ! (or (and (atom (car (cdr range))) (car (cdr range))) ! (car (car (cdr range)))))) ! (if (numberp (car range)) ! (setcar range ! (cons (car range) ! (or (and (numberp (car (cdr range))) ! (car (cdr range))) ! (cdr (car (cdr range)))))) ! (setcdr (car range) ! (or (and (numberp (nth 1 range)) (nth 1 range)) ! (cdr (car (cdr range)))))) ! (setcdr range (cdr (cdr range)))) ! ;; Adjust the first element to be the same as the lower limit. ! (if (and (not (atom (car range))) ! (< (cdr (car range)) (car active))) ! (setcdr (car range) (1- (car active)))) ! ;; Then we want to peel off any elements that are higher ! ;; than the upper active limit. ! (let ((srange range)) ! ;; Go past all legal elements. ! (while (and (cdr srange) ! (<= (or (and (atom (car (cdr srange))) ! (car (cdr srange))) ! (car (car (cdr srange)))) (cdr active))) ! (setq srange (cdr srange))) ! (if (cdr srange) ! ;; Nuke all remaining illegal elements. ! (setcdr srange nil)) ! ! ;; Adjust the final element. ! (if (and (not (atom (car srange))) ! (> (cdr (car srange)) (cdr active))) ! (setcdr (car srange) (cdr active)))) ! ;; Compute the number of unread articles. ! (while range ! (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) ! (cdr (car range)))) ! (or (and (atom (car range)) (car range)) ! (car (car range)))))) ! (setq range (cdr range))) ! (setq num (max 0 (- (cdr active) num))))) ! (and info ! (progn ! (and (assq 'tick marked) ! (inline (gnus-remove-illegal-marked-articles ! (assq 'tick marked) (nth 2 info)))) ! (and (assq 'dormant marked) ! (inline (gnus-remove-illegal-marked-articles ! (assq 'dormant marked) (nth 2 info)))) ! (setcar ! (gnus-gethash (car info) gnus-newsrc-hashtb) ! (setq num (max 0 (- num (length (cdr (assq 'tick marked))) ! (length (cdr (assq 'dormant marked))))))))) ! num)) ! ! (defun gnus-remove-illegal-marked-articles (marked ranges) ! (let ((m (cdr marked))) ! ;; Make sure that all ticked articles are a subset of the unread ! ;; articles. ! (while m ! (if (gnus-member-of-range (car m) ranges) ! (setcdr marked (cdr m)) ! (setq marked m)) ! (setq m (cdr m))))) ! (defun gnus-activate-group (group) ;; Check whether a group has been activated or not. ! (let ((method (gnus-find-method-for-group group)) active) (and (gnus-check-server method) --- 16108,16123 ---- (let ((lists '(gnus-killed-list gnus-zombie-list)) list) ! (setq gnus-killed-hashtb ! (gnus-make-hashtable (+ (length gnus-killed-list) (length gnus-zombie-list)))) ! (while (setq list (pop lists)) ! (setq list (symbol-value list)) (while list ! (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) ! (defun gnus-activate-group (group &optional scan dont-check method) ;; Check whether a group has been activated or not. ! ;; If SCAN, request a scan of that group as well. ! (let ((method (or method (gnus-find-method-for-group group))) active) (and (gnus-check-server method) *************** newsgroup." *** 12671,12677 **** ;; continue if a group is so out-there that it reports bugs ;; and stuff. (condition-case () ! (gnus-request-group group) ! (error nil) (quit nil)) (save-excursion --- 16125,16136 ---- ;; continue if a group is so out-there that it reports bugs ;; and stuff. + (progn + (and scan + (gnus-check-backend-function 'request-scan (car method)) + (gnus-request-scan group method)) + t) (condition-case () ! (gnus-request-group group dont-check method) ! ; (error nil) (quit nil)) (save-excursion *************** newsgroup." *** 12682,12713 **** (progn (goto-char (match-beginning 1)) ! (gnus-sethash group (setq active (cons (read (current-buffer)) ! (read (current-buffer)))) ! gnus-active-hashtb)) ! ;; Return the new active info. ! active))))) ! ! (defun gnus-update-read-articles ! (group unread unselected ticked &optional domarks replied expirable killed ! dormant bookmark score) "Update the list of read and ticked articles in GROUP using the UNREAD and TICKED lists. Note: UNSELECTED has to be sorted over `<'. Returns whether the updating was successful." ! (let* ((active (or gnus-newsgroup-active ! (gnus-gethash group gnus-active-hashtb))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) - (marked (nth 3 info)) (prev 1) ! (unread (sort (copy-sequence unread) (function <))) read) (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, ! ;; killed. Gnus stores no information on killed groups, so ! ;; there's nothing to be done. ;; One could store the information somewhere temporarily, ! ;; perhaps... Hmmm... () ;; Remove any negative articles numbers. --- 16141,16167 ---- (progn (goto-char (match-beginning 1)) ! (gnus-set-active group (setq active (cons (read (current-buffer)) ! (read (current-buffer))))) ! ;; Return the new active info. ! active)))))) ! ! (defun gnus-update-read-articles (group unread) "Update the list of read and ticked articles in GROUP using the UNREAD and TICKED lists. Note: UNSELECTED has to be sorted over `<'. Returns whether the updating was successful." ! (let* ((active (or gnus-newsgroup-active (gnus-active group))) (entry (gnus-gethash group gnus-newsrc-hashtb)) (info (nth 2 entry)) (prev 1) ! (unread (sort (copy-sequence unread) '<)) read) (if (or (not info) (not active)) ;; There is no info on this group if it was, in fact, ! ;; killed. Gnus stores no information on killed groups, so ! ;; there's nothing to be done. ;; One could store the information somewhere temporarily, ! ;; perhaps... Hmmm... () ;; Remove any negative articles numbers. *************** Returns whether the updating was success *** 12717,12733 **** (while (and unread (< (car unread) (car active))) (setq unread (cdr unread))) - (while (and ticked (< (car ticked) (car active))) - (setq ticked (cdr ticked))) - (while (and dormant (< (car dormant) (car active))) - (setq dormant (cdr dormant))) - (setq unread (sort (append unselected unread) '<)) - ;; Weed out duplicates. - (let ((un unread)) - (while (cdr un) - (if (eq (car un) (car (cdr un))) - (setcdr un (cdr (cdr un))) - (setq un (cdr un))))) ;; Compute the ranges of read articles by looking at the list of ! ;; unread articles. (while unread (if (/= (car unread) prev) --- 16171,16176 ---- (while (and unread (< (car unread) (car active))) (setq unread (cdr unread))) ;; Compute the ranges of read articles by looking at the list of ! ;; unread articles. (while unread (if (/= (car unread) prev) *************** Returns whether the updating was success *** 12736,12756 **** (setq prev (1+ (car unread))) (setq unread (cdr unread))) ! (if (<= prev (cdr active)) ! (setq read (cons (cons prev (cdr active)) read))) ;; Enter this list into the group info. ! (setcar (cdr (cdr info)) ! (if (> (length read) 1) (nreverse read) read)) ! ;; Enter the list of ticked articles. ! (gnus-set-marked-articles ! info ticked ! (if domarks replied (cdr (assq 'reply marked))) ! (if domarks expirable (cdr (assq 'expire marked))) ! (if domarks killed (cdr (assq 'killed marked))) ! (if domarks dormant (cdr (assq 'dormant marked))) ! (if domarks bookmark (cdr (assq 'bookmark marked))) ! (if domarks score (cdr (assq 'score marked)))) ;; Set the number of unread articles in gnus-newsrc-hashtb. ! (gnus-get-unread-articles-in-group ! info (gnus-gethash group gnus-active-hashtb)) t))) --- 16179,16189 ---- (setq prev (1+ (car unread))) (setq unread (cdr unread))) ! (when (<= prev (cdr active)) ! (setq read (cons (cons prev (cdr active)) read))) ;; Enter this list into the group info. ! (gnus-info-set-read ! info (if (> (length read) 1) (nreverse read) read)) ;; Set the number of unread articles in gnus-newsrc-hashtb. ! (gnus-get-unread-articles-in-group info (gnus-active group)) t))) *************** Returns whether the updating was success *** 12760,12773 **** (gnus-gethash (gnus-group-real-name group) gnus-newsrc-hashtb)))) ! (ranges (nth 2 info)) ! news) (while articles ! (and (gnus-member-of-range (car articles) ranges) ! (setq news (cons (car articles) news))) ! (setq articles (cdr articles))) ! (if (not news) ! () ! (setcar (nthcdr 2 info) ! (gnus-remove-from-range (nth 2 info) (nreverse news))) (gnus-group-update-group group t)))) --- 16193,16205 ---- (gnus-gethash (gnus-group-real-name group) gnus-newsrc-hashtb)))) ! (ranges (gnus-info-read info)) ! news article) (while articles ! (when (gnus-member-of-range ! (setq article (pop articles)) ranges) ! (setq news (cons article news)))) ! (when news ! (gnus-info-set-read ! info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) (gnus-group-update-group group t)))) *************** Returns whether the updating was success *** 12784,12796 **** (setq lists (cdr lists))))) ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods (if (gnus-check-server gnus-select-method) ! ;; The native server is available. ! (cons gnus-select-method gnus-secondary-select-methods) ! ;; The native server is down, so we just do the ! ;; secondary ones. ! gnus-secondary-select-methods)) list-type) (setq gnus-have-read-active-file nil) --- 16216,16258 ---- (setq lists (cdr lists))))) + (defun gnus-get-killed-groups () + "Go through the active hashtb and all all unknown groups as killed." + ;; First make sure active file has been read. + (unless (gnus-read-active-file-p) + (let ((gnus-read-active-file t)) + (gnus-read-active-file))) + (or gnus-killed-hashtb (gnus-make-hashtable-from-killed)) + ;; Go through all newsgroups that are known to Gnus - enlarge kill list. + (mapatoms + (lambda (sym) + (let ((groups 0) + (group (symbol-name sym))) + (if (or (null group) + (gnus-gethash group gnus-killed-hashtb) + (gnus-gethash group gnus-newsrc-hashtb)) + () + (let ((do-sub (gnus-matches-options-n group))) + (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) + () + (setq groups (1+ groups)) + (setq gnus-killed-list + (cons group gnus-killed-list)) + (gnus-sethash group group gnus-killed-hashtb)))))) + gnus-active-hashtb)) + ;; Get the active file(s) from the backend(s). (defun gnus-read-active-file () (gnus-group-set-mode-line) ! (let ((methods ! (append ! (if (gnus-check-server gnus-select-method) ! ;; The native server is available. ! (cons gnus-select-method gnus-secondary-select-methods) ! ;; The native server is down, so we just do the ! ;; secondary ones. ! gnus-secondary-select-methods) ! ;; Also read from the archive server. ! (when (gnus-archive-server-wanted-p) ! (list "archive")))) list-type) (setq gnus-have-read-active-file nil) *************** Returns whether the updating was success *** 12798,12802 **** (set-buffer nntp-server-buffer) (while methods ! (let* ((method (gnus-server-get-method nil (car methods))) (where (nth 1 method)) (mesg (format "Reading active file%s via %s..." --- 16260,16266 ---- (set-buffer nntp-server-buffer) (while methods ! (let* ((method (if (stringp (car methods)) ! (gnus-server-get-method nil (car methods)) ! (car methods))) (where (nth 1 method)) (mesg (format "Reading active file%s via %s..." *************** Returns whether the updating was success *** 12805,12867 **** (car method)))) (gnus-message 5 mesg) ! (if (not (gnus-check-server method)) ! () ! (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) (let ((newsrc (cdr gnus-newsrc-alist)) (gmethod (gnus-server-get-method nil method)) ! groups) ! (while newsrc ! (and (gnus-server-equal ! (gnus-find-method-for-group ! (car (car newsrc)) (car newsrc)) ! gmethod) ! (setq groups (cons (gnus-group-real-name ! (car (car newsrc))) groups))) ! (setq newsrc (cdr newsrc))) ! (gnus-check-server method) ! (setq list-type (gnus-retrieve-groups groups method)) ! (cond ! ((not list-type) ! (gnus-message ! 1 "Cannot read partial active file from %s server." ! (car method)) ! (ding) ! (sit-for 2)) ! ((eq list-type 'active) ! (gnus-active-to-gnus-format method gnus-active-hashtb)) ! (t ! (gnus-groups-to-gnus-format method gnus-active-hashtb))))) (t (if (not (gnus-request-list method)) ! (progn ! (gnus-message 1 "Cannot read active file from %s server." ! (car method)) ! (ding)) ! (gnus-active-to-gnus-format method) ;; We mark this active file as read. ! (setq gnus-have-read-active-file ! (cons method gnus-have-read-active-file)) (gnus-message 5 "%sdone" mesg)))))) (setq methods (cdr methods)))))) ;; Read an active file and place the results in `gnus-active-hashtb'. ! (defun gnus-active-to-gnus-format (method &optional hashtb ignore-errors) (let ((cur (current-buffer)) ! (hashtb (or hashtb ! (if (and gnus-active-hashtb (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb (if (equal method gnus-select-method) ! (gnus-make-hashtable (count-lines (point-min) (point-max))) ! (gnus-make-hashtable 4096)))))) ! (flag-hashtb (gnus-make-hashtable 60))) ;; Delete unnecessary lines. (goto-char (point-min)) (while (search-forward "\nto." nil t) ! (delete-region (1+ (match-beginning 0)) (progn (forward-line 1) (point)))) (or (string= gnus-ignored-newsgroups "") --- 16269,16331 ---- (car method)))) (gnus-message 5 mesg) ! (when (gnus-check-server method) ! ;; Request that the backend scan its incoming messages. ! (and (gnus-check-backend-function 'request-scan (car method)) ! (gnus-request-scan nil method)) ! (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method))) (let ((newsrc (cdr gnus-newsrc-alist)) (gmethod (gnus-server-get-method nil method)) ! groups info) ! (while (setq info (pop newsrc)) ! (when (gnus-server-equal ! (gnus-find-method-for-group ! (gnus-info-group info) info) ! gmethod) ! (push (gnus-group-real-name (gnus-info-group info)) ! groups))) ! (when groups ! (gnus-check-server method) ! (setq list-type (gnus-retrieve-groups groups method)) ! (cond ! ((not list-type) ! (gnus-error ! 1.2 "Cannot read partial active file from %s server." ! (car method))) ! ((eq list-type 'active) ! (gnus-active-to-gnus-format method gnus-active-hashtb)) ! (t ! (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) (t (if (not (gnus-request-list method)) ! (unless (equal method gnus-message-archive-method) ! (gnus-error 1 "Cannot read active file from %s server." ! (car method))) ! (gnus-message 5 mesg) ! (gnus-active-to-gnus-format method gnus-active-hashtb) ;; We mark this active file as read. ! (push method gnus-have-read-active-file) (gnus-message 5 "%sdone" mesg)))))) (setq methods (cdr methods)))))) ;; 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 ! (setq method gnus-select-method)) (let ((cur (current-buffer)) ! (hashtb (or hashtb ! (if (and gnus-active-hashtb (not (equal method gnus-select-method))) gnus-active-hashtb (setq gnus-active-hashtb (if (equal method gnus-select-method) ! (gnus-make-hashtable (count-lines (point-min) (point-max))) ! (gnus-make-hashtable 4096))))))) ;; Delete unnecessary lines. (goto-char (point-min)) (while (search-forward "\nto." nil t) ! (delete-region (1+ (match-beginning 0)) (progn (forward-line 1) (point)))) (or (string= gnus-ignored-newsgroups "") *************** Returns whether the updating was success *** 12876,12880 **** (insert ?\\)) ;; If these are groups from a foreign select method, we insert the ! ;; group prefix in front of the group names. (and method (not (gnus-server-equal (gnus-server-get-method nil method) --- 16340,16344 ---- (insert ?\\)) ;; If these are groups from a foreign select method, we insert the ! ;; group prefix in front of the group names. (and method (not (gnus-server-equal (gnus-server-get-method nil method) *************** Returns whether the updating was success *** 12890,12894 **** ;; Suggested by Brian Edmonds . ;; If we want information on moderated groups, we use this ! ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) --- 16354,16358 ---- ;; Suggested by Brian Edmonds . ;; If we want information on moderated groups, we use this ! ;; loop... (let* ((mod-hashtb (make-vector 7 0)) (m (intern "m" mod-hashtb)) *************** Returns whether the updating was success *** 12901,12905 **** (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not --- 16365,16369 ---- (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not *************** Returns whether the updating was success *** 12911,12917 **** ;; Enter moderated groups into a list. (if (eq (let ((obarray mod-hashtb)) (read cur)) m) ! (setq gnus-moderated-list (cons (symbol-name group) gnus-moderated-list)))) ! (error (and group (symbolp group) --- 16375,16381 ---- ;; Enter moderated groups into a list. (if (eq (let ((obarray mod-hashtb)) (read cur)) m) ! (setq gnus-moderated-list (cons (symbol-name group) gnus-moderated-list)))) ! (error (and group (symbolp group) *************** Returns whether the updating was success *** 12931,12935 **** (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not --- 16395,16399 ---- (if (and (numberp (setq max (read cur))) (numberp (setq min (read cur))) ! (progn (skip-chars-forward " \t") (not *************** Returns whether the updating was success *** 12939,12944 **** (set group (cons min max)) (set group nil))) ! (error ! (progn (and group (symbolp group) --- 16403,16408 ---- (set group (cons min max)) (set group nil))) ! (error ! (progn (and group (symbolp group) *************** Returns whether the updating was success *** 12946,12950 **** (or ignore-errors (gnus-message 3 "Warning - illegal active: %s" ! (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))))) (widen) --- 16410,16414 ---- (or ignore-errors (gnus-message 3 "Warning - illegal active: %s" ! (buffer-substring (gnus-point-at-bol) (gnus-point-at-eol))))))) (widen) *************** Returns whether the updating was success *** 12954,12964 **** ;; Parse a "groups" active file. (let ((cur (current-buffer)) ! (hashtb (or hashtb (if (and method gnus-active-hashtb) gnus-active-hashtb (setq gnus-active-hashtb ! (gnus-make-hashtable (count-lines (point-min) (point-max))))))) ! (prefix (and method (not (gnus-server-equal (gnus-server-get-method nil method) --- 16418,16428 ---- ;; Parse a "groups" active file. (let ((cur (current-buffer)) ! (hashtb (or hashtb (if (and method gnus-active-hashtb) gnus-active-hashtb (setq gnus-active-hashtb ! (gnus-make-hashtable (count-lines (point-min) (point-max))))))) ! (prefix (and method (not (gnus-server-equal (gnus-server-get-method nil method) *************** Returns whether the updating was success *** 12981,12985 **** (insert prefix) (goto-char opoint) ! (set (let ((obarray hashtb)) (read cur)) (cons min max))) (error (and group (symbolp group) (set group nil)))) --- 16445,16449 ---- (insert prefix) (goto-char opoint) ! (set (let ((obarray hashtb)) (read cur)) (cons min max))) (error (and group (symbolp group) (set group nil)))) *************** If FORCE is non-nil, the .newsrc file is *** 13009,13025 **** (quick-file (concat newsrc-file ".el"))) (save-excursion ! ;; We always load the .newsrc.eld file. If always contains ;; much information that can not be gotten from the .newsrc ;; file (ticked articles, killed groups, foreign methods, etc.) (gnus-read-newsrc-el-file quick-file) ! ! (if (or force ! (and (file-newer-than-file-p newsrc-file quick-file) ! (file-newer-than-file-p newsrc-file ! (concat quick-file "d"))) ! (not gnus-newsrc-alist)) ! ;; We read the .newsrc file. Note that if there if a ;; .newsrc.eld file exists, it has already been read, and ! ;; the `gnus-newsrc-hashtb' has been created. While reading ;; the .newsrc file, Gnus will only use the information it ;; can find there for changing the data already read - --- 16473,16490 ---- (quick-file (concat newsrc-file ".el"))) (save-excursion ! ;; We always load the .newsrc.eld file. If always contains ;; much information that can not be gotten from the .newsrc ;; file (ticked articles, killed groups, foreign methods, etc.) (gnus-read-newsrc-el-file quick-file) ! ! (if (and (file-exists-p gnus-current-startup-file) ! (or force ! (and (file-newer-than-file-p newsrc-file quick-file) ! (file-newer-than-file-p newsrc-file ! (concat quick-file "d"))) ! (not gnus-newsrc-alist))) ! ;; We read the .newsrc file. Note that if there if a ;; .newsrc.eld file exists, it has already been read, and ! ;; the `gnus-newsrc-hashtb' has been created. While reading ;; the .newsrc file, Gnus will only use the information it ;; can find there for changing the data already read - *************** If FORCE is non-nil, the .newsrc file is *** 13032,13036 **** (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) ! (gnus-message 5 "Reading %s...done" newsrc-file)))))) (defun gnus-read-newsrc-el-file (file) --- 16497,16557 ---- (gnus-newsrc-to-gnus-format) (kill-buffer (current-buffer)) ! (gnus-message 5 "Reading %s...done" newsrc-file))) ! ! ;; Read any slave files. ! (unless gnus-slave ! (gnus-master-read-slave-newsrc)) ! ! ;; Convert old to new. ! (gnus-convert-old-newsrc)))) ! ! (defun gnus-continuum-version (version) ! "Return VERSION as a floating point number." ! (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) ! (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) ! (let* ((alpha (and (match-beginning 1) (match-string 1 version))) ! (number (match-string 2 version)) ! major minor least) ! (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) ! (setq major (string-to-number (match-string 1 number))) ! (setq minor (string-to-number (match-string 2 number))) ! (setq least (if (match-beginning 3) ! (string-to-number (match-string 3 number)) ! 0)) ! (string-to-number ! (if (zerop major) ! (format "%s00%02d%02d" ! (cond ! ((member alpha '("(ding)" "d")) "4.99") ! ((member alpha '("September" "s")) "5.01") ! ((member alpha '("Red" "r")) "5.03")) ! minor least) ! (format "%d.%02d%02d" major minor least)))))) ! ! (defun gnus-convert-old-newsrc () ! "Convert old newsrc into the new format, if needed." ! (let ((fcv (and gnus-newsrc-file-version ! (gnus-continuum-version gnus-newsrc-file-version)))) ! (cond ! ;; No .newsrc.eld file was loaded. ! ((null fcv) nil) ! ;; Gnus 5 .newsrc.eld was loaded. ! ((< fcv (gnus-continuum-version "September Gnus v0.1")) ! (gnus-convert-old-ticks))))) ! ! (defun gnus-convert-old-ticks () ! (let ((newsrc (cdr gnus-newsrc-alist)) ! marks info dormant ticked) ! (while (setq info (pop newsrc)) ! (when (setq marks (gnus-info-marks info)) ! (setq dormant (cdr (assq 'dormant marks)) ! ticked (cdr (assq 'tick marks))) ! (when (or dormant ticked) ! (gnus-info-set-read ! info ! (gnus-add-to-range ! (gnus-info-read info) ! (nconc (gnus-uncompress-range dormant) ! (gnus-uncompress-range ticked))))))))) (defun gnus-read-newsrc-el-file (file) *************** If FORCE is non-nil, the .newsrc file is *** 13041,13060 **** (condition-case nil (load ding-file t t t) ! (error nil)) ! (and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc))) ! (let ((inhibit-quit t)) ! (gnus-uncompress-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist) ! (if (not (file-newer-than-file-p file ding-file)) ! () ;; Old format quick file (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ! ;; as well. (gnus-read-old-newsrc-el-file file)))) ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) ! (let (newsrc killed marked group m) (prog1 (let ((gnus-killed-assoc nil) --- 16562,16580 ---- (condition-case nil (load ding-file t t t) ! (error ! (gnus-error 1 "Error in %s" ding-file))) ! (when gnus-newsrc-assoc ! (setq gnus-newsrc-alist gnus-newsrc-assoc))) (gnus-make-hashtable-from-newsrc-alist) ! (when (file-newer-than-file-p file ding-file) ;; Old format quick file (gnus-message 5 "Reading %s..." file) ;; The .el file is newer than the .eld file, so we read that one ! ;; as well. (gnus-read-old-newsrc-el-file file)))) ;; Parse the old-style quick startup file (defun gnus-read-old-newsrc-el-file (file) ! (let (newsrc killed marked group m info) (prog1 (let ((gnus-killed-assoc nil) *************** If FORCE is non-nil, the .newsrc file is *** 13068,13096 **** marked gnus-marked-assoc))) (setq gnus-newsrc-alist nil) ! (while newsrc ! (setq group (car newsrc)) ! (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb)))) ! (if info ! (progn ! (setcar (nthcdr 2 info) (cdr (cdr group))) ! (setcar (cdr info) ! (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed)) ! (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) ! (setq gnus-newsrc-alist ! (cons ! (setq info ! (list (car group) ! (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed) ! (cdr (cdr group)))) ! gnus-newsrc-alist))) ! (if (setq m (assoc (car group) marked)) ! (setcdr (cdr (cdr info)) ! (cons (list (cons 'tick (cdr m))) nil)))) ! (setq newsrc (cdr newsrc))) (setq newsrc killed) (while newsrc ! (setcar newsrc (car (car newsrc))) (setq newsrc (cdr newsrc))) (setq gnus-killed-list killed)) --- 16588,16615 ---- marked gnus-marked-assoc))) (setq gnus-newsrc-alist nil) ! (while (setq group (pop newsrc)) ! (if (setq info (gnus-get-info (car group))) ! (progn ! (gnus-info-set-read info (cddr group)) ! (gnus-info-set-level ! info (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed)) ! (setq gnus-newsrc-alist (cons info gnus-newsrc-alist))) ! (push (setq info ! (list (car group) ! (if (nth 1 group) gnus-level-default-subscribed ! gnus-level-default-unsubscribed) ! (cddr group))) ! gnus-newsrc-alist)) ! ;; Copy marks into info. ! (when (setq m (assoc (car group) marked)) ! (unless (nthcdr 3 info) ! (nconc info (list nil))) ! (gnus-info-set-marks ! info (list (cons 'tick (gnus-compress-sequence ! (sort (cdr m) '<) t)))))) (setq newsrc killed) (while newsrc ! (setcar newsrc (caar newsrc)) (setq newsrc (cdr newsrc))) (setq gnus-killed-list killed)) *************** If FORCE is non-nil, the .newsrc file is *** 13099,13103 **** ;; isn't there. (and ! gnus-newsrc-options (progn (and (not (string-match "^ *options" gnus-newsrc-options)) --- 16618,16622 ---- ;; isn't there. (and ! gnus-newsrc-options (progn (and (not (string-match "^ *options" gnus-newsrc-options)) *************** If FORCE is non-nil, the .newsrc file is *** 13111,13115 **** (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) ! (defun gnus-make-newsrc-file (file) "Make server dependent file name by catenating FILE and server host name." --- 16630,16634 ---- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) (gnus-make-hashtable-from-newsrc-alist))) ! (defun gnus-make-newsrc-file (file) "Make server dependent file name by catenating FILE and server host name." *************** If FORCE is non-nil, the .newsrc file is *** 13121,13158 **** real-file file))) - (defun gnus-uncompress-newsrc-alist () - ;; Uncompress all lists of marked articles in the newsrc assoc. - (let ((newsrc gnus-newsrc-alist) - marked) - (while newsrc - (if (not (setq marked (nth 3 (car newsrc)))) - () - (while marked - (or (eq 'score (car (car marked))) - (eq 'bookmark (car (car marked))) - (eq 'killed (car (car marked))) - (setcdr (car marked) (gnus-uncompress-range (cdr (car marked))))) - (setq marked (cdr marked)))) - (setq newsrc (cdr newsrc))))) - - (defun gnus-compress-newsrc-alist () - ;; Compress all lists of marked articles in the newsrc assoc. - (let ((newsrc gnus-newsrc-alist) - marked) - (while newsrc - (if (not (setq marked (nth 3 (car newsrc)))) - () - (while marked - (or (eq 'score (car (car marked))) - (eq 'bookmark (car (car marked))) - (eq 'killed (car (car marked))) - (setcdr (car marked) - (condition-case () - (gnus-compress-sequence - (sort (cdr (car marked)) '<) t) - (error (cdr (car marked)))))) - (setq marked (cdr marked)))) - (setq newsrc (cdr newsrc))))) - (defun gnus-newsrc-to-gnus-format () (setq gnus-newsrc-options "") --- 16640,16643 ---- *************** If FORCE is non-nil, the .newsrc file is *** 13170,13174 **** (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) ! (while (not (eobp)) ;; We first read the first word on the line by narrowing and --- 16655,16659 ---- (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) ! (while (not (eobp)) ;; We first read the first word on the line by narrowing and *************** If FORCE is non-nil, the .newsrc file is *** 13180,13190 **** (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) ! (setq symbol (and (/= (point-min) (point-max)) (let ((obarray gnus-active-hashtb)) (read buf)))) (widen) ;; Now, the symbol we have read is either `options' or a group ! ;; name. If it is an options line, we just add it to a string. ! (cond ((or (eq symbol options-symbol) (eq symbol Options-symbol)) --- 16665,16675 ---- (progn (skip-chars-forward "^ \t!:\n") (point))) (goto-char (point-min)) ! (setq symbol (and (/= (point-min) (point-max)) (let ((obarray gnus-active-hashtb)) (read buf)))) (widen) ;; Now, the symbol we have read is either `options' or a group ! ;; name. If it is an options line, we just add it to a string. ! (cond ((or (eq symbol options-symbol) (eq symbol Options-symbol)) *************** If FORCE is non-nil, the .newsrc file is *** 13195,13199 **** ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options ! (buffer-substring (gnus-point-at-bol) ;; Options may continue on the next line. --- 16680,16684 ---- ;; don't give a damn, frankly, my dear. (concat gnus-newsrc-options ! (buffer-substring (gnus-point-at-bol) ;; Options may continue on the next line. *************** If FORCE is non-nil, the .newsrc file is *** 13203,13206 **** --- 16688,16694 ---- (forward-line -1)) (symbol + ;; Group names can be just numbers. + (when (numberp symbol) + (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) (or (boundp symbol) (set symbol nil)) ;; It was a group name. *************** If FORCE is non-nil, the .newsrc file is *** 13218,13225 **** ;; We read them range by range. (while ! (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ ! ;; string-to-int because it's faster. narrow/widen is ;; faster than save-restriction/narrow, and save-restriction ;; produces a garbage object. --- 16706,16713 ---- ;; We read them range by range. (while ! (cond ((looking-at "[0-9]+") ;; We narrow and read a number instead of buffer-substring/ ! ;; string-to-int because it's faster. narrow/widen is ;; faster than save-restriction/narrow, and save-restriction ;; produces a garbage object. *************** If FORCE is non-nil, the .newsrc file is *** 13235,13246 **** (if (not (looking-at "[0-9]+")) ;; This is a buggy line, by we pretend that ! ;; it's kinda OK. Perhaps the user should be ! ;; dinged? (setq reads (cons num1 reads)) ! (setq reads ! (cons (cons num1 (progn ! (narrow-to-region (match-beginning 0) (match-end 0)) (read buf))) --- 16723,16734 ---- (if (not (looking-at "[0-9]+")) ;; This is a buggy line, by we pretend that ! ;; it's kinda OK. Perhaps the user should be ! ;; dinged? (setq reads (cons num1 reads)) ! (setq reads ! (cons (cons num1 (progn ! (narrow-to-region (match-beginning 0) (match-end 0)) (read buf))) *************** If FORCE is non-nil, the .newsrc file is *** 13258,13274 **** (t ;; Not numbers and not eol, so this might be a buggy ! ;; line... ! (or (eobp) ;; If it was eob instead of ?\n, we allow it. (progn ;; The line was buggy. (setq group nil) ! (gnus-message 3 "Mangled line: %s" ! (buffer-substring (gnus-point-at-bol) ! (gnus-point-at-eol))) ! (ding) ! (sit-for 1))) nil)) ! ;; Skip past ", ". Spaces are illegal in these ranges, but ;; we allow them, because it's a common mistake to put a ;; space after the comma. --- 16746,16760 ---- (t ;; Not numbers and not eol, so this might be a buggy ! ;; line... ! (or (eobp) ;; If it was eob instead of ?\n, we allow it. (progn ;; The line was buggy. (setq group nil) ! (gnus-error 3.1 "Mangled line: %s" ! (buffer-substring (gnus-point-at-bol) ! (gnus-point-at-eol))))) nil)) ! ;; Skip past ", ". Spaces are illegal in these ranges, but ;; we allow them, because it's a common mistake to put a ;; space after the comma. *************** If FORCE is non-nil, the .newsrc file is *** 13277,13305 **** ;; We have already read .newsrc.eld, so we gently update the ;; data in the hash table with the information we have just ! ;; read. ! (if (not group) ! () ! (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) level) (if info ;; There is an entry for this file in the alist. (progn ! (setcar (nthcdr 2 info) (nreverse reads)) ;; We update the level very gently. In fact, we ;; only change it if there's been a status change ;; from subscribed to unsubscribed, or vice versa. ! (setq level (nth 1 info)) (cond ((and (<= level gnus-level-subscribed) (not subscribed)) (setq level (if reads ! gnus-level-default-unsubscribed (1+ gnus-level-default-unsubscribed)))) ((and (> level gnus-level-subscribed) subscribed) (setq level gnus-level-default-subscribed))) ! (setcar (cdr info) level)) ;; This is a new group. ! (setq info (list group (if subscribed ! gnus-level-default-subscribed (if reads (1+ gnus-level-subscribed) --- 16763,16790 ---- ;; We have already read .newsrc.eld, so we gently update the ;; data in the hash table with the information we have just ! ;; read. ! (when group ! (let ((info (gnus-get-info group)) level) (if info ;; There is an entry for this file in the alist. (progn ! (gnus-info-set-read info (nreverse reads)) ;; We update the level very gently. In fact, we ;; only change it if there's been a status change ;; from subscribed to unsubscribed, or vice versa. ! (setq level (gnus-info-level info)) (cond ((and (<= level gnus-level-subscribed) (not subscribed)) (setq level (if reads ! gnus-level-default-unsubscribed (1+ gnus-level-default-unsubscribed)))) ((and (> level gnus-level-subscribed) subscribed) (setq level gnus-level-default-subscribed))) ! (gnus-info-set-level info level)) ;; This is a new group. ! (setq info (list group (if subscribed ! gnus-level-default-subscribed (if reads (1+ gnus-level-subscribed) *************** If FORCE is non-nil, the .newsrc file is *** 13308,13312 **** (setq newsrc (cons info newsrc)))))) (forward-line 1)) ! (setq newsrc (nreverse newsrc)) --- 16793,16797 ---- (setq newsrc (cons info newsrc)))))) (forward-line 1)) ! (setq newsrc (nreverse newsrc)) *************** If FORCE is non-nil, the .newsrc file is *** 13315,13321 **** ;; We now have two newsrc lists - `newsrc', which is what we ;; have read from .newsrc, and `gnus-newsrc-alist', which is ! ;; what we've read from .newsrc.eld. We have to merge these ! ;; lists. We do this by "attaching" any (foreign) groups in the ! ;; gnus-newsrc-alist to the (native) group that precedes them. (let ((rc (cdr gnus-newsrc-alist)) (prev gnus-newsrc-alist) --- 16800,16806 ---- ;; We now have two newsrc lists - `newsrc', which is what we ;; have read from .newsrc, and `gnus-newsrc-alist', which is ! ;; what we've read from .newsrc.eld. We have to merge these ! ;; lists. We do this by "attaching" any (foreign) groups in the ! ;; gnus-newsrc-alist to the (native) group that precedes them. (let ((rc (cdr gnus-newsrc-alist)) (prev gnus-newsrc-alist) *************** If FORCE is non-nil, the .newsrc file is *** 13323,13328 **** (while rc (or (null (nth 4 (car rc))) ; It's a native group. ! (assoc (car (car rc)) newsrc) ; It's already in the alist. ! (if (setq entry (assoc (car (car prev)) newsrc)) (setcdr (setq mentry (memq entry newsrc)) (cons (car rc) (cdr mentry))) --- 16808,16813 ---- (while rc (or (null (nth 4 (car rc))) ; It's a native group. ! (assoc (caar rc) newsrc) ; It's already in the alist. ! (if (setq entry (assoc (caar prev) newsrc)) (setcdr (setq mentry (memq entry newsrc)) (cons (car rc) (cdr mentry))) *************** If FORCE is non-nil, the .newsrc file is *** 13345,13356 **** ;; When handling new newsgroups, groups that match a `ignore' regexp ;; will be ignored, and groups that match a `subscribe' regexp will be ! ;; subscribed. A line like ;; options -n !all rec.all ;; will lead to a list that looks like ! ;; (("^rec\\..+" . subscribe) ;; ("^.+" . ignore)) ;; So all "rec.*" groups will be subscribed, while all the other ! ;; groups will be ignored. Note that "options -n !all rec.all" is very ! ;; different from "options -n rec.all !all". (defun gnus-newsrc-parse-options (options) (let (out eol) --- 16830,16841 ---- ;; When handling new newsgroups, groups that match a `ignore' regexp ;; will be ignored, and groups that match a `subscribe' regexp will be ! ;; subscribed. A line like ;; options -n !all rec.all ;; will lead to a list that looks like ! ;; (("^rec\\..+" . subscribe) ;; ("^.+" . ignore)) ;; So all "rec.*" groups will be subscribed, while all the other ! ;; groups will be ignored. Note that "options -n !all rec.all" is very ! ;; different from "options -n rec.all !all". (defun gnus-newsrc-parse-options (options) (let (out eol) *************** If FORCE is non-nil, the .newsrc file is *** 13376,13380 **** ;; ignore the other option lines. (while (re-search-forward "[ \t]-n" nil t) ! (setq eol (or (save-excursion (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) --- 16861,16865 ---- ;; ignore the other option lines. (while (re-search-forward "[ \t]-n" nil t) ! (setq eol (or (save-excursion (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) *************** If FORCE is non-nil, the .newsrc file is *** 13385,13441 **** (if (= (char-after (match-beginning 0)) ?!) ;; If the word begins with a bang (!), this is a "not" ! ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. ! (setq out (cons (cons (concat ! "^" (buffer-substring (1+ (match-beginning 0)) (match-end 0))) 'ignore) out)) ;; There was no bang, so this is a "yes" spec. ! (setq out (cons (cons (concat ! "^" (buffer-substring (match-beginning 0) ! (match-end 0))) 'subscribe) out))))) ! (setq gnus-newsrc-options-n out)))) ! ! (defun gnus-save-newsrc-file () "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed ;; from the variable gnus-newsrc-alist. ! (and (or gnus-newsrc-alist gnus-killed-list) ! gnus-current-startup-file ! (progn ! (run-hooks 'gnus-save-newsrc-hook) ! (save-excursion ! (if (and gnus-use-dribble-file ! (or (not gnus-dribble-buffer) ! (not (buffer-name gnus-dribble-buffer)) ! (zerop (save-excursion ! (set-buffer gnus-dribble-buffer) ! (buffer-size))))) ! (gnus-message 4 "(No changes need to be saved)") ! (if gnus-save-newsrc-file ! (progn ! (gnus-message 5 "Saving %s..." gnus-current-startup-file) ! ;; Make backup file of master newsrc. ! (gnus-gnus-to-newsrc-format) ! (gnus-message 5 "Saving %s...done" ! gnus-current-startup-file))) ! ;; Quickly loadable .newsrc. ! (set-buffer (get-buffer-create " *Gnus-newsrc*")) ! (make-local-variable 'version-control) ! (setq version-control 'never) ! (setq buffer-file-name (concat gnus-current-startup-file ".eld")) ! (gnus-add-current-to-buffer-list) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) ! (gnus-gnus-to-quick-newsrc-format) ! (save-buffer) ! (kill-buffer (current-buffer)) ! (gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file) ! (gnus-dribble-delete-file)))))) (defun gnus-gnus-to-quick-newsrc-format () --- 16870,16928 ---- (if (= (char-after (match-beginning 0)) ?!) ;; If the word begins with a bang (!), this is a "not" ! ;; spec. We put this spec (minus the bang) and the ;; symbol `ignore' into the list. ! (setq out (cons (cons (concat ! "^" (buffer-substring (1+ (match-beginning 0)) (match-end 0))) 'ignore) out)) ;; There was no bang, so this is a "yes" spec. ! (setq out (cons (cons (concat "^" (match-string 0)) 'subscribe) out))))) ! (setq gnus-newsrc-options-n out)))) ! (defun gnus-save-newsrc-file (&optional force) "Save .newsrc file." ;; Note: We cannot save .newsrc file if all newsgroups are removed ;; from the variable gnus-newsrc-alist. ! (when (and (or gnus-newsrc-alist gnus-killed-list) ! gnus-current-startup-file) ! (save-excursion ! (if (and (or gnus-use-dribble-file gnus-slave) ! (not force) ! (or (not gnus-dribble-buffer) ! (not (buffer-name gnus-dribble-buffer)) ! (zerop (save-excursion ! (set-buffer gnus-dribble-buffer) ! (buffer-size))))) ! (gnus-message 4 "(No changes need to be saved)") ! (run-hooks 'gnus-save-newsrc-hook) ! (if gnus-slave ! (gnus-slave-save-newsrc) ! ;; Save .newsrc. ! (when gnus-save-newsrc-file ! (gnus-message 5 "Saving %s..." gnus-current-startup-file) ! (gnus-gnus-to-newsrc-format) ! (gnus-message 5 "Saving %s...done" gnus-current-startup-file)) ! ;; Save .newsrc.eld. ! (set-buffer (get-buffer-create " *Gnus-newsrc*")) ! (make-local-variable 'version-control) ! (setq version-control 'never) ! (setq buffer-file-name ! (concat gnus-current-startup-file ".eld")) ! (setq default-directory (file-name-directory buffer-file-name)) ! (gnus-add-current-to-buffer-list) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) ! (gnus-gnus-to-quick-newsrc-format) ! (run-hooks 'gnus-save-quick-newsrc-hook) ! (save-buffer) ! (kill-buffer (current-buffer)) ! (gnus-message ! 5 "Saving %s.eld...done" gnus-current-startup-file)) ! (gnus-dribble-delete-file) ! (gnus-group-set-mode-line))))) (defun gnus-gnus-to-quick-newsrc-format () *************** If FORCE is non-nil, the .newsrc file is *** 13446,13474 **** (insert "(setq gnus-newsrc-file-version " (prin1-to-string gnus-version) ")\n") ! (let ((variables gnus-variable-list) ! (inhibit-quit t) (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) ! ;; insert lisp expressions. ! (gnus-compress-newsrc-alist) (while variables ! (setq variable (car variables)) ! (and (boundp variable) ! (symbol-value variable) ! (or gnus-save-killed-list (not (eq variable 'gnus-killed-list))) ! (insert "(setq " (symbol-name variable) " '" ! (prin1-to-string (symbol-value variable)) ! ")\n")) ! (setq variables (cdr variables))) ! (gnus-uncompress-newsrc-alist))) ! (defun gnus-gnus-to-newsrc-format () ;; Generate and save the .newsrc file. ! (let ((newsrc (cdr gnus-newsrc-alist)) ! info ranges range) ! (save-excursion ! (set-buffer (create-file-buffer gnus-current-startup-file)) (setq buffer-file-name gnus-current-startup-file) (buffer-disable-undo (current-buffer)) (erase-buffer) --- 16933,16961 ---- (insert "(setq gnus-newsrc-file-version " (prin1-to-string gnus-version) ")\n") ! (let ((variables ! (if gnus-save-killed-list gnus-variable-list ! ;; Remove the `gnus-killed-list' from the list of variables ! ;; to be saved, if required. ! (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) ! ;; Peel off the "dummy" group. (gnus-newsrc-alist (cdr gnus-newsrc-alist)) variable) ! ;; Insert the variables into the file. (while variables ! (when (and (boundp (setq variable (pop variables))) ! (symbol-value variable)) ! (insert "(setq " (symbol-name variable) " '") ! (prin1 (symbol-value variable) (current-buffer)) ! (insert ")\n"))))) (defun gnus-gnus-to-newsrc-format () ;; Generate and save the .newsrc file. ! (save-excursion ! (set-buffer (create-file-buffer gnus-current-startup-file)) ! (let ((newsrc (cdr gnus-newsrc-alist)) ! (standard-output (current-buffer)) ! info ranges range method) (setq buffer-file-name gnus-current-startup-file) + (setq default-directory (file-name-directory buffer-file-name)) (buffer-disable-undo (current-buffer)) (erase-buffer) *************** If FORCE is non-nil, the .newsrc file is *** 13476,13511 **** (if gnus-newsrc-options (insert gnus-newsrc-options)) ;; Write subscribed and unsubscribed. ! (while newsrc ! (setq info (car newsrc)) ! (if (not (nth 4 info)) ;Don't write foreign groups to .newsrc. ! (progn ! (insert (car info) (if (> (nth 1 info) gnus-level-subscribed) ! "!" ":")) ! (if (setq ranges (nth 2 info)) ! (progn ! (insert " ") ! (if (not (listp (cdr ranges))) ! (if (= (car ranges) (cdr ranges)) ! (insert (int-to-string (car ranges))) ! (insert (int-to-string (car ranges)) "-" ! (int-to-string (cdr ranges)))) ! (while ranges ! (setq range (car ranges) ! ranges (cdr ranges)) ! (if (or (atom range) (= (car range) (cdr range))) ! (insert (int-to-string ! (or (and (atom range) range) ! (car range)))) ! (insert (int-to-string (car range)) "-" ! (int-to-string (cdr range)))) ! (if ranges (insert ",")))))) ! (insert "\n"))) ! (setq newsrc (cdr newsrc))) (make-local-variable 'version-control) (setq version-control 'never) ;; It has been reported that sometime the modtime on the .newsrc ! ;; file seems to be off. We really do want to overwrite it, so ! ;; we clear the modtime here before saving. It's a bit odd, ! ;; though... ;; sometimes the modtime clear isn't sufficient. most brute force: ;; delete the silly thing entirely first. but this fails to provide --- 16963,16996 ---- (if gnus-newsrc-options (insert gnus-newsrc-options)) ;; Write subscribed and unsubscribed. ! (while (setq info (pop newsrc)) ! ;; Don't write foreign groups to .newsrc. ! (when (or (null (setq method (gnus-info-method info))) ! (equal method "native") ! (gnus-server-equal method gnus-select-method)) ! (insert (gnus-info-group info) ! (if (> (gnus-info-level info) gnus-level-subscribed) ! "!" ":")) ! (when (setq ranges (gnus-info-read info)) ! (insert " ") ! (if (not (listp (cdr ranges))) ! (if (= (car ranges) (cdr ranges)) ! (princ (car ranges)) ! (princ (car ranges)) ! (insert "-") ! (princ (cdr ranges))) ! (while (setq range (pop ranges)) ! (if (or (atom range) (= (car range) (cdr range))) ! (princ (or (and (atom range) range) (car range))) ! (princ (car range)) ! (insert "-") ! (princ (cdr range))) ! (if ranges (insert ","))))) ! (insert "\n"))) (make-local-variable 'version-control) (setq version-control 'never) ;; It has been reported that sometime the modtime on the .newsrc ! ;; file seems to be off. We really do want to overwrite it, so ! ;; we clear the modtime here before saving. It's a bit odd, ! ;; though... ;; sometimes the modtime clear isn't sufficient. most brute force: ;; delete the silly thing entirely first. but this fails to provide *************** If FORCE is non-nil, the .newsrc file is *** 13514,13522 **** (delete-file gnus-startup-file) (clear-visited-file-modtime)) (save-buffer) (kill-buffer (current-buffer))))) (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method gnus-secondary-select-methods))) (while methods (gnus-read-descriptions-file (car methods)) --- 16999,17071 ---- (delete-file gnus-startup-file) (clear-visited-file-modtime)) + (run-hooks 'gnus-save-standard-newsrc-hook) (save-buffer) (kill-buffer (current-buffer))))) + + ;;; + ;;; Slave functions. + ;;; + + (defun gnus-slave-save-newsrc () + (save-excursion + (set-buffer gnus-dribble-buffer) + (let ((slave-name + (make-temp-name (concat gnus-current-startup-file "-slave-")))) + (write-region (point-min) (point-max) slave-name nil 'nomesg)))) + + (defun gnus-master-read-slave-newsrc () + (let ((slave-files + (directory-files + (file-name-directory gnus-current-startup-file) + t (concat + "^" (regexp-quote + (concat + (file-name-nondirectory gnus-current-startup-file) + "-slave-"))) + t)) + file) + (if (not slave-files) + () ; There are no slave files to read. + (gnus-message 7 "Reading slave newsrcs...") + (save-excursion + (set-buffer (get-buffer-create " *gnus slave*")) + (buffer-disable-undo (current-buffer)) + (setq slave-files + (sort (mapcar (lambda (file) + (list (nth 5 (file-attributes file)) file)) + slave-files) + (lambda (f1 f2) + (or (< (caar f1) (caar f2)) + (< (nth 1 (car f1)) (nth 1 (car f2))))))) + (while slave-files + (erase-buffer) + (setq file (nth 1 (car slave-files))) + (insert-file-contents file) + (if (condition-case () + (progn + (eval-buffer (current-buffer)) + t) + (error + (gnus-error 3.2 "Possible error in %s" file) + nil)) + (or gnus-slave ; Slaves shouldn't delete these files. + (condition-case () + (delete-file file) + (error nil)))) + (setq slave-files (cdr slave-files)))) + (gnus-message 7 "Reading slave newsrcs...done")))) + + + ;;; + ;;; Group description. + ;;; + (defun gnus-read-all-descriptions-files () ! (let ((methods (cons gnus-select-method ! (nconc ! (when (gnus-archive-server-wanted-p) ! (list "archive")) ! gnus-secondary-select-methods)))) (while methods (gnus-read-descriptions-file (car methods)) *************** If FORCE is non-nil, the .newsrc file is *** 13525,13533 **** (defun gnus-read-descriptions-file (&optional method) ! (let ((method (or method gnus-select-method))) ;; We create the hashtable whether we manage to read the desc file ;; to avoid trying to re-read after a failed read. (or gnus-description-hashtb ! (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb)))) ;; Mark this method's desc file as read. --- 17074,17085 ---- (defun gnus-read-descriptions-file (&optional method) ! (let ((method (or method gnus-select-method)) ! group) ! (when (stringp method) ! (setq method (gnus-server-to-method method))) ;; We create the hashtable whether we manage to read the desc file ;; to avoid trying to re-read after a failed read. (or gnus-description-hashtb ! (setq gnus-description-hashtb (gnus-make-hashtable (length gnus-active-hashtb)))) ;; Mark this method's desc file as read. *************** If FORCE is non-nil, the .newsrc file is *** 13536,13540 **** (gnus-message 5 "Reading descriptions file via %s..." (car method)) ! (cond ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") --- 17088,17092 ---- (gnus-message 5 "Reading descriptions file via %s..." (car method)) ! (cond ((not (gnus-check-server method)) (gnus-message 1 "Couldn't open server") *************** If FORCE is non-nil, the .newsrc file is *** 13544,14175 **** nil) (t ! (let (group) ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (if (or (search-forward "\n.\n" nil t) (goto-char (point-max))) ! (progn ! (beginning-of-line) ! (narrow-to-region (point-min) (point)))) ! (goto-char (point-min)) ! (while (not (eobp)) ! ;; If we get an error, we set group to 0, which is not a ! ;; symbol... ! (setq group ! (condition-case () ! (let ((obarray gnus-description-hashtb)) ! ;; Group is set to a symbol interned in this ! ;; hash table. ! (read nntp-server-buffer)) ! (error 0))) ! (skip-chars-forward " \t") ! ;; ... which leads to this line being effectively ignored. ! (and (symbolp group) ! (set group (buffer-substring ! (point) (progn (end-of-line) (point))))) ! (forward-line 1)))) ! (gnus-message 5 "Reading descriptions file...done") ! t))))) (defun gnus-group-get-description (group) ! ;; Get the description of a group by sending XGTITLE to the server. ! (and (gnus-request-group-description group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (and (looking-at "[^ \t]+[ \t]+\\(.*\\)") ! (buffer-substring (match-beginning 1) (match-end 1)))))) ! ! ;;; ! ;;; Server ! ;;; ! ! (defvar gnus-server-mode-hook nil ! "Hook run in `gnus-server-mode' buffers.") ! ! (defconst gnus-server-line-format " {%(%h:%w%)}\n" ! "Format of server lines. ! It works along the same lines as a normal formatting string, ! with some simple extensions.") ! ! (defvar gnus-server-mode-line-format "Gnus List of servers" ! "The format specification for the server mode line.") ! ! (defconst gnus-server-line-format-alist ! (list (list ?h 'how ?s) ! (list ?n 'name ?s) ! (list ?w 'where ?s) ! )) ! ! (defconst gnus-server-mode-line-format-alist ! (list (list ?S 'news-server ?s) ! (list ?M 'news-method ?s) ! (list ?u 'user-defined ?s))) ! ! (defvar gnus-server-line-format-spec nil) ! (defvar gnus-server-mode-line-format-spec nil) ! (defvar gnus-server-killed-servers nil) ! ! (defvar gnus-server-mode-map nil) ! (put 'gnus-server-mode 'mode-class 'special) ! ! (if gnus-server-mode-map ! nil ! (setq gnus-server-mode-map (make-sparse-keymap)) ! (suppress-keymap gnus-server-mode-map) ! (define-key gnus-server-mode-map " " 'gnus-server-read-server) ! (define-key gnus-server-mode-map "\r" 'gnus-server-read-server) ! (define-key gnus-server-mode-map gnus-mouse-2 'gnus-server-pick-server) ! (define-key gnus-server-mode-map "q" 'gnus-server-exit) ! (define-key gnus-server-mode-map "l" 'gnus-server-list-servers) ! (define-key gnus-server-mode-map "k" 'gnus-server-kill-server) ! (define-key gnus-server-mode-map "y" 'gnus-server-yank-server) ! (define-key gnus-server-mode-map "c" 'gnus-server-copy-server) ! (define-key gnus-server-mode-map "a" 'gnus-server-add-server) ! (define-key gnus-server-mode-map "e" 'gnus-server-edit-server)) ! ! (defun gnus-server-mode () ! "Major mode for listing and editing servers. ! ! All normal editing commands are switched off. ! \\ ! ! For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). ! ! The following commands are available: ! ! \\{gnus-server-mode-map}" ! (interactive) ! (if gnus-visual (gnus-server-make-menu-bar)) ! (kill-all-local-variables) ! (gnus-simplify-mode-line) ! (setq major-mode 'gnus-server-mode) ! (setq mode-name "Server") ! ; (gnus-group-set-mode-line) ! (setq mode-line-process nil) ! (use-local-map gnus-server-mode-map) ! (buffer-disable-undo (current-buffer)) ! (setq truncate-lines t) ! (setq buffer-read-only t) ! (run-hooks 'gnus-server-mode-hook)) ! ! (defun gnus-server-insert-server-line (sformat name method) ! (let* ((sformat (or sformat gnus-server-line-format-spec)) ! (how (car method)) ! (where (nth 1 method)) ! b) ! (beginning-of-line) ! (setq b (point)) ! ;; Insert the text. ! (insert (eval sformat)) ! (add-text-properties b (1+ b) (list 'gnus-server (intern name))))) ! ! (defun gnus-server-setup-buffer () ! (if (get-buffer gnus-server-buffer) ! () (save-excursion ! (set-buffer (get-buffer-create gnus-server-buffer)) ! (gnus-server-mode) ! (and 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 ! gnus-server-mode-line-format-alist)) ! (setq gnus-server-line-format-spec ! (gnus-parse-format gnus-server-line-format ! gnus-server-line-format-alist)) ! (let ((alist gnus-server-alist) ! (buffer-read-only nil)) ! (erase-buffer) ! (while alist ! (gnus-server-insert-server-line nil (car (car alist)) (cdr (car alist))) ! (setq alist (cdr alist)))) ! (goto-char (point-min)) ! (gnus-server-position-cursor)) ! ! (defun gnus-server-server-name () ! (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) ! (and server (symbol-name server)))) ! ! (defalias 'gnus-server-position-cursor 'gnus-goto-colon) ! ! (defconst gnus-server-edit-buffer "*Gnus edit server*") ! ! (defun gnus-server-update-server (server) ! (save-excursion ! (set-buffer gnus-server-buffer) ! (let ((buffer-read-only nil) ! (info (cdr (assoc server gnus-server-alist)))) ! (gnus-dribble-enter ! (concat "(gnus-server-set-info \"" server "\" '" ! (prin1-to-string info) ")")) ! ;; Buffer may be narrowed. ! (save-restriction ! (widen) ! (if (gnus-server-goto-server server) ! (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point)))) ! (let ((entry (assoc server gnus-server-alist))) ! (gnus-server-insert-server-line nil (car entry) (cdr entry)) ! (gnus-server-position-cursor)))))) ! ! (defun gnus-server-set-info (server info) ! ;; Enter a select method into the virtual server alist. ! (gnus-dribble-enter ! (concat "(gnus-server-set-info \"" server "\" '" ! (prin1-to-string info) ")")) ! (let* ((server (nth 1 info)) ! (entry (assoc server gnus-server-alist))) ! (if entry (setcdr entry info) ! (setq gnus-server-alist ! (nconc gnus-server-alist (list (cons server info))))))) ! ! (defun gnus-server-to-method (server) ! ;; Map virtual server names to select methods. ! (or (and (equal server "native") gnus-select-method) ! (cdr (assoc server gnus-server-alist)))) ! ! (defun gnus-server-extend-method (group method) ! ;; This function "extends" a virtual server. If the server is ! ;; "hello", and the select method is ("hello" (my-var "something")) ! ;; in the group "alt.alt", this will result in a new virtual server ! ;; called "helly+alt.alt". ! (let ((entry ! (gnus-copy-sequence ! (if (equal (car method) "native") gnus-select-method ! (cdr (assoc (car method) gnus-server-alist)))))) ! (setcar (cdr entry) (concat (nth 1 entry) "+" group)) ! (nconc entry (cdr method)))) ! ! (defun gnus-server-get-method (group method) ! ;; Input either a server name, and extended server name, or a ! ;; select method, and return a select method. ! (cond ((stringp method) ! (gnus-server-to-method method)) ! ((and (stringp (car method)) group) ! (gnus-server-extend-method group method)) ! (t ! (gnus-server-add-address method)))) ! ! (defun gnus-server-add-address (method) ! (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))) ! (append method (list (list (intern (concat method-name "-address")) ! (nth 1 method)))) ! method))) ! ! (defun gnus-server-equal (s1 s2) ! (or (equal s1 s2) ! (and (= (length s1) (length s2)) ! (progn ! (while (and s1 (member (car s1) s2)) ! (setq s1 (cdr s1))) ! (null s1))))) ! ! ;;; Interactive server functions. ! ! (defun gnus-server-kill-server (server) ! "Kill the server on the current line." ! (interactive (list (gnus-server-server-name))) ! (or (gnus-server-goto-server server) ! (if server (error "No such server: %s" server) ! (error "No server on the current line"))) ! (gnus-dribble-enter "") ! (let ((buffer-read-only nil)) ! (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point)))) ! (setq gnus-server-killed-servers ! (cons (assoc server gnus-server-alist) gnus-server-killed-servers)) ! (setq gnus-server-alist (delq (car gnus-server-killed-servers) ! gnus-server-alist)) ! (gnus-server-position-cursor)) ! ! (defun gnus-server-yank-server () ! "Yank the previously killed server." ! (interactive) ! (or gnus-server-killed-servers ! (error "No killed servers to be yanked")) ! (let ((alist gnus-server-alist) ! (server (gnus-server-server-name)) ! (killed (car gnus-server-killed-servers))) ! (if (not server) ! (setq gnus-server-alist (nconc gnus-server-alist (list killed))) ! (if (string= server (car (car gnus-server-alist))) ! (setq gnus-server-alist (cons killed gnus-server-alist)) ! (while (and (cdr alist) ! (not (string= server (car (car (cdr alist)))))) ! (setq alist (cdr alist))) ! (setcdr alist (cons killed (cdr alist))))) ! (gnus-server-update-server (car killed)) ! (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) ! (gnus-server-position-cursor))) ! ! (defun gnus-server-exit () ! "Return to the group buffer." ! (interactive) ! (kill-buffer (current-buffer)) ! (switch-to-buffer gnus-group-buffer)) ! ! (defun gnus-server-list-servers () ! "List all available servers." ! (interactive) ! (let ((cur (gnus-server-server-name))) ! (gnus-server-prepare) ! (if cur (gnus-server-goto-server cur) ! (goto-char (point-max)) ! (forward-line -1)) ! (gnus-server-position-cursor))) ! ! (defun gnus-server-copy-server (from to) ! (interactive ! (list ! (or (gnus-server-server-name) ! (error "No server on the current line")) ! (read-string "Copy to: "))) ! (or from (error "No server on current line")) ! (or (and to (not (string= to ""))) (error "No name to copy to")) ! (and (assoc to gnus-server-alist) (error "%s already exists" to)) ! (or (assoc from gnus-server-alist) ! (error "%s: no such server" from)) ! (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist)))) ! (setcar to-entry to) ! (setcar (nthcdr 2 to-entry) to) ! (setq gnus-server-killed-servers ! (cons to-entry gnus-server-killed-servers)) ! (gnus-server-yank-server))) ! ! (defun gnus-server-add-server (how where) ! (interactive ! (list (intern (completing-read "Server method: " ! gnus-valid-select-methods nil t)) ! (read-string "Server name: "))) ! (setq gnus-server-killed-servers ! (cons (list where how where) gnus-server-killed-servers)) ! (gnus-server-yank-server)) ! ! (defun gnus-server-goto-server (server) ! "Jump to a server line." ! (interactive ! (list (completing-read "Goto server: " gnus-server-alist nil t))) ! (let ((to (text-property-any (point-min) (point-max) ! 'gnus-server (intern server)))) ! (and to ! (progn ! (goto-char to) ! (gnus-server-position-cursor))))) ! ! (defun gnus-server-edit-server (server) ! "Edit the server on the current line." ! (interactive (list (gnus-server-server-name))) ! (or server ! (error "No server on current line")) ! (let ((winconf (current-window-configuration))) ! (get-buffer-create gnus-server-edit-buffer) ! (gnus-configure-windows 'edit-server) ! (gnus-add-current-to-buffer-list) ! (emacs-lisp-mode) ! (make-local-variable 'gnus-prev-winconf) ! (setq gnus-prev-winconf winconf) ! (use-local-map (copy-keymap (current-local-map))) ! (let ((done-func '(lambda () ! "Exit editing mode and update the information." ! (interactive) ! (gnus-server-edit-server-done 'group)))) ! (setcar (cdr (nth 4 done-func)) server) ! (local-set-key "\C-c\C-c" done-func)) ! (erase-buffer) ! (insert ";; Type `C-c C-c' after you have edited the server.\n\n") ! (insert (pp-to-string (cdr (assoc server gnus-server-alist)))))) ! ! (defun gnus-server-edit-server-done (server) ! (interactive) ! (set-buffer (get-buffer-create gnus-server-edit-buffer)) ! (goto-char (point-min)) ! (let ((form (read (current-buffer))) ! (winconf gnus-prev-winconf)) ! (gnus-server-set-info server form) ! (kill-buffer (current-buffer)) ! (and winconf (set-window-configuration winconf)) ! (set-buffer gnus-server-buffer) ! (gnus-server-update-server (gnus-server-server-name)) ! (gnus-server-list-servers) ! (gnus-server-position-cursor))) ! ! (defun gnus-server-read-server (server) ! "Browse a server." ! (interactive (list (gnus-server-server-name))) ! (gnus-browse-foreign-server (gnus-server-to-method server) (current-buffer))) ! ! (defun gnus-mouse-pick-server (e) ! (interactive "e") ! (mouse-set-point e) ! (gnus-server-read-server (gnus-server-server-name))) ;;; ! ;;; entry points into gnus-score.el ;;; ! ;;; Finding score files. ! (defvar gnus-global-score-files nil ! "*List of global score files and directories. ! Set this variable if you want to use people's score files. One entry ! for each score file or each score file directory. Gnus will decide ! by itself what score files are applicable to which group. ! ! Say you want to use the single score file ! \"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all ! score files in the \"/ftp.some-where:/pub/score\" directory. ! ! (setq gnus-global-score-files ! '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\" ! \"/ftp.some-where:/pub/score\"))") ! ! (defun gnus-score-score-files (group) ! "Return a list of all possible score files." ! ;; Search and set any global score files. ! (and gnus-global-score-files ! (or 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 ! (file-name-as-directory ! (or gnus-kill-files-directory "~/News/"))) ! ;; 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 (gnus-use-long-file-name 'not-score) ! ;; We want long file names. ! (if (or (not gnus-score-file-list) ! (not (car gnus-score-file-list)) ! (gnus-file-newer-than gnus-kill-files-directory ! (car 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 ! (gnus-score-file-regexp)))))) ! ;; We do not use long file names, so we have to do some ! ;; directory traversing. ! (let ((mdir (length (expand-file-name gnus-kill-files-directory))) ! (suffixes (list gnus-score-file-suffix gnus-adaptive-file-suffix)) ! dir files suffix) ! (while suffixes ! (setq dir (expand-file-name ! (concat gnus-kill-files-directory ! (gnus-replace-chars-in-string group ?. ?/)))) ! (setq dir (gnus-replace-chars-in-string dir ?: ?/)) ! (setq suffix (car suffixes) ! suffixes (cdr suffixes)) ! (if (file-exists-p (concat dir "/" suffix)) ! (setq files (cons (concat dir "/" suffix) files))) ! (while (>= (1+ (length dir)) mdir) ! (and (file-exists-p (concat dir "/all/" suffix)) ! (setq files (cons (concat dir "/all/" suffix) files))) ! (string-match "/[^/]*$" dir) ! (setq dir (substring dir 0 (match-beginning 0))))) ! (setq gnus-score-file-list ! (cons nil (nreverse files))))) ! (cdr gnus-score-file-list))) ! ! (defun gnus-score-file-regexp () ! (concat "\\(" gnus-score-file-suffix ! "\\|" 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 ! (expand-file-name gnus-kill-files-directory))) ! (klen (length kill-dir)) ! ofiles not-match regexp) ! (save-excursion ! (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. ! (while sfiles ! (erase-buffer) ! (insert (car sfiles)) ! (goto-char (point-min)) ! ;; First remove the suffix itself. ! (re-search-forward (concat "." (gnus-score-file-regexp))) ! (replace-match "" t t) ! (goto-char (point-min)) ! (if (looking-at (regexp-quote kill-dir)) ! ;; If the file name was just "SCORE", `klen' is one character ! ;; too much. ! (delete-char (min (1- (point-max)) klen)) (goto-char (point-max)) ! (search-backward "/") ! (delete-region (1+ (point)) (point-min))) ! ;; If short file names were used, we have to translate slashes. ! (goto-char (point-min)) ! (while (re-search-forward "[/:]" nil t) ! (replace-match "." t t)) ! ;; Kludge to get rid of "nntp+" problems. ! (goto-char (point-min)) ! (and (looking-at "nn[a-z]+\\+") ! (progn ! (search-forward "+") ! (forward-char -1) ! (insert "\\"))) ! ;; Translate ".all" to "[./].*"; ! (while (search-forward ".all" nil t) ! (replace-match "[./:].*" t t)) ! (goto-char (point-min)) ! ;; Translate "all" to ".*". ! (while (search-forward "all" nil t) ! (replace-match ".*" t t)) ! (goto-char (point-min)) ! ;; Deal with "not."s. ! (if (looking-at "not.") ! (progn ! (setq not-match t) ! (setq regexp (buffer-substring 5 (point-max)))) ! (setq regexp (buffer-substring 1 (point-max))) ! (setq not-match nil)) ! ;; Finally - if this resulting regexp matches the group name, ! ;; we add this score file to the list of score files ! ;; applicable to this group. ! (if (or (and not-match ! (not (string-match regexp group))) ! (and (not not-match) ! (string-match regexp group))) ! (setq ofiles (cons (car sfiles) ofiles))) ! (setq sfiles (cdr sfiles))) ! (kill-buffer (current-buffer)) ! ;; Slight kludge here - the last score file returned should be ! ;; the local score file, whether it exists or not. This is so ! ;; that any score commands the user enters will go to the right ! ;; file, and not end up in some global score file. ! (let ((localscore ! (expand-file-name ! (if (gnus-use-long-file-name 'not-score) ! (concat gnus-kill-files-directory group "." ! gnus-score-file-suffix) ! (concat gnus-kill-files-directory ! (gnus-replace-chars-in-string group ?. ?/ ?: ?/) ! "/" gnus-score-file-suffix))))) ! ;; The local score file might already be there, but it's ! ;; supposed to be the very last file, so we delete it from the ! ;; list if it's already there, and add it to the head of the ! ;; list. ! (setq ofiles (cons localscore (delete localscore ofiles)))) ! (nreverse ofiles)))) ! ! (defun gnus-score-find-single (group) ! "Return list containing the score file for GROUP." ! (list (gnus-score-file-name group gnus-adaptive-file-suffix) ! (gnus-score-file-name group))) ! ! (defun gnus-score-find-hierarchical (group) ! "Return list of score files for GROUP. ! This includes the score file for the group and all its parents." ! (let ((all (copy-sequence '(nil))) ! (start 0)) ! (while (string-match "\\." group (1+ start)) ! (setq start (match-beginning 0)) ! (setq all (cons (substring group 0 start) all))) ! (setq all (cons group all)) ! (nconc ! (mapcar (lambda (newsgroup) ! (gnus-score-file-name newsgroup gnus-adaptive-file-suffix)) ! (setq all (nreverse all))) ! (mapcar 'gnus-score-file-name all)))) ! ! (defvar gnus-score-file-alist-cache nil) ! ! (defun gnus-score-find-alist (group) ! "Return list of score files for GROUP. ! The list is determined from the variable gnus-score-file-alist." ! (let ((alist gnus-score-file-multiple-match-alist) ! score-files) ! ;; if this group has been seen before, return the cached entry ! (if (setq score-files (assoc group gnus-score-file-alist-cache)) ! (cdr score-files) ;ensures caching groups with no matches ! ;; handle the multiple match alist ! (while alist ! (and (string-match (car (car alist)) group) ! (setq score-files ! (nconc score-files (copy-sequence (cdr (car alist)))))) ! (setq alist (cdr alist))) ! (setq alist gnus-score-file-single-match-alist) ! ;; handle the single match alist ! (while alist ! (and (string-match (car (car alist)) group) ! ;; 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 ! (progn ! (setq score-files ! (nconc score-files (copy-sequence (cdr (car alist))))) ! (setq alist nil))) ! (setq alist (cdr alist))) ! ;; cache the score files ! (setq gnus-score-file-alist-cache ! (cons (cons group score-files) gnus-score-file-alist-cache)) ! score-files))) ! ! ! (defun gnus-possibly-score-headers (&optional trace) ! (let ((func gnus-score-find-score-files-function) ! score-files) ! (and func (not (listp func)) ! (setq func (list func))) ! ;; Go through all the functions for finding score files (or actual ! ;; scores) and add them to a list. ! (setq score-files (gnus-score-find-alist gnus-newsgroup-name)) ! (while func ! (and (symbolp (car func)) ! (fboundp (car func)) ! (setq score-files ! (nconc score-files (funcall (car func) gnus-newsgroup-name)))) ! (setq func (cdr func))) ! (if score-files (gnus-score-headers score-files trace)))) ! ! (defun gnus-score-file-name (newsgroup &optional suffix) ! "Return the name of a score file for NEWSGROUP." ! (let ((suffix (or suffix gnus-score-file-suffix))) ! (cond ! ((or (null newsgroup) ! (string-equal newsgroup "")) ! ;; The global score file is placed at top of the directory. ! (expand-file-name ! suffix (or gnus-kill-files-directory "~/News"))) ! ((gnus-use-long-file-name 'not-score) ! ;; Append ".SCORE" to newsgroup name. ! (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) ! "." suffix) ! (or gnus-kill-files-directory "~/News"))) ! (t ! ;; Place "SCORE" under the hierarchical directory. ! (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) ! "/" suffix) ! (or gnus-kill-files-directory "~/News")))))) ! ! (defun gnus-score-search-global-directories (files) ! "Scan all global score directories for score files." ! ;; Set the variable `gnus-internal-global-score-files' to all ! ;; available global score files. ! (interactive (list gnus-global-score-files)) ! (let (out) ! (while files ! (if (string-match "/$" (car files)) ! (setq out (nconc (directory-files ! (car files) t ! (concat (gnus-score-file-regexp) "$")))) ! (setq out (cons (car files) out))) ! (setq files (cdr files))) ! (setq gnus-internal-global-score-files out))) ;; Allow redefinition of Gnus functions. --- 17096,17265 ---- nil) (t ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (when (or (search-forward "\n.\n" nil t) (goto-char (point-max))) ! (beginning-of-line) ! (narrow-to-region (point-min) (point))) ! ;; If these are groups from a foreign select method, we insert the ! ;; group prefix in front of the group names. ! (and method (not (gnus-server-equal ! (gnus-server-get-method nil method) ! (gnus-server-get-method nil gnus-select-method))) ! (let ((prefix (gnus-group-prefixed-name "" method))) ! (goto-char (point-min)) ! (while (and (not (eobp)) ! (progn (insert prefix) ! (zerop (forward-line 1))))))) ! (goto-char (point-min)) ! (while (not (eobp)) ! ;; If we get an error, we set group to 0, which is not a ! ;; symbol... ! (setq group ! (condition-case () ! (let ((obarray gnus-description-hashtb)) ! ;; Group is set to a symbol interned in this ! ;; hash table. ! (read nntp-server-buffer)) ! (error 0))) ! (skip-chars-forward " \t") ! ;; ... which leads to this line being effectively ignored. ! (and (symbolp group) ! (set group (buffer-substring ! (point) (progn (end-of-line) (point))))) ! (forward-line 1)))) ! (gnus-message 5 "Reading descriptions file...done") ! t)))) (defun gnus-group-get-description (group) ! "Get the description of a group by sending XGTITLE to the server." ! (when (gnus-request-group-description group) (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") ! (match-string 1))))) + ;;; ! ;;; Buffering of read articles. ;;; ! (defvar gnus-backlog-buffer " *Gnus Backlog*") ! (defvar gnus-backlog-articles nil) ! (defvar gnus-backlog-hashtb nil) ! ! (defun gnus-backlog-buffer () ! "Return the backlog buffer." ! (or (get-buffer gnus-backlog-buffer) ! (save-excursion ! (set-buffer (get-buffer-create gnus-backlog-buffer)) ! (buffer-disable-undo (current-buffer)) ! (setq buffer-read-only t) ! (gnus-add-current-to-buffer-list) ! (get-buffer gnus-backlog-buffer)))) ! (defun gnus-backlog-setup () ! "Initialize backlog variables." ! (unless gnus-backlog-hashtb ! (setq gnus-backlog-hashtb (make-vector 1023 0)))) ! ! (gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) ! ! (defun gnus-backlog-shutdown () ! "Clear all backlog variables and buffers." ! (when (get-buffer gnus-backlog-buffer) ! (kill-buffer gnus-backlog-buffer)) ! (setq gnus-backlog-hashtb nil ! gnus-backlog-articles nil)) ! ! (defun gnus-backlog-enter-article (group number buffer) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) ! b) ! (if (memq ident gnus-backlog-articles) ! () ; It's already kept. ! ;; Remove the oldest article, if necessary. ! (and (numberp gnus-keep-backlog) ! (>= (length gnus-backlog-articles) gnus-keep-backlog) ! (gnus-backlog-remove-oldest-article)) ! (setq gnus-backlog-articles (cons ident gnus-backlog-articles)) ! ;; Insert the new article. ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (let (buffer-read-only) (goto-char (point-max)) ! (or (bolp) (insert "\n")) ! (setq b (point)) ! (insert-buffer-substring buffer) ! ;; Tag the beginning of the article with the ident. ! (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) ! ! (defun gnus-backlog-remove-oldest-article () ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (goto-char (point-min)) ! (if (zerop (buffer-size)) ! () ; The buffer is empty. ! (let ((ident (get-text-property (point) 'gnus-backlog)) ! buffer-read-only) ! ;; Remove the ident from the list of articles. ! (when ident ! (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ! ;; Delete the article itself. ! (delete-region ! (point) (next-single-property-change ! (1+ (point)) 'gnus-backlog nil (point-max))))))) ! ! (defun gnus-backlog-remove-article (group number) ! "Remove article NUMBER in GROUP from the backlog." ! (when (numberp number) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) ! beg end) ! (when (memq ident gnus-backlog-articles) ! ;; It was in the backlog. ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (let (buffer-read-only) ! (when (setq beg (text-property-any ! (point-min) (point-max) 'gnus-backlog ! ident)) ! ;; Find the end (i. e., the beginning of the next article). ! (setq end ! (next-single-property-change ! (1+ beg) 'gnus-backlog (current-buffer) (point-max))) ! (delete-region beg end) ! ;; Return success. ! t))))))) ! ! (defun gnus-backlog-request-article (group number buffer) ! (when (numberp number) ! (gnus-backlog-setup) ! (let ((ident (intern (concat group ":" (int-to-string number)) ! gnus-backlog-hashtb)) ! beg end) ! (when (memq ident gnus-backlog-articles) ! ;; It was in the backlog. ! (save-excursion ! (set-buffer (gnus-backlog-buffer)) ! (if (not (setq beg (text-property-any ! (point-min) (point-max) 'gnus-backlog ! ident))) ! ;; It wasn't in the backlog after all. ! (ignore ! (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) ! ;; Find the end (i. e., the beginning of the next article). ! (setq end ! (next-single-property-change ! (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) ! (let ((buffer-read-only nil)) ! (erase-buffer) ! (insert-buffer-substring gnus-backlog-buffer beg end) ! t))))) ;; Allow redefinition of Gnus functions. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/goto-addr.el emacs-19.32/lisp/goto-addr.el *** emacs-19.31/lisp/goto-addr.el Mon Apr 15 23:56:08 1996 --- emacs-19.32/lisp/goto-addr.el Fri Jun 28 03:45:58 1996 *************** and `goto-address-send-using-mh-e' (MH-E *** 107,110 **** --- 107,122 ---- "keymap to hold goto-addr's mouse key defs under highlighted URLs.") + (defvar goto-address-url-face 'bold + "*Face to use for URLs.") + + (defvar goto-address-url-mouse-face 'highlight + "*Face to use for URLs when the mouse is on them.") + + (defvar goto-address-mail-face 'italic + "*Face to use for e-mail addresses.") + + (defvar goto-address-mail-mouse-face 'secondary-selection + "*Face to use for e-mail addresses when the mouse is on them.") + (defun goto-address-fontify () "Fontify the URL's and e-mail addresses in the current buffer. *************** and `goto-address-fontify-p'." *** 121,128 **** (let ((s (match-beginning 0)) (e (match-end 0))) - (goto-char e) (and goto-address-fontify-p ! (put-text-property s e 'face 'bold)) ! (put-text-property s e 'mouse-face 'highlight) (put-text-property s e 'local-map goto-address-highlight-keymap))) --- 133,139 ---- (let ((s (match-beginning 0)) (e (match-end 0))) (and goto-address-fontify-p ! (put-text-property s e 'face goto-address-url-face)) ! (put-text-property s e 'mouse-face goto-address-url-mouse-face) (put-text-property s e 'local-map goto-address-highlight-keymap))) *************** and `goto-address-fontify-p'." *** 131,140 **** (let ((s (match-beginning 0)) (e (match-end 0))) - (goto-char (match-end 0)) (and goto-address-fontify-p ! (put-text-property (match-beginning 0) (match-end 0) ! 'face 'italic)) ! (put-text-property (match-beginning 0) (match-end 0) ! 'mouse-face 'secondary-selection) (put-text-property s e 'local-map goto-address-highlight-keymap))))) --- 142,148 ---- (let ((s (match-beginning 0)) (e (match-end 0))) (and goto-address-fontify-p ! (put-text-property s e 'face goto-address-mail-face)) ! (put-text-property s e 'mouse-face goto-address-mail-mouse-face) (put-text-property s e 'local-map goto-address-highlight-keymap))))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gud.el emacs-19.32/lisp/gud.el *** emacs-19.31/lisp/gud.el Thu May 9 22:39:31 1996 --- emacs-19.32/lisp/gud.el Thu Aug 1 18:36:10 1996 *************** *** 5,9 **** ;; Keywords: unix, tools ! ;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. --- 5,9 ---- ;; Keywords: unix, tools ! ;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. *************** containing the executable being debugged *** 649,655 **** ;; d.love@dl.ac.uk (Dave Love) can be blamed for this ! (defvar gud-irix-p (string-match "^mips-[^-]*-irix" system-configuration) "Non-nil to assume the interface appropriate for IRIX dbx. ! This works in IRIX 4, 5 and 6.") ;; [Irix dbx seems to be a moving target. The dbx output changed ;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, --- 649,663 ---- ;; d.love@dl.ac.uk (Dave Love) can be blamed for this ! (defvar gud-irix-p ! (and (string-match "^mips-[^-]*-irix" system-configuration) ! (not (string-match "irix[6-9]\\.[1-9]" system-configuration))) "Non-nil to assume the interface appropriate for IRIX dbx. ! This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides ! a better solution in 6.1 upwards.") ! (defvar gud-dbx-use-stopformat-p ! (string-match "irix[6-9]\\.[1-9]" system-configuration) ! "Non-nil to use the dbx feature present at least from Irix 6.1 ! whereby $stopformat=1 produces an output format compatiable with ! `gud-dbx-marker-filter'.") ;; [Irix dbx seems to be a moving target. The dbx output changed ;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance, *************** This works in IRIX 4, 5 and 6.") *** 658,663 **** ;; exclusively) . For 5.3 and 6.0, the $curline variable changed to ;; `long long'(why?!), so the printf stuff needed changing. The line ! ;; number is cast to `long' as a compromise between the new `long ! ;; long' and the original `int'. The process filter is also somewhat ;; unreliable, sometimes not spotting the markers; I don't know ;; whether there's anything that can be done about that. It would be --- 666,677 ---- ;; exclusively) . For 5.3 and 6.0, the $curline variable changed to ;; `long long'(why?!), so the printf stuff needed changing. The line ! ;; number was cast to `long' as a compromise between the new `long ! ;; long' and the original `int'. This is reported not to work in 6.2, ! ;; so it's changed back to int -- don't make your sources too long. ! ;; From Irix6.1 (but not 6.0?) dbx supports an undocumented feature ! ;; whereby `set $stopformat=1' reportedly produces output compatible ! ;; with `gud-dbx-marker-filter', which we prefer. ! ! ;; The process filter is also somewhat ;; unreliable, sometimes not spotting the markers; I don't know ;; whether there's anything that can be done about that. It would be *************** This works in IRIX 4, 5 and 6.") *** 686,690 **** ;; name in a form we can grok as below (process-send-string (get-buffer-process gud-comint-buffer) ! "printf \"\032\032%1d:\",(long)$curline;file\n")) ;; look for result of, say, "up" e.g.: ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c] --- 700,704 ---- ;; name in a form we can grok as below (process-send-string (get-buffer-process gud-comint-buffer) ! "printf \"\032\032%1d:\",(int)$curline;file\n")) ;; look for result of, say, "up" e.g.: ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c] *************** and source-file directory for your debug *** 765,775 **** "\C-b" "Set breakpoint at current line.") (gud-def gud-finish "return" "\C-f" "Finish executing current function.") ! (gud-def gud-up "up %p; printf \"\032\032%1ld:\",(long)$curline;file\n" "<" "Up (numeric arg) stack frames.") ! (gud-def gud-down "down %p; printf \"\032\032%1ld:\",(long)$curline;file\n" ">" "Down (numeric arg) stack frames.") ;; Make dbx give out the source location info that we need. (process-send-string (get-buffer-process gud-comint-buffer) ! "printf \"\032\032%1d:\",(long)$curline;file\n")) (t (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") --- 779,792 ---- "\C-b" "Set breakpoint at current line.") (gud-def gud-finish "return" "\C-f" "Finish executing current function.") ! (gud-def gud-up "up %p; printf \"\032\032%1d:\",(int)$curline;file\n" "<" "Up (numeric arg) stack frames.") ! (gud-def gud-down "down %p; printf \"\032\032%1d:\",(int)$curline;file\n" ">" "Down (numeric arg) stack frames.") ;; Make dbx give out the source location info that we need. (process-send-string (get-buffer-process gud-comint-buffer) ! "printf \"\032\032%1d:\",(int)$curline;file\n")) ! (gud-dbx-use-stopformat-p ! (process-send-string (get-buffer-process gud-comint-buffer) ! "set $stopformat=1\n")) (t (gud-def gud-up "up %p" "<" "Up (numeric arg) stack frames.") *************** directories if your program contains sou *** 973,976 **** --- 990,996 ---- buf))) + (defvar perldb-command-name "perl" + "File name for executing Perl.") + ;;;###autoload (defun perldb (command-line) *************** and source-file directory for your debug *** 982,986 **** (if (consp gud-perldb-history) (car gud-perldb-history) ! "perl ") nil nil '(gud-perldb-history . 1)))) --- 1002,1006 ---- (if (consp gud-perldb-history) (car gud-perldb-history) ! (concat perldb-command-name " ")) nil nil '(gud-perldb-history . 1)))) *************** Obeying it means displaying in another w *** 1336,1355 **** (set-buffer gud-comint-buffer)) (gud-find-file true-file))) ! (window (display-buffer buffer)) (pos)) ! (save-excursion ! (set-buffer buffer) ! (save-restriction ! (widen) ! (goto-line line) ! (setq pos (point)) ! (setq overlay-arrow-string "=>") ! (or overlay-arrow-position ! (setq overlay-arrow-position (make-marker))) ! (set-marker overlay-arrow-position (point) (current-buffer))) ! (cond ((or (< pos (point-min)) (> pos (point-max))) ! (widen) ! (goto-char pos)))) ! (set-window-point window overlay-arrow-position))) ;;; The gud-call function must do the right thing whether its invoking --- 1356,1377 ---- (set-buffer gud-comint-buffer)) (gud-find-file true-file))) ! (window (and buffer (display-buffer buffer))) (pos)) ! (if buffer ! (progn ! (save-excursion ! (set-buffer buffer) ! (save-restriction ! (widen) ! (goto-line line) ! (setq pos (point)) ! (setq overlay-arrow-string "=>") ! (or overlay-arrow-position ! (setq overlay-arrow-position (make-marker))) ! (set-marker overlay-arrow-position (point) (current-buffer))) ! (cond ((or (< pos (point-min)) (> pos (point-max))) ! (widen) ! (goto-char pos)))) ! (set-window-point window overlay-arrow-position))))) ;;; The gud-call function must do the right thing whether its invoking diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/gulp.el emacs-19.32/lisp/gulp.el *** emacs-19.31/lisp/gulp.el Fri May 10 01:55:04 1996 --- emacs-19.32/lisp/gulp.el Sat Jul 20 13:28:31 1996 *************** *** 20,25 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 20,26 ---- ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/help.el emacs-19.32/lisp/help.el *** emacs-19.31/lisp/help.el Mon Mar 18 01:44:13 1996 --- emacs-19.32/lisp/help.el Wed Jul 31 14:15:40 1996 *************** *** 92,111 **** (defvar help-font-lock-keywords ! (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) ! (list ! ;; ! ;; The symbol itself. ! (list (concat "\\`\\(" name-char "+\\)\\(:\\)?") ! '(1 (if (match-beginning 2) ! font-lock-function-name-face ! font-lock-variable-name-face) ! nil t)) ! ;; ! ;; Words inside `' which tend to be symbol names. ! (list (concat "`\\(" sym-char sym-char "+\\)'") ! 1 'font-lock-reference-face t) ! ;; ! ;; CLisp `:' keywords as references. ! (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))) "Default expressions to highlight in Help mode.") --- 92,112 ---- (defvar help-font-lock-keywords ! (eval-when-compile ! (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]")) ! (list ! ;; ! ;; The symbol itself. ! (list (concat "\\`\\(" name-char "+\\)\\(\\(:\\)\\|\\('\\)\\)") ! '(1 (if (match-beginning 3) ! font-lock-function-name-face ! font-lock-variable-name-face) ! nil t)) ! ;; ! ;; Words inside `' which tend to be symbol names. ! (list (concat "`\\(" sym-char sym-char "+\\)'") ! 1 'font-lock-reference-face t) ! ;; ! ;; CLisp `:' keywords as references. ! (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t)))) "Default expressions to highlight in Help mode.") *************** describes the minor mode." *** 316,319 **** --- 317,321 ---- (with-output-to-temp-buffer "*Help*" (let ((minor-modes minor-mode-alist) + (first t) (locals (buffer-local-variables))) (while minor-modes *************** describes the minor mode." *** 335,338 **** --- 337,344 ---- (while (and indicator (symbolp indicator)) (setq indicator (symbol-value indicator))) + (if first + (princ "The minor modes are described first, + followed by the major mode, which is described on the last page.\n\f\n")) + (setq first nil) (princ (format "%s minor mode (%s):\n" pretty-minor-mode *************** describes the minor mode." *** 341,345 **** "no indicator"))) (princ (documentation minor-mode)) ! (princ "\n\n")))) (setq minor-modes (cdr minor-modes)))) (princ mode-name) --- 347,351 ---- "no indicator"))) (princ (documentation minor-mode)) ! (princ "\n\f\n")))) (setq minor-modes (cdr minor-modes)))) (princ mode-name) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/hexl.el emacs-19.32/lisp/hexl.el *** emacs-19.31/lisp/hexl.el Sun Mar 31 20:40:08 1996 --- emacs-19.32/lisp/hexl.el Mon Jun 10 17:36:07 1996 *************** You can use \\[hexl-find-file] to visit *** 164,167 **** --- 164,183 ---- (error "You are already in hexl mode") + (let ((modified (buffer-modified-p)) + (inhibit-read-only t) + (original-point (1- (point))) + max-address) + (and (eobp) (not (bobp)) + (setq original-point (1- original-point))) + (if (not (or (eq arg 1) (not arg))) + ;; if no argument then we guess at hexl-max-address + (setq max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15)) + (setq max-address (1- (buffer-size))) + (hexlify-buffer) + (set-buffer-modified-p modified)) + (make-local-variable 'hexl-max-address) + (setq hexl-max-address max-address) + (hexl-goto-address original-point)) + ;; We do not turn off the old major mode; instead we just ;; override most of it. That way, we can restore it perfectly. *************** You can use \\[hexl-find-file] to visit *** 197,216 **** (make-local-hook 'change-major-mode-hook) ! (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t) ! ! (make-local-variable 'hexl-max-address) ! ! (let ((modified (buffer-modified-p)) ! (inhibit-read-only t) ! (original-point (1- (point)))) ! (and (eobp) (not (bobp)) ! (setq original-point (1- original-point))) ! (if (not (or (eq arg 1) (not arg))) ! ;; if no argument then we guess at hexl-max-address ! (setq hexl-max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15)) ! (setq hexl-max-address (1- (buffer-size))) ! (hexlify-buffer) ! (set-buffer-modified-p modified) ! (hexl-goto-address original-point))))) (defun hexl-after-revert-hook () --- 213,218 ---- (make-local-hook 'change-major-mode-hook) ! (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t)) ! (run-hooks 'hexl-mode-hook)) (defun hexl-after-revert-hook () *************** This discards the buffer's undo informat *** 680,781 **** (if hexl-mode-map nil ! (setq hexl-mode-map (make-sparse-keymap)) ! (define-key hexl-mode-map [left] 'hexl-backward-char) ! (define-key hexl-mode-map [right] 'hexl-forward-char) ! (define-key hexl-mode-map [up] 'hexl-previous-line) ! (define-key hexl-mode-map [down] 'hexl-next-line) ! (define-key hexl-mode-map [M-left] 'hexl-backward-short) ! (define-key hexl-mode-map [M-right] 'hexl-forward-short) ! (define-key hexl-mode-map [next] 'hexl-scroll-up) ! (define-key hexl-mode-map [prev] 'hexl-scroll-down) ! ! (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line) ! (define-key hexl-mode-map "\C-b" 'hexl-backward-char) ! (define-key hexl-mode-map "\C-d" 'undefined) ! (define-key hexl-mode-map "\C-e" 'hexl-end-of-line) ! (define-key hexl-mode-map "\C-f" 'hexl-forward-char) ! ! (if (not (eq (key-binding (char-to-string help-char)) 'help-command)) ! (define-key hexl-mode-map (char-to-string help-char) 'undefined)) ! ! (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command) ! (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command) ! (define-key hexl-mode-map "\C-k" 'undefined) ! (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command) ! (define-key hexl-mode-map "\C-n" 'hexl-next-line) ! (define-key hexl-mode-map "\C-o" 'undefined) ! (define-key hexl-mode-map "\C-p" 'hexl-previous-line) ! (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert) ! (define-key hexl-mode-map "\C-t" 'undefined) ! (define-key hexl-mode-map "\C-v" 'hexl-scroll-up) ! (define-key hexl-mode-map "\C-w" 'undefined) ! (define-key hexl-mode-map "\C-y" 'undefined) ! ! (let ((ch 32)) ! (while (< ch 127) ! (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command) ! (setq ch (1+ ch)))) ! ! (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page) ! (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short) ! (define-key hexl-mode-map "\e\C-c" 'undefined) ! (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char) ! (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page) ! (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short) ! (define-key hexl-mode-map "\e\C-g" 'undefined) ! (define-key hexl-mode-map "\e\C-h" 'undefined) ! (define-key hexl-mode-map "\e\C-i" 'undefined) ! (define-key hexl-mode-map "\e\C-j" 'undefined) ! (define-key hexl-mode-map "\e\C-k" 'undefined) ! (define-key hexl-mode-map "\e\C-l" 'undefined) ! (define-key hexl-mode-map "\e\C-m" 'undefined) ! (define-key hexl-mode-map "\e\C-n" 'undefined) ! (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char) ! (define-key hexl-mode-map "\e\C-p" 'undefined) ! (define-key hexl-mode-map "\e\C-q" 'undefined) ! (define-key hexl-mode-map "\e\C-r" 'undefined) ! (define-key hexl-mode-map "\e\C-s" 'undefined) ! (define-key hexl-mode-map "\e\C-t" 'undefined) ! (define-key hexl-mode-map "\e\C-u" 'undefined) ! ! (define-key hexl-mode-map "\e\C-w" 'undefined) ! (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char) ! (define-key hexl-mode-map "\e\C-y" 'undefined) ! ! (define-key hexl-mode-map "\ea" 'undefined) ! (define-key hexl-mode-map "\eb" 'hexl-backward-word) ! (define-key hexl-mode-map "\ec" 'undefined) ! (define-key hexl-mode-map "\ed" 'undefined) ! (define-key hexl-mode-map "\ee" 'undefined) ! (define-key hexl-mode-map "\ef" 'hexl-forward-word) ! (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address) ! (define-key hexl-mode-map "\eh" 'undefined) ! (define-key hexl-mode-map "\ei" 'undefined) ! (define-key hexl-mode-map "\ej" 'hexl-goto-address) ! (define-key hexl-mode-map "\ek" 'undefined) ! (define-key hexl-mode-map "\el" 'undefined) ! (define-key hexl-mode-map "\em" 'undefined) ! (define-key hexl-mode-map "\en" 'undefined) ! (define-key hexl-mode-map "\eo" 'undefined) ! (define-key hexl-mode-map "\ep" 'undefined) ! (define-key hexl-mode-map "\eq" 'undefined) ! (define-key hexl-mode-map "\er" 'undefined) ! (define-key hexl-mode-map "\es" 'undefined) ! (define-key hexl-mode-map "\et" 'undefined) ! (define-key hexl-mode-map "\eu" 'undefined) ! (define-key hexl-mode-map "\ev" 'hexl-scroll-down) ! (define-key hexl-mode-map "\ey" 'undefined) ! (define-key hexl-mode-map "\ez" 'undefined) ! (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer) ! (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer) ! ! (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit) ! ! (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page) ! (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page) ! (define-key hexl-mode-map "\C-x\C-p" 'undefined) ! (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer) ! (define-key hexl-mode-map "\C-x\C-t" 'undefined)) ;;; hexl.el ends here --- 682,789 ---- (if hexl-mode-map nil ! (setq hexl-mode-map (make-sparse-keymap)) ! (define-key hexl-mode-map [left] 'hexl-backward-char) ! (define-key hexl-mode-map [right] 'hexl-forward-char) ! (define-key hexl-mode-map [up] 'hexl-previous-line) ! (define-key hexl-mode-map [down] 'hexl-next-line) ! (define-key hexl-mode-map [M-left] 'hexl-backward-short) ! (define-key hexl-mode-map [M-right] 'hexl-forward-short) ! (define-key hexl-mode-map [next] 'hexl-scroll-up) ! (define-key hexl-mode-map [prior] 'hexl-scroll-down) ! (define-key hexl-mode-map [home] 'hexl-beginning-of-buffer) ! (define-key hexl-mode-map [deletechar] 'undefined) ! (define-key hexl-mode-map [deleteline] 'undefined) ! (define-key hexl-mode-map [insertline] 'undefined) ! (define-key hexl-mode-map [S-delete] 'undefined) ! (define-key hexl-mode-map "\177" 'undefined) ! ! (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line) ! (define-key hexl-mode-map "\C-b" 'hexl-backward-char) ! (define-key hexl-mode-map "\C-d" 'undefined) ! (define-key hexl-mode-map "\C-e" 'hexl-end-of-line) ! (define-key hexl-mode-map "\C-f" 'hexl-forward-char) ! ! (if (not (eq (key-binding (char-to-string help-char)) 'help-command)) ! (define-key hexl-mode-map (char-to-string help-char) 'undefined)) ! ! (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command) ! (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command) ! (define-key hexl-mode-map "\C-k" 'undefined) ! (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command) ! (define-key hexl-mode-map "\C-n" 'hexl-next-line) ! (define-key hexl-mode-map "\C-o" 'undefined) ! (define-key hexl-mode-map "\C-p" 'hexl-previous-line) ! (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert) ! (define-key hexl-mode-map "\C-t" 'undefined) ! (define-key hexl-mode-map "\C-v" 'hexl-scroll-up) ! (define-key hexl-mode-map "\C-w" 'undefined) ! (define-key hexl-mode-map "\C-y" 'undefined) ! ! (let ((ch 32)) ! (while (< ch 127) ! (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command) ! (setq ch (1+ ch)))) ! ! (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page) ! (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short) ! (define-key hexl-mode-map "\e\C-c" 'undefined) ! (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char) ! (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page) ! (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short) ! (define-key hexl-mode-map "\e\C-g" 'undefined) ! (define-key hexl-mode-map "\e\C-h" 'undefined) ! (define-key hexl-mode-map "\e\C-i" 'undefined) ! (define-key hexl-mode-map "\e\C-j" 'undefined) ! (define-key hexl-mode-map "\e\C-k" 'undefined) ! (define-key hexl-mode-map "\e\C-l" 'undefined) ! (define-key hexl-mode-map "\e\C-m" 'undefined) ! (define-key hexl-mode-map "\e\C-n" 'undefined) ! (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char) ! (define-key hexl-mode-map "\e\C-p" 'undefined) ! (define-key hexl-mode-map "\e\C-q" 'undefined) ! (define-key hexl-mode-map "\e\C-r" 'undefined) ! (define-key hexl-mode-map "\e\C-s" 'undefined) ! (define-key hexl-mode-map "\e\C-t" 'undefined) ! (define-key hexl-mode-map "\e\C-u" 'undefined) ! ! (define-key hexl-mode-map "\e\C-w" 'undefined) ! (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char) ! (define-key hexl-mode-map "\e\C-y" 'undefined) ! ! (define-key hexl-mode-map "\ea" 'undefined) ! (define-key hexl-mode-map "\eb" 'hexl-backward-word) ! (define-key hexl-mode-map "\ec" 'undefined) ! (define-key hexl-mode-map "\ed" 'undefined) ! (define-key hexl-mode-map "\ee" 'undefined) ! (define-key hexl-mode-map "\ef" 'hexl-forward-word) ! (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address) ! (define-key hexl-mode-map "\eh" 'undefined) ! (define-key hexl-mode-map "\ei" 'undefined) ! (define-key hexl-mode-map "\ej" 'hexl-goto-address) ! (define-key hexl-mode-map "\ek" 'undefined) ! (define-key hexl-mode-map "\el" 'undefined) ! (define-key hexl-mode-map "\em" 'undefined) ! (define-key hexl-mode-map "\en" 'undefined) ! (define-key hexl-mode-map "\eo" 'undefined) ! (define-key hexl-mode-map "\ep" 'undefined) ! (define-key hexl-mode-map "\eq" 'undefined) ! (define-key hexl-mode-map "\er" 'undefined) ! (define-key hexl-mode-map "\es" 'undefined) ! (define-key hexl-mode-map "\et" 'undefined) ! (define-key hexl-mode-map "\eu" 'undefined) ! (define-key hexl-mode-map "\ev" 'hexl-scroll-down) ! (define-key hexl-mode-map "\ey" 'undefined) ! (define-key hexl-mode-map "\ez" 'undefined) ! (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer) ! (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer) ! ! (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit) ! ! (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page) ! (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page) ! (define-key hexl-mode-map "\C-x\C-p" 'undefined) ! (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer) ! (define-key hexl-mode-map "\C-x\C-t" 'undefined)) ;;; hexl.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/hilit19.el emacs-19.32/lisp/hilit19.el *** emacs-19.31/lisp/hilit19.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/hilit19.el Fri Jun 21 01:16:05 1996 *************** number of backslashes." *** 1248,1252 **** ("[^\\]\\\\(" "\\\\)" formula) ; \( \) ("[^\\]\\\\\\[" "\\\\\\]" formula) ; \[ \] ! ("[^\\$]\\($\\($[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ; '$...$' or '$$...$$' ;; things that bring in external files --- 1248,1252 ---- ("[^\\]\\\\(" "\\\\)" formula) ; \( \) ("[^\\]\\\\\\[" "\\\\\\]" formula) ; \[ \] ! ("[^\\$]\\(\\$\\(\\$[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ; '$...$' or '$$...$$' ;; things that bring in external files diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/hippie-exp.el emacs-19.32/lisp/hippie-exp.el *** emacs-19.31/lisp/hippie-exp.el Wed Jan 24 19:32:28 1996 --- emacs-19.32/lisp/hippie-exp.el Tue Jun 18 12:27:16 1996 *************** otherwise." *** 446,450 **** (cond ((memq system-type '(vax-vms axp-vms)) "-a-zA-Z0-9_/.,~^#$+=:\\[\\]") ! ((memq system-type '(ms-dos ms-windows)) "-a-zA-Z0-9_/.,~^#$+=:\\\\") (t ;; More strange file formats ? --- 446,450 ---- (cond ((memq system-type '(vax-vms axp-vms)) "-a-zA-Z0-9_/.,~^#$+=:\\[\\]") ! ((memq system-type '(ms-dos windows-nt)) "-a-zA-Z0-9_/.,~^#$+=:\\\\") (t ;; More strange file formats ? *************** otherwise." *** 484,492 **** (or (file-directory-p file) (file-directory-p (concat file "[000000]"))) ! (file-directory-p dir-part))) (defun he-concat-directory-file-name (dir-part name-part) "Try to slam together two parts of a file specification, system dependently." ! (cond ((memq system-type '(axp-vms vax-vms)) (if (and (string= (substring dir-part -1) "]") (string= (substring name-part 0 2) "[.")) --- 484,493 ---- (or (file-directory-p file) (file-directory-p (concat file "[000000]"))) ! (file-directory-p file))) (defun he-concat-directory-file-name (dir-part name-part) "Try to slam together two parts of a file specification, system dependently." ! (cond ((null dir-part) name-part) ! ((memq system-type '(axp-vms vax-vms)) (if (and (string= (substring dir-part -1) "]") (string= (substring name-part 0 2) "[.")) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/icomplete.el emacs-19.32/lisp/icomplete.el *** emacs-19.31/lisp/icomplete.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/icomplete.el Wed May 29 13:15:01 1996 *************** Conditions are: *** 135,139 **** (and (window-minibuffer-p (selected-window)) ! (not executing-macro) (not (symbolp minibuffer-completion-table)))) --- 135,139 ---- (and (window-minibuffer-p (selected-window)) ! (not executing-kbd-macro) (not (symbolp minibuffer-completion-table)))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/imenu.el emacs-19.32/lisp/imenu.el *** emacs-19.31/lisp/imenu.el Sun Mar 17 10:34:47 1996 --- emacs-19.32/lisp/imenu.el Wed Jun 12 10:59:57 1996 *************** *** 65,70 **** ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - (defvar imenu-use-keymap-menu nil - "*Non-nil means use a keymap when making the mouse menu.") (defvar imenu-auto-rescan nil --- 65,68 ---- *************** Returns t for rescan and otherwise a pos *** 710,750 **** (or title (buffer-name)))) position) ! (and imenu-use-keymap-menu ! (setq menu (imenu--create-keymap-1 (car menu) ! (if (< 1 (length (cdr menu))) ! (cdr menu) ! (cdr (cadr menu)))))) ! ! (or imenu-use-keymap-menu ! (setq menu (list "Imenu" (delq nil menu)))) (setq position (x-popup-menu event menu)) ! (if imenu-use-keymap-menu ! (progn ! (cond ! ((and (listp position) ! (numberp (car position)) ! (stringp (nth (1- (length position)) position))) ! (setq position (nth (1- (length position)) position))) ! ((and (stringp (car position)) ! (null (cdr position))) ! (setq position (car position)))))) ! (cond ! ((eq position nil) ! position) ! ((listp position) ! (imenu--mouse-menu position event ! (if title ! (concat title imenu-level-separator ! (car (rassq position index-alist))) ! (car (rassq position index-alist))))) ! ((stringp position) ! (or (string= position (car imenu--rescan-item)) ! (imenu--in-alist position index-alist))) ! ((or (= position (cdr imenu--rescan-item)) ! (and (stringp position) ! (string= position (car imenu--rescan-item)))) ! t) ! (t ! (rassq position index-alist))))) (defun imenu-choose-buffer-index (&optional prompt alist) --- 708,740 ---- (or title (buffer-name)))) position) ! (setq menu (imenu--create-keymap-1 (car menu) ! (if (< 1 (length (cdr menu))) ! (cdr menu) ! (cdr (cadr menu))))) (setq position (x-popup-menu event menu)) ! (cond ((and (listp position) ! (numberp (car position)) ! (stringp (nth (1- (length position)) position))) ! (setq position (nth (1- (length position)) position))) ! ((and (stringp (car position)) ! (null (cdr position))) ! (setq position (car position)))) ! (cond ((eq position nil) ! position) ! ((listp position) ! (imenu--mouse-menu position event ! (if title ! (concat title imenu-level-separator ! (car (rassq position index-alist))) ! (car (rassq position index-alist))))) ! ((stringp position) ! (or (string= position (car imenu--rescan-item)) ! (imenu--in-alist position index-alist))) ! ((or (= position (cdr imenu--rescan-item)) ! (and (stringp position) ! (string= position (car imenu--rescan-item)))) ! t) ! (t ! (rassq position index-alist))))) (defun imenu-choose-buffer-index (&optional prompt alist) *************** See `imenu-choose-buffer-index' for more *** 852,856 **** (list (save-restriction (widen) ! (car (imenu-choose-buffer-index))))) ;; Convert a string to an alist element. (if (stringp index-item) --- 842,846 ---- (list (save-restriction (widen) ! (imenu-choose-buffer-index)))) ;; Convert a string to an alist element. (if (stringp index-item) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/info.el emacs-19.32/lisp/info.el *** emacs-19.31/lisp/info.el Mon May 6 20:51:13 1996 --- emacs-19.32/lisp/info.el Sun Jun 30 04:11:01 1996 *************** In standalone mode, \\\\[ *** 465,468 **** --- 465,469 ---- (cons (cons file attrs) Info-dir-file-attributes)))))) + (or (cdr dirs) (setq Info-dir-contents-directory (car dirs))) (setq dirs (cdr dirs)))) *************** In standalone mode, \\\\[ *** 475,485 **** others (cdr buffers)) ! ;; Insert the entire original dir file as a start; use its ! ;; default directory as the default directory for the whole ! ;; concatenation. (insert-buffer buffer) - (setq Info-dir-contents-directory (save-excursion - (set-buffer buffer) - default-directory)) ;; Look at each of the other buffers one by one. --- 476,483 ---- others (cdr buffers)) ! ;; Insert the entire original dir file as a start; note that we've ! ;; already saved its default directory to use as the default ! ;; directory for the whole concatenation. (insert-buffer buffer) ;; Look at each of the other buffers one by one. *************** N is the digit argument used to invoke t *** 1187,1191 **** ;; Since we have already gone thru all the items in this menu, ;; go up to the end of this node. ! (goto-char (point-max))) (t (error "No more nodes")))) --- 1185,1192 ---- ;; Since we have already gone thru all the items in this menu, ;; go up to the end of this node. ! (goto-char (point-max)) ! ;; Since logically we are done with the node with that menu, ! ;; move on from it. ! (Info-next-preorder)) (t (error "No more nodes")))) *************** N is the digit argument used to invoke t *** 1199,1205 **** --- 1200,1217 ---- ;; so we can scroll back through it. (goto-char (point-max))) + ;; Keep going down, as long as there are nested menu nodes. + (while (Info-no-error + (Info-last-menu-item) + ;; If we go down a menu item, go to the end of the node + ;; so we can scroll back through it. + (goto-char (point-max)))) (recenter -1)) ((Info-no-error (Info-prev)) (goto-char (point-max)) + (while (Info-no-error + (Info-last-menu-item) + ;; If we go down a menu item, go to the end of the node + ;; so we can scroll back through it. + (goto-char (point-max)))) (recenter -1)) ((Info-no-error (Info-up)) *************** previous node or back up to the parent n *** 1237,1243 **** (> (window-start) (point-max))) (set-window-start (selected-window) (point))) ! (let ((virtual-end (save-excursion ! (goto-char (point-min)) ! (search-forward "\n* Menu:" nil t)))) (if (or virtual-end (pos-visible-in-window-p (point-min))) (Info-last-preorder) --- 1249,1260 ---- (> (window-start) (point-max))) (set-window-start (selected-window) (point))) ! (let* ((current-point (point)) ! (virtual-end (save-excursion ! (beginning-of-line) ! (setq current-point (point)) ! (goto-char (point-min)) ! (search-forward "\n* Menu:" ! current-point ! t)))) (if (or virtual-end (pos-visible-in-window-p (point-min))) (Info-last-preorder) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ispell.el emacs-19.32/lisp/ispell.el *** emacs-19.31/lisp/ispell.el Thu May 9 13:35:58 1996 --- emacs-19.32/lisp/ispell.el Fri Jun 28 04:53:05 1996 *************** *** 131,134 **** --- 131,138 ---- ;; HISTORY ;; + ;; Revision 2.38 1996/5/30 ethanb@phys.washington.edu + ;; Update ispell-message for gnus 5 (news-inews-hook => message-send-hook; + ;; different header for quoted message). + ;; ;; Revision 2.37 1995/6/13 12:05:28 stevens ;; Removed autoload from ispell-dictionary-alist. *choices* mode-line shows *************** With prefix argument, set the default di *** 1701,1705 **** (setq ref-type 'tib)) (and ispell-skip-sgml ! (search-forward "[<&]" end t) (setq ref-type 'sgml))) (if (or (and (eq 'tib ref-type) ; tib tag is 2 chars. --- 1705,1709 ---- (setq ref-type 'tib)) (and ispell-skip-sgml ! (re-search-forward "[<&]" end t) (setq ref-type 'sgml))) (if (or (and (eq 'tib ref-type) ; tib tag is 2 chars. *************** With prefix argument, set the default di *** 1715,1719 **** (re-search-forward ispell-tib-ref-end reg-end t))) (and (eq 'sgml ref-type) ! (not (search-forward "[>;]" reg-end t)))) (progn (ispell-pdict-save ispell-silently-savep) --- 1719,1723 ---- (re-search-forward ispell-tib-ref-end reg-end t))) (and (eq 'sgml ref-type) ! (not (re-search-forward "[>;]" reg-end t)))) (progn (ispell-pdict-save ispell-silently-savep) *************** Don't check spelling of message headers *** 2094,2104 **** Don't check included messages. ! To abort spell checking of a message REGION and send the message anyway, ! use the `x' or `q' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: ! (add-hook 'news-inews-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) --- 2098,2108 ---- Don't check included messages. ! To abort spell checking of a message region and send the message anyway, ! use the `x' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: ! (add-hook 'message-send-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) *************** You can bind this to the key C-c i in GN *** 2132,2137 **** (concat "\\(" sc-cite-regexp "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string))) ! ((equal major-mode 'news-reply-mode) ;GNUS (concat "In article <" "\\|" (if mail-yank-prefix (ispell-non-empty-string mail-yank-prefix) --- 2136,2146 ---- (concat "\\(" sc-cite-regexp "\\)" "\\|" (ispell-non-empty-string sc-reference-tag-string))) ! ((equal major-mode 'news-reply-mode) ;GNUS 4 & below (concat "In article <" "\\|" + (if mail-yank-prefix + (ispell-non-empty-string mail-yank-prefix) + "^ \\|^\t"))) + ((equal major-mode 'message-mode) ;GNUS 5 + (concat ".*@.* writes:$" "\\|" (if mail-yank-prefix (ispell-non-empty-string mail-yank-prefix) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/lazy-lock.el emacs-19.32/lisp/lazy-lock.el *** emacs-19.31/lisp/lazy-lock.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/lazy-lock.el Mon Jun 24 03:47:34 1996 *************** *** 0 **** --- 1,825 ---- + ;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode. + + ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. + + ;; Author: Simon Marshall + ;; Keywords: faces files + ;; Version: 2.06 + + ;;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; Purpose: + ;; + ;; To make visiting buffers in `font-lock-mode' faster by making fontification + ;; be demand-driven, deferred and stealthy. + ;; Fontification only occurs when, and where, necessary. + ;; + ;; See caveats and feedback below. + ;; See also the fast-lock package. (But don't use them at the same time!) + + ;; Installation: + ;; + ;; Put in your ~/.emacs: + ;; + ;; (setq font-lock-support-mode 'lazy-lock-mode) + ;; + ;; Start up a new Emacs and use font-lock as usual (except that you can use the + ;; so-called "gaudier" fontification regexps on big files without frustration). + ;; + ;; In a buffer (which has `font-lock-mode' enabled) which is at least + ;; `lazy-lock-minimum-size' characters long, buffer fontification will not + ;; occur and only the visible portion of the buffer will be fontified. Motion + ;; around the buffer will fontify those visible portions not previously + ;; fontified. If stealth fontification is enabled, buffer fontification will + ;; occur in invisible parts of the buffer after `lazy-lock-stealth-time' + ;; seconds of idle time. If on-the-fly fontification is deferred, on-the-fly + ;; fontification will occur after `lazy-lock-defer-time' seconds of idle time. + + ;; User-visible differences with version 1: + ;; + ;; - Version 2 can defer on-the-fly fontification. Therefore you need not, and + ;; should not, use defer-lock.el with this version of lazy-lock.el. + ;; + ;; A number of variables have changed meaning: + ;; + ;; - A value of nil for the variable `lazy-lock-minimum-size' means never turn + ;; on demand-driven fontification. In version 1 this meant always turn on + ;; demand-driven fontification. If you really want demand-driven fontification + ;; regardless of buffer size, set this variable to 0. + ;; + ;; - The variable `lazy-lock-stealth-lines' cannot have a nil value. In + ;; version 1 this meant use `window-height' as the maximum number of lines to + ;; fontify as a stealth chunk. This makes no sense; stealth fontification is + ;; of a buffer, not a window. + + ;; Implementation differences with version 1: + ;; + ;; - Version 1 of lazy-lock.el is a bit of a hack. Version 1 demand-driven + ;; fontification, the core feature of lazy-lock.el, is implemented by placing a + ;; function on `post-command-hook'. This function fontifies where necessary, + ;; i.e., where a window scroll has occurred. However, there are a number of + ;; problems with using `post-command-hook': + ;; + ;; (a) As the name suggests, `post-command-hook' is run after every command, + ;; i.e., frequently and regardless of whether scrolling has occurred. + ;; (b) Scrolling can occur during a command, when `post-command-hook' is not + ;; run, i.e., it is not necessarily run after scrolling has occurred. + ;; (c) When `post-command-hook' is run, there is nothing to suggest where + ;; scrolling might have occurred, i.e., which windows have scrolled. + ;; + ;; Thus lazy-lock.el's function is called almost as often as possible, usually + ;; when it need not be called, yet it is not always called when it is needed. + ;; Also, lazy-lock.el's function must check each window to see if a scroll has + ;; occurred there. Worse still, lazy-lock.el's function must fontify a region + ;; twice as large as necessary to make sure the window is completely fontified. + ;; Basically, `post-command-hook' is completely inappropriate for lazy-lock.el. + ;; + ;; Ideally, we want to attach lazy-lock.el's function to a hook that is run + ;; only when scrolling occurs, e.g., `window-start' has changed, and tells us + ;; as much information as we need, i.e., the window and its new buffer region. + ;; Richard Stallman implemented a `window-scroll-functions' for Emacs 19.30. + ;; Functions on it are run when `window-start' has changed, and are supplied + ;; with the window and the window's new `window-start' position. (It would be + ;; better if it also supplied the window's new `window-end' position, but that + ;; is calculated as part of the redisplay process, and the functions on + ;; `window-scroll-functions' are run before redisplay has finished.) Thus, the + ;; hook deals with the above problems (a), (b) and (c). + ;; + ;; If only life was that easy. Version 2 demand-driven fontification is mostly + ;; implemented by placing a function on `window-scroll-functions'. However, + ;; not all scrolling occurs when `window-start' has changed. A change in + ;; window size, e.g., via C-x 1, or a significant deletion, e.g., of a number + ;; of lines, causes `window-end' to change without changing `window-start'. + ;; Arguably, these events are not scrolling events, but fontification must + ;; occur for lazy-lock.el to work. Hooks `window-size-change-functions' and + ;; `redisplay-end-trigger-functions' were added for these circumstances. + ;; + ;; Ben Wing thinks these hooks are "horribly horribly kludgy", and implemented + ;; a `pre-idle-hook', a `mother-of-all-post-command-hooks', for XEmacs 19.14. + ;; He then hacked up a version 1 lazy-lock.el to use `pre-idle-hook' rather + ;; than `post-command-hook'. Whereas functions on `post-command-hook' are + ;; called almost as often as possible, functions on `pre-idle-hook' really are + ;; called as often as possible, even when the mouse moves and, on some systems, + ;; while XEmacs is idle. Thus, the hook deals with the above problem (b), but + ;; unfortunately it makes (a) worse and does not address (c) at all. + ;; + ;; I freely admit that `redisplay-end-trigger-functions' and, to a much lesser + ;; extent, `window-size-change-functions' are not pretty. However, I feel that + ;; a `window-scroll-functions' feature is cleaner than a `pre-idle-hook', and + ;; the result is faster and smaller, less intrusive and more targeted, code. + ;; Since `pre-idle-hook' is pretty much like `post-command-hook', there is no + ;; point in making this version of lazy-lock.el work with it. Anyway, that's + ;; Lit 30 of my humble opinion. + ;; + ;; - Version 1 stealth fontification is also implemented by placing a function + ;; on `post-command-hook'. This function waits for a given amount of time, + ;; and, if Emacs remains idle, fontifies where necessary. Again, there are a + ;; number of problems with using `post-command-hook': + ;; + ;; (a) Functions on `post-command-hook' are run sequentially, so this function + ;; can interfere with other functions on the hook, and vice versa. + ;; (b) This function waits for a given amount of time, so it can interfere with + ;; various features that are dealt with by Emacs after a command, e.g., + ;; region highlighting, asynchronous updating and keystroke echoing. + ;; (c) Fontification may be required during a command, when `post-command-hook' + ;; is not run. (Version 2 deferred fontification only.) + ;; + ;; Again, `post-command-hook' is completely inappropriate for lazy-lock.el. + ;; Richard Stallman and Morten Welinder implemented internal Timers and Idle + ;; Timers for Emacs 19.31. Functions can be run independently at given times + ;; or after given amounts of idle time. Thus, the feature deals with the above + ;; problems (a), (b) and (c). Version 2 deferral and stealth are implemented + ;; by functions on Idle Timers. (A function on XEmacs' `pre-idle-hook' is + ;; similar to an Emacs Idle Timer function with a fixed zero second timeout. + ;; Hey, maybe I could stop using `window-scroll-functions' for demand-driven + ;; fontification and use a zero second Emacs Idle Timer instead? Only joking!) + + ;; Caveats: + ;; + ;; Lazy Lock mode does not work efficiently with Outline mode. This is because + ;; when in Outline mode, although text may be hidden (not visible in the + ;; window), the text is visible to Emacs Lisp code (not surprisingly) and Lazy + ;; Lock fontifies it mercilessly. Maybe it will be fixed one day. + ;; + ;; Because buffer text is not necessarily fontified, other packages that expect + ;; buffer text to be fontified in Font Lock mode either might not work as + ;; expected, or might not display buffer text as expected. An example of the + ;; latter is `occur', which copies lines of buffer text into another buffer. + ;; + ;; In Emacs 19.30, Lazy Lock mode does not ensure that an existing buffer is + ;; fontified if it is made visible via a minibuffer-less command that replaces + ;; an existing window's buffer (e.g., via the Buffers menu). Upgrade! + ;; + ;; In Emacs 19.30, Lazy Lock mode does not work well with Transient Mark mode + ;; or modes based on Comint mode (e.g., Shell mode), and also interferes with + ;; the echoing of keystrokes in the minibuffer. This is because of the way + ;; deferral and stealth have to be implemented for Emacs 19.30. Upgrade! + ;; + ;; Currently XEmacs does not have the features to support this version of + ;; lazy-lock.el. Maybe it will one day. + + ;; Feedback: + ;; + ;; Feedback is welcome. + ;; To submit a bug report (or make comments) please use the mechanism provided: + ;; + ;; M-x lazy-lock-submit-bug-report RET + + ;; History: + ;; + ;; 1.15--2.00: + ;; - Rewrite for Emacs 19.30 and the features rms added to support lazy-lock.el + ;; so that it could work correctly and efficiently. + ;; - Many thanks to those who reported bugs, fixed bugs, made suggestions or + ;; otherwise contributed in the version 1 cycle; Jari Aalto, Kevin Broadey, + ;; Ulrik Dickow, Bill Dubuque, Bob Glickstein, Boris Goldowsky, + ;; Jonas Jarnestrom, David Karr, Michael Kifer, Erik Naggum, Rick Sladkey, + ;; Jim Thompson, Ben Wing, Ilya Zakharevich, and Richard Stallman. + ;; 2.00--2.01: + ;; - Made `lazy-lock-fontify-after-command' always `sit-for' and so redisplay + ;; - Use `buffer-name' not `buffer-live-p' (Bill Dubuque hint) + ;; - Made `lazy-lock-install' do `add-to-list' not `setq' of `current-buffer' + ;; - Made `lazy-lock-fontify-after-install' loop over buffer list + ;; - Made `lazy-lock-arrange-before-change' to arrange `window-end' triggering + ;; - Made `lazy-lock-let-buffer-state' wrap both `befter-change-functions' + ;; - Made `lazy-lock-fontify-region' do `condition-case' (Hyman Rosen report) + ;; 2.01--2.02: + ;; - Use `buffer-live-p' as `buffer-name' can barf (Richard Stanton report) + ;; - Made `lazy-lock-install' set `font-lock-fontified' (Kevin Davidson report) + ;; - Made `lazy-lock-install' add hooks only if needed + ;; - Made `lazy-lock-unstall' add `font-lock-after-change-function' if needed + ;; 2.02--2.03: + ;; - Made `lazy-lock-fontify-region' do `condition-case' for `quit' too + ;; - Made `lazy-lock-mode' respect the value of `font-lock-inhibit-thing-lock' + ;; - Added `lazy-lock-after-unfontify-buffer' + ;; - Removed `lazy-lock-fontify-after-install' hack + ;; - Made `lazy-lock-fontify-after-scroll' not `set-buffer' to `window-buffer' + ;; - Made `lazy-lock-fontify-after-trigger' not `set-buffer' to `window-buffer' + ;; - Made `lazy-lock-fontify-after-idle' be interruptible (Scott Burson hint) + ;; 2.03--2.04: + ;; - Rewrite for Emacs 19.31 idle timers + ;; - Renamed `buffer-windows' to `get-buffer-window-list' + ;; - Removed `buffer-live-p' + ;; - Made `lazy-lock-defer-after-change' always save `current-buffer' + ;; - Made `lazy-lock-fontify-after-defer' just process buffers + ;; - Made `lazy-lock-install-hooks' add hooks correctly (Kevin Broadey report) + ;; - Made `lazy-lock-install' cope if `lazy-lock-defer-time' is a list + ;; 2.04--2.05: + ;; - Rewrite for Common Lisp macros + ;; - Added `do-while' macro + ;; - Renamed `lazy-lock-let-buffer-state' macro to `save-buffer-state' + ;; - Returned `lazy-lock-fontify-after-install' hack (Darren Hall hint) + ;; - Added `lazy-lock-defer-driven' functionality (Scott Byer hint) + ;; - Made `lazy-lock-mode' wrap `font-lock-support-mode' + ;; 2.05--2.06: + ;; - Made `lazy-lock-fontify-after-defer' swap correctly (Scott Byer report) + + (require 'font-lock) + + ;; Make sure lazy-lock.el is supported. + (if (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version))) + t + (and (= emacs-major-version 19) (< emacs-minor-version 30))) + (error "`lazy-lock' was written for Emacs 19.30 or later")) + + ;; Flush out those lusers who didn't read all of the Commentary. + (if (or (memq 'turn-on-defer-lock font-lock-mode-hook) + (memq 'defer-lock-mode font-lock-mode-hook)) + (error "`lazy-lock' was written for use without `defer-lock'")) + + (eval-when-compile + ;; + ;; We don't do this at the top-level as idle timers are not necessarily used. + (require 'timer) + ;; We don't do this at the top-level as we only use non-autoloaded macros. + (require 'cl) + ;; + ;; Well, shouldn't Lazy Lock mode be as lazy as possible? + (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t) + ;; But, we make sure that the code is as zippy as can be. + (setq byte-optimize t) + ;; + ;; We use this to preserve or protect things when modifying text properties. + (defmacro save-buffer-state (varlist &rest body) + "Bind variables according to VARLIST and eval BODY restoring buffer state." + (` (let* ((,@ (append varlist + '((modified (buffer-modified-p)) + (inhibit-read-only t) (buffer-undo-list t) + before-change-functions after-change-functions + deactivate-mark buffer-file-name buffer-file-truename)))) + (,@ body) + (when (and (not modified) (buffer-modified-p)) + (set-buffer-modified-p nil))))) + (put 'save-buffer-state 'lisp-indent-function 1) + ;; + ;; We use this for clarity and speed. Naughty but nice. + (defmacro do-while (test &rest body) + "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil. + The order of execution is thus BODY, TEST, BODY, TEST and so on + until TEST returns nil." + (` (while (progn (,@ body) (, test))))) + (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function))) + + ;; User Variables: + + (defvar lazy-lock-minimum-size (* 25 1024) + "*Minimum size of a buffer for demand-driven fontification. + On-demand fontification occurs if the buffer size is greater than this value. + If nil, means demand-driven fontification is never performed. + If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), + where MAJOR-MODE is a symbol or t (meaning the default). For example: + ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576)) + means that the minimum size is 25K for buffers in C or C++ modes, one megabyte + for buffers in Rmail mode, and size is irrelevant otherwise. + + The value of this variable is used when Lazy Lock mode is turned on.") + + (defvar lazy-lock-defer-driven nil + "*If non-nil, means fontification should be defer-driven. + If nil, means demand-driven fontification is performed. This means when + scrolling into unfontified areas of the buffer, those areas are immediately + fontified. Thus scrolling never presents unfontified areas. However, since + fontification occurs during scrolling, scrolling may be slow. + If t, means defer-driven fontification is performed. This means fontification + of those areas is deferred. Thus scrolling may present momentarily unfontified + areas. However, since fontification does not occur during scrolling, scrolling + will be faster than demand-driven fontification. + If any other value, e.g., `eventually', means demand-driven fontification is + performed until the buffer is fontified, then buffer fontification becomes + defer-driven. Thus scrolling never presents unfontified areas until the buffer + is first fontified, after which subsequent scrolling may present future buffer + insertions momentarily unfontified. However, since fontification does not + occur during scrolling after the buffer is first fontified, scrolling will + become faster. + + The value of this variable is used when Lazy Lock mode is turned on.") + + (defvar lazy-lock-defer-time + (if (featurep 'lisp-float-type) (/ (float 1) (float 4)) 1) + "*Time in seconds to delay before beginning deferred fontification. + Deferred fontification occurs if there is no input within this time. + If nil, means fontification is never deferred. However, fontification occurs + on-the-fly or during scrolling, which may be slow. + If a list, it should be of the form (MAJOR-MODES . TIME), where MAJOR-MODES is + a list of `major-mode' symbols for which deferred fontification should occur. + The sense of the list is negated if it begins with `not'. For example: + ((c-mode c++-mode) . 0.25) + means that the deferral time is 0.25s for buffers in C or C++ modes, and + deferral does not occur otherwise. + + The value of this variable is used when Lazy Lock mode is turned on.") + + (defvar lazy-lock-stealth-time 30 + "*Time in seconds to delay before beginning stealth fontification. + Stealth fontification occurs if there is no input within this time. + If nil, means stealth fontification is never performed. + + The value of this variable is used when Lazy Lock mode is turned on.") + + (defvar lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250) + "*Maximum size of a chunk of stealth fontification. + Each iteration of stealth fontification can fontify this number of lines. + To speed up input response during stealth fontification, at the cost of stealth + taking longer to fontify, you could reduce the value of this variable.") + + (defvar lazy-lock-stealth-nice + (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1) + "*Time in seconds to pause between chunks of stealth fontification. + Each iteration of stealth fontification is separated by this amount of time. + To reduce machine load during stealth fontification, at the cost of stealth + taking longer to fontify, you could increase the value of this variable.") + + (defvar lazy-lock-stealth-verbose (not (null font-lock-verbose)) + "*If non-nil, means stealth fontification should show status messages.") + + (defvar lazy-lock-mode nil) + (defvar lazy-lock-buffers nil) ; for deferral + (defvar lazy-lock-timers (cons nil nil)) ; for deferral and stealth + + ;; User Functions: + + ;;;###autoload + (defun lazy-lock-mode (&optional arg) + "Toggle Lazy Lock mode. + With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it + automatically in your `~/.emacs' by: + + (setq font-lock-support-mode 'lazy-lock-mode) + + When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: + + - Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. + This means initial fontification does not occur if the buffer is greater + than `lazy-lock-minimum-size' characters in length. Instead, fontification + occurs when necessary, such as when scrolling through the buffer would + otherwise reveal unfontified areas. This is useful if buffer fontification + is too slow for large buffers. + + - Defer-driven buffer fontification if `lazy-lock-defer-driven' is non-nil. + This means all fontification is deferred, such as fontification that occurs + when scrolling through the buffer would otherwise reveal unfontified areas. + Instead, these areas are seen momentarily unfontified. This is useful if + demand-driven fontification is too slow to keep up with scrolling. + + - Deferred on-the-fly fontification if `lazy-lock-defer-time' is non-nil. + This means on-the-fly fontification does not occur as you type. Instead, + fontification is deferred until after `lazy-lock-defer-time' seconds of + Emacs idle time, while Emacs remains idle. This is useful if on-the-fly + fontification is too slow to keep up with your typing. + + - Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. + This means remaining unfontified areas of buffers are fontified if Emacs has + been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. + This is useful if any buffer has demand- or defer-driven fontification. + + See also variables `lazy-lock-stealth-lines', `lazy-lock-stealth-nice' and + `lazy-lock-stealth-verbose' for stealth fontification. + + Use \\[lazy-lock-submit-bug-report] to send bug reports or feedback." + (interactive "P") + (set (make-local-variable 'lazy-lock-mode) + (and (not (memq 'lazy-lock-mode font-lock-inhibit-thing-lock)) + (if arg (> (prefix-numeric-value arg) 0) (not lazy-lock-mode)))) + (cond ((and lazy-lock-mode (not font-lock-mode)) + ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'. + (let ((font-lock-support-mode 'lazy-lock-mode)) + (font-lock-mode t))) + (lazy-lock-mode + ;; Turn ourselves on. + (lazy-lock-install)) + (t + ;; Turn ourselves off. + (lazy-lock-unstall)))) + + (defun lazy-lock-submit-bug-report () + "Submit via mail a bug report on lazy-lock.el." + (interactive) + (let ((reporter-prompt-for-summary-p t)) + (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "lazy-lock 2.06" + '(lazy-lock-minimum-size lazy-lock-defer-driven lazy-lock-defer-time + lazy-lock-stealth-time lazy-lock-stealth-nice lazy-lock-stealth-lines + lazy-lock-stealth-verbose) + nil nil + (concat "Hi Si., + + I want to report a bug. I've read the `Bugs' section of `Info' on Emacs, so I + know how to make a clear and unambiguous report. To reproduce the bug: + + Start a fresh Emacs via `" invocation-name " -no-init-file -no-site-file'. + In the `*scratch*' buffer, evaluate:")))) + + ;;;###autoload + (defun turn-on-lazy-lock () + "Unconditionally turn on Lazy Lock mode." + (lazy-lock-mode t)) + + (defun lazy-lock-install () + (let ((min-size (font-lock-value-in-major-mode lazy-lock-minimum-size))) + ;; + ;; Tell Font Lock whether Lazy Lock will do fontification. + (make-local-variable 'font-lock-fontified) + (setq font-lock-fontified (and min-size (>= (buffer-size) min-size))) + ;; + ;; Add the text properties and fontify. + (if (not font-lock-fontified) + (lazy-lock-after-fontify-buffer) + ;; Make sure we fontify in any existing windows showing the buffer. + (let ((windows (get-buffer-window-list (current-buffer) 'nomini t))) + (lazy-lock-after-unfontify-buffer) + (while windows + (lazy-lock-fontify-conservatively (car windows)) + (setq windows (cdr windows))))) + ;; + ;; Add the fontification hooks. + (lazy-lock-install-hooks + (or (numberp lazy-lock-defer-time) + (if (eq (car (car lazy-lock-defer-time)) 'not) + (not (memq major-mode (cdr (car lazy-lock-defer-time)))) + (memq major-mode (car lazy-lock-defer-time)))) + font-lock-fontified + (eq lazy-lock-defer-driven t)) + ;; + ;; Add the fontification timers. + (lazy-lock-install-timers + (or (cdr-safe lazy-lock-defer-time) lazy-lock-defer-time) + lazy-lock-stealth-time))) + + (defun lazy-lock-install-hooks (deferring fontifying defer-driven) + ;; + ;; Add hook if lazy-lock.el is deferring or is fontifying on scrolling. + (when (or deferring fontifying) + (make-local-hook 'window-scroll-functions) + (add-hook 'window-scroll-functions (if (and deferring defer-driven) + 'lazy-lock-defer-after-scroll + 'lazy-lock-fontify-after-scroll) + nil t)) + ;; + ;; Add hook if lazy-lock.el is not deferring and is fontifying. + (when (and (not deferring) fontifying) + (make-local-hook 'before-change-functions) + (add-hook 'before-change-functions 'lazy-lock-arrange-before-change nil t)) + ;; + ;; Add hook if lazy-lock.el is deferring. + (when deferring + (remove-hook 'after-change-functions 'font-lock-after-change-function t) + (add-hook 'after-change-functions 'lazy-lock-defer-after-change nil t)) + ;; + ;; Add package-specific hooks. + (make-local-hook 'outline-view-change-hook) + (add-hook 'outline-view-change-hook 'lazy-lock-fontify-after-outline nil t)) + + (defun lazy-lock-install-timers (dtime stime) + ;; Schedule or re-schedule the deferral and stealth timers. + ;; The layout of `lazy-lock-timers' is: + ;; ((DEFER-TIME . DEFER-TIMER) (STEALTH-TIME . STEALTH-TIMER) + ;; If an idle timeout has changed, cancel the existing idle timer (if there + ;; is one) and schedule a new one (if the new idle timeout is non-nil). + (unless (eq dtime (car (car lazy-lock-timers))) + (let ((defer (car lazy-lock-timers))) + (when (cdr defer) + (cancel-timer (cdr defer))) + (setcar lazy-lock-timers (cons dtime (and dtime + (run-with-idle-timer dtime t 'lazy-lock-fontify-after-defer)))))) + (unless (eq stime (car (cdr lazy-lock-timers))) + (let ((stealth (cdr lazy-lock-timers))) + (when (cdr stealth) + (cancel-timer (cdr stealth))) + (setcdr lazy-lock-timers (cons stime (and stime + (run-with-idle-timer stime t 'lazy-lock-fontify-after-idle))))))) + + (defun lazy-lock-unstall () + ;; + ;; Remove the text properties. + (lazy-lock-after-unfontify-buffer) + ;; + ;; Remove the fontification hooks. + (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t) + (remove-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll t) + (remove-hook 'before-change-functions 'lazy-lock-arrange-before-change t) + (remove-hook 'after-change-functions 'lazy-lock-defer-after-change t) + (remove-hook 'outline-view-change-hook 'lazy-lock-fontify-after-outline t) + ;; + ;; If Font Lock mode is still enabled, reinstall its hook. + (when font-lock-mode + (add-hook 'after-change-functions 'font-lock-after-change-function nil t))) + + ;; Hook functions. + + (defun lazy-lock-fontify-after-scroll (window window-start) + ;; Called from `window-scroll-functions'. + ;; Fontify WINDOW from WINDOW-START. We cannot use `window-end' so we work + ;; out what it would be via `vertical-motion'. + (save-excursion + (goto-char window-start) + (vertical-motion (window-height window) window) + (lazy-lock-fontify-region window-start (point))) + ;; A prior deletion that did not cause scrolling, followed by a scroll, would + ;; result in an unnecessary trigger after this if we did not cancel it now. + (set-window-redisplay-end-trigger window nil)) + + (defun lazy-lock-fontify-after-trigger (window trigger-point) + ;; Called from `redisplay-end-trigger-functions'. + ;; Fontify WINDOW from TRIGGER-POINT. We cannot use `window-end' so we work + ;; out what it would be via `vertical-motion'. + ;; We could probably just use `lazy-lock-fontify-after-scroll' without loss: + ;; (lazy-lock-fontify-after-scroll window (window-start window)) + (save-excursion + (goto-char (window-start window)) + (vertical-motion (window-height window) window) + (lazy-lock-fontify-region trigger-point (point)))) + + (defun lazy-lock-fontify-after-resize (frame) + ;; Called from `window-size-change-functions'. + ;; Fontify windows in FRAME. We cannot use `window-start' or `window-end' so + ;; we fontify conservatively. + (save-excursion + (save-selected-window + (select-frame frame) + (walk-windows (function (lambda (window) + (set-buffer (window-buffer window)) + (when lazy-lock-mode + (lazy-lock-fontify-conservatively window)) + (set-window-redisplay-end-trigger window nil))) + 'nomini frame)))) + + (defun lazy-lock-arrange-before-change (beg end) + ;; Called from `before-change-functions'. + ;; Arrange that if text becomes visible it will be fontified (if a deletion + ;; is pending, text might become visible at the bottom). + (unless (eq beg end) + (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)) window) + (while windows + (setq window (car windows)) + (unless (markerp (window-redisplay-end-trigger window)) + (set-window-redisplay-end-trigger window (make-marker))) + (set-marker (window-redisplay-end-trigger window) (window-end window)) + (setq windows (cdr windows)))))) + + (defun lazy-lock-defer-after-scroll (window window-start) + ;; Called from `window-scroll-functions'. + ;; Defer fontification following the scroll. Save the current buffer so that + ;; we subsequently fontify in all windows showing the buffer. + (unless (memq (current-buffer) lazy-lock-buffers) + (push (current-buffer) lazy-lock-buffers))) + + (defun lazy-lock-defer-after-change (beg end old-len) + ;; Called from `after-change-functions'. + ;; Defer fontification of the current line. Save the current buffer so that + ;; we subsequently fontify in all windows showing the buffer. + (save-buffer-state nil + (unless (memq (current-buffer) lazy-lock-buffers) + (push (current-buffer) lazy-lock-buffers)) + (remove-text-properties + (max (1- beg) (point-min)) (min (1+ end) (point-max)) '(lazy-lock nil)))) + + (defun lazy-lock-fontify-after-defer () + ;; Called from `timer-idle-list'. + ;; Fontify all windows where deferral has occurred for its buffer. + (while (and lazy-lock-buffers (not (input-pending-p))) + (let ((windows (get-buffer-window-list (car lazy-lock-buffers) 'nomini t))) + (while windows + (lazy-lock-fontify-window (car windows)) + (setq windows (cdr windows))) + (setq lazy-lock-buffers (cdr lazy-lock-buffers)))) + ;; Add hook if fontification should now be defer-driven in this buffer. + (when (and lazy-lock-mode lazy-lock-defer-driven + (memq 'lazy-lock-fontify-after-scroll window-scroll-functions) + (not (or (input-pending-p) (lazy-lock-unfontified-p)))) + (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t) + (add-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll nil t))) + + (defun lazy-lock-fontify-after-idle () + ;; Called from `timer-idle-list'. + ;; Fontify all buffers that need it, stealthily while idle. + (unless (or executing-kbd-macro (window-minibuffer-p (selected-window))) + ;; Loop over all buffers, fontify stealthily for each if necessary. + (let ((buffers (buffer-list)) (continue t) message message-log-max) + (save-excursion + (do-while (and buffers continue) + (set-buffer (car buffers)) + (if (not (and lazy-lock-mode (lazy-lock-unfontified-p))) + (setq continue (not (input-pending-p))) + ;; Fontify regions in this buffer while there is no input. + (do-while (and (lazy-lock-unfontified-p) + (setq continue (sit-for lazy-lock-stealth-nice))) + (when lazy-lock-stealth-verbose + (if message + (message "Fontifying stealthily... %2d%% of %s" + (lazy-lock-percent-fontified) (buffer-name)) + (message "Fontifying stealthily...") + (setq message t))) + (lazy-lock-fontify-chunk))) + (setq buffers (cdr buffers)))) + (when message + (message "Fontifying stealthily...%s" (if continue "done" "quit")))))) + + (defun lazy-lock-fontify-after-outline () + ;; Called from `outline-view-change-hook'. + ;; Fontify windows showing the current buffer, as its visibility has changed. + ;; This is a conspiracy hack between lazy-lock.el and noutline.el. + (let ((windows (get-buffer-window-list (current-buffer) 'nomini t))) + (while windows + (lazy-lock-fontify-conservatively (car windows)) + (setq windows (cdr windows))))) + + (defun lazy-lock-after-fontify-buffer () + ;; Called from `font-lock-after-fontify-buffer'. + ;; Mark the current buffer as fontified. + ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. + (save-buffer-state nil + (add-text-properties (point-min) (point-max) '(lazy-lock t)))) + + (defun lazy-lock-after-unfontify-buffer () + ;; Called from `font-lock-after-unfontify-buffer'. + ;; Mark the current buffer as unfontified. + ;; This is a conspiracy hack between lazy-lock.el and font-lock.el. + (save-buffer-state nil + (remove-text-properties (point-min) (point-max) '(lazy-lock nil)))) + + ;; Fontification functions. + + ;; If packages want to ensure that some region of the buffer is fontified, they + ;; should use this function. For an example, see ps-print.el. + (defun lazy-lock-fontify-region (beg end) + ;; Fontify between BEG and END, where necessary, in the current buffer. + (when (setq beg (text-property-any beg end 'lazy-lock nil)) + (save-excursion + (save-match-data + (save-buffer-state + ;; Ensure syntactic fontification is always correct. + (font-lock-beginning-of-syntax-function next) + ;; Find successive unfontified regions between BEG and END. + (condition-case data + (do-while beg + (setq next (or (text-property-any beg end 'lazy-lock t) end)) + ;; Make sure the region end points are at beginning of line. + (goto-char beg) + (unless (bolp) + (beginning-of-line) + (setq beg (point))) + (goto-char next) + (unless (bolp) + (forward-line) + (setq next (point))) + ;; Fontify the region, then flag it as fontified. + (font-lock-fontify-region beg next) + (add-text-properties beg next '(lazy-lock t)) + (setq beg (text-property-any next end 'lazy-lock nil))) + ((error quit) (message "Fontifying region...%s" data)))))))) + + (defun lazy-lock-fontify-chunk () + ;; Fontify the nearest chunk, for stealth, in the current buffer. + (save-excursion + (save-restriction + (widen) + ;; Move to end of line in case the character at point is not fontified. + (end-of-line) + ;; Find where the previous, and next, unfontified regions end, and begin. + (let ((prev (previous-single-property-change (point) 'lazy-lock)) + (next (text-property-any (point) (point-max) 'lazy-lock nil))) + ;; Fontify from the nearest unfontified position. + (if (or (null prev) (and next (< (- next (point)) (- (point) prev)))) + ;; The next, or neither, region is the nearest not fontified. + (lazy-lock-fontify-region + (progn (goto-char (or next (point-min))) + (beginning-of-line) + (point)) + (progn (goto-char (or next (point-min))) + (forward-line lazy-lock-stealth-lines) + (point))) + ;; The previous region is the nearest not fontified. + (lazy-lock-fontify-region + (progn (goto-char prev) + (forward-line (- lazy-lock-stealth-lines)) + (point)) + (progn (goto-char prev) + (forward-line) + (point)))))))) + + (defun lazy-lock-fontify-window (window) + ;; Fontify in WINDOW between `window-start' and `window-end'. + ;; We can only do this when we can use `window-start' and `window-end'. + (save-excursion + (set-buffer (window-buffer window)) + (lazy-lock-fontify-region (window-start window) (window-end window)))) + + (defun lazy-lock-fontify-conservatively (window) + ;; Fontify in WINDOW conservatively around point. + ;; Where we cannot use `window-start' and `window-end' we do `window-height' + ;; lines around point. That way we guarantee to have done enough. + (save-excursion + (set-buffer (window-buffer window)) + (lazy-lock-fontify-region + (save-excursion + (vertical-motion (- (window-height window)) window) (point)) + (save-excursion + (vertical-motion (window-height window) window) (point))))) + + (defun lazy-lock-unfontified-p () + ;; Return non-nil if there is anywhere still to be fontified. + (save-restriction + (widen) + (text-property-any (point-min) (point-max) 'lazy-lock nil))) + + (defun lazy-lock-percent-fontified () + ;; Return the percentage (of characters) of the buffer that are fontified. + (save-restriction + (widen) + (let ((beg (point-min)) (end (point-max)) (size 0) next) + ;; Find where the next fontified region begins. + (while (setq beg (text-property-any beg end 'lazy-lock t)) + (setq next (or (text-property-any beg end 'lazy-lock nil) end) + size (+ size (- next beg)) + beg next)) + (/ (* size 100) (buffer-size))))) + + ;; Version dependent workarounds and fixes. + + (when (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version))) + nil + (and (= emacs-major-version 19) (= emacs-minor-version 30))) + ;; + ;; We use `post-command-idle-hook' for deferral and stealth. Oh Lordy. + (defun lazy-lock-install-timers (foo bar) + (add-hook 'post-command-idle-hook 'lazy-lock-fontify-post-command t) + (add-hook 'post-command-idle-hook 'lazy-lock-fontify-post-idle t) + (add-to-list 'lazy-lock-install (current-buffer)) + (add-hook 'post-command-hook 'lazy-lock-fontify-after-install)) + (defun lazy-lock-fontify-post-command () + (and lazy-lock-buffers (not executing-kbd-macro) + (progn + (and deactivate-mark (deactivate-mark)) + (sit-for + (or (cdr-safe lazy-lock-defer-time) lazy-lock-defer-time 0))) + (lazy-lock-fontify-after-defer))) + (defun lazy-lock-fontify-post-idle () + (and lazy-lock-stealth-time (not executing-kbd-macro) + (not (window-minibuffer-p (selected-window))) + (progn + (and deactivate-mark (deactivate-mark)) + (sit-for lazy-lock-stealth-time)) + (lazy-lock-fontify-after-idle))) + ;; + ;; Simulate running of `window-scroll-functions' in `set-window-buffer'. + (defvar lazy-lock-install nil) + (defun lazy-lock-fontify-after-install () + (remove-hook 'post-command-hook 'lazy-lock-fontify-after-install) + (while lazy-lock-install + (mapcar 'lazy-lock-fontify-conservatively + (get-buffer-window-list (pop lazy-lock-install) 'nomini t))))) + + ;; Possibly absent. + + (unless (boundp 'font-lock-inhibit-thing-lock) + ;; Font Lock mode uses this to direct Lazy and Fast Lock modes to stay off. + (defvar font-lock-inhibit-thing-lock nil + "List of Font Lock mode related modes that should not be turned on.")) + + (unless (fboundp 'font-lock-value-in-major-mode) + (defun font-lock-value-in-major-mode (alist) + ;; Return value in ALIST for `major-mode'. + (if (consp alist) + (cdr (or (assq major-mode alist) (assq t alist))) + alist))) + + (unless (fboundp 'get-buffer-window-list) + ;; We use this to get all windows showing a buffer we have to fontify. + (defun get-buffer-window-list (buffer &optional minibuf frame) + "Return windows currently displaying BUFFER, or nil if none." + (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows) + (walk-windows (function (lambda (window) + (when (eq (window-buffer window) buffer) + (push window windows)))) + minibuf frame) + windows))) + + ;; Install ourselves: + + (add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize) + (add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger) + + (unless (assq 'lazy-lock-mode minor-mode-alist) + (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil))))) + + ;; Provide ourselves: + + (provide 'lazy-lock) + + ;;; lazy-lock.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/lisp-mode.el emacs-19.32/lisp/lisp-mode.el *** emacs-19.31/lisp/lisp-mode.el Sun Mar 17 10:34:53 1996 --- emacs-19.32/lisp/lisp-mode.el Thu Jul 4 00:45:04 1996 *************** *** 120,124 **** (setq comment-start ";") (make-local-variable 'comment-start-skip) ! (setq comment-start-skip ";+ *") (make-local-variable 'comment-column) (setq comment-column 40) --- 120,126 ---- (setq comment-start ";") (make-local-variable 'comment-start-skip) ! ;; Look within the line for a ; following an even number of backslashes ! ;; after either a non-backslash or the line beginning. ! (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *") (make-local-variable 'comment-column) (setq comment-column 40) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/lmenu.el emacs-19.32/lisp/lmenu.el *** emacs-19.31/lisp/lmenu.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/lmenu.el Thu Jun 13 16:34:49 1996 *************** *** 82,85 **** --- 82,86 ---- (fset command callback) (fset command (list 'lambda () '(interactive) callback))) + (put command 'menu-alias t) (let ((i 2)) (while (< i (length item)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/loaddefs.el emacs-19.32/lisp/loaddefs.el *** emacs-19.31/lisp/loaddefs.el Thu May 23 15:49:58 1996 --- emacs-19.32/lisp/loaddefs.el Thu Aug 1 22:02:09 1996 *************** is okay. See `mode-line-format'.") *** 167,172 **** ;; Completion ! (concat "^To complete, the point must be after a symbol at " ! "least [0-9]* character long\\.$") "^The string \".*\" is too short to be saved as a completion\\.$" --- 167,171 ---- ;; Completion ! "^To complete, the point must be after a symbol at least [0-9]* character long\\.$" "^The string \".*\" is too short to be saved as a completion\\.$" *************** for \\[find-tag] (which see)." *** 261,264 **** --- 260,265 ---- ;; Changed from C-x ESC so that function keys work following C-x. (define-key ctl-x-map "\e\e" 'repeat-complex-command) + ;; New binding analogous to M-:. + (define-key ctl-x-map "\M-:" 'repeat-complex-command) (define-key ctl-x-map "u" 'advertised-undo) ;; Many people are used to typing C-/ on X terminals and getting C-_. *************** Determine the filename of a package/proc *** 627,631 **** ;;;*** ! ;;;### (autoloads (add-log-current-defun change-log-mode add-change-log-entry-other-window add-change-log-entry find-change-log prompt-for-change-log-name) "add-log" "add-log.el" (12626 43402)) ;;; Generated autoloads from add-log.el --- 628,632 ---- ;;;*** ! ;;;### (autoloads (add-log-current-defun change-log-mode add-change-log-entry-other-window add-change-log-entry find-change-log prompt-for-change-log-name) "add-log" "add-log.el" (12755 36002)) ;;; Generated autoloads from add-log.el *************** Look at the file `advice.el' for compreh *** 781,785 **** ;;;*** ! ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (12629 58728)) ;;; Generated autoloads from ange-ftp.el --- 782,786 ---- ;;;*** ! ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (12796 58959)) ;;; Generated autoloads from ange-ftp.el *************** Look at the file `advice.el' for compreh *** 792,796 **** ;;;*** ! ;;;### (autoloads (appt-make-list) "appt" "appt.el" (12536 45574)) ;;; Generated autoloads from appt.el --- 793,797 ---- ;;;*** ! ;;;### (autoloads (appt-make-list) "appt" "appt.el" (12778 43089)) ;;; Generated autoloads from appt.el *************** as the first thing on a line.") *** 819,823 **** (defvar appt-display-diary t "\ ! *Non-nil means to display the next days diary on the screen. This will occur at midnight when the appointment list is updated.") --- 820,824 ---- (defvar appt-display-diary t "\ ! *Non-nil means to display the next days diary on the screen. This will occur at midnight when the appointment list is updated.") *************** archive. *** 875,879 **** ;;;*** ! ;;;### (autoloads (asm-mode) "asm-mode" "asm-mode.el" (12536 45574)) ;;; Generated autoloads from asm-mode.el --- 876,880 ---- ;;;*** ! ;;;### (autoloads (asm-mode) "asm-mode" "asm-mode.el" (12747 22249)) ;;; Generated autoloads from asm-mode.el *************** Vectors work just like lists. Nested ba *** 1007,1011 **** ;;;*** ! ;;;### (autoloads (bibtex-mode) "bibtex" "bibtex.el" (12608 29069)) ;;; Generated autoloads from bibtex.el --- 1008,1012 ---- ;;;*** ! ;;;### (autoloads (bibtex-mode) "bibtex" "bibtex.el" (12773 35096)) ;;; Generated autoloads from bibtex.el *************** corresponding bookmark function from Lis *** 1436,1440 **** ;;;*** ! ;;;### (autoloads (browse-url-of-dired-file browse-url-of-buffer browse-url-of-file browse-url-at-mouse browse-url-at-point) "browse-url" "browse-url.el" (12599 60492)) ;;; Generated autoloads from browse-url.el --- 1437,1441 ---- ;;;*** ! ;;;### (autoloads (browse-url-of-dired-file browse-url-of-buffer browse-url-of-file browse-url-at-mouse browse-url-at-point) "browse-url" "browse-url.el" (12786 33098)) ;;; Generated autoloads from browse-url.el *************** In Dired, ask a WWW browser to display t *** 1466,1470 **** ;;;*** ! ;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile display-call-tree byte-compile compile-defun byte-compile-file byte-recompile-directory byte-force-recompile) "bytecomp" "bytecomp.el" (12649 17674)) ;;; Generated autoloads from bytecomp.el --- 1467,1471 ---- ;;;*** ! ;;;### (autoloads (batch-byte-recompile-directory batch-byte-compile display-call-tree byte-compile compile-defun byte-compile-file byte-recompile-directory byte-force-recompile) "bytecomp" "bytecomp.el" (12728 26482)) ;;; Generated autoloads from bytecomp.el *************** from the cursor position." t nil) *** 1550,1554 **** ;;;*** ! ;;;### (autoloads (calendar) "calendar" "calendar.el" (12704 37201)) ;;; Generated autoloads from calendar.el --- 1551,1555 ---- ;;;*** ! ;;;### (autoloads (calendar) "calendar" "calendar.el" (12722 29358)) ;;; Generated autoloads from calendar.el *************** of `scheme-program-name'). Runs the hoo *** 2147,2151 **** ;;;*** ! ;;;### (autoloads (comint-run make-comint) "comint" "comint.el" (12620 12215)) ;;; Generated autoloads from comint.el --- 2148,2152 ---- ;;;*** ! ;;;### (autoloads (comint-run make-comint) "comint" "comint.el" (12801 12302)) ;;; Generated autoloads from comint.el *************** If `compare-ignore-case' is non-nil, cha *** 2190,2194 **** ;;;*** ! ;;;### (autoloads (next-error compilation-minor-mode compilation-mode grep compile) "compile" "compile.el" (12673 10114)) ;;; Generated autoloads from compile.el --- 2191,2195 ---- ;;;*** ! ;;;### (autoloads (next-error compilation-minor-mode compilation-mode grep compile) "compile" "compile.el" (12755 29072)) ;;; Generated autoloads from compile.el *************** Edit display information for cpp conditi *** 2330,2334 **** ;;;*** ! ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" (12550 33268)) ;;; Generated autoloads from dabbrev.el --- 2331,2335 ---- ;;;*** ! ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" (12800 14378)) ;;; Generated autoloads from dabbrev.el *************** See also `dabbrev-abbrev-char-regexp' an *** 2375,2379 **** ;;;*** ! ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" "debug.el" (12536 45574)) ;;; Generated autoloads from debug.el --- 2376,2380 ---- ;;;*** ! ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" "debug.el" (12716 34307)) ;;; Generated autoloads from debug.el *************** If argument is nil or an empty string, c *** 2403,2407 **** ;;;*** ! ;;;### (autoloads (decipher-mode decipher) "decipher" "decipher.el" (12590 21179)) ;;; Generated autoloads from decipher.el --- 2404,2408 ---- ;;;*** ! ;;;### (autoloads (decipher-mode decipher) "decipher" "decipher.el" (12785 5878)) ;;; Generated autoloads from decipher.el *************** The backup file is the first file given *** 2509,2513 **** ;;;*** ! ;;;### (autoloads (dired-noselect dired-other-frame dired-other-window dired) "dired" "dired.el" (12645 28719)) ;;; Generated autoloads from dired.el --- 2510,2514 ---- ;;;*** ! ;;;### (autoloads (dired-noselect dired-other-frame dired-other-window dired) "dired" "dired.el" (12724 30616)) ;;; Generated autoloads from dired.el *************** may contain even `F', `b', `i' and `s'. *** 2518,2522 **** `dired-ls-F-marks-symlinks' concerning the `F' switch.") ! (defvar dired-chown-program (if (memq system-type (quote (hpux dgux usg-unix-v irix linux lignux))) "chown" "/etc/chown") "\ Name of chown command (usually `chown' or `/etc/chown').") --- 2519,2523 ---- `dired-ls-F-marks-symlinks' concerning the `F' switch.") ! (defvar dired-chown-program (if (memq system-type (quote (hpux dgux usg-unix-v irix linux lignux))) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown")) "\ Name of chown command (usually `chown' or `/etc/chown').") *************** Switch to *dungeon* buffer and start gam *** 2928,2932 **** ;;;*** ! ;;;### (autoloads (easy-menu-create-keymaps easy-menu-do-define easy-menu-define) "easymenu" "easymenu.el" (12536 45574)) ;;; Generated autoloads from easymenu.el --- 2929,2933 ---- ;;;*** ! ;;;### (autoloads (easy-menu-create-keymaps easy-menu-do-define easy-menu-define) "easymenu" "easymenu.el" (12736 32257)) ;;; Generated autoloads from easymenu.el *************** ENABLE is an expression; the item is ena *** 2949,2953 **** whenever this expression's value is non-nil. ! Alternatively, a menu item may have the form: [ NAME CALLBACK [ KEYWORD ARG ] ... ] --- 2950,2954 ---- whenever this expression's value is non-nil. ! Alternatively, a menu item may have the form: [ NAME CALLBACK [ KEYWORD ARG ] ... ] *************** NAME is a string; the name of an argumen *** 2971,2981 **** :style STYLE ! STYLE is a symbol describing the type of menu item. The following are ! defined: ! toggle: A checkbox. Currently just prepend the name with the string \"Toggle \". ! radio: A radio button. nil: An ordinary menu item. --- 2972,2982 ---- :style STYLE ! STYLE is a symbol describing the type of menu item. The following are ! defined: ! toggle: A checkbox. Currently just prepend the name with the string \"Toggle \". ! radio: A radio button. nil: An ordinary menu item. *************** With prefix arg NOCONFIRM, execute curre *** 3032,3036 **** ;;;*** ! ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec) "edebug" "edebug.el" (12624 2197)) ;;; Generated autoloads from edebug.el --- 3033,3037 ---- ;;;*** ! ;;;### (autoloads (edebug-eval-top-level-form def-edebug-spec) "edebug" "edebug.el" (12790 20773)) ;;; Generated autoloads from edebug.el *************** or if an error occurs, leave point after *** 3050,3063 **** ;;;*** ! ;;;### (autoloads (ediff-documentation ediff-version ediff-revision ediff-patch-buffer run-ediff-from-cvs-buffer ediff-merge-revisions-with-ancestor ediff-merge-revisions ediff-merge-buffers-with-ancestor ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-files ediff-regions-linewise ediff-regions-wordwise ediff-windows-linewise ediff-windows-wordwise ediff-merge-directory-revisions-with-ancestor ediff-merge-directory-revisions ediff-merge-directories-with-ancestor ediff-merge-directories ediff-directories3 ediff-directory-revisions ediff-directories ediff-buffers3 ediff-buffers ediff-files3 ediff-files ediff-patch-file) "ediff" "ediff.el" (12580 9260)) ;;; Generated autoloads from ediff.el - (autoload (quote ediff-patch-file) "ediff" "\ - Run Ediff by patching SOURCE-FILENAME." t nil) - - (defalias (quote epatch) (quote ediff-patch-file)) - - (defalias (quote epatch-buffer) (quote ediff-patch-buffer)) - (autoload (quote ediff-files) "ediff" "\ Run Ediff on a pair of files, FILE-A and FILE-B." t nil) --- 3051,3057 ---- ;;;*** ! ;;;### (autoloads (ediff-documentation ediff-version ediff-revision ediff-patch-buffer ediff-patch-file run-ediff-from-cvs-buffer ediff-merge-revisions-with-ancestor ediff-merge-revisions ediff-merge-buffers-with-ancestor ediff-merge-buffers ediff-merge-files-with-ancestor ediff-merge-files ediff-regions-linewise ediff-regions-wordwise ediff-windows-linewise ediff-windows-wordwise ediff-merge-directory-revisions-with-ancestor ediff-merge-directory-revisions ediff-merge-directories-with-ancestor ediff-merge-directories ediff-directories3 ediff-directory-revisions ediff-directories ediff-buffers3 ediff-buffers ediff-files3 ediff-files) "ediff" "ediff.el" (12747 20842)) ;;; Generated autoloads from ediff.el (autoload (quote ediff-files) "ediff" "\ Run Ediff on a pair of files, FILE-A and FILE-B." t nil) *************** Run Ediff on three files, FILE-A, FILE-B *** 3073,3083 **** Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." t nil) (autoload (quote ediff-buffers3) "ediff" "\ Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." t nil) (autoload (quote ediff-directories) "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that ! further filters the file names." t nil) (defalias (quote edirs) (quote ediff-directories)) --- 3067,3081 ---- Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B." t nil) + (defalias (quote ebuffers) (quote ediff-buffers)) + (autoload (quote ediff-buffers3) "ediff" "\ Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C." t nil) + (defalias (quote ebuffers3) (quote ediff-buffers3)) + (autoload (quote ediff-directories) "ediff" "\ Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have the same name in both. The third argument, REGEXP, is a regular expression that ! can be used to filter out certain file names." t nil) (defalias (quote edirs) (quote ediff-directories)) *************** names. Only the files that are under rev *** 3093,3097 **** Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular ! expression that further filters the file names." t nil) (defalias (quote edirs3) (quote ediff-directories3)) --- 3091,3095 ---- Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that have the same name in all three. The last argument, REGEXP, is a regular ! expression that can be used to filter out certain file names." t nil) (defalias (quote edirs3) (quote ediff-directories3)) *************** expression that further filters the file *** 3100,3111 **** Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that ! further filters the file names." t nil) (defalias (quote edirs-merge) (quote ediff-merge-directories)) (autoload (quote ediff-merge-directories-with-ancestor) "ediff" "\ ! Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have ! the same name in both. The third argument, REGEXP, is a regular expression that ! further filters the file names." t nil) (autoload (quote ediff-merge-directory-revisions) "ediff" "\ --- 3098,3111 ---- Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have the same name in both. The third argument, REGEXP, is a regular expression that ! can be used to filter out certain file names." t nil) (defalias (quote edirs-merge) (quote ediff-merge-directories)) (autoload (quote ediff-merge-directories-with-ancestor) "ediff" "\ ! Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors. ! Ediff merges files that have identical names in DIR1, DIR2. If a pair of files ! in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge ! without ancestor. The fourth argument, REGEXP, is a regular expression that ! can be used to filter out certain file names." t nil) (autoload (quote ediff-merge-directory-revisions) "ediff" "\ *************** First run after `M-x cvs-update'. Then p *** 3183,3189 **** --- 3183,3196 ---- file and then run `run-ediff-from-cvs-buffer'." t nil) + (autoload (quote ediff-patch-file) "ediff" "\ + Run Ediff by patching SOURCE-FILENAME." t nil) + (autoload (quote ediff-patch-buffer) "ediff" "\ Run Ediff by patching BUFFER-NAME." t nil) + (defalias (quote epatch) (quote ediff-patch-file)) + + (defalias (quote epatch-buffer) (quote ediff-patch-buffer)) + (autoload (quote ediff-revision) "ediff" "\ Run Ediff by comparing versions of a file. *************** When called interactively, displays the *** 3196,3204 **** (autoload (quote ediff-documentation) "ediff" "\ ! Jump to Ediff's Info file." t nil) ;;;*** ! ;;;### (autoloads (ediff-show-registry) "ediff-mult" "ediff-mult.el" (12580 9252)) ;;; Generated autoloads from ediff-mult.el --- 3203,3211 ---- (autoload (quote ediff-documentation) "ediff" "\ ! Display Ediff's manual." t nil) ;;;*** ! ;;;### (autoloads (ediff-show-registry) "ediff-mult" "ediff-mult.el" (12747 21069)) ;;; Generated autoloads from ediff-mult.el *************** Turn on EDT Emulation." t nil) *** 3275,3279 **** ;;;*** ! ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" (12645 17531)) ;;; Generated autoloads from ehelp.el --- 3282,3286 ---- ;;;*** ! ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" (12719 4369)) ;;; Generated autoloads from ehelp.el *************** Prompts for bug subject. Leaves you in *** 3348,3352 **** ;;;*** ! ;;;### (autoloads (emerge-merge-directories emerge-revisions-with-ancestor emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" "emerge.el" (12592 59080)) ;;; Generated autoloads from emerge.el --- 3355,3359 ---- ;;;*** ! ;;;### (autoloads (emerge-merge-directories emerge-revisions-with-ancestor emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" "emerge.el" (12798 27204)) ;;; Generated autoloads from emerge.el *************** This function works by modifying `proces *** 3437,3441 **** ;;;*** ! ;;;### (autoloads (complete-tag select-tags-table tags-apropos list-tags tags-query-replace tags-search tags-loop-continue next-file find-tag-regexp find-tag-other-frame find-tag-other-window find-tag find-tag-noselect tags-table-files visit-tags-table) "etags" "etags.el" (12686 37769)) ;;; Generated autoloads from etags.el --- 3444,3448 ---- ;;;*** ! ;;;### (autoloads (complete-tag select-tags-table tags-apropos list-tags tags-query-replace tags-search tags-loop-continue next-file find-tag-regexp find-tag-other-frame find-tag-other-window find-tag find-tag-noselect tags-table-files visit-tags-table) "etags" "etags.el" (12789 21264)) ;;; Generated autoloads from etags.el *************** for \\[find-tag] (which see)." t nil) *** 3626,3630 **** ;;;*** ! ;;;### (autoloads (executable-self-display executable-set-magic) "executable" "executable.el" (12598 35455)) ;;; Generated autoloads from executable.el --- 3633,3637 ---- ;;;*** ! ;;;### (autoloads (executable-self-display executable-set-magic) "executable" "executable.el" (12786 35238)) ;;; Generated autoloads from executable.el *************** The magic number of such a command displ *** 3642,3646 **** ;;;*** ! ;;;### (autoloads (f90-mode) "f90" "f90.el" (12700 59718)) ;;; Generated autoloads from f90.el --- 3649,3653 ---- ;;;*** ! ;;;### (autoloads (f90-mode) "f90" "f90.el" (12755 36864)) ;;; Generated autoloads from f90.el *************** with no args, if that value is non-nil." *** 3706,3710 **** ;;;*** ! ;;;### (autoloads (list-colors-display facemenu-read-color list-text-properties-at facemenu-remove-special facemenu-remove-all facemenu-remove-props facemenu-set-read-only facemenu-set-intangible facemenu-set-invisible facemenu-set-face-from-menu facemenu-set-background facemenu-set-foreground facemenu-set-face) "facemenu" "facemenu.el" (12634 6160)) ;;; Generated autoloads from facemenu.el (define-key global-map "\M-g" 'facemenu-keymap) --- 3713,3717 ---- ;;;*** ! ;;;### (autoloads (list-colors-display facemenu-read-color list-text-properties-at facemenu-remove-special facemenu-remove-all facemenu-remove-props facemenu-set-read-only facemenu-set-intangible facemenu-set-invisible facemenu-set-face-from-menu facemenu-set-background facemenu-set-foreground facemenu-set-face) "facemenu" "facemenu.el" (12728 53123)) ;;; Generated autoloads from facemenu.el (define-key global-map "\M-g" 'facemenu-keymap) *************** of colors that the current display can h *** 3835,3843 **** ;;;*** ! ;;;### (autoloads (turn-on-fast-lock fast-lock-mode) "fast-lock" "fast-lock.el" (12552 36914)) ;;; Generated autoloads from fast-lock.el - (defvar fast-lock-mode nil) - (autoload (quote fast-lock-mode) "fast-lock" "\ Toggle Fast Lock mode. --- 3842,3848 ---- ;;;*** ! ;;;### (autoloads (turn-on-fast-lock fast-lock-mode) "fast-lock" "fast-lock.el" (12750 18247)) ;;; Generated autoloads from fast-lock.el (autoload (quote fast-lock-mode) "fast-lock" "\ Toggle Fast Lock mode. *************** With arg, turn Fast Lock mode on if and *** 3845,3849 **** is associated with a file. Enable it automatically in your `~/.emacs' by: ! (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) If Fast Lock mode is enabled, and the current buffer does not contain any text --- 3850,3854 ---- is associated with a file. Enable it automatically in your `~/.emacs' by: ! (setq font-lock-support-mode 'fast-lock-mode) If Fast Lock mode is enabled, and the current buffer does not contain any text *************** Use \\[fast-lock-submit-bug-report] to s *** 3870,3873 **** --- 3875,3880 ---- Unconditionally turn on Fast Lock mode." nil nil) + (if (fboundp (quote add-minor-mode)) (add-minor-mode (quote fast-lock-mode) nil)) + ;;;*** *************** in your `~/.emacs' file, replacing [f7] *** 4086,4090 **** ;;;*** ! ;;;### (autoloads (font-lock-fontify-buffer global-font-lock-mode turn-on-font-lock font-lock-mode) "font-lock" "font-lock.el" (12606 59029)) ;;; Generated autoloads from font-lock.el --- 4093,4097 ---- ;;;*** ! ;;;### (autoloads (font-lock-fontify-buffer global-font-lock-mode turn-on-font-lock font-lock-mode) "font-lock" "font-lock.el" (12797 18123)) ;;; Generated autoloads from font-lock.el *************** If a number, use that level of decoratio *** 4096,4102 **** If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c++-mode . 2) (c-mode . t) (t . 1)) ! means use level 2 decoration for buffers in `c++-mode', the maximum decoration ! available for buffers in `c-mode', and level 1 decoration otherwise.") (defvar font-lock-maximum-size (* 250 1024) "\ --- 4103,4109 ---- If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c-mode . t) (c++-mode . 2) (t . 1)) ! means use the maximum decoration available for buffers in C mode, level 2 ! decoration for buffers in C++ mode, and level 1 decoration otherwise.") (defvar font-lock-maximum-size (* 250 1024) "\ *************** If nil, means size is irrelevant. *** 4106,4112 **** If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c++-mode . 256000) (c-mode . 256000) (rmail-mode . 1048576)) ! means that the maximum size is 250K for buffers in `c++-mode' or `c-mode', one ! megabyte for buffers in `rmail-mode', and size is irrelevant otherwise.") (defvar font-lock-mode-hook nil "\ --- 4113,4119 ---- If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE), where MAJOR-MODE is a symbol or t (meaning the default). For example: ! ((c-mode . 256000) (c++-mode . 256000) (rmail-mode . 1048576)) ! means that the maximum size is 250K for buffers in C or C++ modes, one megabyte ! for buffers in Rmail mode, and size is irrelevant otherwise.") (defvar font-lock-mode-hook nil "\ *************** the major mode's hook. For example, put *** 4130,4149 **** Alternatively, you can use Global Font Lock mode to automagically turn on Font ! Lock mode in buffers whose major mode supports it, or in buffers whose major ! mode is one of `font-lock-global-modes'. For example, put in your ~/.emacs: (global-font-lock-mode t) ! The default Font Lock mode faces and their attributes are defined in the ! variable `font-lock-face-attributes', and Font Lock mode default settings in ! the variable `font-lock-defaults-alist'. You can set your own default settings ! for some mode, by setting a buffer local value for `font-lock-defaults', via ! its mode hook. ! ! Where modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. To fontify a buffer, without turning on Font Lock mode and regardless of buffer size, you can use \\[font-lock-fontify-buffer]. --- 4137,4158 ---- Alternatively, you can use Global Font Lock mode to automagically turn on Font ! Lock mode in buffers whose major mode supports it and whose major mode is one ! of `font-lock-global-modes'. For example, put in your ~/.emacs: (global-font-lock-mode t) ! There are a number of support modes that may be used to speed up Font Lock mode ! in various ways, specified via the variable `font-lock-support-mode'. Where ! major modes support different levels of fontification, you can use the variable `font-lock-maximum-decoration' to specify which level you generally prefer. When you turn Font Lock mode on/off the buffer is fontified/defontified, though fontification occurs only if the buffer is less than `font-lock-maximum-size'. + For example, to specify that Font Lock mode use use Lazy Lock mode as a support + mode and use maximum levels of fontification, put in your ~/.emacs: + + (setq font-lock-support-mode 'lazy-lock-mode) + (setq font-lock-maximum-decoration t) + To fontify a buffer, without turning on Font Lock mode and regardless of buffer size, you can use \\[font-lock-fontify-buffer]. *************** size, you can use \\[font-lock-fontify-b *** 4151,4168 **** To fontify a block (the function or paragraph containing point, or a number of lines around point), perhaps because modification on the current line caused ! syntactic change on other lines, you can use \\[font-lock-fontify-block]." t nil) (autoload (quote turn-on-font-lock) "font-lock" "\ Turn on Font Lock mode conditionally. ! Turn on only if the buffer mode supports it and the terminal can display it." nil nil) (defvar font-lock-global-modes t "\ ! *Modes for which Font Lock mode is automatically turned on. Global Font Lock mode is controlled by the `global-font-lock-mode' command. If nil, means no modes have Font Lock mode automatically turned on. If t, all modes that support Font Lock mode have it automatically turned on. ! If a list, each element should be a major mode symbol name such as `c-mode'. ! Font Lock is automatically turned on if the buffer major mode supports it and ! is in this list. The sense of the list is negated if it begins with `not'.") (autoload (quote global-font-lock-mode) "font-lock" "\ --- 4160,4185 ---- To fontify a block (the function or paragraph containing point, or a number of lines around point), perhaps because modification on the current line caused ! syntactic change on other lines, you can use \\[font-lock-fontify-block]. ! ! The default Font Lock mode faces and their attributes are defined in the ! variable `font-lock-face-attributes', and Font Lock mode default settings in ! the variable `font-lock-defaults-alist'. You can set your own default settings ! for some mode, by setting a buffer local value for `font-lock-defaults', via ! its mode hook." t nil) (autoload (quote turn-on-font-lock) "font-lock" "\ Turn on Font Lock mode conditionally. ! Turn on only if the terminal can display it." nil nil) (defvar font-lock-global-modes t "\ ! *Modes for which Font Lock mode is automagically turned on. Global Font Lock mode is controlled by the `global-font-lock-mode' command. If nil, means no modes have Font Lock mode automatically turned on. If t, all modes that support Font Lock mode have it automatically turned on. ! If a list, it should be a list of `major-mode' symbol names for which Font Lock ! mode should be automatically turned on. The sense of the list is negated if it ! begins with `not'. For example: ! (c-mode c++-mode) ! means that Font Lock mode is turned on for buffers in C and C++ modes only.") (autoload (quote global-font-lock-mode) "font-lock" "\ *************** When Global Font Lock mode is enabled, F *** 4175,4178 **** --- 4192,4210 ---- turned on in a buffer if its major mode is one of `font-lock-global-modes'." t nil) + (defvar font-lock-support-mode nil "\ + *Support mode for Font Lock mode. + Support modes speed up Font Lock mode by being choosy about when fontification + occurs. Known support modes are Fast Lock mode (symbol `fast-lock-mode') and + Lazy Lock mode (symbol `lazy-lock-mode'). See those modes for more info. + If nil, means support for Font Lock mode is never performed. + If a symbol, use that support mode. + If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE), + where MAJOR-MODE is a symbol or t (meaning the default). For example: + ((c-mode . fast-lock-mode) (c++-mode . fast-lock-mode) (t . lazy-lock-mode)) + means that Fast Lock mode is used to support Font Lock mode for buffers in C or + C++ modes, and Lazy Lock mode is used to support Font Lock mode otherwise. + + The value of this variable is used when Font Lock mode is turned on.") + (autoload (quote font-lock-fontify-buffer) "font-lock" "\ Fontify the current buffer the way `font-lock-mode' would." t nil) *************** with no args, if that value is non-nil." *** 4293,4316 **** ;;;*** ! ;;;### (autoloads (gnus-batch-score gnus read-news gnus-no-server) "gnus" "gnus.el" (12662 39334)) ;;; Generated autoloads from gnus.el (autoload (quote 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. 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) ! (autoload (quote read-news) "gnus" "\ ! Read network news. This is an alias for the `gnus' command." nil nil) (autoload (quote gnus) "gnus" "\ Read network news. If ARG is non-nil and a positive number, Gnus will use that as the ! startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." t nil) (defalias (quote gnus-batch-kill) (quote gnus-batch-score)) --- 4325,4364 ---- ;;;*** ! ;;;### (autoloads (gnus-batch-score gnus-fetch-group gnus gnus-other-frame gnus-slave gnus-no-server gnus-slave-no-server gnus-add-configuration gnus-update-format) "gnus" "gnus.el" (12777 3230)) ;;; Generated autoloads from gnus.el + (autoload (quote gnus-update-format) "gnus" "\ + Update the format specification near point." t nil) + + (autoload (quote gnus-add-configuration) "gnus" "\ + Add the window configuration CONF to `gnus-buffer-configuration'." nil nil) + + (autoload (quote gnus-slave-no-server) "gnus" "\ + Read network news as a slave, without connecting to local server" t nil) + (autoload (quote 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. 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) ! (autoload (quote gnus-slave) "gnus" "\ ! Read news as a slave." t nil) ! ! (autoload (quote gnus-other-frame) "gnus" "\ ! Pop up a frame to read news." t nil) (autoload (quote gnus) "gnus" "\ Read network news. If ARG is non-nil and a positive number, Gnus will use that as the ! startup level. If ARG is non-nil and not a positive number, Gnus will prompt the user for the name of an NNTP server to use." t nil) + (autoload (quote gnus-fetch-group) "gnus" "\ + Start Gnus if necessary and enter GROUP. + Returns whether the fetching was successful or not." t nil) + (defalias (quote gnus-batch-kill) (quote gnus-batch-score)) *************** Run batched scoring. *** 4319,4337 **** Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score ! the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." t nil) ;;;*** ! ;;;### (autoloads (gnus-post-news) "gnus-msg" "gnus-msg.el" (12586 7966)) ! ;;; Generated autoloads from gnus-msg.el ! (defalias (quote sendnews) (quote gnus-post-news)) ! (defalias (quote postnews) (quote gnus-post-news)) ! (autoload (quote gnus-post-news) "gnus-msg" "\ ! Begin editing a new USENET news article to be posted. ! Type \\[describe-mode] in the buffer to get a list of commands." t nil) ;;;*** --- 4367,4401 ---- Usage: emacs -batch -l gnus -f gnus-batch-score ... Newsgroups is a list of strings in Bnews format. If you want to score ! the comp hierarchy, you'd say \"comp.all\". If you would not like to score the alt hierarchy, you'd say \"!alt.all\"." t nil) ;;;*** ! ;;;### (autoloads (gnus-cache-generate-nov-databases gnus-cache-generate-active gnus-jog-cache) "gnus-cache" "gnus-cache.el" (12777 3818)) ! ;;; Generated autoloads from gnus-cache.el ! (autoload (quote gnus-jog-cache) "gnus-cache" "\ ! Go through all groups and put the articles into the cache." t nil) ! (autoload (quote gnus-cache-generate-active) "gnus-cache" "\ ! Generate the cache active file." t nil) ! (autoload (quote gnus-cache-generate-nov-databases) "gnus-cache" "\ ! Generate NOV files recursively starting in DIR." t nil) ! ! ;;;*** ! ! ;;;### (autoloads (gnus-batch-brew-soup) "gnus-soup" "gnus-soup.el" (12752 26765)) ! ;;; Generated autoloads from gnus-soup.el ! ! (autoload (quote gnus-batch-brew-soup) "gnus-soup" "\ ! Brew a SOUP packet from groups mention on the command line. ! Will use the remaining command line arguments as regular expressions ! for matching on group names. ! ! For instance, if you want to brew on all the nnml groups, as well as ! groups with \"emacs\" in the name, you could say something like: ! ! $ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" t nil) ;;;*** *************** Use \\[describe-mode] for more info." t *** 4356,4360 **** ;;;*** ! ;;;### (autoloads (goto-address goto-address-at-point goto-address-at-mouse) "goto-addr" "goto-addr.el" (12659 6744)) ;;; Generated autoloads from goto-addr.el --- 4420,4424 ---- ;;;*** ! ;;;### (autoloads (goto-address goto-address-at-point goto-address-at-mouse) "goto-addr" "goto-addr.el" (12755 36278)) ;;; Generated autoloads from goto-addr.el *************** Also fontifies the buffer appropriately *** 4382,4386 **** ;;;*** ! ;;;### (autoloads (perldb xdb dbx sdb gdb) "gud" "gud.el" (12690 44131)) ;;; Generated autoloads from gud.el --- 4446,4450 ---- ;;;*** ! ;;;### (autoloads (perldb xdb dbx sdb gdb) "gud" "gud.el" (12801 12634)) ;;; Generated autoloads from gud.el *************** Provide help for current mode." t nil) *** 4446,4450 **** ;;;*** ! ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" "hexl.el" (12639 13304)) ;;; Generated autoloads from hexl.el --- 4510,4514 ---- ;;;*** ! ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" "hexl.el" (12732 38215)) ;;; Generated autoloads from hexl.el *************** variables to default values and disables *** 4604,4608 **** ;;;*** ! ;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp" "hippie-exp.el" (12550 53148)) ;;; Generated autoloads from hippie-exp.el --- 4668,4672 ---- ;;;*** ! ;;;### (autoloads (make-hippie-expand-function hippie-expand) "hippie-exp" "hippie-exp.el" (12742 55524)) ;;; Generated autoloads from hippie-exp.el *************** argument VERBOSE non-nil makes the funct *** 4641,4645 **** ;;;*** ! ;;;### (autoloads (icomplete-minibuffer-setup icomplete-mode) "icomplete" "icomplete.el" (12536 45574)) ;;; Generated autoloads from icomplete.el --- 4705,4709 ---- ;;;*** ! ;;;### (autoloads (icomplete-minibuffer-setup icomplete-mode) "icomplete" "icomplete.el" (12716 34325)) ;;; Generated autoloads from icomplete.el *************** Switches to the buffer `*ielm*', or crea *** 4702,4706 **** ;;;*** ! ;;;### (autoloads (imenu imenu-add-to-menubar) "imenu" "imenu.el" (12620 12567)) ;;; Generated autoloads from imenu.el --- 4766,4770 ---- ;;;*** ! ;;;### (autoloads (imenu imenu-add-to-menubar) "imenu" "imenu.el" (12734 56173)) ;;; Generated autoloads from imenu.el *************** of `inferior-lisp-program'). Runs the h *** 4797,4801 **** ;;;*** ! ;;;### (autoloads (Info-goto-emacs-key-command-node Info-goto-emacs-command-node info-standalone info) "info" "info.el" (12686 40577)) ;;; Generated autoloads from info.el (add-hook 'same-window-buffer-names "*info*") --- 4861,4865 ---- ;;;*** ! ;;;### (autoloads (Info-goto-emacs-key-command-node Info-goto-emacs-command-node info-standalone info) "info" "info.el" (12758 13973)) ;;; Generated autoloads from info.el (add-hook 'same-window-buffer-names "*info*") *************** and a negative argument disables it." t *** 4892,4896 **** ;;;*** ! ;;;### (autoloads (ispell-message ispell-minor-mode ispell-complete-word-interior-frag ispell-complete-word ispell-continue ispell-buffer ispell-region ispell-change-dictionary ispell-kill-ispell ispell-help ispell-word) "ispell" "ispell.el" (12690 11518)) ;;; Generated autoloads from ispell.el --- 4956,4960 ---- ;;;*** ! ;;;### (autoloads (ispell-message ispell-minor-mode ispell-complete-word-interior-frag ispell-complete-word ispell-continue ispell-buffer ispell-region ispell-change-dictionary ispell-kill-ispell ispell-help ispell-word) "ispell" "ispell.el" (12755 40305)) ;;; Generated autoloads from ispell.el *************** Don't check spelling of message headers *** 5049,5059 **** Don't check included messages. ! To abort spell checking of a message REGION and send the message anyway, ! use the `x' or `q' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: ! (add-hook 'news-inews-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) --- 5113,5123 ---- Don't check included messages. ! To abort spell checking of a message region and send the message anyway, ! use the `x' command. (Any subsequent regions will be checked.) The `X' command aborts the message send so that you can edit the buffer. To spell-check whenever a message is sent, include the appropriate lines in your .emacs file: ! (add-hook 'message-send-hook 'ispell-message) (add-hook 'mail-send-hook 'ispell-message) (add-hook 'mh-before-send-letter-hook 'ispell-message) *************** Returns the new status of auto compressi *** 5082,5085 **** --- 5146,5195 ---- ;;;*** + ;;;### (autoloads (turn-on-lazy-lock lazy-lock-mode) "lazy-lock" "lazy-lock.el" (12750 18454)) + ;;; Generated autoloads from lazy-lock.el + + (autoload (quote lazy-lock-mode) "lazy-lock" "\ + Toggle Lazy Lock mode. + With arg, turn Lazy Lock mode on if and only if arg is positive. Enable it + automatically in your `~/.emacs' by: + + (setq font-lock-support-mode 'lazy-lock-mode) + + When Lazy Lock mode is enabled, fontification can be lazy in a number of ways: + + - Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil. + This means initial fontification does not occur if the buffer is greater + than `lazy-lock-minimum-size' characters in length. Instead, fontification + occurs when necessary, such as when scrolling through the buffer would + otherwise reveal unfontified areas. This is useful if buffer fontification + is too slow for large buffers. + + - Defer-driven buffer fontification if `lazy-lock-defer-driven' is non-nil. + This means all fontification is deferred, such as fontification that occurs + when scrolling through the buffer would otherwise reveal unfontified areas. + Instead, these areas are seen momentarily unfontified. This is useful if + demand-driven fontification is too slow to keep up with scrolling. + + - Deferred on-the-fly fontification if `lazy-lock-defer-time' is non-nil. + This means on-the-fly fontification does not occur as you type. Instead, + fontification is deferred until after `lazy-lock-defer-time' seconds of + Emacs idle time, while Emacs remains idle. This is useful if on-the-fly + fontification is too slow to keep up with your typing. + + - Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil. + This means remaining unfontified areas of buffers are fontified if Emacs has + been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle. + This is useful if any buffer has demand- or defer-driven fontification. + + See also variables `lazy-lock-stealth-lines', `lazy-lock-stealth-nice' and + `lazy-lock-stealth-verbose' for stealth fontification. + + Use \\[lazy-lock-submit-bug-report] to send bug reports or feedback." t nil) + + (autoload (quote turn-on-lazy-lock) "lazy-lock" "\ + Unconditionally turn on Lazy Lock mode." nil nil) + + ;;;*** + ;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el" (12536 45574)) ;;; Generated autoloads from ledit.el *************** This function is suitable for execution *** 5182,5186 **** ;;;*** ! ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro name-last-kbd-macro) "macros" "macros.el" (12554 59502)) ;;; Generated autoloads from macros.el --- 5292,5296 ---- ;;;*** ! ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro name-last-kbd-macro) "macros" "macros.el" (12716 34333)) ;;; Generated autoloads from macros.el *************** and then select the region of un-tablifi *** 5262,5266 **** ;;;*** ! ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" "mail-extr.el" (12587 31302)) ;;; Generated autoloads from mail-extr.el --- 5372,5376 ---- ;;;*** ! ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" "mail-extr.el" (12752 13978)) ;;; Generated autoloads from mail-extr.el *************** Convert mail domain DOMAIN to the countr *** 5282,5286 **** ;;;*** ! ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-enable mail-hist-define-keys) "mail-hist" "mail-hist.el" (12689 407)) ;;; Generated autoloads from mail-hist.el --- 5392,5396 ---- ;;;*** ! ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-enable mail-hist-define-keys) "mail-hist" "mail-hist.el" (12785 6028)) ;;; Generated autoloads from mail-hist.el *************** This function normally would be called w *** 5302,5306 **** ;;;*** ! ;;;### (autoloads (mail-fetch-field mail-file-babyl-p) "mail-utils" "mail-utils.el" (12653 17008)) ;;; Generated autoloads from mail-utils.el --- 5412,5416 ---- ;;;*** ! ;;;### (autoloads (mail-fetch-field mail-file-babyl-p) "mail-utils" "mail-utils.el" (12765 6689)) ;;; Generated autoloads from mail-utils.el *************** If third arg ALL is non-nil, concatenate *** 5320,5324 **** ;;;*** ! ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup) "mailabbrev" "mailabbrev.el" (12609 17904)) ;;; Generated autoloads from mailabbrev.el --- 5430,5434 ---- ;;;*** ! ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup) "mailabbrev" "mailabbrev.el" (12715 6275)) ;;; Generated autoloads from mailabbrev.el *************** If DEFINITION contains multiple addresse *** 5336,5340 **** ;;;*** ! ;;;### (autoloads (mail-complete define-mail-alias) "mailalias" "mailalias.el" (12609 15124)) ;;; Generated autoloads from mailalias.el --- 5446,5450 ---- ;;;*** ! ;;;### (autoloads (mail-complete define-mail-alias) "mailalias" "mailalias.el" (12750 25780)) ;;; Generated autoloads from mailalias.el *************** current header, calls `mail-complete-fun *** 5355,5359 **** ;;;*** ! ;;;### (autoloads (makefile-mode) "make-mode" "make-mode.el" (12594 2787)) ;;; Generated autoloads from make-mode.el --- 5465,5469 ---- ;;;*** ! ;;;### (autoloads (makefile-mode) "make-mode" "make-mode.el" (12754 15556)) ;;; Generated autoloads from make-mode.el *************** If a buffer already exists for this man *** 5458,5461 **** --- 5568,5827 ---- ;;;*** + ;;;### (autoloads (unbold-region bold-region message-news-other-frame message-news-other-window message-mail-other-frame message-mail-other-window message-bounce message-resend message-forward message-recover message-supersede message-cancel-news message-followup message-wide-reply message-reply message-news message-mail message-mode) "message" "message.el" (12780 9694)) + ;;; Generated autoloads from message.el + + (defvar message-fcc-handler-function (quote rmail-output) "\ + *A function called to save outgoing articles. + This function will be called with the name of the file to store the + article in. The default function is `rmail-output' which saves in Unix + mailbox format.") + + (defvar message-courtesy-message "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" "\ + *This is inserted at the start of a mailed copy of a posted message. + If this variable is nil, no such courtesy message will be added.") + + (defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" "\ + *Regexp that matches headers to be removed in resent bounced mail.") + + (defvar message-from-style (quote default) "\ + *Specifies how \"From\" headers look. + + If `nil', they contain just the return address like: + king@grassland.com + If `parens', they look like: + king@grassland.com (Elvis Parsley) + If `angles', they look like: + Elvis Parsley + + Otherwise, most addresses look like `angles', but they look like + `parens' if `angles' would need quoting and `parens' would not.") + + (defvar message-syntax-checks nil "\ + Controls what syntax checks should not be performed on outgoing posts. + To disable checking of long signatures, for instance, add + `(signature . disabled)' to this list. + + Don't touch this variable unless you really know what you're doing. + + Checks include subject-cmsg multiple-headers sendsys message-id from + long-lines control-chars size new-text redirected-followup signature + approved sender empty empty-headers message-id from subject.") + + (defvar message-required-news-headers (quote (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, + Message-ID. Organization, Lines, In-Reply-To, Expires, and + X-Newsreader are optional. If don't you want message to insert some + header, remove it from this list.") + + (defvar message-required-mail-headers (quote (From Subject Date (optional . In-Reply-To) Message-ID Lines (optional . X-Mailer))) "\ + *Headers to be generated or prompted for when mailing a message. + RFC822 required that From, Date, To, Subject and Message-ID be + included. Organization, Lines and X-Mailer are optional.") + + (defvar message-deletable-headers (quote (Message-ID Date)) "\ + *Headers to be deleted if they already exist and were generated by message previously.") + + (defvar message-ignored-news-headers "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:" "\ + *Regexp of headers to be removed unconditionally before posting.") + + (defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:" "\ + *Regexp of headers to be removed unconditionally before mailing.") + + (defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:" "\ + *Header lines matching this regexp will be deleted before posting. + It's best to delete old Path and Date headers before posting to avoid + any confusion.") + + (defvar message-signature-separator "^-- *$" "\ + Regexp matching the signature separator.") + + (defvar 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.") + + (defvar message-generate-new-buffers t "\ + *Non-nil means that a new message buffer will be created whenever `mail-setup' is called. + If this is a function, call that function with three parameters: The type, + the to address and the group name. (Any of these may be nil.) The function + should return the new buffer name.") + + (defvar message-kill-buffer-on-exit nil "\ + *Non-nil means that the message buffer will be killed after sending a message.") + + (defvar message-user-organization-file "/usr/lib/news/organization" "\ + *Local news organization file.") + + (defvar message-signature-before-forwarded-message t "\ + *If non-nil, put the signature before any included forwarded message.") + + (defvar 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.") + + (defvar message-ignored-resent-headers "^Return-receipt" "\ + *All headers that match this regexp will be deleted when resending a message.") + + (defvar message-ignored-cited-headers "." "\ + Delete these headers from the messages you yank.") + + (defvar message-send-mail-function (quote message-send-mail-with-sendmail) "\ + Function to call to send the current buffer as mail. + The headers should be delimited by a line whose contents match the + variable `mail-header-separator'. + + Legal values include `message-send-mail-with-mh' and + `message-send-mail-with-sendmail', which is the default.") + + (defvar message-send-news-function (quote message-send-news) "\ + Function to call to send the current buffer as news. + The headers should be delimited by a line whose contents match the + variable `mail-header-separator'.") + + (defvar message-reply-to-function nil "\ + Function that should return a list of headers. + This function should pick out addresses from the To, Cc, and From headers + and respond with new To and Cc headers.") + + (defvar message-wide-reply-to-function nil "\ + Function that should return a list of headers. + This function should pick out addresses from the To, Cc, and From headers + and respond with new To and Cc headers.") + + (defvar message-followup-to-function nil "\ + Function that should return a list of headers. + This function should pick out addresses from the To, Cc, and From headers + and respond with new To and Cc headers.") + + (defvar message-use-followup-to (quote ask) "\ + *Specifies what to do with Followup-To header. + If nil, ignore the header. If it is t, use its value, but query before + using the \"poster\" value. If it is the symbol `ask', query the user + whether to ignore the \"poster\" value. If it is the symbol `use', + always use the value.") + + (defvar message-post-method (cond ((and (boundp (quote gnus-post-method)) gnus-post-method) gnus-post-method) ((boundp (quote gnus-select-method)) gnus-select-method) (t (quote (nnspool "")))) "\ + Method used to post news.") + + (defvar message-generate-headers-first nil "\ + *If non-nil, generate all possible headers before composing.") + + (defvar message-citation-line-function (quote message-insert-citation-line) "\ + *Function called to insert the \"Whomever writes:\" line.") + + (defvar message-yank-prefix "> " "\ + *Prefix inserted on the lines of yanked messages. + nil means use indentation.") + + (defvar message-cite-function (quote message-cite-original) "\ + *Function for citing an original message.") + + (defvar message-indent-citation-function (quote message-indent-citation) "\ + *Function for modifying a citation just inserted in the mail buffer. + This can also be a list of functions. Each function can find the + citation between (point) and (mark t). And each function should leave + point and mark around the citation text as modified.") + + (defvar message-signature t "\ + *String to be inserted at the end of the message buffer. + If t, the `message-signature-file' file will be inserted instead. + If a function, the result from the function will be used instead. + If a form, the result from the form will be used instead.") + + (defvar message-signature-file "~/.signature" "\ + *File containing the text inserted at end of message. buffer.") + + (defvar message-default-headers nil "\ + *A string containing header lines to be inserted in outgoing messages. + It is inserted before you edit the message, so you can edit or delete + these lines.") + + (defvar message-default-mail-headers nil "\ + *A string of header lines to be inserted in outgoing mails.") + + (defvar message-default-news-headers nil "\ + *A string of header lines to be inserted in outgoing news articles.") + + (autoload (quote message-mode) "message" "\ + Major mode for editing mail and news to be sent. + Like Text Mode but with these additional commands: + C-c C-s message-send (send the message) C-c C-c message-send-and-exit + C-c C-f move to a header field (and create it if there isn't): + C-c C-f C-t move to To C-c C-f C-s move to Subject + C-c C-f C-c move to Cc C-c C-f C-b move to Bcc + C-c C-f C-f move to Fcc C-c C-f C-r move to Reply-To + C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups + C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution + C-c C-f C-o move to Followup-To + C-c C-t message-insert-to (add a To header to a news followup) + C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) + C-c C-b message-goto-body (move to beginning of message text). + C-c C-i message-goto-signature (move to the beginning of the signature). + C-c C-w message-insert-signature (insert `message-signature-file' file). + C-c C-y message-yank-original (insert current message, if any). + C-c C-q message-fill-yanked-message (fill what was yanked). + C-c C-r message-ceasar-buffer-body (rot13 the message body)." t nil) + + (autoload (quote message-mail) "message" "\ + Start editing a mail message to be sent." t nil) + + (autoload (quote message-news) "message" "\ + Start editing a news article to be sent." t nil) + + (autoload (quote message-reply) "message" "\ + Start editing a reply to the article in the current buffer." t nil) + + (autoload (quote message-wide-reply) "message" nil t nil) + + (autoload (quote message-followup) "message" nil t nil) + + (autoload (quote message-cancel-news) "message" "\ + Cancel an article you posted." t nil) + + (autoload (quote message-supersede) "message" "\ + Start composing a message to supersede the current message. + This is done simply by taking the old article and adding a Supersedes + header line with the old Message-ID." t nil) + + (autoload (quote message-recover) "message" "\ + Reread contents of current buffer from its last auto-save file." t nil) + + (autoload (quote message-forward) "message" "\ + Forward the current message via mail. + Optional NEWS will use news to forward instead of mail." t nil) + + (autoload (quote message-resend) "message" "\ + Resend the current article to ADDRESS." t nil) + + (autoload (quote message-bounce) "message" "\ + Re-mail the current message. + This only makes sense if the current message is a bounce message than + contains some mail you have written which has been bounced back to + you." t nil) + + (autoload (quote message-mail-other-window) "message" "\ + Like `message-mail' command, but display mail buffer in another window." t nil) + + (autoload (quote message-mail-other-frame) "message" "\ + Like `message-mail' command, but display mail buffer in another frame." t nil) + + (autoload (quote message-news-other-window) "message" "\ + Start editing a news article to be sent." t nil) + + (autoload (quote message-news-other-frame) "message" "\ + Start editing a news article to be sent." t nil) + + (autoload (quote bold-region) "message" "\ + Bold all nonblank characters in the region. + Works by overstriking characters. + Called from program, takes two arguments START and END + which specify the range to operate on." t nil) + + (autoload (quote unbold-region) "message" "\ + Remove all boldness (overstruck characters) in the region. + Called from program, takes two arguments START and END + which specify the range to operate on." t nil) + + ;;;*** + ;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body metamail-interpret-header) "metamail" "metamail.el" (12663 54771)) ;;; Generated autoloads from metamail.el *************** Legal MIME content types. See documenta *** 5572,5576 **** ;;;*** ! ;;;### (autoloads nil "mh-utils" "mh-utils.el" (12557 21887)) ;;; Generated autoloads from mh-utils.el --- 5938,5942 ---- ;;;*** ! ;;;### (autoloads nil "mh-utils" "mh-utils.el" (12755 33294)) ;;; Generated autoloads from mh-utils.el *************** Multiplication puzzle with GNU Emacs." t *** 5626,5630 **** ;;;*** ! ;;;### (autoloads (nnkiboze-generate-groups) "nnkiboze" "nnkiboze.el" (12540 16656)) ;;; Generated autoloads from nnkiboze.el --- 5992,6004 ---- ;;;*** ! ;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "nnfolder.el" (12756 29868)) ! ;;; Generated autoloads from nnfolder.el ! ! (autoload (quote nnfolder-generate-active-file) "nnfolder" "\ ! Look for mbox folders in the nnfolder directory and make them into groups." t nil) ! ! ;;;*** ! ! ;;;### (autoloads (nnkiboze-generate-groups) "nnkiboze" "nnkiboze.el" (12752 26144)) ;;; Generated autoloads from nnkiboze.el *************** Finds out what articles are to be part o *** 5635,5643 **** ;;;*** ! ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "nnml.el" (12536 45574)) ;;; Generated autoloads from nnml.el (autoload (quote nnml-generate-nov-databases) "nnml" "\ ! Generate nov databases in all nnml mail newsgroups." t nil) ;;;*** --- 6009,6031 ---- ;;;*** ! ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "nnml.el" (12756 29670)) ;;; Generated autoloads from nnml.el (autoload (quote nnml-generate-nov-databases) "nnml" "\ ! Generate nov databases in all nnml directories." t nil) ! ! ;;;*** ! ! ;;;### (autoloads (nnsoup-revert-variables nnsoup-set-variables nnsoup-pack-replies) "nnsoup" "nnsoup.el" (12752 26882)) ! ;;; Generated autoloads from nnsoup.el ! ! (autoload (quote nnsoup-pack-replies) "nnsoup" "\ ! Make an outbound package of SOUP replies." t nil) ! ! (autoload (quote nnsoup-set-variables) "nnsoup" "\ ! Use the SOUP methods for posting news and mailing mail." t nil) ! ! (autoload (quote nnsoup-revert-variables) "nnsoup" "\ ! Revert posting and mailing methods to the standard Emacs methods." t nil) ;;;*** *************** they are not defaultly assigned to keys. *** 5946,5950 **** ;;;*** ! ;;;### (autoloads (pp-eval-last-sexp pp-eval-expression pp) "pp" "pp.el" (12543 32626)) ;;; Generated autoloads from pp.el --- 6334,6338 ---- ;;;*** ! ;;;### (autoloads (pp-eval-last-sexp pp-eval-expression pp) "pp" "pp.el" (12742 53103)) ;;; Generated autoloads from pp.el *************** Run an inferior Prolog process, input an *** 5984,5988 **** ;;;*** ! ;;;### (autoloads (ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "ps-print.el" (12679 63685)) ;;; Generated autoloads from ps-print.el --- 6372,6376 ---- ;;;*** ! ;;;### (autoloads (ps-despool ps-spool-region-with-faces ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ps-print-buffer) "ps-print" "ps-print.el" (12787 44357)) ;;; Generated autoloads from ps-print.el *************** When called from a program, requires two *** 6119,6125 **** ;;;*** ! ;;;### (autoloads (reporter-submit-bug-report) "reporter" "reporter.el" (12557 20662)) ;;; Generated autoloads from reporter.el (autoload (quote reporter-submit-bug-report) "reporter" nil nil nil) --- 6507,6528 ---- ;;;*** ! ;;;### (autoloads (reporter-submit-bug-report) "reporter" "reporter.el" (12761 52437)) ;;; Generated autoloads from reporter.el + (defvar mail-user-agent (quote sendmail-user-agent) "\ + *Your preference for a mail composition package. + Various Emacs Lisp packages (e.g. reporter) require you to compose an + outgoing email message. As there are several such packages available + for Emacs, you can indicate your preference by setting this variable. + + Valid values currently are: + + 'sendmail-user-agent -- use Emacs built-in Mail package + 'vm-user-agent -- use Kyle Jones' VM package + 'mh-e-user-agent -- use the Emacs interface to the MH mail system + + Additional valid symbols may be available; check with the author of + your package for details.") + (autoload (quote reporter-submit-bug-report) "reporter" nil nil nil) *************** Make a ring that can contain SIZE elemen *** 6170,6179 **** ;;;*** ! ;;;### (autoloads (rlogin) "rlogin" "rlogin.el" (12687 61518)) ;;; Generated autoloads from rlogin.el (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)") (autoload (quote rlogin) "rlogin" "\ ! Open a network login connection to HOST via the `rlogin' program. Input is sent line-at-a-time to the remote connection. --- 6573,6585 ---- ;;;*** ! ;;;### (autoloads (rlogin) "rlogin" "rlogin.el" (12748 51349)) ;;; Generated autoloads from rlogin.el (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)") (autoload (quote rlogin) "rlogin" "\ ! Open a network login connection via `rlogin' with args INPUT-ARGS. ! INPUT-ARGS should start with a host name; it may also contain ! other arguments for `rlogin'. ! Input is sent line-at-a-time to the remote connection. *************** If a prefix argument is given and the bu *** 6183,6188 **** a new buffer with a different connection will be made. ! When called from a program, if the optional second argument is a string or ! buffer, it names the buffer to use. The variable `rlogin-program' contains the name of the actual program to --- 6589,6594 ---- a new buffer with a different connection will be made. ! When called from a program, if the optional second argument BUFFER is ! a string or buffer, it specifies the buffer to use. The variable `rlogin-program' contains the name of the actual program to *************** variable." t nil) *** 6210,6214 **** ;;;*** ! ;;;### (autoloads (rmail-input rmail-mode rmail) "rmail" "rmail.el" (12673 10151)) ;;; Generated autoloads from rmail.el --- 6616,6620 ---- ;;;*** ! ;;;### (autoloads (rmail-input rmail-mode rmail) "rmail" "rmail.el" (12786 33193)) ;;; Generated autoloads from rmail.el *************** Run Rmail on file FILENAME." t nil) *** 6341,6345 **** ;;;*** ! ;;;### (autoloads nil "rmailsum" "rmailsum.el" (12644 27)) ;;; Generated autoloads from rmailsum.el --- 6747,6751 ---- ;;;*** ! ;;;### (autoloads nil "rmailsum" "rmailsum.el" (12774 62518)) ;;; Generated autoloads from rmailsum.el *************** counterparts." t nil) *** 6430,6434 **** ;;;*** ! ;;;### (autoloads (scheme-mode) "scheme" "scheme.el" (12536 45574)) ;;; Generated autoloads from scheme.el --- 6836,6840 ---- ;;;*** ! ;;;### (autoloads (scheme-mode) "scheme" "scheme.el" (12763 19530)) ;;; Generated autoloads from scheme.el *************** if that value is non-nil." t nil) *** 6453,6456 **** --- 6859,6873 ---- ;;;*** + ;;;### (autoloads (gnus-score-mode) "score-mode" "score-mode.el" (12758 49973)) + ;;; Generated autoloads from score-mode.el + + (autoload (quote gnus-score-mode) "score-mode" "\ + Mode for editing Gnus score files. + This mode is an extended emacs-lisp mode. + + \\{gnus-score-mode-map}" t nil) + + ;;;*** + ;;;### (autoloads (scribe-mode) "scribe" "scribe.el" (12536 45574)) ;;; Generated autoloads from scribe.el *************** scribe-electric-parenthesis *** 6475,6479 **** ;;;*** ! ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (12684 9816)) ;;; Generated autoloads from sendmail.el --- 6892,6896 ---- ;;;*** ! ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (12755 38587)) ;;; Generated autoloads from sendmail.el *************** Prefix arg means just kill any existing *** 6614,6618 **** ;;;*** ! ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "sgml-mode.el" (12570 12618)) ;;; Generated autoloads from sgml-mode.el --- 7031,7035 ---- ;;;*** ! ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "sgml-mode.el" (12739 17407)) ;;; Generated autoloads from sgml-mode.el *************** do: *** 6667,6671 **** ;;;*** ! ;;;### (autoloads (sh-mode) "sh-script" "sh-script.el" (12658 48259)) ;;; Generated autoloads from sh-script.el --- 7084,7088 ---- ;;;*** ! ;;;### (autoloads (sh-mode) "sh-script" "sh-script.el" (12778 42738)) ;;; Generated autoloads from sh-script.el *************** with your script for an edit-interpret-d *** 6721,6734 **** ;;;*** ! ;;;### (autoloads (list-load-path-shadows) "shadow" "shadow.el" (12550 53409)) ;;; Generated autoloads from shadow.el (autoload (quote list-load-path-shadows) "shadow" "\ ! Display a list of Emacs Lisp files that create shadows. This function lists potential load-path problems. Directories in the `load-path' variable are searched, in order, for Emacs Lisp ! files. When a previously encountered file name is re-located, a ! message is displayed indicating that the later file is \"shadowed\" by the earlier. --- 7138,7151 ---- ;;;*** ! ;;;### (autoloads (list-load-path-shadows) "shadow" "shadow.el" (12788 55803)) ;;; Generated autoloads from shadow.el (autoload (quote list-load-path-shadows) "shadow" "\ ! Display a list of Emacs Lisp files that shadow other files. This function lists potential load-path problems. Directories in the `load-path' variable are searched, in order, for Emacs Lisp ! files. When a previously encountered file name is found again, a ! message is displayed indicating that the later file is \"hidden\" by the earlier. *************** buffer called `*Shadows*'. Shadowings a *** 6765,6769 **** ;;;*** ! ;;;### (autoloads (shell) "shell" "shell.el" (12563 25910)) ;;; Generated autoloads from shell.el --- 7182,7186 ---- ;;;*** ! ;;;### (autoloads (shell) "shell" "shell.el" (12801 12210)) ;;; Generated autoloads from shell.el *************** Otherwise, one argument `-i' is passed t *** 6804,6812 **** ;;;*** ! ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy define-skeleton) "skeleton" "skeleton.el" (12599 6572)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter (quote identity) "\ ! Function for transforming a skeleton-proxy's aliases' variable value.") (autoload (quote define-skeleton) "skeleton" "\ --- 7221,7229 ---- ;;;*** ! ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy skeleton-proxy-new define-skeleton) "skeleton" "skeleton.el" (12752 13637)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter (quote identity) "\ ! Function for transforming a skeleton proxy's aliases' variable value.") (autoload (quote define-skeleton) "skeleton" "\ *************** which contains the skeleton, has a docum *** 6816,6822 **** --- 7233,7253 ---- INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'." nil (quote macro)) + (autoload (quote skeleton-proxy-new) "skeleton" "\ + Insert skeleton defined by variable of same name (see `skeleton-insert'). + Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). + If no ARG was given, but the region is visible, ARG defaults to -1 depending + on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. + This command can also be an abbrev expansion (3rd and 4th columns in + \\[edit-abbrevs] buffer: \"\" command-name). + + When called as a function, optional first argument STR may also be a string + which will be the value of `str' whereas the skeleton's interactor is then + ignored." t nil) + (autoload (quote skeleton-proxy) "skeleton" "\ Insert skeleton defined by variable of same name (see `skeleton-insert'). Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). + If no ARG was given, but the region is visible, ARG defaults to -1 depending + on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. This command can also be an abbrev expansion (3rd and 4th columns in \\[edit-abbrevs] buffer: \"\" command-name). *************** formatted with `skeleton-subprompt'. Su *** 6865,6870 **** strings with the subskeleton being repeated once for each string. ! Quoted lisp-expressions are evaluated evaluated for their side-effect. ! Other lisp-expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this implies an endless loop. Modes can define other symbols by locally setting them --- 7296,7301 ---- strings with the subskeleton being repeated once for each string. ! Quoted Lisp expressions are evaluated evaluated for their side-effect. ! Other Lisp expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this implies an endless loop. Modes can define other symbols by locally setting them *************** available: *** 6876,6880 **** help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str ! v1, v2 local variables for memorising anything you want When done with skeleton, but before going back to `_'-point call --- 7307,7311 ---- help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str ! v1, v2 local variables for memorizing anything you want When done with skeleton, but before going back to `_'-point call *************** When done with skeleton, but before goin *** 6884,6889 **** Insert the character you type ARG times. ! With no ARG, if `skeleton-pair' is non-nil, and if ! `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. --- 7315,7321 ---- Insert the character you type ARG times. ! With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region ! is visible the pair is wrapped around it depending on `skeleton-autowrap'. ! Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. *************** Connect to display DISPLAY for the Emacs *** 7226,7230 **** ;;;*** ! ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (12605 17260)) ;;; Generated autoloads from tar-mode.el --- 7658,7662 ---- ;;;*** ! ;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (12767 4318)) ;;; Generated autoloads from tar-mode.el *************** See also: variables `tar-update-datestam *** 7247,7251 **** ;;;*** ! ;;;### (autoloads (tcl-mode) "tcl-mode" "tcl-mode.el" (12536 45574)) ;;; Generated autoloads from tcl-mode.el --- 7679,7683 ---- ;;;*** ! ;;;### (autoloads (tcl-mode) "tcl-mode" "tcl-mode.el" (12761 19256)) ;;; Generated autoloads from tcl-mode.el *************** Normally input is edited in Emacs and se *** 7275,7279 **** ;;;*** ! ;;;### (autoloads (term make-term) "term" "term.el" (12700 60494)) ;;; Generated autoloads from term.el --- 7707,7711 ---- ;;;*** ! ;;;### (autoloads (term make-term) "term" "term.el" (12749 26402)) ;;; Generated autoloads from term.el *************** subprocess started." t nil) *** 7324,7328 **** ;;;*** ! ;;;### (autoloads (tex-start-shell slitex-mode latex-mode plain-tex-mode tex-mode) "tex-mode" "tex-mode.el" (12697 62715)) ;;; Generated autoloads from tex-mode.el --- 7756,7760 ---- ;;;*** ! ;;;### (autoloads (tex-start-shell slitex-mode latex-mode plain-tex-mode tex-mode) "tex-mode" "tex-mode.el" (12773 37893)) ;;; Generated autoloads from tex-mode.el *************** Entering SliTeX mode runs the hook `text *** 7555,7559 **** ;;;*** ! ;;;### (autoloads (texinfo-format-region texinfo-format-buffer) "texinfmt" "texinfmt.el" (12536 45574)) ;;; Generated autoloads from texinfmt.el --- 7987,7991 ---- ;;;*** ! ;;;### (autoloads (texinfo-format-region texinfo-format-buffer) "texinfmt" "texinfmt.el" (12778 43266)) ;;; Generated autoloads from texinfmt.el *************** value of texinfo-mode-hook." t nil) *** 7647,7651 **** ;;;*** ! ;;;### (autoloads (texinfo-sequential-node-update texinfo-every-node-update texinfo-update-node) "texnfo-upd" "texnfo-upd.el" (12536 45574)) ;;; Generated autoloads from texnfo-upd.el --- 8079,8083 ---- ;;;*** ! ;;;### (autoloads (texinfo-sequential-node-update texinfo-every-node-update texinfo-update-node) "texnfo-upd" "texnfo-upd.el" (12730 54418)) ;;; Generated autoloads from texnfo-upd.el *************** bounds-of-thing-at-point." nil nil) *** 7712,7716 **** ;;;*** ! ;;;### (autoloads (display-time) "time" "time.el" (12599 58564)) ;;; Generated autoloads from time.el --- 8144,8148 ---- ;;;*** ! ;;;### (autoloads (display-time) "time" "time.el" (12786 35123)) ;;; Generated autoloads from time.el *************** be detected." nil (quote macro)) *** 7798,7802 **** ;;;*** ! ;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm" "tmm.el" (12634 55024)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) --- 8230,8234 ---- ;;;*** ! ;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm" "tmm.el" (12755 34696)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) *************** First column's text sSs Second colum *** 7936,7940 **** ;;;*** ! ;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics type-break type-break-mode) "type-break" "type-break.el" (12557 16919)) ;;; Generated autoloads from type-break.el --- 8368,8372 ---- ;;;*** ! ;;;### (autoloads (type-break-guesstimate-keystroke-threshold type-break-statistics type-break type-break-mode) "type-break" "type-break.el" (12785 6539)) ;;; Generated autoloads from type-break.el *************** Convert Rmail file FILE to system inbox *** 8106,8110 **** ;;;*** ! ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) "userlock" "userlock.el" (12536 45574)) ;;; Generated autoloads from userlock.el --- 8538,8542 ---- ;;;*** ! ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) "userlock" "userlock.el" (12757 35884)) ;;; Generated autoloads from userlock.el *************** The buffer in question is current when t *** 8129,8133 **** ;;;*** ! ;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-diff vc-register vc-next-action) "vc" "vc.el" (12692 55721)) ;;; Generated autoloads from vc.el --- 8561,8565 ---- ;;;*** ! ;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-diff vc-register vc-next-action) "vc" "vc.el" (12793 14043)) ;;; Generated autoloads from vc.el *************** Syntax table and abbrevs while in vi mod *** 8287,8291 **** ;;;*** ! ;;;### (autoloads (view-mode view-buffer-other-window view-buffer view-file-other-window view-file) "view" "view.el" (12565 8462)) ;;; Generated autoloads from view.el --- 8719,8723 ---- ;;;*** ! ;;;### (autoloads (view-mode view-buffer-other-window view-buffer view-file-other-window view-file) "view" "view.el" (12784 31023)) ;;; Generated autoloads from view.el *************** This command runs the normal hook `view- *** 8338,8345 **** (autoload (quote view-mode) "view" "\ Toggle View mode. ! If you use this function to turn on View mode, ! \"exiting\" View mode does nothing except turn View mode off. ! The other way to turn View mode on is by calling ! `view-mode-enter'. Letters do not insert themselves. Instead these commands are provided. --- 8770,8780 ---- (autoload (quote view-mode) "view" "\ Toggle View mode. ! With a prefix argument, turn View mode on if the argument is >= zero ! and off if it is not. ! ! If you use this function to turn on View mode, then subsequently ! \"exiting\" View mode does nothing except turn View mode off. The ! other way to turn View mode on is by calling `view-mode-enter'; ! that is what Lisp programs usually use. Letters do not insert themselves. Instead these commands are provided. *************** Turn on VIP emulation of VI." t nil) *** 8387,8391 **** ;;;*** ! ;;;### (autoloads (viper-mode) "viper" "viper.el" (12635 12679)) ;;; Generated autoloads from viper.el --- 8822,8826 ---- ;;;*** ! ;;;### (autoloads (viper-mode) "viper" "viper.el" (12786 34058)) ;;; Generated autoloads from viper.el *************** The key bindings are: *** 8508,8512 **** ;;;*** ! ;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (12603 24337)) ;;; Generated autoloads from xt-mouse.el --- 8943,8947 ---- ;;;*** ! ;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (12724 45031)) ;;; Generated autoloads from xt-mouse.el diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/loadup.el emacs-19.32/lisp/loadup.el *** emacs-19.31/lisp/loadup.el Sat May 18 16:10:13 1996 --- emacs-19.32/lisp/loadup.el Mon Jun 10 17:18:03 1996 *************** *** 180,184 **** (if (memq system-type '(ms-dos windows-nt)) (setq name (expand-file-name ! (if (fboundp 'make-frame) "DOC-X" "DOC") "../etc")) (setq name (concat (expand-file-name "../etc/DOC-") name)) (if (file-exists-p name) --- 180,184 ---- (if (memq system-type '(ms-dos windows-nt)) (setq name (expand-file-name ! (if (fboundp 'x-create-frame) "DOC-X" "DOC") "../etc")) (setq name (concat (expand-file-name "../etc/DOC-") name)) (if (file-exists-p name) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/macros.el emacs-19.32/lisp/macros.el *** emacs-19.31/lisp/macros.el Sat Jan 27 22:07:26 1996 --- emacs-19.32/lisp/macros.el Wed May 29 13:15:09 1996 *************** Your options are: \\ *** 183,193 **** \\[edit] Enter recursive edit; ask again when you exit from that." (interactive "P") ! (or executing-macro defining-kbd-macro (error "Not defining or executing kbd macro")) (if flag ! (let (executing-macro defining-kbd-macro) (recursive-edit)) ! (if (not executing-macro) nil (let ((loop t) --- 183,193 ---- \\[edit] Enter recursive edit; ask again when you exit from that." (interactive "P") ! (or executing-kbd-macro defining-kbd-macro (error "Not defining or executing kbd macro")) (if flag ! (let (executing-kbd-macro defining-kbd-macro) (recursive-edit)) ! (if (not executing-kbd-macro) nil (let ((loop t) *************** Your options are: \\ *** 196,200 **** (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) "))) (while loop ! (let ((key (let ((executing-macro nil) (defining-kbd-macro nil)) (message "%s" msg) --- 196,200 ---- (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) "))) (while loop ! (let ((key (let ((executing-kbd-macro nil) (defining-kbd-macro nil)) (message "%s" msg) *************** Your options are: \\ *** 207,218 **** ((eq def 'skip) (setq loop nil) ! (setq executing-macro "")) ((eq def 'exit) (setq loop nil) ! (setq executing-macro t)) ((eq def 'recenter) (recenter nil)) ((eq def 'edit) ! (let (executing-macro defining-kbd-macro) (recursive-edit))) ((eq def 'quit) --- 207,218 ---- ((eq def 'skip) (setq loop nil) ! (setq executing-kbd-macro "")) ((eq def 'exit) (setq loop nil) ! (setq executing-kbd-macro t)) ((eq def 'recenter) (recenter nil)) ((eq def 'edit) ! (let (executing-kbd-macro defining-kbd-macro) (recursive-edit))) ((eq def 'quit) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mail-extr.el emacs-19.32/lisp/mail-extr.el *** emacs-19.31/lisp/mail-extr.el Wed Feb 21 15:02:14 1996 --- emacs-19.32/lisp/mail-extr.el Tue Jun 25 14:57:30 1996 *************** If ADDRESS contains more than one RFC-82 *** 731,735 **** char ;; multiple-addresses ! <-pos >-pos @-pos :-pos ,-pos !-pos %-pos \;-pos group-:-pos group-\;-pos route-addr-:-pos record-pos-symbol --- 731,735 ---- char ;; multiple-addresses ! <-pos >-pos @-pos :-pos comma-pos !-pos %-pos \;-pos group-:-pos group-\;-pos route-addr-:-pos record-pos-symbol *************** If ADDRESS contains more than one RFC-82 *** 850,854 **** (cdr (assq char '((?< . <-pos) (?> . >-pos) (?@ . @-pos) ! (?: . :-pos) (?, . ,-pos) (?! . !-pos) (?% . %-pos) (?\; . \;-pos))))) (set record-pos-symbol --- 850,854 ---- (cdr (assq char '((?< . <-pos) (?> . >-pos) (?@ . @-pos) ! (?: . :-pos) (?, . comma-pos) (?! . !-pos) (?% . %-pos) (?\; . \;-pos))))) (set record-pos-symbol *************** If ADDRESS contains more than one RFC-82 *** 979,983 **** (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t) (mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t) ! (mail-extr-nuke-outside-range ,-pos group-:-pos group-\;-pos t) (and last-real-pos (> last-real-pos (1+ group-\;-pos)) --- 979,983 ---- (mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t) (mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t) ! (mail-extr-nuke-outside-range comma-pos group-:-pos group-\;-pos t) (and last-real-pos (> last-real-pos (1+ group-\;-pos)) *************** If ADDRESS contains more than one RFC-82 *** 1005,1009 **** ;; **** This will cause problems when we start handling commas in ;; the PHRASE part .... no it won't ... yes it will ... ????? ! (mail-extr-nuke-outside-range ,-pos 1 1) ;; can only have multiple @s inside < >. The fact that some MTAs --- 1005,1009 ---- ;; **** This will cause problems when we start handling commas in ;; the PHRASE part .... no it won't ... yes it will ... ????? ! (mail-extr-nuke-outside-range comma-pos 1 1) ;; can only have multiple @s inside < >. The fact that some MTAs diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mail-hist.el emacs-19.32/lisp/mail-hist.el *** emacs-19.31/lisp/mail-hist.el Wed May 8 16:18:31 1996 --- emacs-19.32/lisp/mail-hist.el Sat Jul 20 13:29:48 1996 *************** *** 26,33 **** ;;; Commentary: - ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. - ;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of ;; time. --- 26,29 ---- *************** the message." *** 118,122 **** name-start name-end ! (downcase (buffer-substring name-start name-end))))))) (defsubst mail-hist-forward-header (count) --- 114,118 ---- name-start name-end ! (downcase (buffer-substring-no-properties name-start name-end))))))) (defsubst mail-hist-forward-header (count) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mail-utils.el emacs-19.32/lisp/mail-utils.el *** emacs-19.31/lisp/mail-utils.el Thu Apr 11 13:33:36 1996 --- emacs-19.32/lisp/mail-utils.el Fri Jul 5 09:35:29 1996 *************** Return a modified address list." *** 76,80 **** ;; Detect nested comments. ! (if (string-match "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*(" address) ;; Strip nested comments. (save-excursion --- 76,80 ---- ;; Detect nested comments. ! (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) ;; Strip nested comments. (save-excursion *************** Return a modified address list." *** 99,103 **** ;; This doesn't hack rfc822 nested comments ;; `(xyzzy (foo) whinge)' properly. Big deal. ! "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)" address)) (setq address --- 99,103 ---- ;; This doesn't hack rfc822 nested comments ;; `(xyzzy (foo) whinge)' properly. Big deal. ! "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" address)) (setq address diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mailabbrev.el emacs-19.32/lisp/mailabbrev.el *** emacs-19.31/lisp/mailabbrev.el Sat Mar 9 03:48:48 1996 --- emacs-19.32/lisp/mailabbrev.el Tue May 28 11:15:15 1996 *************** *** 27,31 **** ;;; Commentary: ! ;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: ;; field, word-abbrevs are defined for each of your mail aliases. These ;; aliases will be defined from your .mailrc file (or the file specified by --- 27,31 ---- ;;; Commentary: ! ;; This file ensures that, when the point is in a To:, CC:, BCC:, or From: ;; field, word-abbrevs are defined for each of your mail aliases. These ;; aliases will be defined from your .mailrc file (or the file specified by *************** *** 42,46 **** ;; appropriate header field. When in the body of the message, or other ;; header fields, the mail aliases will not expand. Rather, the normal ! ;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if ;; defined. So if you use mail-mode specific abbrevs, this code will not ;; adversely affect you. You can control which header fields the abbrevs --- 42,46 ---- ;; appropriate header field. When in the body of the message, or other ;; header fields, the mail aliases will not expand. Rather, the normal ! ;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if ;; defined. So if you use mail-mode specific abbrevs, this code will not ;; adversely affect you. You can control which header fields the abbrevs *************** no aliases, which is represented by this *** 154,158 **** (file-exists-p mail-personal-alias-file)) (progn ! (setq mail-abbrev-modtime (nth 5 (file-attributes mail-personal-alias-file))) (build-mail-abbrevs))) --- 154,158 ---- (file-exists-p mail-personal-alias-file)) (progn ! (setq mail-abbrev-modtime (nth 5 (file-attributes mail-personal-alias-file))) (build-mail-abbrevs))) *************** By default this is the file specified by *** 234,238 **** (defvar mail-alias-separator-string ", " "*A string inserted between addresses in multi-address mail aliases. ! This has to contain a comma, so \", \" is a reasonable value. You might also want something like \",\\n \" to get each address on its own line.") --- 234,238 ---- (defvar mail-alias-separator-string ", " "*A string inserted between addresses in multi-address mail aliases. ! This has to contain a comma, so \", \" is a reasonable value. You might also want something like \",\\n \" to get each address on its own line.") *************** If DEFINITION contains multiple addresse *** 330,362 **** After expanding a mail-abbrev, if Auto Fill mode is on and we're past the fill-column, break the line at the previous comma, and indent the next line." ! (save-excursion ! (let ((p (point)) ! bol comma fp) ! (beginning-of-line) ! (setq bol (point)) ! (goto-char p) ! (while (and auto-fill-function ! (>= (current-column) fill-column) ! (search-backward "," bol t)) ! (setq comma (point)) ! (forward-char 1) ; Now we are just past the comma. ! (insert "\n") ! (delete-horizontal-space) ! (setq p (point)) ! (indent-relative) ! (setq fp (buffer-substring p (point))) ! ;; Go to the end of the new line. ! (end-of-line) ! (if (> (current-column) fill-column) ! ;; It's still too long; do normal auto-fill. ! (let ((fill-prefix (or fp "\t"))) ! (do-auto-fill))) ! ;; Resume the search. ! (goto-char comma) ! )))) ;;; Syntax tables and abbrev-expansion ! (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" "*Regexp to select mail-headers in which mail abbrevs should be expanded. --- 330,365 ---- After expanding a mail-abbrev, if Auto Fill mode is on and we're past the fill-column, break the line at the previous comma, and indent the next line." ! ;; Disable abbrev mode to avoid recursion in indent-relative expanding ! ;; part of the abbrev expansion as an abbrev itself. ! (let ((abbrev-mode nil)) ! (save-excursion ! (let ((p (point)) ! bol comma fp) ! (beginning-of-line) ! (setq bol (point)) ! (goto-char p) ! (while (and auto-fill-function ! (>= (current-column) fill-column) ! (search-backward "," bol t)) ! (setq comma (point)) ! (forward-char 1) ; Now we are just past the comma. ! (insert "\n") ! (delete-horizontal-space) ! (setq p (point)) ! (indent-relative) ! (setq fp (buffer-substring p (point))) ! ;; Go to the end of the new line. ! (end-of-line) ! (if (> (current-column) fill-column) ! ;; It's still too long; do normal auto-fill. ! (let ((fill-prefix (or fp "\t"))) ! (do-auto-fill))) ! ;; Resume the search. ! (goto-char comma) ! ))))) ;;; Syntax tables and abbrev-expansion ! (defvar mail-abbrev-mode-regexp "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):" "*Regexp to select mail-headers in which mail abbrevs should be expanded. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mailalias.el emacs-19.32/lisp/mailalias.el *** emacs-19.31/lisp/mailalias.el Sat Mar 9 03:02:28 1996 --- emacs-19.32/lisp/mailalias.el Mon Jun 24 05:49:40 1996 *************** Completable headers are according to `ma *** 290,293 **** --- 290,300 ---- current header, calls `mail-complete-function' and passes prefix arg if any." (interactive "P") + ;; Read the defaults first, if we have not done so. + (sendmail-sync-aliases) + (if (eq mail-aliases t) + (progn + (setq mail-aliases nil) + (if (file-exists-p mail-personal-alias-file) + (build-mail-aliases)))) (let ((list mail-complete-alist)) (if (and (save-excursion (search-forward diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mailheader.el emacs-19.32/lisp/mailheader.el *** emacs-19.31/lisp/mailheader.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/mailheader.el Mon Jul 1 20:00:34 1996 *************** *** 0 **** --- 1,183 ---- + ;;; mailheader.el --- Mail header parsing, merging, formatting + + ;; Copyright (C) 1996 by Free Software Foundation, Inc. + + ;; Author: Erik Naggum + ;; Keywords: tools, mail, news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to + ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; This package provides an abstraction to RFC822-style messages, used in + ;; mail, news, and some other systems. The simple syntactic rules for such + ;; headers, such as quoting and line folding, are routinely reimplemented + ;; in many individual packages. This package removes the need for this + ;; redundancy by representing message headers as association lists, + ;; offering functions to extract the set of headers from a message, to + ;; parse individual headers, to merge sets of headers, and to format a set + ;; of headers. + + ;; The car of each element in the message-header alist is a symbol whose + ;; print name is the name of the header, in all lower-case. The cdr of an + ;; element depends on the operation. After extracting headers from a + ;; messge, it is a string, the value of the header. An extracted set of + ;; headers may be parsed further, which may turn it into a list, whose car + ;; is the original value and whose subsequent elements depend on the + ;; header. For formatting, it is evaluated to obtain the strings to be + ;; inserted. For merging, one set of headers consists of strings, while + ;; the other set will be evaluated with the symbols in the first set of + ;; headers bound to their respective values. + + ;;; Code: + + (eval-when-compile + (require 'cl)) + + ;; Make the byte-compiler shut up. + (defvar headers) + + (defun mail-header-extract () + "Extract headers from current buffer after point. + Returns a header alist, where each element is a cons cell (name . value), + where NAME is a symbol, and VALUE is the string value of the header having + that name." + (let ((message-headers ()) (top (point)) + start end) + (while (and (setq start (point)) + (> (skip-chars-forward "^\0- :") 0) + (= (following-char) ?:) + (setq end (point)) + (progn (forward-char) + (> (skip-chars-forward " \t") 0))) + (let ((header (intern (downcase (buffer-substring start end)))) + (value (list (buffer-substring + (point) (progn (end-of-line) (point)))))) + (while (progn (forward-char) (> (skip-chars-forward " \t") 0)) + (push (buffer-substring (point) (progn (end-of-line) (point))) + value)) + (push (if (cdr value) + (cons header (mapconcat #'identity (nreverse value) " ")) + (cons header (car value))) + message-headers))) + (goto-char top) + (nreverse message-headers))) + + (defun mail-header-extract-no-properties () + "Extract headers from current buffer after point, without properties. + Returns a header alist, where each element is a cons cell (name . value), + where NAME is a symbol, and VALUE is the string value of the header having + that name." + (mapcar + (lambda (elt) + (set-text-properties 0 (length (cdr elt)) nil (cdr elt)) + elt) + (mail-header-extract))) + + (defun mail-header-parse (parsing-rules headers) + "Apply PARSING-RULES to HEADERS. + PARSING-RULES is an alist whose keys are header names (symbols) and whose + value is a parsing function. The function takes one argument, a string, + and return a list of values, which will destructively replace the value + associated with the key in HEADERS, after being prepended with the original + value." + (dolist (rule parsing-rules) + (let ((header (assq (car rule) headers))) + (when header + (if (consp (cdr header)) + (setf (cddr header) (funcall (cdr rule) (cadr header))) + (setf (cdr header) + (cons (cdr header) (funcall (cdr rule) (cdr header)))))))) + headers) + + (defsubst mail-header (header &optional header-alist) + "Return the value associated with header HEADER in HEADER-ALIST. + If the value is a string, it is the original value of the header. If the + value is a list, its first element is the original value of the header, + with any subsequent elements bing the result of parsing the value. + If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." + (cdr (assq header (or header-alist headers)))) + + (defun mail-header-set (header value &optional header-alist) + "Set the value associated with header HEADER to VALUE in HEADER-ALIST. + HEADER-ALIST defaults to the dynamically bound variable `headers' if nil. + See `mail-header' for the semantics of VALUE." + (let* ((alist (or header-alist headers)) + (entry (assq header alist))) + (if entry + (setf (cdr entry) value) + (nconc alist (list (cons header value))))) + value) + + (defsetf mail-header (header &optional header-alist) (value) + `(mail-header-set ,header ,value ,header-alist)) + + (defun mail-header-merge (merge-rules headers) + "Return a new header alist with MERGE-RULES applied to HEADERS. + MERGE-RULES is an alist whose keys are header names (symbols) and whose + values are forms to evaluate, the results of which are the new headers. It + should be a string or a list of string. The first element may be nil to + denote that the formatting functions must use the remaining elements, or + skip the header altogether if there are no other elements. + The macro `mail-header' can be used to access headers in HEADERS." + (mapcar + (lambda (rule) + (cons (car rule) (eval (cdr rule)))) + merge-rules)) + + (defvar mail-header-format-function + (lambda (header value) + "Function to format headers without a specified formatting function." + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n"))) + + (defun mail-header-format (format-rules headers) + "Use FORMAT-RULES to format HEADERS and insert into current buffer. + FORMAT-RULES is an alist whose keys are header names (symbols), and whose + values are functions that format the header, the results of which are + inserted, unless it is nil. The function takes two arguments, the header + symbol, and the value of that header. If the function itself is nil, the + default action is to insert the value of the header, unless it is nil. + The headers are inserted in the order of the FORMAT-RULES. + A key of t represents any otherwise unmentioned headers. + A key of nil has as its value a list of defaulted headers to ignore." + (let ((ignore (append (cdr (assq nil format-rules)) + (mapcar #'car format-rules)))) + (dolist (rule format-rules) + (let* ((header (car rule)) + (value (mail-header header))) + (cond ((null header) 'ignore) + ((eq header t) + (dolist (defaulted headers) + (unless (memq (car defaulted) ignore) + (let* ((header (car defaulted)) + (value (cdr defaulted))) + (if (cdr rule) + (funcall (cdr rule) header value) + (funcall mail-header-format-function header value)))))) + (value + (if (cdr rule) + (funcall (cdr rule) header value) + (funcall mail-header-format-function header value)))))) + (insert "\n"))) + + (provide 'mailheader) + + ;;; mailheader.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/make-mode.el emacs-19.32/lisp/make-mode.el *** emacs-19.31/lisp/make-mode.el Mon Feb 26 14:32:51 1996 --- emacs-19.32/lisp/make-mode.el Thu Jun 27 03:48:20 1996 *************** The function must satisfy this calling c *** 388,391 **** --- 388,392 ---- ("suffix" "Names") ("basename" "Names") + ("addprefix" "Prefix" "Names") ("addsuffix" "Suffix" "Names") ("join" "List 1" "List 2") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/makefile.nt emacs-19.32/lisp/makefile.nt *** emacs-19.31/lisp/makefile.nt Wed Mar 27 23:30:59 1996 --- emacs-19.32/lisp/makefile.nt Sat Jul 20 14:00:02 1996 *************** *** 16,21 **** # # 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ # --- 16,22 ---- # # 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. # diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/menu-bar.el emacs-19.32/lisp/menu-bar.el *** emacs-19.31/lisp/menu-bar.el Fri Mar 8 13:14:30 1996 --- emacs-19.32/lisp/menu-bar.el Fri Jun 21 01:54:07 1996 *************** Do the same for the keys of the same nam *** 381,390 **** "Return non-nil if `delete-frame' should be enabled in the menu bar." (let ((frames (frame-list)) ! (count 0)) ! (while frames ! (if (frame-visible-p (car frames)) ! (setq count (1+ count))) ! (setq frames (cdr frames))) ! (> count 1))) (put 'advertised-undo 'menu-enable --- 381,390 ---- "Return non-nil if `delete-frame' should be enabled in the menu bar." (let ((frames (frame-list)) ! (count 0)) ! (while frames ! (if (frame-visible-p (car frames)) ! (setq count (1+ count))) ! (setq frames (cdr frames))) ! (> count 1))) (put 'advertised-undo 'menu-enable diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/message.el emacs-19.32/lisp/message.el *** emacs-19.31/lisp/message.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/message.el Tue Jul 16 19:29:34 1996 *************** *** 0 **** --- 1,3000 ---- + ;;; message.el --- composing mail and news messages + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: mail, news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; This mode provides mail-sending facilities from within Emacs. It + ;; consists mainly of large chunks of code from the sendmail.el, + ;; gnus-msg.el and rnewspost.el files. + + ;;; Code: + + (eval-when-compile + (require 'cl)) + (require 'mailheader) + (require 'rmail) + (require 'nnheader) + (require 'timezone) + (require 'easymenu) + (if (string-match "XEmacs\\|Lucid" emacs-version) + (require 'mail-abbrevs) + (require 'mailabbrev)) + + (defvar message-directory "~/Mail/" + "*Directory from which all other mail file variables are derived.") + + (defvar message-max-buffers 10 + "*How many buffers to keep before starting to kill them off.") + + (defvar message-send-rename-function nil + "Function called to rename the buffer after sending it.") + + ;;;###autoload + (defvar message-fcc-handler-function 'rmail-output + "*A function called to save outgoing articles. + This function will be called with the name of the file to store the + article in. The default function is `rmail-output' which saves in Unix + mailbox format.") + + ;;;###autoload + (defvar message-courtesy-message + "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n" + "*This is inserted at the start of a mailed copy of a posted message. + If this variable is nil, no such courtesy message will be added.") + + ;;;###autoload + (defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" + "*Regexp that matches headers to be removed in resent bounced mail.") + + ;;;###autoload + (defvar message-from-style 'default + "*Specifies how \"From\" headers look. + + If `nil', they contain just the return address like: + king@grassland.com + If `parens', they look like: + king@grassland.com (Elvis Parsley) + If `angles', they look like: + Elvis Parsley + + Otherwise, most addresses look like `angles', but they look like + `parens' if `angles' would need quoting and `parens' would not.") + + ;;;###autoload + (defvar message-syntax-checks nil + "Controls what syntax checks should not be performed on outgoing posts. + To disable checking of long signatures, for instance, add + `(signature . disabled)' to this list. + + Don't touch this variable unless you really know what you're doing. + + Checks include subject-cmsg multiple-headers sendsys message-id from + long-lines control-chars size new-text redirected-followup signature + approved sender empty empty-headers message-id from subject.") + + ;;;###autoload + (defvar message-required-news-headers + '(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, + Message-ID. Organization, Lines, In-Reply-To, Expires, and + X-Newsreader are optional. If don't you want message to insert some + header, remove it from this list.") + + ;;;###autoload + (defvar 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. + RFC822 required that From, Date, To, Subject and Message-ID be + included. Organization, Lines and X-Mailer are optional.") + + ;;;###autoload + (defvar message-deletable-headers '(Message-ID Date) + "*Headers to be deleted if they already exist and were generated by message previously.") + + ;;;###autoload + (defvar message-ignored-news-headers + "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:" + "*Regexp of headers to be removed unconditionally before posting.") + + ;;;###autoload + (defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:" + "*Regexp of headers to be removed unconditionally before mailing.") + + ;;;###autoload + (defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:" + "*Header lines matching this regexp will be deleted before posting. + It's best to delete old Path and Date headers before posting to avoid + any confusion.") + + ;;;###autoload + (defvar message-signature-separator "^-- *$" + "Regexp matching the signature separator.") + + ;;;###autoload + (defvar 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.") + + ;;;###autoload + (defvar message-generate-new-buffers t + "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called. + If this is a function, call that function with three parameters: The type, + the to address and the group name. (Any of these may be nil.) The function + should return the new buffer name.") + + ;;;###autoload + (defvar message-kill-buffer-on-exit nil + "*Non-nil means that the message buffer will be killed after sending a message.") + + (defvar gnus-local-organization) + (defvar message-user-organization + (or (and (boundp 'gnus-local-organization) + gnus-local-organization) + (getenv "ORGANIZATION") + t) + "*String to be used as an Organization header. + If t, use `message-user-organization-file'.") + + ;;;###autoload + (defvar message-user-organization-file "/usr/lib/news/organization" + "*Local news organization file.") + + (defvar message-autosave-directory "~/" + ; (concat (file-name-as-directory message-directory) "drafts/") + "*Directory where message autosaves buffers. + If nil, message won't autosave.") + + (defvar message-forward-start-separator + "------- Start of forwarded message -------\n" + "*Delimiter inserted before forwarded messages.") + + (defvar message-forward-end-separator + "------- End of forwarded message -------\n" + "*Delimiter inserted after forwarded messages.") + + ;;;###autoload + (defvar message-signature-before-forwarded-message t + "*If non-nil, put the signature before any included forwarded message.") + + ;;;###autoload + (defvar 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.") + + ;;;###autoload + (defvar message-ignored-resent-headers "^Return-receipt" + "*All headers that match this regexp will be deleted when resending a message.") + + ;;;###autoload + (defvar message-ignored-cited-headers "." + "Delete these headers from the messages you yank.") + + ;; Useful to set in site-init.el + ;;;###autoload + (defvar message-send-mail-function 'message-send-mail-with-sendmail + "Function to call to send the current buffer as mail. + The headers should be delimited by a line whose contents match the + variable `mail-header-separator'. + + Legal values include `message-send-mail-with-mh' and + `message-send-mail-with-sendmail', which is the default.") + + ;;;###autoload + (defvar message-send-news-function 'message-send-news + "Function to call to send the current buffer as news. + The headers should be delimited by a line whose contents match the + variable `mail-header-separator'.") + + ;;;###autoload + (defvar message-reply-to-function nil + "Function that should return a list of headers. + This function should pick out addresses from the To, Cc, and From headers + and respond with new To and Cc headers.") + + ;;;###autoload + (defvar message-wide-reply-to-function nil + "Function that should return a list of headers. + This function should pick out addresses from the To, Cc, and From headers + and respond with new To and Cc headers.") + + ;;;###autoload + (defvar message-followup-to-function nil + "Function that should return a list of headers. + This function should pick out addresses from the To, Cc, and From headers + and respond with new To and Cc headers.") + + ;;;###autoload + (defvar message-use-followup-to 'ask + "*Specifies what to do with Followup-To header. + If nil, ignore the header. If it is t, use its value, but query before + using the \"poster\" value. If it is the symbol `ask', query the user + whether to ignore the \"poster\" value. If it is the symbol `use', + always use the value.") + + (defvar gnus-post-method) + (defvar gnus-select-method) + ;;;###autoload + (defvar message-post-method + (cond ((and (boundp 'gnus-post-method) + gnus-post-method) + gnus-post-method) + ((boundp 'gnus-select-method) + gnus-select-method) + (t '(nnspool ""))) + "Method used to post news.") + + ;;;###autoload + (defvar message-generate-headers-first nil + "*If non-nil, generate all possible headers before composing.") + + (defvar message-setup-hook nil + "Normal hook, run each time a new outgoing message is initialized. + The function `message-setup' runs this hook.") + + (defvar 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 + the signature is inserted.") + + (defvar message-mode-hook nil + "Hook run in message mode buffers.") + + (defvar message-header-hook nil + "Hook run in a message mode buffer narrowed to the headers.") + + (defvar message-header-setup-hook nil + "Hook called narrowed to the headers when setting up a message buffer.") + + ;;;###autoload + (defvar message-citation-line-function 'message-insert-citation-line + "*Function called to insert the \"Whomever writes:\" line.") + + ;;;###autoload + (defvar message-yank-prefix "> " + "*Prefix inserted on the lines of yanked messages. + nil means use indentation.") + + (defvar message-indentation-spaces 3 + "*Number of spaces to insert at the beginning of each cited line. + Used by `message-yank-original' via `message-yank-cite'.") + + ;;;###autoload + (defvar message-cite-function 'message-cite-original + "*Function for citing an original message.") + + ;;;###autoload + (defvar message-indent-citation-function 'message-indent-citation + "*Function for modifying a citation just inserted in the mail buffer. + This can also be a list of functions. Each function can find the + citation between (point) and (mark t). And each function should leave + point and mark around the citation text as modified.") + + (defvar message-abbrevs-loaded nil) + + ;;;###autoload + (defvar message-signature t + "*String to be inserted at the end of the message buffer. + If t, the `message-signature-file' file will be inserted instead. + If a function, the result from the function will be used instead. + If a form, the result from the form will be used instead.") + + ;;;###autoload + (defvar message-signature-file "~/.signature" + "*File containing the text inserted at end of message. buffer.") + + (defvar message-distribution-function nil + "*Function called to return a Distribution header.") + + (defvar message-expires 14 + "*Number of days before your article expires.") + + (defvar message-user-path nil + "If nil, use the NNTP server name in the Path header. + If stringp, use this; if non-nil, use no host name (user name only).") + + (defvar message-reply-buffer nil) + (defvar message-reply-headers nil) + (defvar message-newsreader nil) + (defvar message-mailer nil) + (defvar message-sent-message-via nil) + (defvar message-checksum nil) + (defvar message-send-actions nil + "A list of actions to be performed upon successful sending of a message.") + (defvar message-exit-actions nil + "A list of actions to be performed upon exiting after sending a message.") + (defvar message-kill-actions nil + "A list of actions to be performed before killing a message buffer.") + (defvar message-postpone-actions nil + "A list of actions to be performed after postponing a message.") + + ;;;###autoload + (defvar message-default-headers nil + "*A string containing header lines to be inserted in outgoing messages. + It is inserted before you edit the message, so you can edit or delete + these lines.") + + ;;;###autoload + (defvar message-default-mail-headers nil + "*A string of header lines to be inserted in outgoing mails.") + + ;;;###autoload + (defvar message-default-news-headers nil + "*A string of header lines to be inserted in outgoing news articles.") + + ;; Note: could use /usr/ucb/mail instead of sendmail; + ;; options -t, and -v if not interactive. + (defvar message-mailer-swallows-blank-line + (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" + system-configuration) + (file-readable-p "/etc/sendmail.cf") + (let ((buffer (get-buffer-create " *temp*"))) + (unwind-protect + (save-excursion + (set-buffer buffer) + (insert-file-contents "/etc/sendmail.cf") + (goto-char (point-min)) + (let ((case-fold-search nil)) + (re-search-forward "^OR\\>" nil t))) + (kill-buffer buffer)))) + ;; According to RFC822, "The field-name must be composed of printable + ;; ASCII characters (i.e. characters that have decimal values between + ;; 33 and 126, except colon)", i.e. any chars except ctl chars, + ;; space, or colon. + '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) + "Set this non-nil if the system's mailer runs the header and body together. + \(This problem exists on Sunos 4 when sendmail is run in remote mode.) + The value should be an expression to test whether the problem will + actually occur.") + + (defvar message-mode-syntax-table + (let ((table (copy-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?% ". " table) + table) + "Syntax table used while in Message mode.") + + (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))) + "Additional expressions to highlight in Message mode.") + + (defvar message-face-alist + '((bold . bold-region) + (underline . underline-region) + (default . (lambda (b e) + (unbold-region b e) + (ununderline-region b e)))) + "Alist of mail and news faces for facemenu. + The cdr of ech entry is a function for applying the face to a region.") + + (defvar message-send-hook nil + "Hook run before sending messages.") + + (defvar message-sent-hook nil + "Hook run after sending messages.") + + ;;; Internal variables. + + (defvar message-buffer-list nil) + + ;;; Regexp matching the delimiter of messages in UNIX mail format + ;;; (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\\)?" + "\\|[-+]?[0-9][0-9][0-9][0-9]" + "\\|" + "\\) *"))) + (concat + "From " + + ;; Username, perhaps with a quoted section that can contain spaces. + "\\(" + "[^ \n]*" + "\\(\\|\".*\"[^ \n]*\\)" + "\\|<[^<>\n]+>" + "\\) ?" + + ;; The time the message was sent. + "\\([^ \n]*\\) *" ; day of the week + "\\([^ ]*\\) *" ; month + "\\([0-9]*\\) *" ; day of month + "\\([0-9:]*\\) *" ; time of day + + ;; Perhaps a time zone, specified by an abbreviation, or by a + ;; numeric offset. + time-zone-regexp + + ;; The year. + " [0-9][0-9]\\([0-9]*\\) *" + + ;; On some systems the time zone can appear after the year, too. + time-zone-regexp + + ;; Old uucp cruft. + "\\(remote from .*\\)?" + + "\n"))) + + (defvar message-unsent-separator + (concat "^ *---+ +Unsent message follows +---+ *$\\|" + "^ *---+ +Returned message +---+ *$\\|" + "^Start of returned message$\\|" + "^ *---+ +Original message +---+ *$\\|" + "^ *--+ +begin message +--+ *$\\|" + "^ *---+ +Original message follows +---+ *$\\|" + "^|? *---+ +Message text follows: +---+ *|?$") + "A regexp that matches the separator before the text of a failed message.") + + (defvar message-header-format-alist + `((Newsgroups) + (To . message-fill-address) + (Cc . message-fill-address) + (Subject) + (In-Reply-To) + (Fcc) + (Bcc) + (Date) + (Organization) + (Distribution) + (Lines) + (Expires) + (Message-ID) + (References . message-fill-header) + (X-Mailer) + (X-Newsreader)) + "Alist used for formatting headers.") + + (eval-and-compile + (autoload 'message-setup-toolbar "messagexmas") + (autoload 'mh-send-letter "mh-comp")) + + + + ;;; + ;;; Utility functions. + ;;; + + (defun message-point-at-bol () + "Return point at the beginning of the line." + (let ((p (point))) + (beginning-of-line) + (prog1 + (point) + (goto-char p)))) + + (defun message-point-at-eol () + "Return point at the end of the line." + (let ((p (point))) + (end-of-line) + (prog1 + (point) + (goto-char p)))) + + ;; Delete the current line (and the next N lines.); + (defmacro message-delete-line (&optional n) + `(delete-region (progn (beginning-of-line) (point)) + (progn (forward-line ,(or n 1)) (point)))) + + (defun message-tokenize-header (header &optional separator) + "Split HEADER into a list of header elements. + \",\" is used as the separator." + (let ((regexp (format "[%s]+" (or separator ","))) + (beg 1) + quoted elems) + (save-excursion + (message-set-work-buffer) + (insert header) + (goto-char (point-min)) + (while (not (eobp)) + (forward-char 1) + (cond ((and (> (point) beg) + (or (eobp) + (and (looking-at regexp) + (not quoted)))) + (push (buffer-substring beg (point)) elems) + (setq beg (match-end 0))) + ((= (following-char) ?\") + (setq quoted (not quoted))))) + (nreverse elems)))) + + (defun message-fetch-field (header) + "The same as `mail-fetch-field', only remove all newlines." + (let ((value (mail-fetch-field header))) + (when value + (nnheader-replace-chars-in-string value ?\n ? )))) + + (defun message-fetch-reply-field (header) + "Fetch FIELD from the message we're replying to." + (when (and message-reply-buffer + (buffer-name message-reply-buffer)) + (save-excursion + (set-buffer message-reply-buffer) + (message-fetch-field header)))) + + (defun message-set-work-buffer () + (if (get-buffer " *message work*") + (progn + (set-buffer " *message work*") + (erase-buffer)) + (set-buffer (get-buffer-create " *message work*")) + (kill-all-local-variables) + (buffer-disable-undo (current-buffer)))) + + (defun message-functionp (form) + "Return non-nil if FORM is funcallable." + (or (and (symbolp form) (fboundp form)) + (and (listp form) (eq (car form) 'lambda)))) + + (defun message-strip-subject-re (subject) + "Remove \"Re:\" from subject lines." + (if (string-match "^[Rr][Ee]: *" subject) + (substring subject (match-end 0)) + subject)) + + (defun message-remove-header (header &optional is-regexp first reverse) + "Remove HEADER in the narrowed buffer. + If REGEXP, HEADER is a regular expression. + If FIRST, only remove the first instance of the header. + Return the number of headers removed." + (goto-char (point-min)) + (let ((regexp (if is-regexp header (concat "^" header ":"))) + (number 0) + (case-fold-search t) + last) + (while (and (not (eobp)) + (not last)) + (if (if reverse + (not (looking-at regexp)) + (looking-at regexp)) + (progn + (incf number) + (when first + (setq last t)) + (delete-region + (point) + ;; There might be a continuation header, so we have to search + ;; until we find a new non-continuation line. + (progn + (forward-line 1) + (if (re-search-forward "^[^ \t]" nil t) + (goto-char (match-beginning 0)) + (point-max))))) + (forward-line 1) + (if (re-search-forward "^[^ \t]" nil t) + (goto-char (match-beginning 0)) + (point-max)))) + number)) + + (defun message-narrow-to-headers () + "Narrow the buffer to the head of the message." + (widen) + (narrow-to-region + (goto-char (point-min)) + (if (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") nil t) + (match-beginning 0) + (point-max))) + (goto-char (point-min))) + + (defun message-narrow-to-head () + "Narrow the buffer to the head of the message." + (widen) + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil 1) + (1- (point)) + (point-max))) + (goto-char (point-min))) + + (defun message-news-p () + "Say whether the current buffer contains a news message." + (save-excursion + (save-restriction + (message-narrow-to-headers) + (message-fetch-field "newsgroups")))) + + (defun message-mail-p () + "Say whether the current buffer contains a mail message." + (save-excursion + (save-restriction + (message-narrow-to-headers) + (or (message-fetch-field "to") + (message-fetch-field "cc") + (message-fetch-field "bcc"))))) + + (defun message-next-header () + "Go to the beginning of the next header." + (beginning-of-line) + (or (eobp) (forward-char 1)) + (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 + (lambda () + (message-next-header) + (unless (bobp) + (forward-char -1))) + (lambda () + (or (get-text-property (point) 'message-rank) + 0)))) + + (defun message-sort-headers () + "Sort the headers of the current message according to `message-header-format-alist'." + (interactive) + (save-excursion + (save-restriction + (let ((max (1+ (length message-header-format-alist))) + rank) + (message-narrow-to-headers) + (while (re-search-forward "^[^ \n]+:" nil t) + (put-text-property + (match-beginning 0) (1+ (match-beginning 0)) + 'message-rank + (if (setq rank (length (memq (assq (intern (buffer-substring + (match-beginning 0) + (1- (match-end 0)))) + message-header-format-alist) + message-header-format-alist))) + (- max rank) + (1+ max))))) + (message-sort-headers-1)))) + + + + ;;; + ;;; Message mode + ;;; + + ;;; Set up keymap. + + (defvar message-mode-map nil) + + (unless message-mode-map + (setq message-mode-map (copy-keymap text-mode-map)) + (define-key message-mode-map "\C-c?" 'describe-mode) + + (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) + (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) + (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) + (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) + (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) + (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) + (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) + (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) + (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) + (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) + (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) + (define-key message-mode-map "\C-c\C-b" 'message-goto-body) + (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) + + (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) + (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) + (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) + (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) + + (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) + (define-key message-mode-map "\C-c\C-s" 'message-send) + (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) + (define-key message-mode-map "\C-c\C-d" 'message-dont-send) + + (define-key message-mode-map "\t" 'message-tab)) + + (easy-menu-define message-mode-menu message-mode-map + "Message Menu." + '("Message" + "Go to Field:" + "----" + ["To" message-goto-to t] + ["Subject" message-goto-subject t] + ["Cc" message-goto-cc t] + ["Reply-to" message-goto-reply-to t] + ["Summary" message-goto-summary t] + ["Keywords" message-goto-keywords t] + ["Newsgroups" message-goto-newsgroups t] + ["Followup-To" message-goto-followup-to t] + ["Distribution" message-goto-distribution t] + ["Body" message-goto-body t] + ["Signature" message-goto-signature t] + "----" + "Miscellaneous Commands:" + "----" + ["Sort Headers" message-sort-headers t] + ["Yank Original" message-yank-original t] + ["Fill Yanked Message" message-fill-yanked-message t] + ["Insert Signature" message-insert-signature t] + ["Caesar (rot13) Message" message-caesar-buffer-body t] + ["Rename buffer" message-rename-buffer t] + ["Spellcheck" ispell-message t] + "----" + ["Send Message" message-send-and-exit t] + ["Abort Message" message-dont-send t])) + + (defvar facemenu-add-face-function) + (defvar facemenu-remove-face-function) + + ;;;###autoload + (defun message-mode () + "Major mode for editing mail and news to be sent. + Like Text Mode but with these additional commands: + C-c C-s message-send (send the message) C-c C-c message-send-and-exit + C-c C-f move to a header field (and create it if there isn't): + C-c C-f C-t move to To C-c C-f C-s move to Subject + C-c C-f C-c move to Cc C-c C-f C-b move to Bcc + C-c C-f C-f move to Fcc C-c C-f C-r move to Reply-To + C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups + C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution + C-c C-f C-o move to Followup-To + C-c C-t message-insert-to (add a To header to a news followup) + C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) + C-c C-b message-goto-body (move to beginning of message text). + C-c C-i message-goto-signature (move to the beginning of the signature). + C-c C-w message-insert-signature (insert `message-signature-file' file). + C-c C-y message-yank-original (insert current message, if any). + C-c C-q message-fill-yanked-message (fill what was yanked). + C-c C-r message-ceasar-buffer-body (rot13 the message body)." + (interactive) + (kill-all-local-variables) + (make-local-variable 'message-reply-buffer) + (setq message-reply-buffer nil) + (make-local-variable 'message-send-actions) + (make-local-variable 'message-exit-actions) + (make-local-variable 'message-kill-actions) + (make-local-variable 'message-postpone-actions) + (set-syntax-table message-mode-syntax-table) + (use-local-map message-mode-map) + (setq local-abbrev-table text-mode-abbrev-table) + (setq major-mode 'message-mode) + (setq mode-name "Message") + (setq buffer-offer-save t) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '(message-font-lock-keywords t)) + (make-local-variable 'facemenu-add-face-function) + (make-local-variable 'facemenu-remove-face-function) + (setq facemenu-add-face-function + (lambda (face end) + (let ((face-fun (cdr (assq face message-face-alist)))) + (if face-fun + (funcall face-fun (point) end) + (error "Face %s not configured for %s mode" face mode-name))) + "") + facemenu-remove-face-function t) + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat (regexp-quote mail-header-separator) + "$\\|[ \t]*[-_][-_][-_]+$\\|" + "-- $\\|" + paragraph-start)) + (setq paragraph-separate (concat (regexp-quote mail-header-separator) + "$\\|[ \t]*[-_][-_][-_]+$\\|" + "-- $\\|" + paragraph-separate)) + (make-local-variable 'message-reply-headers) + (setq message-reply-headers nil) + (make-local-variable 'message-newsreader) + (make-local-variable 'message-mailer) + (make-local-variable 'message-post-method) + (make-local-variable 'message-sent-message-via) + (setq message-sent-message-via nil) + (make-local-variable 'message-checksum) + (setq message-checksum nil) + ;;(when (fboundp 'mail-hist-define-keys) + ;; (mail-hist-define-keys)) + (when (string-match "XEmacs\\|Lucid" emacs-version) + (message-setup-toolbar)) + (easy-menu-add message-mode-menu message-mode-map) + ;; Allow mail alias things. + (if (fboundp 'mail-abbrevs-setup) + (mail-abbrevs-setup) + (funcall (intern "mail-aliases-setup"))) + (run-hooks 'text-mode-hook 'message-mode-hook)) + + + + ;;; + ;;; Message mode commands + ;;; + + ;;; Movement commands + + (defun message-goto-to () + "Move point to the To header." + (interactive) + (message-position-on-field "To")) + + (defun message-goto-subject () + "Move point to the Subject header." + (interactive) + (message-position-on-field "Subject")) + + (defun message-goto-cc () + "Move point to the Cc header." + (interactive) + (message-position-on-field "Cc" "To")) + + (defun message-goto-bcc () + "Move point to the Bcc header." + (interactive) + (message-position-on-field "Bcc" "Cc" "To")) + + (defun message-goto-fcc () + "Move point to the Fcc header." + (interactive) + (message-position-on-field "Fcc" "To" "Newsgroups")) + + (defun message-goto-reply-to () + "Move point to the Reply-To header." + (interactive) + (message-position-on-field "Reply-To" "Subject")) + + (defun message-goto-newsgroups () + "Move point to the Newsgroups header." + (interactive) + (message-position-on-field "Newsgroups")) + + (defun message-goto-distribution () + "Move point to the Distribution header." + (interactive) + (message-position-on-field "Distribution")) + + (defun message-goto-followup-to () + "Move point to the Followup-To header." + (interactive) + (message-position-on-field "Followup-To" "Newsgroups")) + + (defun message-goto-keywords () + "Move point to the Keywords header." + (interactive) + (message-position-on-field "Keywords" "Subject")) + + (defun message-goto-summary () + "Move point to the Summary header." + (interactive) + (message-position-on-field "Summary" "Subject")) + + (defun message-goto-body () + "Move point to the beginning of the message body." + (interactive) + (if (looking-at "[ \t]*\n") (expand-abbrev)) + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n") nil t)) + + (defun message-goto-signature () + "Move point to the beginning of the message signature." + (interactive) + (goto-char (point-min)) + (or (re-search-forward message-signature-separator nil t) + (goto-char (point-max)))) + + + + (defun message-insert-to () + "Insert a To header that points to the author of the article being replied to." + (interactive) + (when (and (message-position-on-field "To") + (mail-fetch-field "to") + (not (string-match "\\` *\\'" (mail-fetch-field "to")))) + (insert ", ")) + (insert (or (message-fetch-reply-field "reply-to") + (message-fetch-reply-field "from") ""))) + + (defun message-insert-newsgroups () + "Insert the Newsgroups header from the article being replied to." + (interactive) + (when (and (message-position-on-field "Newsgroups") + (mail-fetch-field "newsgroups") + (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) + (insert ",")) + (insert (or (message-fetch-reply-field "newsgroups") ""))) + + + + ;;; Various commands + + (defun message-insert-signature (&optional force) + "Insert a signature. See documentation for the `message-signature' variable." + (interactive (list 0)) + (let* ((signature + (cond ((and (null message-signature) + (eq force 0)) + (save-excursion + (goto-char (point-max)) + (not (re-search-backward + message-signature-separator nil t)))) + ((and (null message-signature) + force) + t) + ((message-functionp message-signature) + (funcall message-signature)) + ((listp message-signature) + (eval message-signature)) + (t message-signature))) + (signature + (cond ((stringp signature) + signature) + ((and (eq t signature) + message-signature-file + (file-exists-p message-signature-file)) + signature)))) + (when signature + ; ;; Remove blank lines at the end of the message. + (goto-char (point-max)) + ; (skip-chars-backward " \t\n") + ; (delete-region (point) (point-max)) + ;; Insert the signature. + (unless (bolp) + (insert "\n")) + (insert "\n-- \n") + (if (eq signature t) + (insert-file-contents message-signature-file) + (insert signature)) + (goto-char (point-max)) + (or (bolp) (insert "\n"))))) + + (defvar message-caesar-translation-table nil) + + (defun message-caesar-region (b e &optional n) + "Caesar rotation of region by N, default 13, for decrypting netnews." + (interactive + (list + (min (point) (or (mark t) (point))) + (max (point) (or (mark t) (point))) + (when current-prefix-arg + (prefix-numeric-value current-prefix-arg)))) + + (setq n (if (numberp n) (mod n 26) 13)) ;canonize N + (unless (or (zerop n) ; no action needed for a rot of 0 + (= b e)) ; no region to rotate + ;; We build the table, if necessary. + (when (or (not message-caesar-translation-table) + (/= (aref message-caesar-translation-table ?a) (+ ?a n))) + (let ((i -1) + (table (make-string 256 0))) + (while (< (incf i) 256) + (aset table i i)) + (setq table + (concat + (substring table 0 ?A) + (substring table (+ ?A n) (+ ?A n (- 26 n))) + (substring table ?A (+ ?A n)) + (substring table (+ ?A 26) ?a) + (substring table (+ ?a n) (+ ?a n (- 26 n))) + (substring table ?a (+ ?a n)) + (substring table (+ ?a 26) 255))) + (setq message-caesar-translation-table table))) + ;; Then we translate the region. Do it this way to retain + ;; text properties. + (while (< b e) + (subst-char-in-region + b (1+ b) (char-after b) + (aref message-caesar-translation-table (char-after b))) + (incf b)))) + + (defun message-caesar-buffer-body (&optional rotnum) + "Caesar rotates all letters in the current buffer by 13 places. + Used to encode/decode possibly offensive messages (commonly in net.jokes). + With prefix arg, specifies the number of places to rotate each letter forward. + Mail and USENET news headers are not rotated." + (interactive (if current-prefix-arg + (list (prefix-numeric-value current-prefix-arg)) + (list nil))) + (save-excursion + (save-restriction + (when (message-goto-body) + (narrow-to-region (point) (point-max))) + (message-caesar-region (point-min) (point-max) rotnum)))) + + (defun message-rename-buffer (&optional enter-string) + "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) + (search-forward mail-header-separator nil 'end)) + (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups") + (message-fetch-field "To"))) + (mail-trimmed-to + (if (string-match "," mail-to) + (concat (substring mail-to 0 (match-beginning 0)) ", ...") + mail-to)) + (name-default (concat "*message* " mail-trimmed-to)) + (name (if enter-string + (read-string "New buffer name: " name-default) + name-default))) + (rename-buffer name t))))) + + (defun message-fill-yanked-message (&optional justifyp) + "Fill the paragraphs of a message yanked into this one. + Numeric argument means justify as well." + (interactive "P") + (save-excursion + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n") nil t) + (let ((fill-prefix message-yank-prefix)) + (fill-individual-paragraphs (point) (point-max) justifyp t)))) + + (defun message-indent-citation () + "Modify text just inserted from a message to be cited. + The inserted text should be the region. + When this function returns, the region is again around the modified text. + + Normally, indent each nonblank line `message-indentation-spaces' spaces. + However, if `message-yank-prefix' is non-nil, insert that prefix on each line." + (let ((start (point))) + ;; Remove unwanted headers. + (when message-ignored-cited-headers + (save-restriction + (narrow-to-region + (goto-char start) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point))) + (message-remove-header message-ignored-cited-headers t))) + ;; Do the indentation. + (if (null message-yank-prefix) + (indent-rigidly start (mark t) message-indentation-spaces) + (save-excursion + (goto-char start) + (while (< (point) (mark t)) + (insert message-yank-prefix) + (forward-line 1))) + (goto-char start)))) + + (defun message-yank-original (&optional arg) + "Insert the message being replied to, if any. + Puts point before the text and mark after. + Normally indents each nonblank line ARG spaces (default 3). However, + if `message-yank-prefix' is non-nil, insert that prefix on each line. + + This function uses `message-cite-function' to do the actual citing. + + Just \\[universal-argument] as argument means don't indent, insert no + prefix, and don't delete any headers." + (interactive "P") + (let ((modified (buffer-modified-p))) + (when (and message-reply-buffer + message-cite-function) + (delete-windows-on message-reply-buffer t) + (insert-buffer message-reply-buffer) + (funcall message-cite-function) + (message-exchange-point-and-mark) + (unless (bolp) + (insert ?\n)) + (unless modified + (setq message-checksum (cons (message-checksum) (buffer-size))))))) + + (defun message-cite-original () + (let ((start (point)) + (functions + (when message-indent-citation-function + (if (listp message-indent-citation-function) + message-indent-citation-function + (list message-indent-citation-function))))) + (goto-char start) + (while functions + (funcall (pop functions))) + (when message-citation-line-function + (unless (bolp) + (insert "\n")) + (funcall message-citation-line-function)))) + + (defun message-insert-citation-line () + "Function that inserts a simple citation line." + (when message-reply-headers + (insert (mail-header-from message-reply-headers) " writes:\n\n"))) + + (defun message-position-on-field (header &rest afters) + (let ((case-fold-search t)) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (progn + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (match-beginning 0))) + (goto-char (point-min)) + (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t) + (progn + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line) + (skip-chars-backward "\n") + t) + (while (and afters + (not (re-search-forward + (concat "^" (regexp-quote (car afters)) ":") + nil t))) + (pop afters)) + (when afters + (re-search-forward "^[^ \t]" nil 'move) + (beginning-of-line)) + (insert header ": \n") + (forward-char -1) + nil)))) + + (defun message-remove-signature () + "Remove the signature from the text between point and mark. + The text will also be indented the normal way." + (save-excursion + (let ((start (point)) + mark) + (if (not (re-search-forward message-signature-separator (mark t) t)) + ;; No signature here, so we just indent the cited text. + (message-indent-citation) + ;; Find the last non-empty line. + (forward-line -1) + (while (looking-at "[ \t]*$") + (forward-line -1)) + (forward-line 1) + (setq mark (set-marker (make-marker) (point))) + (goto-char start) + (message-indent-citation) + ;; Enable undoing the deletion. + (undo-boundary) + (delete-region mark (mark t)) + (set-marker mark nil))))) + + + + ;;; + ;;; Sending messages + ;;; + + (defun message-send-and-exit (&optional arg) + "Send message like `message-send', then, if no errors, exit from mail buffer." + (interactive "P") + (let ((buf (current-buffer)) + (actions message-exit-actions)) + (when (and (message-send arg) + (buffer-name buf)) + (if message-kill-buffer-on-exit + (kill-buffer buf) + (bury-buffer buf) + (when (eq buf (current-buffer)) + (message-bury buf))) + (message-do-actions actions)))) + + (defun message-dont-send () + "Don't send the message you have been editing." + (interactive) + (message-bury (current-buffer)) + (message-do-actions message-postpone-actions)) + + (defun message-kill-buffer () + "Kill the current buffer." + (interactive) + (let ((actions message-kill-actions)) + (kill-buffer (current-buffer)) + (message-do-actions actions))) + + (defun message-bury (buffer) + "Bury this mail buffer." + (let ((newbuf (other-buffer buffer))) + (bury-buffer buffer) + (if (and (fboundp 'frame-parameters) + (cdr (assq 'dedicated (frame-parameters))) + (not (null (delq (selected-frame) (visible-frame-list))))) + (delete-frame (selected-frame)) + (switch-to-buffer newbuf)))) + + (defun message-send (&optional arg) + "Send the message in the current buffer. + If `message-interactive' is non-nil, wait for success indication + or error messages, and inform user. + Otherwise any failure is reported in a message back to + the user from the mailer." + (interactive "P") + (when (if buffer-file-name + (y-or-n-p (format "Send buffer contents as %s message? " + (if (message-mail-p) + (if (message-news-p) "mail and news" "mail") + "news"))) + (or (buffer-modified-p) + (y-or-n-p "No changes in the buffer; really send? "))) + ;; Make it possible to undo the coming changes. + (undo-boundary) + (let ((inhibit-read-only t)) + (put-text-property (point-min) (point-max) 'read-only nil)) + (message-fix-before-sending) + (run-hooks 'message-send-hook) + (message "Sending...") + (when (and (or (not (message-news-p)) + (and (or (not (memq 'news message-sent-message-via)) + (y-or-n-p + "Already sent message via news; resend? ")) + (funcall message-send-news-function arg))) + (or (not (message-mail-p)) + (and (or (not (memq 'mail message-sent-message-via)) + (y-or-n-p + "Already sent message via mail; resend? ")) + (message-send-mail arg)))) + (message-do-fcc) + ;;(when (fboundp 'mail-hist-put-headers-into-history) + ;; (mail-hist-put-headers-into-history)) + (run-hooks 'message-sent-hook) + (message "Sending...done") + ;; If buffer has no file, mark it as unmodified and delete autosave. + (unless buffer-file-name + (set-buffer-modified-p nil) + (delete-auto-save-file-if-necessary t)) + ;; Delete other mail buffers and stuff. + (message-do-send-housekeeping) + (message-do-actions message-send-actions) + ;; Return success. + t))) + + (defun message-fix-before-sending () + "Do various things to make the message nice before sending it." + ;; Make sure there's a newline at the end of the message. + (goto-char (point-max)) + (unless (bolp) + (insert "\n"))) + + (defun message-add-action (action &rest types) + "Add ACTION to be performed when doing an exit of type TYPES." + (let (var) + (while types + (set (setq var (intern (format "message-%s-actions" (pop types)))) + (nconc (symbol-value var) (list action)))))) + + (defun message-do-actions (actions) + "Perform all actions in ACTIONS." + ;; Now perform actions on successful sending. + (while actions + (condition-case nil + (cond + ;; A simple function. + ((message-functionp (car actions)) + (funcall (car actions))) + ;; Something to be evaled. + (t + (eval (car actions)))) + (error)) + (pop actions))) + + (defun message-send-mail (&optional arg) + (require 'mail-utils) + (let ((tembuf (generate-new-buffer " message temp")) + (case-fold-search nil) + (news (message-news-p)) + (mailbuf (current-buffer))) + (save-restriction + (message-narrow-to-headers) + ;; Insert some headers. + (let ((message-deletable-headers + (if news nil message-deletable-headers))) + (message-generate-headers message-required-mail-headers)) + ;; Let the user do all of the above. + (run-hooks 'message-header-hook)) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + ;; Remove some headers. + (save-restriction + (message-narrow-to-headers) + ;; Remove some headers. + (message-remove-header message-ignored-mail-headers t)) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (when (and news + (or (message-fetch-field "cc") + (message-fetch-field "to"))) + (message-insert-courtesy-copy)) + (funcall message-send-mail-function)) + (kill-buffer tembuf)) + (set-buffer mailbuf) + (push 'mail message-sent-message-via))) + + (defun message-send-mail-with-sendmail () + "Send off the prepared buffer with sendmail." + (let ((errbuf (if message-interactive + (generate-new-buffer " sendmail errors") + 0)) + resend-to-addresses delimline) + (let ((case-fold-search t)) + (save-restriction + (message-narrow-to-headers) + (setq resend-to-addresses (message-fetch-field "resent-to"))) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (when (eval message-mailer-swallows-blank-line) + (newline)) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + (let ((default-directory "/")) + (apply 'call-process-region + (append (list (point-min) (point-max) + (if (boundp 'sendmail-program) + sendmail-program + "/usr/lib/sendmail") + nil errbuf nil "-oi") + ;; Always specify who from, + ;; since some systems have broken sendmails. + (list "-f" (user-login-name)) + ;; These mean "report errors by mail" + ;; and "deliver in background". + (if (null message-interactive) '("-oem" "-odb")) + ;; Get the addresses from the message + ;; unless this is a resend. + ;; We must not do that for a resend + ;; because we would find the original addresses. + ;; For a resend, include the specific addresses. + (if resend-to-addresses + (list resend-to-addresses) + '("-t"))))) + (when message-interactive + (save-excursion + (set-buffer errbuf) + (goto-char (point-min)) + (while (re-search-forward "\n\n* *" nil t) + (replace-match "; ")) + (if (not (zerop (buffer-size))) + (error "Sending...failed to %s" + (buffer-substring (point-min) (point-max))))) + (when (bufferp errbuf) + (kill-buffer errbuf))))) + + (defun message-send-mail-with-mh () + "Send the prepared message buffer with mh." + (let ((mh-previous-window-config nil) + (name (make-temp-name + (concat (file-name-as-directory message-autosave-directory) + "msg.")))) + (setq buffer-file-name name) + (mh-send-letter) + (condition-case () + (delete-file name) + (error nil)))) + + (defun message-send-news (&optional arg) + (let ((tembuf (generate-new-buffer " *message temp*")) + (case-fold-search nil) + (method (if (message-functionp message-post-method) + (funcall message-post-method arg) + message-post-method)) + (messbuf (current-buffer)) + (message-syntax-checks + (if arg + (cons '(existing-newsgroups . disabled) + message-syntax-checks) + message-syntax-checks)) + result) + (save-restriction + (message-narrow-to-headers) + ;; Insert some headers. + (message-generate-headers message-required-news-headers) + ;; Let the user do all of the above. + (run-hooks 'message-header-hook)) + (message-cleanup-headers) + (when (message-check-news-syntax) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring messbuf) + ;; Remove some headers. + (save-restriction + (message-narrow-to-headers) + ;; Remove some headers. + (message-remove-header message-ignored-news-headers t)) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (let ((case-fold-search t)) + ;; Remove the delimeter. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1)) + (require (car method)) + (funcall (intern (format "%s-open-server" (car method))) + (cadr method) (cddr method)) + (setq result + (funcall (intern (format "%s-request-post" (car method)))))) + (kill-buffer tembuf)) + (set-buffer messbuf) + (if result + (push 'news message-sent-message-via) + (message "Couldn't send message via news: %s" + (nnheader-get-report (car method))) + nil)))) + + ;;; + ;;; Header generation & syntax checking. + ;;; + + (defun message-check-news-syntax () + "Check the syntax of the message." + (and + ;; We narrow to the headers and check them first. + (save-excursion + (save-restriction + (message-narrow-to-headers) + (and + ;; Check for commands in Subject. + (or + (message-check-element 'subject-cmsg) + (save-excursion + (if (string-match "^cmsg " (message-fetch-field "subject")) + (y-or-n-p + "The control code \"cmsg \" is in the subject. Really post? ") + t))) + ;; Check for multiple identical headers. + (or (message-check-element 'multiple-headers) + (save-excursion + (let (found) + (while (and (not found) + (re-search-forward "^[^ \t:]+: " nil t)) + (save-excursion + (or (re-search-forward + (concat "^" (setq found + (buffer-substring + (match-beginning 0) + (- (match-end 0) 2)))) + nil t) + (setq found nil)))) + (if found + (y-or-n-p + (format "Multiple %s headers. Really post? " found)) + t)))) + ;; Check for Version and Sendsys. + (or (message-check-element 'sendsys) + (save-excursion + (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) + (1- (match-end 0))))) + t))) + ;; See whether we can shorten Followup-To. + (or (message-check-element 'shorten-followup-to) + (let ((newsgroups (message-fetch-field "newsgroups")) + (followup-to (message-fetch-field "followup-to")) + to) + (when (and newsgroups (string-match "," newsgroups) + (not followup-to) + (not + (zerop + (length + (setq to (completing-read + "Followups to: (default all groups) " + (mapcar (lambda (g) (list g)) + (cons "poster" + (message-tokenize-header + newsgroups))))))))) + (goto-char (point-min)) + (insert "Followup-To: " to "\n")) + t)) + ;; Check "Shoot me". + (or (message-check-element 'shoot) + (save-excursion + (if (re-search-forward + "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me" + nil t) + (y-or-n-p + "You appear to have a misconfigured system. Really post? ") + t))) + ;; Check for Approved. + (or (message-check-element 'approved) + (save-excursion + (if (re-search-forward "^Approved:" nil t) + (y-or-n-p + "The article contains an Approved header. Really post? ") + t))) + ;; Check the Message-Id header. + (or (message-check-element 'message-id) + (save-excursion + (let* ((case-fold-search t) + (message-id (message-fetch-field "message-id"))) + (or (not message-id) + (and (string-match "@" message-id) + (string-match "@[^\\.]*\\." message-id)) + (y-or-n-p + (format + "The Message-ID looks strange: \"%s\". Really post? " + message-id)))))) + ;; Check the Subject header. + (or + (message-check-element 'subject) + (save-excursion + (let* ((case-fold-search t) + (subject (message-fetch-field "subject"))) + (or + (and subject + (not (string-match "\\`[ \t]*\\'" subject))) + (progn + (message + "The subject field is empty or missing. Posting is denied.") + nil))))) + ;; Check the Newsgroups & Followup-To headers. + (or + (message-check-element 'existing-newsgroups) + (let* ((case-fold-search t) + (newsgroups (message-fetch-field "newsgroups")) + (followup-to (message-fetch-field "followup-to")) + (groups (message-tokenize-header + (if followup-to + (concat newsgroups "," followup-to) + newsgroups))) + (hashtb (and (boundp 'gnus-active-hashtb) + gnus-active-hashtb)) + errors) + (if (not hashtb) + t + (while groups + (when (and (not (boundp (intern (car groups) hashtb))) + (not (equal (car groups) "poster"))) + (push (car groups) errors)) + (pop groups)) + (if (not errors) + t + (y-or-n-p + (format + "Really post to %s unknown group%s: %s " + (if (= (length errors) 1) "this" "these") + (if (= (length errors) 1) "" "s") + (mapconcat 'identity errors ", "))))))) + ;; Check the Newsgroups & Followup-To headers for syntax errors. + (or + (message-check-element 'valid-newsgroups) + (let ((case-fold-search t) + (headers '("Newsgroups" "Followup-To")) + header error) + (while (and headers (not error)) + (when (setq header (mail-fetch-field (car headers))) + (if (or + (not + (string-match + "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'" + header)) + (memq + nil (mapcar + (lambda (g) + (not (string-match "\\.\\'\\|\\.\\." g))) + (message-tokenize-header header ",")))) + (setq error t))) + (unless error + (pop headers))) + (if (not error) + t + (y-or-n-p + (format "The %s header looks odd: \"%s\". Really post? " + (car headers) header))))) + ;; Check the From header. + (or + (save-excursion + (let* ((case-fold-search t) + (from (message-fetch-field "from"))) + (cond + ((not from) + (message "There is no From line. Posting is denied.") + nil) + ((not (string-match "@[^\\.]*\\." from)) + (message + "Denied posting -- the From looks strange: \"%s\"." from) + nil) + ((string-match "@[^@]*@" from) + (message + "Denied posting -- two \"@\"'s in the From header: %s." from) + nil) + ((string-match "(.*).*(.*)" from) + (message + "Denied posting -- the From header looks strange: \"%s\"." + from) + nil) + (t t)))))))) + ;; Check for long lines. + (or (message-check-element 'long-lines) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (while (and + (progn + (end-of-line) + (< (current-column) 80)) + (zerop (forward-line 1)))) + (or (bolp) + (eobp) + (y-or-n-p + "You have lines longer than 79 characters. Really post? ")))) + ;; Check whether the article is empty. + (or (message-check-element 'empty) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) + (let ((b (point))) + (or (re-search-forward message-signature-separator nil t) + (goto-char (point-max))) + (beginning-of-line) + (or (re-search-backward "[^ \n\t]" b t) + (y-or-n-p "Empty article. Really post? "))))) + ;; Check for control characters. + (or (message-check-element 'control-chars) + (save-excursion + (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) + (y-or-n-p + "The article contains control characters. Really post? ") + t))) + ;; Check excessive size. + (or (message-check-element 'size) + (if (> (buffer-size) 60000) + (y-or-n-p + (format "The article is %d octets long. Really post? " + (buffer-size))) + t)) + ;; Check whether any new text has been added. + (or (message-check-element 'new-text) + (not message-checksum) + (not (and (eq (message-checksum) (car message-checksum)) + (eq (buffer-size) (cdr message-checksum)))) + (y-or-n-p + "It looks like no new text has been added. Really post? ")) + ;; Check the length of the signature. + (or + (message-check-element 'signature) + (progn + (goto-char (point-max)) + (if (or (not (re-search-backward "^-- $" nil t)) + (search-forward message-forward-end-separator nil t)) + t + (if (> (count-lines (point) (point-max)) 5) + (y-or-n-p + (format + "Your .sig is %d lines; it should be max 4. Really post? " + (count-lines (point) (point-max)))) + t)))))) + + (defun message-check-element (type) + "Returns non-nil if this type is not to be checked." + (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) + t + (let ((able (assq type message-syntax-checks))) + (and (consp able) + (eq (cdr able) 'disabled))))) + + (defun message-checksum () + "Return a \"checksum\" for the current buffer." + (let ((sum 0)) + (save-excursion + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (while (not (eobp)) + (when (not (looking-at "[ \t\n]")) + (setq sum (logxor (ash sum 1) (following-char)))) + (forward-char 1))) + sum)) + + (defun message-do-fcc () + "Process Fcc headers in the current buffer." + (let ((case-fold-search t) + (buf (current-buffer)) + list file) + (save-excursion + (set-buffer (get-buffer-create " *message temp*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring buf) + (save-restriction + (message-narrow-to-headers) + (while (setq file (message-fetch-field "fcc")) + (push file list) + (message-remove-header "fcc" nil t))) + (goto-char (point-min)) + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) + (replace-match "" t t) + ;; Process FCC operations. + (while list + (setq file (pop list)) + (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) + ;; Pipe the article to the program in question. + (call-process-region (point-min) (point-max) shell-file-name + nil nil nil shell-command-switch + (match-string 1 file)) + ;; Save the article. + (setq file (expand-file-name file)) + (unless (file-exists-p (file-name-directory file)) + (make-directory (file-name-directory file) t)) + (if (and message-fcc-handler-function + (not (eq message-fcc-handler-function 'rmail-output))) + (funcall message-fcc-handler-function file) + (if (and (file-readable-p file) (mail-file-babyl-p file)) + (rmail-output file 1) + (let ((mail-use-rfc822 t)) + (rmail-output file 1 t t)))))) + (kill-buffer (current-buffer))))) + + (defun message-cleanup-headers () + "Do various automatic cleanups of the headers." + ;; Remove empty lines in the header. + (save-restriction + (message-narrow-to-headers) + (while (re-search-forward "^[ \t]*\n" nil t) + (replace-match "" t t))) + + ;; Correct Newsgroups and Followup-To headers: change sequence of + ;; spaces to comma and eliminate spaces around commas. Eliminate + ;; embedded line breaks. + (goto-char (point-min)) + (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t) + (save-restriction + (narrow-to-region + (point) + (if (re-search-forward "^[^ \t]" nil t) + (match-beginning 0) + (forward-line 1) + (point))) + (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+" nil t) + (replace-match " " t t)) ;No line breaks (too confusing) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) + (replace-match "," t t)) + (goto-char (point-min)) + ;; Remove trailing commas. + (when (re-search-forward ",+$" nil t) + (replace-match "" t t))))) + + (defun message-make-date () + "Make a valid data header." + (let ((now (current-time))) + (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) + (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= + (message-strip-subject-re + (mail-header-subject message-reply-headers)) + (message-strip-subject-re psubject)))) + "_-_" "")) + "@" (message-make-fqdn) ">")) + + (defvar message-unique-id-char nil) + + ;; If you ever change this function, make sure the new version + ;; cannot generate IDs that the old version could. + ;; You might for example insert a "." somewhere (not next to another dot + ;; or string boundary), or modify the "fsf" string. + (defun message-unique-id () + ;; Don't use microseconds from (current-time), they may be unsupported. + ;; Instead we use this randomly inited counter. + (setq message-unique-id-char + (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) + ;; (current-time) returns 16-bit ints, + ;; and 2^16*25 just fits into 4 digits i base 36. + (* 25 25))) + (let ((tm (current-time))) + (concat + (if (memq system-type '(ms-dos emx vax-vms)) + (let ((user (downcase (user-login-name)))) + (while (string-match "[^a-z0-9_]" user) + (aset user (match-beginning 0) ?_)) + user) + (message-number-base36 (user-uid) -1)) + (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) + ;; Append the newsreader name, because while the generated + ;; ID is unique to this newsreader, other newsreaders might + ;; otherwise generate the same ID via another algorithm. + ".fsf"))) + + (defun message-number-base36 (num len) + (if (if (< len 0) (<= num 0) (= len 0)) + "" + (concat (message-number-base36 (/ num 36) (1- len)) + (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" + (% num 36)))))) + + (defun message-make-organization () + "Make an Organization header." + (let* ((organization + (or (getenv "ORGANIZATION") + (when message-user-organization + (if (message-functionp message-user-organization) + (funcall message-user-organization) + message-user-organization))))) + (save-excursion + (message-set-work-buffer) + (cond ((stringp organization) + (insert organization)) + ((and (eq t organization) + message-user-organization-file + (file-exists-p message-user-organization-file)) + (insert-file-contents message-user-organization-file))) + (goto-char (point-min)) + (while (re-search-forward "[\t\n]+" nil t) + (replace-match "" t t)) + (unless (zerop (buffer-size)) + (buffer-string))))) + + (defun message-make-lines () + "Count the number of lines and return numeric string." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "$")) + (forward-line 1) + (int-to-string (count-lines (point) (point-max)))))) + + (defun message-make-in-reply-to () + "Return the In-Reply-To header for this message." + (when message-reply-headers + (let ((from (mail-header-from message-reply-headers)) + (date (mail-header-date message-reply-headers))) + (when from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (concat (if stop-pos (substring from 0 stop-pos) from) + "'s message of " + (if (or (not date) (string= date "")) + "(unknown date)" date))))))) + + (defun message-make-distribution () + "Make a Distribution header." + (let ((orig-distribution (message-fetch-reply-field "distribution"))) + (cond ((message-functionp message-distribution-function) + (funcall message-distribution-function)) + (t orig-distribution)))) + + (defun message-make-expires () + "Return an Expires header based on `message-expires'." + (let ((current (current-time)) + (future (* 1.0 message-expires 60 60 24))) + ;; Add the future to current. + (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 + (current-time-string current) (current-time-zone current) '(0 "UT")))) + + (defun message-make-path () + "Return uucp path." + (let ((login-name (user-login-name))) + (cond ((null message-user-path) + (concat (system-name) "!" login-name)) + ((stringp message-user-path) + ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. + (concat message-user-path "!" login-name)) + (t login-name)))) + + (defun message-make-from () + "Make a From header." + (let* ((login (message-make-address)) + (fullname + (or (and (boundp 'user-full-name) + user-full-name) + (user-full-name)))) + (when (string= fullname "&") + (setq fullname (user-login-name))) + (save-excursion + (message-set-work-buffer) + (cond + ((or (null message-from-style) + (equal fullname "")) + (insert login)) + ((or (eq message-from-style 'angles) + (and (not (eq message-from-style 'parens)) + ;; Use angles if no quoting is needed, or if parens would + ;; need quoting too. + (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) + (let ((tmp (concat fullname nil))) + (while (string-match "([^()]*)" tmp) + (aset tmp (match-beginning 0) ?-) + (aset tmp (1- (match-end 0)) ?-)) + (string-match "[\\()]" tmp))))) + (insert fullname) + (goto-char (point-min)) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) + ;; Quote fullname, escaping specials. + (goto-char (point-min)) + (insert "\"") + (while (re-search-forward "[\"\\]" nil 1) + (replace-match "\\\\\\&" t)) + (insert "\"")) + (insert " <" login ">")) + (t ; 'parens or default + (insert login " (") + (let ((fullname-start (point))) + (insert fullname) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" nil 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + nil 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start))) + (insert ")"))) + (buffer-string)))) + + (defun message-make-sender () + "Return the \"real\" user address. + This function tries to ignore all user modifications, and + give as trustworthy answer as possible." + (concat (user-login-name) "@" (system-name))) + + (defun message-make-address () + "Make the address of the user." + (or (message-user-mail-address) + (concat (user-login-name) "@" (message-make-domain)))) + + (defun message-user-mail-address () + "Return the pertinent part of `user-mail-address'." + (when user-mail-address + (nth 1 (mail-extract-address-components user-mail-address)))) + + (defun message-make-fqdn () + "Return user's fully qualified domain name." + (let ((system-name (system-name)) + (user-mail (message-user-mail-address))) + (cond + ((string-match "[^.]\\.[^.]" system-name) + ;; `system-name' returned the right result. + system-name) + ;; Try `mail-host-address'. + ((and (boundp 'mail-host-address) + (stringp mail-host-address) + (string-match "\\." mail-host-address)) + mail-host-address) + ;; We try `user-mail-address' as a backup. + ((and (string-match "\\." user-mail) + (string-match "@\\(.*\\)\\'" user-mail)) + (match-string 1 user-mail)) + ;; Default to this bogus thing. + (t + (concat system-name ".i-have-a-misconfigured-system-so-shoot-me"))))) + + (defun message-make-host-name () + "Return the name of the host." + (let ((fqdn (message-make-fqdn))) + (string-match "^[^.]+\\." fqdn) + (substring fqdn 0 (1- (match-end 0))))) + + (defun message-make-domain () + "Return the domain name." + (or mail-host-address + (message-make-fqdn))) + + (defun message-generate-headers (headers) + "Prepare article HEADERS. + Headers already prepared in the buffer are not modified." + (save-restriction + (message-narrow-to-headers) + (let* ((Date (message-make-date)) + (Message-ID (message-make-message-id)) + (Organization (message-make-organization)) + (From (message-make-from)) + (Path (message-make-path)) + (Subject nil) + (Newsgroups nil) + (In-Reply-To (message-make-in-reply-to)) + (To nil) + (Distribution (message-make-distribution)) + (Lines (message-make-lines)) + (X-Newsreader message-newsreader) + (X-Mailer (and (not (message-fetch-field "X-Newsreader")) + message-mailer)) + (Expires (message-make-expires)) + (case-fold-search t) + header value elem) + ;; First we remove any old generated headers. + (let ((headers message-deletable-headers)) + (while headers + (goto-char (point-min)) + (and (re-search-forward + (concat "^" (symbol-name (car headers)) ": *") nil t) + (get-text-property (1+ (match-beginning 0)) 'message-deletable) + (message-delete-line)) + (pop headers))) + ;; 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. + (while headers + (goto-char (point-min)) + (setq elem (pop headers)) + (if (consp elem) + (if (eq (car elem) 'optional) + (setq header (cdr elem)) + (setq header (car elem))) + (setq header elem)) + (when (or (not (re-search-forward + (concat "^" (downcase (symbol-name header)) ":") + nil t)) + (progn + ;; The header was found. We insert a space after the + ;; colon, if there is none. + (if (/= (following-char) ? ) (insert " ") (forward-char 1)) + ;; Find out whether the header is empty... + (looking-at "[ \t]*$"))) + ;; So we find out what value we should insert. + (setq value + (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 + ;; this header. + (setq header (cdr elem)) + (or (and (fboundp (cdr elem)) (funcall (cdr elem))) + (and (boundp (cdr elem)) (symbol-value (cdr elem))))) + ((consp elem) + ;; The element is a cons. Either the cdr is a + ;; string to be inserted verbatim, or it is a + ;; function, and we insert the value returned from + ;; this function. + (or (and (stringp (cdr elem)) (cdr elem)) + (and (fboundp (cdr elem)) (funcall (cdr elem))))) + ((and (boundp header) (symbol-value header)) + ;; The element is a symbol. We insert the value + ;; of this symbol, if any. + (symbol-value header)) + (t + ;; We couldn't generate a value for this header, + ;; so we just ask the user. + (read-from-minibuffer + (format "Empty header for %s; enter value: " header))))) + ;; Finally insert the header. + (when (and value + (not (equal value ""))) + (save-excursion + (if (bolp) + (progn + ;; This header didn't exist, so we insert it. + (goto-char (point-max)) + (insert (symbol-name header) ": " value "\n") + (forward-line -1)) + ;; The value of this header was empty, so we clear + ;; totally and insert the new value. + (delete-region (point) (message-point-at-eol)) + (insert value)) + ;; 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 + (point) (match-end 0) + '(message-deletable t face italic) (current-buffer))))))) + ;; 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 + (not (message-check-element 'sender)) + (not (string= + (downcase + (cadr (mail-extract-address-components from))) + (downcase secure-sender))) + (or (null sender) + (not + (string= + (downcase + (cadr (mail-extract-address-components sender))) + (downcase secure-sender))))) + (goto-char (point-min)) + ;; Rename any old Sender headers to Original-Sender. + (when (re-search-forward "^Sender:" nil t) + (beginning-of-line) + (insert "Original-") + (beginning-of-line)) + (insert "Sender: " secure-sender "\n")))))) + + (defun message-insert-courtesy-copy () + "Insert a courtesy message in mail copies of combined messages." + (save-excursion + (save-restriction + (message-narrow-to-headers) + (let ((newsgroups (message-fetch-field "newsgroups"))) + (when newsgroups + (goto-char (point-max)) + (insert "Posted-To: " newsgroups "\n")))) + (forward-line 1) + (insert message-courtesy-message))) + + ;;; + ;;; Setting up a message buffer + ;;; + + (defun message-fill-address (header value) + (save-restriction + (narrow-to-region (point) (point)) + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n") + (narrow-to-region (point-min) (1- (point-max))) + (let (quoted last) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward "^,\"" (point-max)) + (if (or (= (following-char) ?,) + (eobp)) + (when (not quoted) + (if (and (> (current-column) 78) + last) + (progn + (save-excursion + (goto-char last) + (insert "\n\t")) + (setq last (1+ (point)))) + (setq last (1+ (point))))) + (setq quoted (not quoted))) + (unless (eobp) + (forward-char 1)))) + (goto-char (point-max)) + (widen) + (forward-line 1))) + + (defun message-fill-header (header value) + (let ((begin (point)) + (fill-column 78) + (fill-prefix "\t")) + (insert (capitalize (symbol-name header)) + ": " + (if (consp value) (car value) value) + "\n") + (save-restriction + (narrow-to-region begin (point)) + (fill-region-as-paragraph begin (point)) + ;; Tapdance around looong Message-IDs. + (forward-line -1) + (when (looking-at "[ \t]*$") + (message-delete-line)) + (goto-char begin) + (re-search-forward ":" nil t) + (when (looking-at "\n[ \t]+") + (replace-match " " t t)) + (goto-char (point-max))))) + + (defun message-position-point () + "Move point to where the user probably wants to find it." + (message-narrow-to-headers) + (cond + ((re-search-forward "^[^:]+:[ \t]*$" nil t) + (search-backward ":" ) + (widen) + (forward-char 1) + (if (= (following-char) ? ) + (forward-char 1) + (insert " "))) + (t + (goto-char (point-max)) + (widen) + (forward-line 1) + (unless (looking-at "$") + (forward-line 2))) + (sit-for 0))) + + (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, + ;; and if so, call it. + ((message-functionp message-generate-new-buffers) + (funcall message-generate-new-buffers type to group)) + ;; Generate a new buffer name The Message Way. + (message-generate-new-buffers + (generate-new-buffer-name + (concat "*" type + (if to + (concat " to " + (or (car (mail-extract-address-components to)) + to) "") + "") + (if (and group (not (string= group ""))) (concat " on " group) "") + "*"))) + ;; Use standard name. + (t + (format "*%s message*" type)))) + + (defun message-pop-to-buffer (name) + "Pop to buffer NAME, and warn if it already exists and is modified." + (let ((buffer (get-buffer name))) + (if (and buffer + (buffer-name buffer)) + (progn + (set-buffer (pop-to-buffer buffer)) + (when (and (buffer-modified-p) + (not (y-or-n-p + "Message already being composed; erase? "))) + (error "Message being composed"))) + (set-buffer (pop-to-buffer name)))) + (erase-buffer) + (message-mode)) + + (defun message-do-send-housekeeping () + "Kill old message buffers." + ;; We might have sent this buffer already. Delete it from the + ;; list of buffers. + (setq message-buffer-list (delq (current-buffer) message-buffer-list)) + (when (and message-max-buffers + (>= (length message-buffer-list) message-max-buffers)) + ;; Kill the oldest buffer -- unless it has been changed. + (let ((buffer (pop message-buffer-list))) + (when (and (buffer-name buffer) + (not (buffer-modified-p buffer))) + (kill-buffer buffer)))) + ;; Rename the buffer. + (if message-send-rename-function + (funcall message-send-rename-function) + (when (string-match "\\`\\*" (buffer-name)) + (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 + (nconc message-buffer-list (list (current-buffer)))))) + + (defvar mc-modes-alist) + (defun message-setup (headers &optional replybuffer actions) + (when (and (boundp 'mc-modes-alist) + (not (assq 'message-mode mc-modes-alist))) + (push '(message-mode (encrypt . mc-encrypt-message) + (sign . mc-sign-message)) + mc-modes-alist)) + (when actions + (setq message-send-actions actions)) + (setq message-reply-buffer replybuffer) + (goto-char (point-min)) + ;; Insert all the headers. + (mail-header-format + (let ((h headers) + (alist message-header-format-alist)) + (while h + (unless (assq (caar h) message-header-format-alist) + (push (list (caar h)) alist)) + (pop h)) + alist) + headers) + (delete-region (point) (progn (forward-line -1) (point))) + (when message-default-headers + (insert message-default-headers)) + (put-text-property + (point) + (progn + (insert mail-header-separator "\n") + (1- (point))) + 'read-only nil) + (forward-line -1) + (when (message-news-p) + (when message-default-news-headers + (insert message-default-news-headers)) + (when message-generate-headers-first + (message-generate-headers + (delq 'Lines + (delq 'Subject + (copy-sequence message-required-news-headers)))))) + (when (message-mail-p) + (when message-default-mail-headers + (insert message-default-mail-headers)) + (when message-generate-headers-first + (message-generate-headers + (delq 'Lines + (delq 'Subject + (copy-sequence message-required-mail-headers)))))) + (run-hooks 'message-signature-setup-hook) + (message-insert-signature) + (message-set-auto-save-file-name) + (save-restriction + (message-narrow-to-headers) + (run-hooks 'message-header-setup-hook)) + (set-buffer-modified-p nil) + (run-hooks 'message-setup-hook) + (message-position-point) + (undo-boundary)) + + (defun message-set-auto-save-file-name () + "Associate the message buffer with a file in the drafts directory." + (when message-autosave-directory + (unless (file-exists-p message-autosave-directory) + (make-directory message-autosave-directory t)) + (let ((name (make-temp-name + (concat (file-name-as-directory message-autosave-directory) + "msg.")))) + (setq buffer-auto-save-file-name + (save-excursion + (prog1 + (progn + (set-buffer (get-buffer-create " *draft tmp*")) + (setq buffer-file-name name) + (make-auto-save-file-name)) + (kill-buffer (current-buffer))))) + (clear-visited-file-modtime)))) + + + + ;;; + ;;; Commands for interfacing with message + ;;; + + ;;;###autoload + (defun message-mail (&optional to subject) + "Start editing a mail message to be sent." + (interactive) + (message-pop-to-buffer (message-buffer-name "mail" to)) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-news (&optional newsgroups subject) + "Start editing a news article to be sent." + (interactive) + (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-reply (&optional to-address wide ignore-reply-to) + "Start editing a reply to the article in the current buffer." + (interactive) + (let ((cur (current-buffer)) + from subject date reply-to to cc + references message-id follow-to + mct never-mct gnus-warning) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + ;; Allow customizations to have their say. + (if (not wide) + ;; This is a regular reply. + (if (message-functionp message-reply-to-function) + (setq follow-to (funcall message-reply-to-function))) + ;; This is a followup. + (if (message-functionp message-wide-reply-to-function) + (save-excursion + (setq follow-to + (funcall message-wide-reply-to-function))))) + ;; Find all relevant headers we need. + (setq from (message-fetch-field "from") + date (message-fetch-field "date") + subject (or (message-fetch-field "subject") "none") + to (message-fetch-field "to") + cc (message-fetch-field "cc") + mct (message-fetch-field "mail-copies-to") + reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) + references (message-fetch-field "references") + message-id (message-fetch-field "message-id")) + ;; Remove any (buggy) Re:'s that are present and make a + ;; proper one. + (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) + (setq subject (substring subject (match-end 0)))) + (setq subject (concat "Re: " subject)) + + (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") + (setq never-mct t) + (setq mct nil)) + ((equal (downcase mct) "always") + (setq mct (or reply-to from))))) + + (unless follow-to + (if (or (not wide) + to-address) + (setq follow-to (list (cons 'To (or to-address reply-to from)))) + (let (ccalist) + (save-excursion + (message-set-work-buffer) + (unless never-mct + (insert (or reply-to from ""))) + (insert + (if (bolp) "" ", ") (or to "") + (if mct (concat (if (bolp) "" ", ") mct) "") + (if cc (concat (if (bolp) "" ", ") cc) "")) + ;; Remove addresses that match `rmail-dont-reply-to-names'. + (insert (prog1 (rmail-dont-reply-to (buffer-string)) + (erase-buffer))) + (goto-char (point-min)) + (setq ccalist + (mapcar + (lambda (addr) + (cons (mail-strip-quoted-names addr) addr)) + (nreverse (mail-parse-comma-list)))) + (let ((s ccalist)) + (while s + (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) + (setq follow-to (list (cons 'To (cdr (pop ccalist))))) + (when ccalist + (push (cons 'Cc + (mapconcat (lambda (addr) (cdr addr)) ccalist ", ")) + follow-to))))) + (widen)) + + (message-pop-to-buffer (message-buffer-name + (if wide "wide reply" "reply") from + (if wide to-address nil))) + + (setq message-reply-headers + (vector 0 subject from date message-id references 0 0 "")) + + (message-setup + `((Subject . ,subject) + ,@follow-to + ,@(if (or references message-id) + `((References . ,(concat (or references "") (and references " ") + (or message-id "")))) + nil)) + cur))) + + ;;;###autoload + (defun message-wide-reply (&optional to-address) + (interactive) + (message-reply to-address t)) + + ;;;###autoload + (defun message-followup () + (interactive) + (let ((cur (current-buffer)) + from subject date reply-to mct + references message-id follow-to + followup-to distribution newsgroups gnus-warning) + (save-restriction + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (when (message-functionp message-followup-to-function) + (setq follow-to + (funcall message-followup-to-function))) + (setq from (message-fetch-field "from") + date (message-fetch-field "date") + subject (or (message-fetch-field "subject") "none") + references (message-fetch-field "references") + message-id (message-fetch-field "message-id") + followup-to (message-fetch-field "followup-to") + newsgroups (message-fetch-field "newsgroups") + reply-to (message-fetch-field "reply-to") + distribution (message-fetch-field "distribution") + mct (message-fetch-field "mail-copies-to")) + (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) + (string-match "<[^>]+>" gnus-warning)) + (setq message-id (match-string 0 gnus-warning))) + ;; Remove bogus distribution. + (and (stringp distribution) + (string-match "world" distribution) + (setq distribution nil)) + ;; Remove any (buggy) Re:'s that are present and make a + ;; proper one. + (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) + (setq subject (substring subject (match-end 0)))) + (setq subject (concat "Re: " subject)) + (widen)) + + (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) + + (message-setup + `((Subject . ,subject) + ,@(cond + (follow-to follow-to) + ((and followup-to message-use-followup-to) + (list + (cond + ((equal (downcase followup-to) "poster") + (if (or (eq message-use-followup-to 'use) + (message-y-or-n-p "Obey Followup-To: poster? " t "\ + You should normally obey the Followup-To: header. + + `Followup-To: poster' sends your response via e-mail instead of news. + + A typical situation where `Followup-To: poster' is used is when the poster + does not read the newsgroup, so he wouldn't see any replies sent to it.")) + (cons 'To (or reply-to from "")) + (cons 'Newsgroups newsgroups))) + (t + (if (or (equal followup-to newsgroups) + (not (eq message-use-followup-to 'ask)) + (message-y-or-n-p + (concat "Obey Followup-To: " followup-to "? ") t "\ + You should normally obey the Followup-To: header. + + `Followup-To: " followup-to "' + directs your response to " (if (string-match "," followup-to) + "the specified newsgroups" + "that newsgroup only") ". + + If a message is posted to several newsgroups, Followup-To is often + used to direct the following discussion to one newsgroup only, + because discussions that are spread over several newsgroup tend to + be fragmented and very difficult to follow. + + Also, some source/announcment newsgroups are not indented for discussion; + responses here are directed to other newsgroups.")) + (cons 'Newsgroups followup-to) + (cons 'Newsgroups newsgroups)))))) + (t + `((Newsgroups . ,newsgroups)))) + ,@(and distribution (list (cons 'Distribution distribution))) + (References . ,(concat (or references "") (and references " ") + (or message-id ""))) + ,@(when (and mct + (not (equal (downcase mct) "never"))) + (list (cons 'Cc (if (equal (downcase mct) "always") + (or reply-to from "") + mct))))) + + cur) + + (setq message-reply-headers + (vector 0 subject from date message-id references 0 0 "")))) + + + ;;;###autoload + (defun message-cancel-news () + "Cancel an article you posted." + (interactive) + (unless (message-news-p) + (error "This is not a news article; canceling is impossible")) + (when (yes-or-no-p "Do you really want to cancel this article? ") + (let (from newsgroups message-id distribution buf) + (save-excursion + ;; Get header info. from original article. + (save-restriction + (message-narrow-to-head) + (setq from (message-fetch-field "from") + newsgroups (message-fetch-field "newsgroups") + message-id (message-fetch-field "message-id") + distribution (message-fetch-field "distribution"))) + ;; Make sure that this article was written by the user. + (unless (string-equal + (downcase (cadr (mail-extract-address-components from))) + (downcase (message-make-address))) + (error "This article is not yours")) + ;; Make control message. + (setq buf (set-buffer (get-buffer-create " *message cancel*"))) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert "Newsgroups: " newsgroups "\n" + "From: " (message-make-from) "\n" + "Subject: cmsg cancel " message-id "\n" + "Control: cancel " message-id "\n" + (if distribution + (concat "Distribution: " distribution "\n") + "") + mail-header-separator "\n" + "This is a cancel message from " from ".\n") + (message "Canceling your article...") + (let ((message-syntax-checks 'dont-check-for-anything-just-trust-me)) + (funcall message-send-news-function)) + (message "Canceling your article...done") + (kill-buffer buf))))) + + ;;;###autoload + (defun message-supersede () + "Start composing a message to supersede the current message. + This is done simply by taking the old article and adding a Supersedes + header line with the old Message-ID." + (interactive) + (let ((cur (current-buffer))) + ;; 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")))) + (downcase (message-make-address))) + (error "This article is not yours")) + ;; Get a normal message buffer. + (message-pop-to-buffer (message-buffer-name "supersede")) + (insert-buffer-substring cur) + (message-narrow-to-head) + ;; Remove unwanted headers. + (when message-ignored-supersedes-headers + (message-remove-header message-ignored-supersedes-headers t)) + (goto-char (point-min)) + (if (not (re-search-forward "^Message-ID: " nil t)) + (error "No Message-ID in this article") + (replace-match "Supersedes: " t t)) + (goto-char (point-max)) + (insert mail-header-separator) + (widen) + (forward-line 1))) + + ;;;###autoload + (defun message-recover () + "Reread contents of current buffer from its last auto-save file." + (interactive) + (let ((file-name (make-auto-save-file-name))) + (cond ((save-window-excursion + (if (not (eq system-type 'vax-vms)) + (with-output-to-temp-buffer "*Directory*" + (buffer-disable-undo standard-output) + (let ((default-directory "/")) + (call-process + "ls" nil standard-output nil "-l" file-name)))) + (yes-or-no-p (format "Recover auto save file %s? " file-name))) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert-file-contents file-name nil))) + (t (error "message-recover cancelled"))))) + + ;;; Forwarding messages. + + (defun message-make-forward-subject () + "Return a Subject header suitable for the message in the current buffer." + (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. + Optional NEWS will use news to forward instead of mail." + (interactive "P") + (let ((cur (current-buffer)) + (subject (message-make-forward-subject))) + (if news (message-news nil subject) (message-mail nil subject)) + ;; Put point where we want it before inserting the forwarded + ;; message. + (if message-signature-before-forwarded-message + (goto-char (point-max)) + (message-goto-body)) + ;; Make sure we're at the start of the line. + (unless (eolp) + (insert "\n")) + ;; Narrow to the area we are to insert. + (narrow-to-region (point) (point)) + ;; Insert the separators and the forwarded buffer. + (insert message-forward-start-separator) + (insert-buffer-substring cur) + (goto-char (point-max)) + (insert message-forward-end-separator) + (set-text-properties (point-min) (point-max) nil) + ;; Remove all unwanted headers. + (goto-char (point-min)) + (forward-line 1) + (narrow-to-region (point) (if (search-forward "\n\n" nil t) + (1- (point)) + (point))) + (goto-char (point-min)) + (message-remove-header message-included-forward-headers t nil t) + (widen) + (message-position-point))) + + ;;;###autoload + (defun message-resend (address) + "Resend the current article to ADDRESS." + (interactive "sResend message to: ") + (save-excursion + (let ((cur (current-buffer)) + beg) + ;; We first set up a normal mail buffer. + (set-buffer (get-buffer-create " *message resend*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (message-setup `((To . ,address))) + ;; Insert our usual headers. + (message-generate-headers '(From Date To)) + (message-narrow-to-headers) + ;; Rename them all to "Resent-*". + (while (re-search-forward "^[A-Za-z]" nil t) + (forward-char -1) + (insert "Resent-")) + (widen) + (forward-line) + (delete-region (point) (point-max)) + (setq beg (point)) + ;; Insert the message to be resent. + (insert-buffer-substring cur) + (goto-char (point-min)) + (search-forward "\n\n") + (forward-char -1) + (save-restriction + (narrow-to-region beg (point)) + (message-remove-header message-ignored-resent-headers t) + (goto-char (point-max))) + (insert mail-header-separator) + ;; Rename all old ("Also-")Resent headers. + (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) + (beginning-of-line) + (insert "Also-")) + ;; Send it. + (message-send-mail) + (kill-buffer (current-buffer))))) + + ;;;###autoload + (defun message-bounce () + "Re-mail the current message. + This only makes sense if the current message is a bounce message than + contains some mail you have written which has been bounced back to + you." + (interactive) + (let ((cur (current-buffer)) + boundary) + (message-pop-to-buffer (message-buffer-name "bounce")) + (insert-buffer-substring cur) + (undo-boundary) + (message-narrow-to-head) + (if (and (message-fetch-field "Mime-Version") + (setq boundary (message-fetch-field "Content-Type"))) + (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) + (setq boundary (concat (match-string 1 boundary) " *\n" + "Content-Type: message/rfc822")) + (setq boundary nil))) + (widen) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (or (and boundary + (re-search-forward boundary nil t) + (forward-line 2)) + (and (re-search-forward message-unsent-separator nil t) + (forward-line 1)) + (and (search-forward "\n\n" nil t) + (re-search-forward "^Return-Path:.*\n" nil t))) + ;; We remove everything before the bounced mail. + (delete-region + (point-min) + (if (re-search-forward "^[^ \n\t]+:" nil t) + (match-beginning 0) + (point))) + (save-restriction + (message-narrow-to-head) + (message-remove-header message-ignored-bounced-headers t) + (goto-char (point-max)) + (insert mail-header-separator)) + (message-position-point))) + + ;;; + ;;; Interactive entry points for new message buffers. + ;;; + + ;;;###autoload + (defun message-mail-other-window (&optional to subject) + "Like `message-mail' command, but display mail buffer in another window." + (interactive) + (let ((pop-up-windows t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (message-pop-to-buffer (message-buffer-name "mail" to))) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-mail-other-frame (&optional to subject) + "Like `message-mail' command, but display mail buffer in another frame." + (interactive) + (let ((pop-up-frames t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (message-pop-to-buffer (message-buffer-name "mail" to))) + (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-news-other-window (&optional newsgroups subject) + "Start editing a news article to be sent." + (interactive) + (let ((pop-up-windows t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject ""))))) + + ;;;###autoload + (defun message-news-other-frame (&optional newsgroups subject) + "Start editing a news article to be sent." + (interactive) + (let ((pop-up-frames t) + (special-display-buffer-names nil) + (special-display-regexps nil) + (same-window-buffer-names nil) + (same-window-regexps nil)) + (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) + (message-setup `((Newsgroups . ,(or newsgroups "")) + (Subject . ,(or subject ""))))) + + ;;; underline.el + + ;; This code should be moved to underline.el (from which it is stolen). + + ;;;###autoload + (defun bold-region (start end) + "Bold all nonblank characters in the region. + Works by overstriking characters. + Called from program, takes two arguments START and END + which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max start end)) + (goto-char (min start end)) + (while (< (point) end1) + (or (looking-at "[_\^@- ]") + (insert (following-char) "\b")) + (forward-char 1))))) + + ;;;###autoload + (defun unbold-region (start end) + "Remove all boldness (overstruck characters) in the region. + Called from program, takes two arguments START and END + which specify the range to operate on." + (interactive "r") + (save-excursion + (let ((end1 (make-marker))) + (move-marker end1 (max 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)))))) + + (fset 'message-exchange-point-and-mark 'exchange-point-and-mark) + + ;; Support for toolbar + (when (string-match "XEmacs\\|Lucid" emacs-version) + (require 'messagexmas)) + + ;;; Group name completion. + + (defvar message-newgroups-header-regexp + "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):" + "Regexp that match headers that lists groups.") + + (defun message-tab () + "Expand group names in Newsgroups and Followup-To headers. + Do a `tab-to-tab-stop' if not in those headers." + (interactive) + (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp)) + (mail-abbrev-in-expansion-header-p)) + (message-expand-group) + (tab-to-tab-stop))) + + (defvar gnus-active-hashtb) + (defun message-expand-group () + (let* ((b (save-excursion (skip-chars-backward "^, :\t\n") (point))) + (completion-ignore-case t) + (string (buffer-substring b (point))) + (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) + (completions (all-completions string hashtb)) + (cur (current-buffer)) + comp) + (delete-region b (point)) + (cond + ((= (length completions) 1) + (if (string= (car completions) string) + (progn + (insert string) + (message "Only matching group")) + (insert (car completions)))) + ((and (setq comp (try-completion string hashtb)) + (not (string= comp string))) + (insert comp)) + (t + (insert string) + (if (not comp) + (message "No matching groups") + (pop-to-buffer "*Completions*") + (buffer-disable-undo (current-buffer)) + (let ((buffer-read-only nil)) + (erase-buffer) + (let ((standard-output (current-buffer))) + (display-completion-list (sort completions 'string<))) + (goto-char (point-min)) + (pop-to-buffer cur))))))) + + ;;; Help stuff. + + (defmacro message-y-or-n-p (question show &rest text) + "Ask QUESTION, displaying the rest of the arguments in a temporary buffer." + `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) + + (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. + The following arguments may contain lists of values." + (if (and show + (setq text (message-flatten-list text))) + (save-window-excursion + (save-excursion + (with-output-to-temp-buffer " *MESSAGE information message*" + (set-buffer " *MESSAGE information message*") + (mapcar 'princ text) + (goto-char (point-min)))) + (funcall ask question)) + (funcall ask question))) + + (defun message-flatten-list (&rest list) + (message-flatten-list-1 list)) + + (defun message-flatten-list-1 (list) + (cond ((consp list) + (apply 'append (mapcar 'message-flatten-list-1 list))) + (list + (list list)))) + + (run-hooks 'message-load-hook) + + (provide 'message) + + ;;; message.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mh-utils.el emacs-19.32/lisp/mh-utils.el *** emacs-19.31/lisp/mh-utils.el Mon Jan 29 18:17:19 1996 --- emacs-19.32/lisp/mh-utils.el Fri Jun 28 02:56:14 1996 *************** *** 27,31 **** ;;; Change Log: ! ;; $Id: mh-utils.el,v 1.9 1996/01/29 23:17:16 kwzh Exp $ ;;; Code: --- 27,31 ---- ;;; Change Log: ! ;; $Id: mh-utils.el,v 1.10 1996/06/28 06:56:17 rms Exp $ ;;; Code: *************** Non-nil third argument means not to show *** 514,518 **** (buffer-substring start (point))))))) ! (defvar mua-paradigm "MH-E") ;from mua.el (defun mh-find-path () --- 514,518 ---- (buffer-substring start (point))))))) ! (defvar mail-user-agent 'mh-e-user-agent) ;from reporter.el 3.2 (defun mh-find-path () *************** Non-nil third argument means not to show *** 558,562 **** (if mh-previous-seq (setq mh-previous-seq (intern mh-previous-seq))) ! (setq mua-paradigm "MH-E") (run-hooks 'mh-find-path-hook)))) --- 558,562 ---- (if mh-previous-seq (setq mh-previous-seq (intern mh-previous-seq))) ! (setq mail-user-agent 'mh-e-user-agent) (run-hooks 'mh-find-path-hook)))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/mouse.el emacs-19.32/lisp/mouse.el *** emacs-19.31/lisp/mouse.el Sun May 5 20:41:33 1996 --- emacs-19.32/lisp/mouse.el Fri Jul 12 20:54:21 1996 *************** *** 48,88 **** ;; the mode's commands may not make sense. (interactive "@e") ! (let ((newmap (make-sparse-keymap)) ! (unread-command-events (list event))) ! ;; Make a keymap in which our last command leads to a menu ! (define-key newmap (vector (car event)) ! (nconc (make-sparse-keymap "Menu") ! (mouse-major-mode-menu-1 ! (and (current-local-map) ! (lookup-key (current-local-map) [menu-bar]))))) ! (mouse-major-mode-menu-compute-equiv-keys newmap) ! ;; Make NEWMAP override the usual definition ! ;; of the mouse button that got us here. ! ;; Then read the user's menu choice. ! (let* ((minor-mode-map-alist ! (cons (cons t newmap) minor-mode-map-alist)) ! ;; read-key-sequence quits if the user aborts the menu. ! ;; If that happens, do nothing silently. ! (keyseq (condition-case nil ! (read-key-sequence "") ! (quit nil))) ! (command (if keyseq (lookup-key newmap keyseq)))) ! (if command ! (command-execute command))))) ;; Compute and cache the equivalent keys in MENU and all its submenus. ! (defun mouse-major-mode-menu-compute-equiv-keys (menu) ! (and (eq (car menu) 'keymap) ! (x-popup-menu nil menu)) ! (while menu ! (and (consp (car menu)) ! (consp (cdr (car menu))) ! (let ((tail (cdr (car menu)))) ! (while (and (consp tail) ! (not (eq (car tail) 'keymap))) ! (setq tail (cdr tail))) ! (if (consp tail) ! (mouse-major-mode-menu-compute-equiv-keys tail)))) ! (setq menu (cdr menu)))) ;; Given a mode's menu bar keymap, --- 48,87 ---- ;; the mode's commands may not make sense. (interactive "@e") ! (let (;; This is where mouse-major-mode-menu-prefix ! ;; returns the prefix we should use (after menu-bar). ! ;; It is either nil or (SOME-SYMBOL). ! (mouse-major-mode-menu-prefix nil) ! ;; Make a keymap in which our last command leads to a menu ! (newmap (make-sparse-keymap (concat mode-name " Mode"))) ! result) ! ;; Make our menu inherit from the desired keymap ! ;; which we want to display as the menu now. ! (set-keymap-parent newmap ! (mouse-major-mode-menu-1 ! (and (current-local-map) ! (lookup-key (current-local-map) [menu-bar])))) ! (setq result (x-popup-menu t (list newmap))) ! (if result ! (let ((command (key-binding ! (apply 'vector (append '(menu-bar) ! mouse-major-mode-menu-prefix ! result))))) ! (if command ! (command-execute command)))))) ;; Compute and cache the equivalent keys in MENU and all its submenus. ! ;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu) ! ;;; (and (eq (car menu) 'keymap) ! ;;; (x-popup-menu nil menu)) ! ;;; (while menu ! ;;; (and (consp (car menu)) ! ;;; (consp (cdr (car menu))) ! ;;; (let ((tail (cdr (car menu)))) ! ;;; (while (and (consp tail) ! ;;; (not (eq (car tail) 'keymap))) ! ;;; (setq tail (cdr tail))) ! ;;; (if (consp tail) ! ;;; (mouse-major-mode-menu-compute-equiv-keys tail)))) ! ;;; (setq menu (cdr menu)))) ;; Given a mode's menu bar keymap, *************** *** 98,105 **** (if submap (setq submap t) ! (setq submap (cdr (car tail))))) (setq tail (cdr tail))) ! (if (eq submap t) menubar ! submap)))) ;; Commands that operate on windows. --- 97,106 ---- (if submap (setq submap t) ! (setq submap (car tail)))) (setq tail (cdr tail))) ! (if (eq submap t) ! menubar ! (setq mouse-major-mode-menu-prefix (list (car submap))) ! (cdr (cdr submap)))))) ;; Commands that operate on windows. *************** remains active. Otherwise, it remains u *** 517,521 **** ;; It is the place where the drag has reached so far ;; (but not outside the window where the drag started). ! (let (event end end-point (end-of-range (point))) (track-mouse (while (progn --- 518,522 ---- ;; It is the place where the drag has reached so far ;; (but not outside the window where the drag started). ! (let (event end end-point last-end-point (end-of-range (point))) (track-mouse (while (progn *************** remains active. Otherwise, it remains u *** 527,530 **** --- 528,533 ---- (setq end (event-end event) end-point (posn-point end)) + (if end-point + (setq last-end-point end-point)) (cond *************** remains active. Otherwise, it remains u *** 575,588 **** (if (not (= (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay))) ! (let (last-command this-command) ! (push-mark (overlay-start mouse-drag-overlay) t t) ! (goto-char (overlay-end mouse-drag-overlay)) (copy-region-as-kill (point) (mark t)) ! (let ((inhibit-quit t)) ! (setq unread-command-events ! (cons (read-event) unread-command-events)) ! (setq quit-flag nil)) ! (mouse-set-region-1) ! (delete-overlay mouse-drag-overlay)) (goto-char (overlay-end mouse-drag-overlay)) (setq this-command 'mouse-set-point) --- 578,600 ---- (if (not (= (overlay-start mouse-drag-overlay) (overlay-end mouse-drag-overlay))) ! (let* ((stop-point (or (posn-point (event-end event)) last-end-point)) ! ;; The end that comes from where we ended the drag. ! ;; Point goes here. ! (region-termination ! (if (and stop-point (< stop-point start-point)) ! (overlay-start mouse-drag-overlay) ! (overlay-end mouse-drag-overlay))) ! ;; The end that comes from where we started the drag. ! ;; Mark goes there. ! (region-commencement ! (- (+ (overlay-end mouse-drag-overlay) ! (overlay-start mouse-drag-overlay)) ! region-termination)) ! last-command this-command) ! (push-mark region-commencement t t) ! (goto-char region-termination) (copy-region-as-kill (point) (mark t)) ! (mouse-show-mark) ! (mouse-set-region-1)) (goto-char (overlay-end mouse-drag-overlay)) (setq this-command 'mouse-set-point) *************** If DIR is positive skip forward; if nega *** 643,646 **** --- 655,683 ---- (point)) (1+ start))) + ((and (= mode 1) + (= start end) + (char-after start) + (= (char-syntax (char-after start)) ?\")) + (let ((open (or (eq start (point-min)) + (save-excursion + (goto-char (- start 1)) + (looking-at "\\s(\\|\\s \\|\\s>"))))) + (if open + (list start + (save-excursion + (condition-case nil + (progn + (goto-char start) + (forward-sexp 1) + (point)) + (error end)))) + (list (1+ start) + (save-excursion + (condition-case nil + (progn + (goto-char (1+ start)) + (backward-sexp 1) + (point)) + (error end))))))) ((= mode 1) (list (save-excursion *************** If DIR is positive skip forward; if nega *** 671,680 **** (push-mark (posn-point posn) t t)))) ;; Momentarily show where the mark is, if highlighting doesn't show it. (defun mouse-show-mark () ! (or transient-mark-mode (save-excursion ! (goto-char (mark t)) ! (sit-for 1)))) (defun mouse-set-mark (click) --- 708,750 ---- (push-mark (posn-point posn) t t)))) + (defun mouse-undouble-last-event (events) + (let* ((index (1- (length events))) + (last (nthcdr index events)) + (event (car last)) + (basic (event-basic-type event)) + (modifiers (delq 'double (delq 'triple (copy-sequence (event-modifiers event))))) + (new + (if (consp event) + (cons (event-convert-list (nreverse (cons basic modifiers))) + (cdr event)) + event))) + (setcar last new) + (if (key-binding (apply 'vector events)) + t + (setcar last event) + nil))) + ;; Momentarily show where the mark is, if highlighting doesn't show it. (defun mouse-show-mark () ! (if transient-mark-mode ! (if window-system ! (delete-overlay mouse-drag-overlay)) ! (if window-system ! (let ((inhibit-quit t) ! (echo-keystrokes 0) ! event events) ! (move-overlay mouse-drag-overlay (point) (mark t)) ! (while (progn (setq event (read-event)) ! (setq events (append events (list event))) ! (and (memq 'down (event-modifiers event)) ! (not (key-binding (apply 'vector events))) ! (not (mouse-undouble-last-event events))))) ! (setq unread-command-events ! (nconc events unread-command-events)) ! (setq quit-flag nil) ! (delete-overlay mouse-drag-overlay)) (save-excursion ! (goto-char (mark t)) ! (sit-for 1))))) (defun mouse-set-mark (click) *************** If you do this twice in the same positio *** 834,837 **** --- 904,909 ---- ;; After we kill, another click counts as "the first time". (setq mouse-save-then-kill-posn nil)) + ;; This is not a repetition. + ;; We are adjusting an old selection or creating a new one. (if (or (and (eq last-command 'mouse-save-then-kill) mouse-save-then-kill-posn) *************** If you do this twice in the same positio *** 860,864 **** (goto-char before-scroll)) (exchange-point-and-mark) ! (kill-new (buffer-substring (point) (mark t)))) (mouse-set-region-1) (setq mouse-save-then-kill-posn --- 932,938 ---- (goto-char before-scroll)) (exchange-point-and-mark) ! (kill-new (buffer-substring (point) (mark t))) ! (if window-system ! (mouse-show-mark))) (mouse-set-region-1) (setq mouse-save-then-kill-posn *************** and selects that window." *** 1185,1190 **** (while tail (let ((elt (car tail))) ! (if (not (string-match "^ " ! (buffer-name elt))) (setq head (cons --- 1259,1263 ---- (while tail (let ((elt (car tail))) ! (if (/= (aref (buffer-name elt) 0) ?\ ) (setq head (cons diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnbabyl.el emacs-19.32/lisp/nnbabyl.el *** emacs-19.31/lisp/nnbabyl.el Fri Jan 5 16:59:51 1996 --- emacs-19.32/lisp/nnbabyl.el Fri Jun 28 20:12:12 1996 *************** *** 1,4 **** ;;; nnbabyl.el --- rmail mbox access for Gnus ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnbabyl.el --- rmail mbox access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 19,24 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 19,25 ---- ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: *************** *** 32,46 **** (require 'rmail) (require 'nnmail) ! (defvar nnbabyl-mbox-file (expand-file-name "~/RMAIL") "The name of the rmail box file in the users home directory.") ! (defvar nnbabyl-active-file (expand-file-name "~/.rmail-active") "The name of the active file for the rmail box.") ! (defvar nnbabyl-get-new-mail t "If non-nil, nnbabyl will check the incoming mail file and split the mail.") ! (defvar nnbabyl-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") --- 33,51 ---- (require 'rmail) (require 'nnmail) + (require 'nnoo) + (eval-when-compile (require 'cl)) ! (nnoo-declare nnbabyl) ! ! (defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL") "The name of the rmail box file in the users home directory.") ! (defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active") "The name of the active file for the rmail box.") ! (defvoo nnbabyl-get-new-mail t "If non-nil, nnbabyl will check the incoming mail file and split the mail.") ! (defvoo nnbabyl-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") *************** *** 52,73 **** "nnbabyl version.") ! (defvar nnbabyl-mbox-buffer nil) ! (defvar nnbabyl-current-group nil) ! (defvar nnbabyl-status-string "") ! (defvar nnbabyl-group-alist nil) ! (defvar nnbabyl-active-timestamp nil) ! ! (defvar nnbabyl-current-server nil) ! (defvar nnbabyl-server-alist nil) ! (defvar nnbabyl-server-variables ! (list ! (list 'nnbabyl-mbox-file nnbabyl-mbox-file) ! (list 'nnbabyl-active-file nnbabyl-active-file) ! (list 'nnbabyl-get-new-mail nnbabyl-get-new-mail) ! '(nnbabyl-current-group nil) ! '(nnbabyl-status-string "") ! '(nnbabyl-group-alist nil))) --- 57,70 ---- "nnbabyl version.") ! (defvoo nnbabyl-mbox-buffer nil) ! (defvoo nnbabyl-current-group nil) ! (defvoo nnbabyl-status-string "") ! (defvoo nnbabyl-group-alist nil) ! (defvoo nnbabyl-active-timestamp nil) ! (defvoo nnbabyl-previous-buffer-mode nil) ! (eval-and-compile ! (autoload 'gnus-set-text-properties "gnus-ems")) *************** *** 75,149 **** ;;; Interface functions ! (defun nnbabyl-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((number (length sequence)) (count 0) article art-string start stop) ! (nnbabyl-possibly-change-newsgroup newsgroup) ! (if (stringp (car sequence)) ! 'headers ! (while sequence ! (setq article (car sequence)) ! (setq art-string (nnbabyl-article-string article)) ! (set-buffer nnbabyl-mbox-buffer) ! (if (or (search-forward art-string nil t) (search-backward art-string nil t)) ! (progn ! (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) ! (while (and (not (looking-at ".+:")) ! (zerop (forward-line 1)))) ! (setq start (point)) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert "221 " (int-to-string article) " Article retrieved.\n") ! (insert-buffer-substring nnbabyl-mbox-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq sequence (cdr sequence)) ! (setq count (1+ count)) ! (and (numberp nnmail-large-newsgroup) ! (> number nnmail-large-newsgroup) ! (zerop (% count 20)) ! gnus-verbose-backends ! (message "nnbabyl: Receiving headers... %d%%" ! (/ (* count 100) number)))) ! (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! gnus-verbose-backends ! (message "nnbabyl: Receiving headers...done")) ! ! ;; Fold continuation lines. ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! 'headers)))) ! ! (defun nnbabyl-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nnbabyl-current-server) ! t ! (if nnbabyl-current-server ! (setq nnbabyl-server-alist ! (cons (list nnbabyl-current-server ! (nnheader-save-variables nnbabyl-server-variables)) ! nnbabyl-server-alist))) ! (let ((state (assoc server nnbabyl-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nnbabyl-server-alist (delq state nnbabyl-server-alist))) ! (nnheader-set-init-variables nnbabyl-server-variables defs))) ! (setq nnbabyl-current-server server))) ! ! (defun nnbabyl-close-server (&optional server) t) ! (defun nnbabyl-server-opened (&optional server) ! (and (equal server nnbabyl-current-server) nnbabyl-mbox-buffer (buffer-name nnbabyl-mbox-buffer) --- 72,149 ---- ;;; Interface functions ! (nnoo-define-basics nnbabyl) ! ! (deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((number (length articles)) (count 0) + (delim (concat "^" nnbabyl-mail-delimiter)) article art-string start stop) ! (nnbabyl-possibly-change-newsgroup group server) ! (while (setq article (pop articles)) ! (setq art-string (nnbabyl-article-string article)) ! (set-buffer nnbabyl-mbox-buffer) ! (beginning-of-line) ! (when (or (search-forward art-string nil t) (search-backward art-string nil t)) ! (re-search-backward delim nil t) ! (while (and (not (looking-at ".+:")) ! (zerop (forward-line 1)))) ! (setq start (point)) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert "221 ") ! (princ article (current-buffer)) ! (insert " Article retrieved.\n") ! (insert-buffer-substring nnbabyl-mbox-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n")) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! (zerop (% (incf count) 20)) ! (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" ! (/ (* count 100) number)))) ! ! (and (numberp nnmail-large-newsgroup) ! (> number nnmail-large-newsgroup) ! (nnheader-message 5 "nnbabyl: Receiving headers...done")) ! ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines) ! 'headers))) ! ! (deffoo nnbabyl-open-server (server &optional defs) ! (nnoo-change-server 'nnbabyl server defs) ! (cond ! ((not (file-exists-p nnbabyl-mbox-file)) ! (nnbabyl-close-server) ! (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) ! ((file-directory-p nnbabyl-mbox-file) ! (nnbabyl-close-server) ! (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file)) ! (t ! (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server ! nnbabyl-mbox-file) ! t))) ! ! (deffoo nnbabyl-close-server (&optional server) ! ;; Restore buffer mode. ! (when (and (nnbabyl-server-opened) ! nnbabyl-previous-buffer-mode) ! (save-excursion ! (set-buffer nnbabyl-mbox-buffer) ! (narrow-to-region ! (caar nnbabyl-previous-buffer-mode) ! (cdar nnbabyl-previous-buffer-mode)) ! (funcall (cdr nnbabyl-previous-buffer-mode)))) ! (nnoo-close-server 'nnbabyl server) ! (setq nnbabyl-mbox-buffer nil) t) ! (deffoo nnbabyl-server-opened (&optional server) ! (and (nnoo-current-server-p 'nnbabyl server) nnbabyl-mbox-buffer (buffer-name nnbabyl-mbox-buffer) *************** *** 151,253 **** (buffer-name nntp-server-buffer))) ! (defun nnbabyl-status-message (&optional server) ! nnbabyl-status-string) ! (defun nnbabyl-request-article (article &optional newsgroup server buffer) ! (nnbabyl-possibly-change-newsgroup newsgroup) ! (if (stringp article) ! nil (save-excursion ! (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-min)) ! (if (search-forward (nnbabyl-article-string article) nil t) ! (let (start stop summary-line) ! (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) ! (while (and (not (looking-at ".+:")) ! (zerop (forward-line 1)))) ! (setq start (point)) ! (or (and (re-search-forward ! (concat "^" nnbabyl-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (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. ! (setq summary-line (looking-at "Summary-line:")) ! (if (search-forward "\n*** EOOH ***" nil t) ! (if summary-line ! ;; The headers to be deleted are located before the ! ;; EOOH line... ! (delete-region (point-min) ! (progn (forward-line 1) (point))) ! ;; ...or after. ! (delete-region (progn (beginning-of-line) (point)) ! (or (search-forward "\n\n" nil t) ! (point))))) ! t)))))) ! ! (defun nnbabyl-request-group (group &optional server dont-check) ! (save-excursion ! (if (nnbabyl-possibly-change-newsgroup group) ! (if dont-check ! t ! (nnbabyl-get-new-mail group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (let ((active (assoc group nnbabyl-group-alist))) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) ! t))))) ! (defun nnbabyl-close-group (group &optional server) t) ! (defun nnbabyl-request-create-group (group &optional server) (nnmail-activate 'nnbabyl) ! (or (assoc group nnbabyl-group-alist) ! (let (active) ! (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 0))) ! nnbabyl-group-alist)) ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))) t) ! (defun nnbabyl-request-list (&optional server) ! (if server (nnbabyl-get-new-mail)) (save-excursion ! (or (nnmail-find-file nnbabyl-active-file) ! (progn ! (setq nnbabyl-group-alist (nnmail-get-active)) ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) ! (nnmail-find-file nnbabyl-active-file))))) ! (defun nnbabyl-request-newgroups (date &optional server) (nnbabyl-request-list server)) ! (defun nnbabyl-request-list-newsgroups (&optional server) ! (setq nnbabyl-status-string "nnbabyl: LIST NEWSGROUPS is not implemented.") ! nil) ! ! (defun nnbabyl-request-post (&optional server) ! (mail-send-and-exit nil)) ! ! (defalias 'nnbabyl-request-post-buffer 'nnmail-request-post-buffer) ! (defun nnbabyl-request-expire-articles (articles newsgroup &optional server force) ! (nnbabyl-possibly-change-newsgroup newsgroup) ! (let* ((days (or (and nnmail-expiry-wait-function ! (funcall nnmail-expiry-wait-function newsgroup)) ! nnmail-expiry-wait)) ! (is-old t) rest) (nnmail-activate 'nnbabyl) --- 151,256 ---- (buffer-name nntp-server-buffer))) ! (deffoo nnbabyl-request-article (article &optional newsgroup server buffer) ! (nnbabyl-possibly-change-newsgroup newsgroup server) ! (save-excursion ! (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-min)) ! (when (search-forward (nnbabyl-article-string article) nil t) ! (let (start stop summary-line) ! (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) ! (while (and (not (looking-at ".+:")) ! (zerop (forward-line 1)))) ! (setq start (point)) ! (or (and (re-search-forward ! (concat "^" nnbabyl-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (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. ! (setq summary-line (looking-at "Summary-line:")) ! (when (search-forward "\n*** EOOH ***" nil t) ! (if summary-line ! ;; The headers to be deleted are located before the ! ;; EOOH line... ! (delete-region (point-min) (progn (forward-line 1) ! (point))) ! ;; ...or after. ! (delete-region (progn (beginning-of-line) (point)) ! (or (search-forward "\n\n" nil t) ! (point))))) ! (if (numberp article) ! (cons nnbabyl-current-group article) ! (nnbabyl-article-group-number))))))) ! (deffoo nnbabyl-request-group (group &optional server dont-check) ! (let ((active (cadr (assoc group nnbabyl-group-alist)))) (save-excursion ! (cond ! ((or (null active) ! (null (nnbabyl-possibly-change-newsgroup group server))) ! (nnheader-report 'nnbabyl "No such group: %s" group)) ! (dont-check ! (nnheader-report 'nnbabyl "Selected group %s" group) ! (nnheader-insert "")) ! (t ! (nnheader-report 'nnbabyl "Selected group %s" group) ! (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-read-mbox) ! (nnmail-get-new-mail ! 'nnbabyl ! (lambda () ! (save-excursion ! (set-buffer nnbabyl-mbox-buffer) ! (save-buffer))) ! nnbabyl-mbox-file group ! (lambda () ! (save-excursion ! (let ((in-buf (current-buffer))) ! (goto-char (point-min)) ! (while (search-forward "\n\^_\n" nil t) ! (delete-char -1)) ! (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-max)) ! (search-backward "\n\^_" nil t) ! (goto-char (match-end 0)) ! (insert-buffer-substring in-buf))) ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) ! (deffoo nnbabyl-close-group (group &optional server) t) ! (deffoo nnbabyl-request-create-group (group &optional server) (nnmail-activate 'nnbabyl) ! (unless (assoc group nnbabyl-group-alist) ! (setq nnbabyl-group-alist (cons (list group (cons 1 0)) ! nnbabyl-group-alist)) ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) t) ! (deffoo nnbabyl-request-list (&optional server) (save-excursion ! (nnmail-find-file nnbabyl-active-file) ! (setq nnbabyl-group-alist (nnmail-get-active)))) ! (deffoo nnbabyl-request-newgroups (date &optional server) (nnbabyl-request-list server)) ! (deffoo nnbabyl-request-list-newsgroups (&optional server) ! (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) ! (deffoo nnbabyl-request-expire-articles (articles newsgroup &optional server force) ! (nnbabyl-possibly-change-newsgroup newsgroup server) ! (let* ((is-old t) rest) (nnmail-activate 'nnbabyl) *************** *** 255,272 **** (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (set-text-properties (point-min) (point-max) nil) (while (and articles is-old) (goto-char (point-min)) (if (search-forward (nnbabyl-article-string (car articles)) nil t) ! (if (or force ! (setq is-old ! (> (nnmail-days-between ! (current-time-string) ! (buffer-substring ! (point) (progn (end-of-line) (point)))) ! days))) (progn ! (and gnus-verbose-backends ! (message "Deleting article %s..." (car articles))) (nnbabyl-delete-mail)) (setq rest (cons (car articles) rest)))) --- 258,273 ---- (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (gnus-set-text-properties (point-min) (point-max) nil) (while (and articles is-old) (goto-char (point-min)) (if (search-forward (nnbabyl-article-string (car articles)) nil t) ! (if (setq is-old ! (nnmail-expired-article-p ! newsgroup ! (buffer-substring ! (point) (progn (end-of-line) (point))) force)) (progn ! (nnheader-message 5 "Deleting article %d in %s..." ! (car articles) newsgroup) (nnbabyl-delete-mail)) (setq rest (cons (car articles) rest)))) *************** *** 284,290 **** (nconc rest articles)))) ! (defun nnbabyl-request-move-article (article group server accept-form &optional last) ! (nnbabyl-possibly-change-newsgroup group) (let ((buf (get-buffer-create " *nnbabyl move*")) result) --- 285,291 ---- (nconc rest articles)))) ! (deffoo nnbabyl-request-move-article (article group server accept-form &optional last) ! (nnbabyl-possibly-change-newsgroup group server) (let ((buf (get-buffer-create " *nnbabyl move*")) result) *************** *** 311,315 **** result)) ! (defun nnbabyl-request-accept-article (group &optional last) (let ((buf (current-buffer)) result beg) --- 312,318 ---- result)) ! (deffoo nnbabyl-request-accept-article (group &optional server last) ! (nnbabyl-possibly-change-newsgroup group server) ! (nnmail-check-syntax) (let ((buf (current-buffer)) result beg) *************** *** 331,342 **** (search-backward "\n\^_") (goto-char (match-end 0)) ! (insert-buffer buf) ! (and last (progn ! (save-buffer) ! (nnmail-save-active ! nnbabyl-group-alist nnbabyl-active-file))) result)))) ! (defun nnbabyl-request-replace-article (article group buffer) (nnbabyl-possibly-change-newsgroup group) (save-excursion --- 334,344 ---- (search-backward "\n\^_") (goto-char (match-end 0)) ! (insert-buffer-substring buf) ! (when last ! (save-buffer) ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) result)))) ! (deffoo nnbabyl-request-replace-article (article group buffer) (nnbabyl-possibly-change-newsgroup group) (save-excursion *************** *** 350,355 **** t))) ! ;;; Low-Level Interface ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup --- 352,399 ---- t))) + (deffoo nnbabyl-request-delete-group (group &optional force server) + (nnbabyl-possibly-change-newsgroup group server) + ;; Delete all articles in GROUP. + (if (not force) + () ; Don't delete the articles. + (save-excursion + (set-buffer nnbabyl-mbox-buffer) + (goto-char (point-min)) + ;; Delete all articles in this group. + (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) + found) + (while (search-forward ident nil t) + (setq found t) + (nnbabyl-delete-mail)) + (and found (save-buffer))))) + ;; Remove the group from all structures. + (setq nnbabyl-group-alist + (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) + nnbabyl-current-group nil) + ;; Save the active file. + (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) + t) + + (deffoo nnbabyl-request-rename-group (group new-name &optional server) + (nnbabyl-possibly-change-newsgroup group server) + (save-excursion + (set-buffer nnbabyl-mbox-buffer) + (goto-char (point-min)) + (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) + (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) + found) + (while (search-forward ident nil t) + (replace-match new-ident t t) + (setq found t)) + (and found (save-buffer)))) + (let ((entry (assoc group nnbabyl-group-alist))) + (and entry (setcar entry new-name)) + (setq nnbabyl-current-group nil) + ;; Save the new group alist. + (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) + t)) + ! ;;; Internal functions. ;; If FORCE, delete article no matter how many X-Gnus-Newsgroup *************** *** 384,388 **** (delete-region (point-min) (point-max)))))) ! (defun nnbabyl-possibly-change-newsgroup (newsgroup) (if (or (not nnbabyl-mbox-buffer) (not (buffer-name nnbabyl-mbox-buffer))) --- 428,435 ---- (delete-region (point-min) (point-max)))))) ! (defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server ! (not (nnbabyl-server-opened server))) ! (nnbabyl-open-server server)) (if (or (not nnbabyl-mbox-buffer) (not (buffer-name nnbabyl-mbox-buffer))) *************** *** 393,402 **** (if (assoc newsgroup nnbabyl-group-alist) (setq nnbabyl-current-group newsgroup) ! (setq nnbabyl-status-string "No such group in file") ! nil))) (defun nnbabyl-article-string (article) ! (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" ! (int-to-string article) " ")) (defun nnbabyl-insert-lines () --- 440,460 ---- (if (assoc newsgroup nnbabyl-group-alist) (setq nnbabyl-current-group newsgroup) ! (nnheader-report 'nnbabyl "No such group in file")) ! t)) (defun nnbabyl-article-string (article) ! (if (numberp article) ! (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" ! (int-to-string article) " ") ! (concat "\nMessage-ID: " article))) ! ! (defun nnbabyl-article-group-number () ! (save-excursion ! (goto-char (point-min)) ! (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " ! nil t) ! (cons (buffer-substring (match-beginning 1) (match-end 1)) ! (string-to-int ! (buffer-substring (match-beginning 2) (match-end 2))))))) (defun nnbabyl-insert-lines () *************** *** 405,424 **** (save-excursion (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (progn ! ;; There may be an EOOH line here... ! (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*") ! (search-forward "\n\n" nil t)) ! (setq chars (- (point-max) (point))) ! (setq lines (- (count-lines (point) (point-max)) 1)) ! ;; Move back to the end of the headers. ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (forward-char -1) ! (save-excursion ! (if (re-search-backward "^Lines: " nil t) ! (delete-region (point) (progn (forward-line 1) (point))))) ! (insert (format "Lines: %d\n" lines)) ! chars))))) (defun nnbabyl-save-mail () --- 463,481 ---- (save-excursion (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! ;; There may be an EOOH line here... ! (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") ! (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. ! (goto-char (point-min)) ! (search-forward "\n\n" nil t) ! (forward-char -1) ! (save-excursion ! (when (re-search-backward "^Lines: " nil t) ! (delete-region (point) (progn (forward-line 1) (point))))) ! (insert (format "Lines: %d\n" lines)) ! chars)))) (defun nnbabyl-save-mail () *************** *** 450,454 **** (while group-art (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" ! (car (car group-art)) (cdr (car group-art)) (current-time-string))) (setq group-art (cdr group-art))))) --- 507,511 ---- (while group-art (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" ! (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art))))) *************** *** 457,461 **** (defun nnbabyl-active-number (group) ;; Find the next article number in GROUP. ! (let ((active (car (cdr (assoc group nnbabyl-group-alist))))) (if active (setcdr active (1+ (cdr active))) --- 514,518 ---- (defun nnbabyl-active-number (group) ;; Find the next article number in GROUP. ! (let ((active (cadr (assoc group nnbabyl-group-alist)))) (if active (setcdr active (1+ (cdr active))) *************** *** 469,479 **** (defun nnbabyl-read-mbox () (nnmail-activate 'nnbabyl) ! (or (file-exists-p nnbabyl-mbox-file) ! (save-excursion ! (set-buffer (setq nnbabyl-mbox-buffer ! (create-file-buffer nnbabyl-mbox-file))) ! (setq buffer-file-name nnbabyl-mbox-file) ! (insert "BABYL OPTIONS:\n\n\^_") ! (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))) (if (and nnbabyl-mbox-buffer --- 526,537 ---- (defun nnbabyl-read-mbox () (nnmail-activate 'nnbabyl) ! (unless (file-exists-p nnbabyl-mbox-file) ! ;; Create a new, empty RMAIL mbox file. ! (save-excursion ! (set-buffer (setq nnbabyl-mbox-buffer ! (create-file-buffer nnbabyl-mbox-file))) ! (setq buffer-file-name nnbabyl-mbox-file) ! (insert "BABYL OPTIONS:\n\n\^_") ! (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))) (if (and nnbabyl-mbox-buffer *************** *** 481,497 **** (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (= (buffer-size) (nth 7 (file-attributes nnbabyl-mbox-file))))) ! () (save-excursion (let ((delim (concat "^" nnbabyl-mail-delimiter)) ! start end) (set-buffer (setq nnbabyl-mbox-buffer (nnheader-find-file-noselect nnbabyl-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) (widen) (setq buffer-read-only nil) (fundamental-mode) (goto-char (point-min)) (re-search-forward delim nil t) --- 539,578 ---- (save-excursion (set-buffer nnbabyl-mbox-buffer) ! (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) ! () ; This buffer hasn't changed since we read it last. Possibly. (save-excursion (let ((delim (concat "^" nnbabyl-mail-delimiter)) ! (alist nnbabyl-group-alist) ! start end number) (set-buffer (setq nnbabyl-mbox-buffer (nnheader-find-file-noselect nnbabyl-mbox-file nil 'raw))) + ;; Save previous buffer mode. + (setq nnbabyl-previous-buffer-mode + (cons (cons (point-min) (point-max)) + major-mode)) + (buffer-disable-undo (current-buffer)) (widen) (setq buffer-read-only nil) (fundamental-mode) + + ;; Go through the group alist and compare against + ;; the rmail file. + (while alist + (goto-char (point-max)) + (when (and (re-search-backward + (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " + (caar alist)) nil t) + (> (setq number + (string-to-number + (buffer-substring + (match-beginning 1) (match-end 1)))) + (cdadar alist))) + (setcdr (cadar alist) (1+ number))) + (setq alist (cdr alist))) + ;; We go through the mbox and make sure that each and + ;; every mail belongs to some group or other. (goto-char (point-min)) (re-search-forward delim nil t) *************** *** 499,513 **** (while (re-search-forward delim nil t) (setq end (match-end 0)) ! (or (search-backward "\nX-Gnus-Newsgroup: " start t) ! (progn ! (goto-char end) ! (save-excursion ! (save-restriction ! (goto-char start) ! (narrow-to-region start end) ! (nnbabyl-save-mail) ! (setq end (point-max)))))) (goto-char (setq start end))) ! (and (buffer-modified-p (current-buffer)) (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) --- 580,593 ---- (while (re-search-forward delim nil t) (setq end (match-end 0)) ! (unless (search-backward "\nX-Gnus-Newsgroup: " start t) ! (goto-char end) ! (save-excursion ! (save-restriction ! (narrow-to-region (goto-char start) end) ! (nnbabyl-save-mail) ! (setq end (point-max))))) (goto-char (setq start end))) ! (when (buffer-modified-p (current-buffer)) ! (save-buffer)) (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) *************** *** 517,576 **** (replace-match "?" t t))) ! (defun nnbabyl-get-new-mail (&optional group) ! "Read new incoming mail." ! (let* ((spools (nnmail-get-spool-files group)) ! (group-in group) ! incoming incomings) ! (nnbabyl-read-mbox) ! (if (or (not nnbabyl-get-new-mail) (not nnmail-spool-file)) ! () ! ;; We go through all the existing spool files and split the ! ;; mail from each. ! (while spools ! (and ! (file-exists-p (car spools)) ! (> (nth 7 (file-attributes (car spools))) 0) ! (progn ! (and gnus-verbose-backends ! (message "nnbabyl: Reading incoming mail...")) ! (if (not (setq incoming ! (nnmail-move-inbox ! (car spools) ! (concat nnbabyl-mbox-file "-Incoming")))) ! () ! (setq incomings (cons incoming incomings)) ! (save-excursion ! (setq group (nnmail-get-split-group (car spools) group-in)) ! (let* ((nnmail-prepare-incoming-hook ! (cons 'nnbabyl-remove-incoming-delims ! nnmail-prepare-incoming-hook)) ! in-buf) ! (setq in-buf (nnmail-split-incoming ! incoming 'nnbabyl-save-mail t group)) ! (set-buffer in-buf) ! (goto-char (point-min)) ! (while (search-forward "\n\^_\n" nil t) ! (delete-char -1)) ! (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-max)) ! (search-backward "\n\^_" nil t) ! (goto-char (match-end 0)) ! (insert-buffer-substring in-buf) ! (kill-buffer in-buf)))))) ! (setq spools (cdr spools))) ! ;; If we did indeed read any incoming spools, we save all info. ! (and (buffer-modified-p nnbabyl-mbox-buffer) ! (save-excursion ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) ! (set-buffer nnbabyl-mbox-buffer) ! (save-buffer))) ! (if incomings (run-hooks 'nnmail-read-incoming-hook)) ! (while incomings ! (setq incoming (car incomings)) ! (and nnmail-delete-incoming ! (file-exists-p incoming) ! (file-writable-p incoming) ! (delete-file incoming)) ! (setq incomings (cdr incomings)))))) (provide 'nnbabyl) --- 597,623 ---- (replace-match "?" t t))) ! (defun nnbabyl-check-mbox () ! "Go through the nnbabyl mbox and make sure that no article numbers are reused." ! (interactive) ! (let ((idents (make-vector 1000 0)) ! id) ! (save-excursion ! (when (or (not nnbabyl-mbox-buffer) ! (not (buffer-name nnbabyl-mbox-buffer))) ! (nnbabyl-read-mbox)) ! (set-buffer nnbabyl-mbox-buffer) ! (goto-char (point-min)) ! (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) ! (if (intern-soft (setq id (match-string 1)) idents) ! (progn ! (delete-region (progn (beginning-of-line) (point)) ! (progn (forward-line 1) (point))) ! (nnheader-message 7 "Moving %s..." id) ! (nnbabyl-save-mail)) ! (intern id idents))) ! (when (buffer-modified-p (current-buffer)) ! (save-buffer)) ! (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) ! (message "")))) (provide 'nnbabyl) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nndb.el emacs-19.32/lisp/nndb.el *** emacs-19.31/lisp/nndb.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/nndb.el Tue Jun 25 18:31:21 1996 *************** *** 0 **** --- 1,229 ---- + ;;; nndb.el --- nndb access for Gnus + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Kai Grossjohann + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; I have shamelessly snarfed the code of nntp.el from sgnus. + ;; Kai + + + ;;- + ;; Register nndb with known select methods. + + (setq gnus-valid-select-methods + (cons '("nndb" mail address respool prompt-address) + gnus-valid-select-methods)) + + + ;;; Code: + + (require 'nnheader) + (require 'nntp) + (eval-when-compile (require 'cl)) + + (eval-and-compile + (unless (fboundp 'open-network-stream) + (require 'tcp))) + + (eval-when-compile (require 'cl)) + + (eval-and-compile + (autoload 'news-setup "rnewspost") + (autoload 'news-reply-mode "rnewspost") + (autoload 'cancel-timer "timer") + (autoload 'telnet "telnet" nil t) + (autoload 'telnet-send-input "telnet" nil t) + (autoload 'timezone-parse-date "timezone")) + + ;; Declare nndb as derived from nntp + + (nnoo-declare nndb nntp) + + ;; Variables specific to nndb + + ;;- currently not used but just in case... + (defvoo nndb-deliver-program "nndel" + "*The program used to put a message in an NNDB group.") + + ;; Variables copied from nntp + + (defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) + "Like nntp-server-opened-hook." + nntp-server-opened-hook) + + ;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000") + ; "*Parameters to nndb-open-login. Like nntp-rlogin-parameters." + ; nntp-rlogin-parameters) + + ;(defvoo nndb-rlogin-user-name nil + ; "*User name for rlogin connect method." + ; nntp-rlogin-user-name) + + (defvoo nndb-address "localhost" + "*The name of the NNDB server." + nntp-address) + + (defvoo nndb-port-number 9000 + "*Port number to connect to." + nntp-port-number) + + ;(defvoo nndb-current-group "" + ; "Like nntp-current-group." + ; nntp-current-group) + + (defvoo nndb-status-string nil "" nntp-status-string) + + + + (defconst nndb-version "nndb 0.3" + "Version numbers of this version of NNDB.") + + + ;;; Interface functions. + + (nnoo-define-basics nndb) + + ;; Import other stuff from nntp as is. + + (nnoo-import nndb + (nntp)) + + ;;- maybe this should be mail?? + ;;-(defun nndb-request-type (group &optional article) + ;;- 'news) + + ;;------------------------------------------------------------------ + ;;- only new stuff below + + ; nndb-request-update-info does not exist and is not needed + + ; nndb-request-update-mark does not exist and is not needed + + ; nndb-request-scan does not exist + ; get new mail from somewhere -- maybe this is not needed? + ; --> todo + + (deffoo nndb-request-create-group (group &optional server) + "Creates a group if it doesn't exist yet." + (nntp-send-command "^[23].*\n" "MKGROUP" group)) + + ; todo -- use some other time than the creation time of the article + ; best is time since article has been marked as expirable + (deffoo nndb-request-expire-articles + (articles &optional group server force) + "Expires ARTICLES from GROUP on SERVER. + If FORCE, delete regardless of exiration date, otherwise use normal + expiry mechanism." + (let (msg art) + (nntp-possibly-change-server group server) ;;- + (while articles + (setq art (pop articles)) + (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art) + (setq msg (nndb-status-message)) + ;; CCC we shouldn't be using the variable nndb-status-string? + (if (string-match "^423" (nnheader-get-report 'nndb)) + () + (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg) + (error "Not a valid response for DATE command: %s" + msg)) + (if (nnmail-expired-article-p + group + (list (string-to-int + (substring msg (match-beginning 1) (match-end 1))) + (string-to-int + (substring msg (match-beginning 2) (match-end 2)))) + force) + (nnheader-message 5 "Deleting article %s in %s..." + art group) + (nntp-send-command "^[23].*\n" "DELETE" art)))))) + + (deffoo nndb-request-move-article + (article group server accept-form &optional last) + "Move ARTICLE (a number) from GROUP on SERVER. + Evals ACCEPT-FORM in current buffer, where the article is. + Optional LAST is ignored." + (let ((artbuf (get-buffer-create " *nndb move*")) + result) + (and + (nndb-request-article article group server artbuf) + (save-excursion + (set-buffer artbuf) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result) + (nndb-request-expire-articles (list article) + group + 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-server group server) ;;- + (let (art statmsg) + (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) + (nnheader-insert "") + (nntp-encode-text) + (nntp-send-region-to-server (point-min) (point-max)) + ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not + ;; appended to end of the status message. + (nntp-wait-for-response "^[23].*\n") + (setq statmsg (nntp-status-message)) + (or (string-match "^\\([0-9]+\\)" statmsg) + (error "nndb: %s" statmsg)) + (setq art (substring statmsg + (match-beginning 1) + (match-end 1))) + (message "nndb: accepted %s" art) + (list art)))) + + (deffoo nndb-request-replace-article (article group buffer) + "ARTICLE is the number of the article in GROUP to be replaced + with the contents of the BUFFER." + (set-buffer buffer) + (let (art statmsg) + (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article)) + (nnheader-insert "") + (nntp-encode-text) + (nntp-send-region-to-server (point-min) (point-max)) + ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not + ;; appended to end of the status message. + (nntp-wait-for-response "^[23].*\n") + ; (setq statmsg (nntp-status-message)) + ; (or (string-match "^\\([0-9]+\\)" statmsg) + ; (error "nndb: %s" statmsg)) + ; (setq art (substring statmsg + ; (match-beginning 1) + ; (match-end 1))) + ; (message "nndb: replaced %s" art) + (list (int-to-string article))))) + + ; nndb-request-delete-group does not exist + ; todo -- maybe later + + ; nndb-request-rename-group does not exist + ; todo -- maybe later + + (provide 'nndb) + + diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nndir.el emacs-19.32/lisp/nndir.el *** emacs-19.31/lisp/nndir.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nndir.el Tue Jun 25 18:16:00 1996 *************** *** 1,8 **** ;;; nndir.el --- single directory newsgroup access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen - ;; Masanobu UMEDA ;; Keywords: news --- 1,6 ---- ;;; nndir.el --- single directory newsgroup access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; Keywords: news *************** *** 31,49 **** (require 'nnmh) (require 'nnml) ! (eval-and-compile ! (autoload 'mail-send-and-exit "sendmail")) ! ! (defconst nndir-version "nndir 1.0") ! ! (defvar nndir-current-directory nil ! "Current news group directory.") ! (defvar nndir-status-string "") ! (defvar nndir-nov-is-evil nil ! "*Non-nil means that nndir will never retrieve NOV headers.") --- 29,54 ---- (require 'nnmh) (require 'nnml) + (require 'nnoo) + (eval-when-compile (require 'cl)) ! (nnoo-declare nndir ! nnml nnmh) ! (defvoo nndir-directory nil ! "Where nndir will look for groups." ! nnml-current-directory nnmh-current-directory) ! ! (defvoo nndir-nov-is-evil nil ! "*Non-nil means that nndir will never retrieve NOV headers." ! nnml-nov-is-evil) ! ! (defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) ! (defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) ! (defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) ! (defvoo nndir-status-string "" nil nnmh-status-string) ! (defconst nndir-version "nndir 1.0") *************** *** 51,141 **** ;;; Interface functions. ! (defun nndir-retrieve-headers (sequence &optional newsgroup server) ! (nndir-execute-nnml-command ! '(nnml-retrieve-headers sequence group server) server)) ! ! (defun nndir-open-server (host &optional service) ! "Open nndir backend." ! (setq nndir-status-string "") ! (nnheader-init-server-buffer)) ! ! (defun nndir-close-server (&optional server) ! "Close news server." ! t) ! ! (defun nndir-server-opened (&optional server) ! "Return server process status, T or NIL. ! If the stream is opened, return T, otherwise return NIL." ! (and nntp-server-buffer ! (get-buffer nntp-server-buffer))) ! ! (defun nndir-status-message (&optional server) ! "Return server status response as string." ! nndir-status-string) ! ! (defun nndir-request-article (id &optional newsgroup server buffer) ! (nndir-execute-nnmh-command ! '(nnmh-request-article id group server buffer) server)) ! ! (defun nndir-request-group (group &optional server dont-check) ! "Select news GROUP." ! (nndir-execute-nnmh-command ! '(nnmh-request-group group "" dont-check) server)) ! ! (defun nndir-request-list (&optional server dir) ! "Get list of active articles in all newsgroups." ! (nndir-execute-nnmh-command ! '(nnmh-request-list nil dir) server)) ! ! (defun nndir-request-newgroups (date &optional server) ! (nndir-execute-nnmh-command ! '(nnmh-request-newgroups date server) server)) ! ! (defun nndir-request-post (&optional server) ! "Post a new news in current buffer." ! (mail-send-and-exit nil)) ! ! (defalias 'nndir-request-post-buffer 'nnmail-request-post-buffer) ! ! (defun nndir-request-expire-articles (articles newsgroup &optional server force) ! "Expire all articles in the ARTICLES list in group GROUP." ! (setq nndir-status-string "nndir: expire not possible") ! nil) ! ! (defun nndir-close-group (group &optional server) ! t) ! ! (defun nndir-request-move-article (article group server accept-form) ! (setq nndir-status-string "nndir: move not possible") ! nil) ! ! (defun nndir-request-accept-article (group) ! (setq nndir-status-string "nndir: accept not possible") ! nil) ! ! ! ;;; Low-Level Interface ! ! (defun nndir-execute-nnmh-command (command server) ! (let ((dir (expand-file-name server))) ! (and (string-match "/$" dir) ! (setq dir (substring dir 0 (match-beginning 0)))) ! (string-match "/[^/]+$" dir) ! (let ((group (substring dir (1+ (match-beginning 0)))) ! (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) ! (nnmh-get-new-mail nil)) ! (eval command)))) ! ! (defun nndir-execute-nnml-command (command server) ! (let ((dir (expand-file-name server))) ! (and (string-match "/$" dir) ! (setq dir (substring dir 0 (match-beginning 0)))) ! (string-match "/[^/]+$" dir) ! (let ((group (substring dir (1+ (match-beginning 0)))) ! (nnml-directory (substring dir 0 (1+ (match-beginning 0)))) ! (nnml-nov-is-evil nndir-nov-is-evil) ! (nnml-get-new-mail nil)) ! (eval command)))) (provide 'nndir) --- 56,97 ---- ;;; Interface functions. + (nnoo-define-basics nndir) ! (deffoo nndir-open-server (server &optional defs) ! (setq nndir-directory ! (or (cadr (assq 'nndir-directory defs)) ! server)) ! (unless (assq 'nndir-directory defs) ! (push `(nndir-directory ,server) defs)) ! (push `(nndir-current-group ! ,(file-name-nondirectory (directory-file-name nndir-directory))) ! defs) ! (push `(nndir-top-directory ! ,(file-name-directory (directory-file-name nndir-directory))) ! defs) ! (nnoo-change-server 'nndir server defs) ! (let (err) ! (cond ! ((not (condition-case arg ! (file-exists-p nndir-directory) ! (ftp-error (setq err (format "%s" arg))))) ! (nndir-close-server) ! (nnheader-report ! 'nndir (or err "No such file or directory: %s" nndir-directory))) ! ((not (file-directory-p (file-truename nndir-directory))) ! (nndir-close-server) ! (nnheader-report 'nndir "Not a directory: %s" nndir-directory)) ! (t ! (nnheader-report 'nndir "Opened server %s using directory %s" ! server nndir-directory) ! t)))) ! ! (nnoo-map-functions nndir ! (nnml-retrieve-headers 0 nndir-current-group 0 0) ! (nnmh-request-article 0 nndir-current-group 0 0) ! (nnmh-request-group nndir-current-group 0 0) ! (nnmh-close-group nndir-current-group 0) ! (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory) ! (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) (provide 'nndir) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nndoc.el emacs-19.32/lisp/nndoc.el *** emacs-19.31/lisp/nndoc.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nndoc.el Tue Jun 25 18:16:54 1996 *************** *** 1,5 **** ;;; nndoc.el --- single file access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nndoc.el --- single file access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 29,265 **** (require 'nnheader) ! (require 'rmail) (require 'nnmail) ! (defvar nndoc-article-type 'mbox ! "*Type of the file - one of `mbox', `babyl' or `digest'.") ! (defvar nndoc-digest-type 'traditional ! "Type of the last digest. Auto-detected from the article header. ! Possible values: ! `traditional' -- the \"lots of dashes\" (30+) rules used; ! we currently also do unconditional RFC 934 unquoting. ! `rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).") ! ! (defconst nndoc-type-to-regexp ! (list (list 'mbox ! (concat "^" rmail-unix-mail-delimiter) ! (concat "^" rmail-unix-mail-delimiter) ! nil "^$" nil nil nil) ! (list 'babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil ! "\\*\\*\\* EOOH \\*\\*\\*\n\\(^.+\n\\)*") ! (list 'digest ! "^------------------------------*[\n \t]+" ! "^------------------------------*[\n \t]+" ! nil "^ ?$" ! "^------------------------------*[\n \t]+" ! "^End of" nil)) ! "Regular expressions for articles of the various types.") ! (defvar nndoc-article-begin nil) ! (defvar nndoc-article-end nil) ! (defvar nndoc-head-begin nil) ! (defvar nndoc-head-end nil) ! (defvar nndoc-first-article nil) ! (defvar nndoc-end-of-file nil) ! (defvar nndoc-body-begin nil) ! ! (defvar nndoc-current-server nil) ! (defvar nndoc-server-alist nil) ! (defvar nndoc-server-variables ! (list ! (list 'nndoc-article-type nndoc-article-type) ! '(nndoc-article-begin nil) ! '(nndoc-article-end nil) ! '(nndoc-head-begin nil) ! '(nndoc-head-end nil) ! '(nndoc-first-article nil) ! '(nndoc-current-buffer nil) ! '(nndoc-group-alist nil) ! '(nndoc-end-of-file nil) ! '(nndoc-body-begin nil) ! '(nndoc-address nil))) (defconst nndoc-version "nndoc 1.0" "nndoc version.") - (defvar nndoc-current-buffer nil - "Current nndoc news buffer.") - - (defvar nndoc-address nil) - - (defvar nndoc-status-string "") - - (defvar nndoc-group-alist nil) - ;;; Interface functions ! (defun nndoc-retrieve-headers (sequence &optional newsgroup server) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (let ((prev 2) ! article p beg lines) ! (nndoc-possibly-change-buffer newsgroup server) ! (if (stringp (car sequence)) ! 'headers ! (set-buffer nndoc-current-buffer) ! (widen) ! (goto-char (point-min)) ! (re-search-forward (or nndoc-first-article ! nndoc-article-begin) nil t) ! (or (not nndoc-head-begin) ! (re-search-forward nndoc-head-begin nil t)) ! (re-search-forward nndoc-head-end nil t) ! (while sequence ! (setq article (car sequence)) ! (set-buffer nndoc-current-buffer) ! (if (not (nndoc-forward-article (max 0 (- article prev)))) ! () ! (setq p (point)) ! (setq beg (or (and ! (re-search-backward nndoc-article-begin nil t) ! (match-end 0)) ! (point-min))) ! (goto-char p) ! (setq lines (count-lines ! (point) ! (or ! (and (re-search-forward nndoc-article-end nil t) ! (goto-char (match-beginning 0))) ! (goto-char (point-max))))) ! ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nndoc-current-buffer beg p) ! (goto-char (point-max)) ! (or (= (char-after (1- (point))) ?\n) (insert "\n")) ! (insert (format "Lines: %d\n" lines)) ! (insert ".\n")) ! ! (setq prev article ! sequence (cdr sequence))) ! ! ;; Fold continuation lines. ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! 'headers)))) ! ! (defun nndoc-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nndoc-current-server) ! t ! (if nndoc-current-server ! (setq nndoc-server-alist ! (cons (list nndoc-current-server ! (nnheader-save-variables nndoc-server-variables)) ! nndoc-server-alist))) ! (let ((state (assoc server nndoc-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nndoc-server-alist (delq state nndoc-server-alist))) ! (nnheader-set-init-variables nndoc-server-variables defs))) ! (setq nndoc-current-server server) ! (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp)))) ! (setq nndoc-article-begin (nth 0 defs)) ! (setq nndoc-article-end (nth 1 defs)) ! (setq nndoc-head-begin (nth 2 defs)) ! (setq nndoc-head-end (nth 3 defs)) ! (setq nndoc-first-article (nth 4 defs)) ! (setq nndoc-end-of-file (nth 5 defs)) ! (setq nndoc-body-begin (nth 6 defs))) ! t)) ! ! (defun nndoc-close-server (&optional server) ! t) ! (defun nndoc-server-opened (&optional server) ! (and (equal server nndoc-current-server) ! nntp-server-buffer ! (buffer-name nntp-server-buffer))) ! (defun nndoc-status-message (&optional server) ! nndoc-status-string) ! (defun nndoc-request-article (article &optional newsgroup server buffer) (nndoc-possibly-change-buffer newsgroup server) (save-excursion ! (let ((buffer (or buffer nntp-server-buffer))) (set-buffer buffer) (erase-buffer) (if (stringp article) nil ! (nndoc-insert-article article) ! ;; Unquote quoted non-separators in digests. ! (if (and (eq nndoc-article-type 'digest) ! (eq nndoc-digest-type 'traditional)) ! (progn ! (goto-char (point-min)) ! (while (re-search-forward "^- -"nil t) ! (replace-match "-" t t)))) ! ;; Some assholish digests do not have a blank line after the ! ;; headers. Aargh! ! (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! () ; We let this one pass. ! (if (re-search-forward "^[ \t]+$" nil t) ! (replace-match "" t t) ; We nix out a line of blanks. ! (while (and (looking-at "[^ ]+:") ! (zerop (forward-line 1)))) ! ;; We just insert a couple of lines. If you read digests ! ;; that are so badly formatted, you don't deserve any ! ;; better. Blphphpht! ! (insert "\n\n"))) t)))) ! (defun nndoc-request-group (group &optional server dont-check) "Select news GROUP." ! (save-excursion ! (if (not (nndoc-possibly-change-buffer group server)) ! (progn ! (setq nndoc-status-string "No such file or buffer") ! nil) ! (nndoc-set-header-dependent-regexps) ; hack for MIME digests ! (if dont-check ! t ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (let ((number (nndoc-number-of-articles))) ! (if (zerop number) ! (progn ! (nndoc-close-group group) ! nil) ! (insert (format "211 %d %d %d %s\n" number 1 number group)) ! t))))))) ! (defun nndoc-close-group (group &optional server) (nndoc-possibly-change-buffer group server) ! (kill-buffer nndoc-current-buffer) (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) nndoc-group-alist)) (setq nndoc-current-buffer nil) ! (setq nndoc-current-server nil) t) ! (defun nndoc-request-list (&optional server) nil) ! (defun nndoc-request-newgroups (date &optional server) nil) ! (defun nndoc-request-list-newsgroups (&optional server) nil) - (defalias 'nndoc-request-post 'nnmail-request-post) - (defalias 'nndoc-request-post-buffer 'nnmail-request-post-buffer) - ;;; Internal functions. --- 28,228 ---- (require 'nnheader) ! (require 'message) (require 'nnmail) + (require 'nnoo) + (eval-when-compile (require 'cl)) ! (nnoo-declare nndoc) ! (defvoo nndoc-article-type 'guess ! "*Type of the file. ! One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', ! `mime-digest', `standard-digest', `slack-digest', `clari-briefs' or ! `guess'.") ! ! (defvoo nndoc-post-type 'mail ! "*Whether the nndoc group is `mail' or `post'.") ! ! (defvar nndoc-type-alist ! `((mmdf ! (article-begin . "^\^A\^A\^A\^A\n") ! (body-end . "^\^A\^A\^A\^A\n")) ! (news ! (article-begin . "^Path:")) ! (rnews ! (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") ! (body-end-function . nndoc-rnews-body-end)) ! (mbox ! (article-begin . ! ,(let ((delim (concat "^" message-unix-mail-delimiter))) ! (if (string-match "\n\\'" delim) ! (substring delim 0 (match-beginning 0)) ! delim))) ! (body-end-function . nndoc-mbox-body-end)) ! (babyl ! (article-begin . "\^_\^L *\n") ! (body-end . "\^_") ! (body-begin-function . nndoc-babyl-body-begin) ! (head-begin-function . nndoc-babyl-head-begin)) ! (forward ! (article-begin . "^-+ Start of forwarded message -+\n+") ! (body-end . "^-+ End of forwarded message -+$") ! (prepare-body . nndoc-unquote-dashes)) ! (clari-briefs ! (article-begin . "^ \\*") ! (body-end . "^\t------*[ \t]^*\n^ \\*") ! (body-begin . "^\t") ! (head-end . "^\t") ! (generate-head . nndoc-generate-clari-briefs-head) ! (article-transform . nndoc-transform-clari-briefs)) ! (slack-digest ! (article-begin . "^------------------------------*[\n \t]+") ! (head-end . "^ ?$") ! (body-end-function . nndoc-digest-body-end) ! (body-begin . "^ ?$") ! (file-end . "^End of") ! (prepare-body . nndoc-unquote-dashes)) ! (mime-digest ! (article-begin . "") ! (head-end . "^ ?$") ! (body-end . "") ! (file-end . "")) ! (standard-digest ! (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) ! (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) ! (prepare-body . nndoc-unquote-dashes) ! (body-end-function . nndoc-digest-body-end) ! (head-end . "^ ?$") ! (body-begin . "^ ?\n") ! (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")) ! (guess ! (guess . nndoc-guess-type)) ! (digest ! (guess . nndoc-guess-digest-type)) ! )) ! (defvoo nndoc-file-begin nil) ! (defvoo nndoc-first-article nil) ! (defvoo nndoc-article-end nil) ! (defvoo nndoc-article-begin nil) ! (defvoo nndoc-head-begin nil) ! (defvoo nndoc-head-end nil) ! (defvoo nndoc-file-end nil) ! (defvoo nndoc-body-begin nil) ! (defvoo nndoc-body-end-function nil) ! (defvoo nndoc-body-begin-function nil) ! (defvoo nndoc-head-begin-function nil) ! (defvoo nndoc-body-end nil) ! (defvoo nndoc-dissection-alist nil) ! (defvoo nndoc-prepare-body nil) ! (defvoo nndoc-generate-head nil) ! (defvoo nndoc-article-transform nil) ! ! (defvoo nndoc-status-string "") ! (defvoo nndoc-group-alist nil) ! (defvoo nndoc-current-buffer nil ! "Current nndoc news buffer.") ! (defvoo nndoc-address nil) (defconst nndoc-version "nndoc 1.0" "nndoc version.") ;;; Interface functions ! (nnoo-define-basics nndoc) ! (deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) ! (when (nndoc-possibly-change-buffer newsgroup server) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (let (article entry) ! (if (stringp (car articles)) ! 'headers ! (while articles ! (when (setq entry (cdr (assq (setq article (pop articles)) ! nndoc-dissection-alist))) ! (insert (format "221 %d Article retrieved.\n" article)) ! (if nndoc-generate-head ! (funcall nndoc-generate-head article) ! (insert-buffer-substring ! nndoc-current-buffer (car entry) (nth 1 entry))) ! (goto-char (point-max)) ! (or (= (char-after (1- (point))) ?\n) (insert "\n")) ! (insert (format "Lines: %d\n" (nth 4 entry))) ! (insert ".\n"))) ! (nnheader-fold-continuation-lines) ! 'headers))))) ! (deffoo nndoc-request-article (article &optional newsgroup server buffer) (nndoc-possibly-change-buffer newsgroup server) (save-excursion ! (let ((buffer (or buffer nntp-server-buffer)) ! (entry (cdr (assq article nndoc-dissection-alist))) ! beg) (set-buffer buffer) (erase-buffer) (if (stringp article) nil ! (insert-buffer-substring ! nndoc-current-buffer (car entry) (nth 1 entry)) ! (insert "\n") ! (setq beg (point)) ! (insert-buffer-substring ! nndoc-current-buffer (nth 2 entry) (nth 3 entry)) ! (goto-char beg) ! (when nndoc-prepare-body ! (funcall nndoc-prepare-body)) ! (when nndoc-article-transform ! (funcall nndoc-article-transform article)) t)))) ! (deffoo nndoc-request-group (group &optional server dont-check) "Select news GROUP." ! (let (number) ! (cond ! ((not (nndoc-possibly-change-buffer group server)) ! (nnheader-report 'nndoc "No such file or buffer: %s" ! nndoc-address)) ! (dont-check ! (nnheader-report 'nndoc "Selected group %s" group) ! t) ! ((zerop (setq number (length nndoc-dissection-alist))) ! (nndoc-close-group group) ! (nnheader-report 'nndoc "No articles in group %s" group)) ! (t ! (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) ! ! (deffoo nndoc-request-type (group &optional article) ! (cond ((not article) 'unknown) ! (nndoc-post-type nndoc-post-type) ! (t 'unknown))) ! (deffoo nndoc-close-group (group &optional server) (nndoc-possibly-change-buffer group server) ! (and nndoc-current-buffer ! (buffer-name nndoc-current-buffer) ! (kill-buffer nndoc-current-buffer)) (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) nndoc-group-alist)) (setq nndoc-current-buffer nil) ! (nnoo-close-server 'nndoc server) ! (setq nndoc-dissection-alist nil) t) ! (deffoo nndoc-request-list (&optional server) nil) ! (deffoo nndoc-request-newgroups (date &optional server) nil) ! (deffoo nndoc-request-list-newsgroups (&optional server) nil) ;;; Internal functions. *************** Possible values: *** 270,273 **** --- 233,237 ---- ;; The current buffer is this group's buffer. ((and nndoc-current-buffer + (buffer-name nndoc-current-buffer) (eq nndoc-current-buffer (setq buf (cdr (assoc group nndoc-group-alist)))))) *************** Possible values: *** 282,290 **** (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) ! (setq nndoc-group-alist ! (cons (cons group (setq nndoc-current-buffer ! (get-buffer-create ! (concat " *nndoc " group "*")))) ! nndoc-group-alist)) (save-excursion (set-buffer nndoc-current-buffer) --- 246,254 ---- (file-exists-p nndoc-address) (not (file-directory-p nndoc-address)))) ! (push (cons group (setq nndoc-current-buffer ! (get-buffer-create ! (concat " *nndoc " group "*")))) ! nndoc-group-alist) ! (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) *************** Possible values: *** 293,400 **** (if (stringp nndoc-address) (insert-file-contents nndoc-address) ! (save-excursion ! (set-buffer nndoc-address) ! (widen)) ! (insert-buffer-substring nndoc-address)) ! t))))) ! ! ;; MIME (RFC 1341) digest hack by Ulrik Dickow . ! (defun nndoc-set-header-dependent-regexps () ! (if (not (eq nndoc-article-type 'digest)) ! () ! (let ((case-fold-search t) ; We match a bit too much, keep it simple. ! (boundary-id) (b-delimiter)) (save-excursion (set-buffer nndoc-current-buffer) ! (goto-char (point-min)) ! (if (and ! (re-search-forward ! (concat "\n\n\\|^Content-Type: *multipart/digest;[ \t\n]*[ \t]" ! "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") ! nil t) ! (match-beginning 1)) ! (setq nndoc-digest-type 'rfc1341 ! boundary-id (format "%s" ! (buffer-substring ! (match-beginning 1) (match-end 1))) ! b-delimiter (concat "\n--" boundary-id "[\n \t]+") ! nndoc-article-begin b-delimiter ; Too strict: "[ \t]*$" ! nndoc-article-end (concat "\n--" boundary-id ! "\\(--\\)?[\n \t]+") ! nndoc-first-article b-delimiter ; ^eof ends article too. ! nndoc-end-of-file (concat "\n--" boundary-id "--[ \t]*$")) ! (setq nndoc-digest-type 'traditional)))))) ! ! (defun nndoc-forward-article (n) ! (while (and (> n 0) ! (re-search-forward nndoc-article-begin nil t) ! (or (not nndoc-head-begin) ! (re-search-forward nndoc-head-begin nil t)) ! (re-search-forward nndoc-head-end nil t)) ! (setq n (1- n))) ! (zerop n)) ! ! (defun nndoc-number-of-articles () ! (save-excursion ! (set-buffer nndoc-current-buffer) ! (widen) ! (goto-char (point-min)) ! (let ((num 0)) ! (if (re-search-forward (or nndoc-first-article ! nndoc-article-begin) nil t) ! (progn ! (setq num 1) ! (while (and (re-search-forward nndoc-article-begin nil t) ! (or (not nndoc-end-of-file) ! (not (looking-at nndoc-end-of-file))) ! (or (not nndoc-head-begin) ! (re-search-forward nndoc-head-begin nil t)) ! (re-search-forward nndoc-head-end nil t)) ! (setq num (1+ num))))) ! num))) ! (defun nndoc-narrow-to-article (article) ! (save-excursion ! (set-buffer nndoc-current-buffer) ! (widen) (goto-char (point-min)) ! (while (and (re-search-forward nndoc-article-begin nil t) ! (not (zerop (setq article (1- article)))))) ! (if (not (zerop article)) ! () ! (narrow-to-region ! (match-end 0) ! (or (and (re-search-forward nndoc-article-end nil t) ! (match-beginning 0)) ! (point-max))) ! t))) ! ! ;; Insert article ARTICLE in the current buffer. ! (defun nndoc-insert-article (article) ! (let ((ibuf (current-buffer))) (save-excursion (set-buffer nndoc-current-buffer) - (widen) (goto-char (point-min)) ! (while (and (re-search-forward nndoc-article-begin nil t) ! (not (zerop (setq article (1- article)))))) ! (if (not (zerop article)) ! () ! (narrow-to-region ! (match-end 0) ! (or (and (re-search-forward nndoc-article-end nil t) ! (match-beginning 0)) ! (point-max))) (goto-char (point-min)) ! (and nndoc-head-begin ! (re-search-forward nndoc-head-begin nil t) ! (narrow-to-region (point) (point-max))) ! (or (re-search-forward nndoc-head-end nil t) ! (goto-char (point-max))) ! (append-to-buffer ibuf (point-min) (point)) ! (and nndoc-body-begin ! (re-search-forward nndoc-body-begin nil t)) ! (append-to-buffer ibuf (point) (point-max)) ! t)))) (provide 'nndoc) --- 257,474 ---- (if (stringp nndoc-address) (insert-file-contents nndoc-address) ! (insert-buffer-substring nndoc-address))))) ! ;; Initialize the nndoc structures according to this new document. ! (when (and nndoc-current-buffer ! (not nndoc-dissection-alist)) (save-excursion (set-buffer nndoc-current-buffer) ! (nndoc-set-delims) ! (nndoc-dissect-buffer))) ! (unless nndoc-current-buffer ! (nndoc-close-server)) ! ;; Return whether we managed to select a file. ! nndoc-current-buffer)) ! ;; MIME (RFC 1341) digest hack by Ulrik Dickow . ! (defun nndoc-guess-digest-type () ! "Guess what digest type the current document is." ! (let ((case-fold-search t) ; We match a bit too much, keep it simple. ! boundary-id b-delimiter entry) (goto-char (point-min)) ! (cond ! ;; MIME digest. ! ((and ! (re-search-forward ! (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" ! "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") ! nil t) ! (match-beginning 1)) ! (setq boundary-id (match-string 1) ! b-delimiter (concat "\n--" boundary-id "[\n \t]+")) ! (setq entry (assq 'mime-digest nndoc-type-alist)) ! (setcdr entry ! (list ! (cons 'head-end "^ ?$") ! (cons 'body-begin "^ ?\n") ! (cons 'article-begin b-delimiter) ! (cons 'body-end-function 'nndoc-digest-body-end) ! ; (cons 'body-end ! ; (concat "\n--" boundary-id "\\(--\\)?[\n \t]+")) ! (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) ! 'mime-digest) ! ;; Standard digest. ! ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) ! (re-search-forward ! (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) ! 'standard-digest) ! ;; Stupid digest. ! (t ! 'slack-digest)))) ! ! (defun nndoc-guess-type () ! "Guess what document type is in the current buffer." ! (goto-char (point-min)) ! (cond ! ((looking-at message-unix-mail-delimiter) ! 'mbox) ! ((looking-at "\^A\^A\^A\^A$") ! 'mmdf) ! ((looking-at "^Path:.*\n") ! 'news) ! ((looking-at "#! *rnews") ! 'rnews) ! ((re-search-forward "\^_\^L *\n" nil t) ! 'babyl) ! ((save-excursion ! (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) ! (not (re-search-forward "^Subject:.*digest" nil t)))) ! 'forward) ! ((let ((case-fold-search nil)) ! (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) ! 'clari-briefs) ! (t ! 'digest))) ! ! (defun nndoc-set-delims () ! "Set the nndoc delimiter variables according to the type of the document." ! (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 ! nndoc-prepare-body nndoc-article-transform ! nndoc-generate-head nndoc-body-begin-function ! nndoc-head-begin-function))) ! (while vars ! (set (pop vars) nil))) ! (let* (defs guess) ! ;; Guess away until we find the real file type. ! (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist)) ! guess (assq 'guess defs)) ! (setq nndoc-article-type (funcall (cdr guess)))) ! ;; Set the nndoc variables. ! (while defs ! (set (intern (format "nndoc-%s" (caar defs))) ! (cdr (pop defs)))))) ! ! (defun nndoc-search (regexp) ! (prog1 ! (re-search-forward regexp nil t) ! (beginning-of-line))) ! ! (defun nndoc-dissect-buffer () ! "Go through the document and partition it into heads/bodies/articles." ! (let ((i 0) ! (first t) ! head-begin head-end body-begin body-end) ! (setq nndoc-dissection-alist nil) (save-excursion (set-buffer nndoc-current-buffer) (goto-char (point-min)) ! ;; Find the beginning of the file. ! (when nndoc-file-begin ! (nndoc-search nndoc-file-begin)) ! ;; Go through the file. ! (while (if (and first nndoc-first-article) ! (nndoc-search nndoc-first-article) ! (nndoc-search nndoc-article-begin)) ! (setq first nil) ! (cond (nndoc-head-begin-function ! (funcall nndoc-head-begin-function)) ! (nndoc-head-begin ! (nndoc-search nndoc-head-begin))) ! (if (and nndoc-file-end ! (looking-at nndoc-file-end)) ! (goto-char (point-max)) ! (setq head-begin (point)) ! (nndoc-search (or nndoc-head-end "^$")) ! (setq head-end (point)) ! (if nndoc-body-begin-function ! (funcall nndoc-body-begin-function) ! (nndoc-search (or nndoc-body-begin "^\n"))) ! (setq body-begin (point)) ! (or (and nndoc-body-end-function ! (funcall nndoc-body-end-function)) ! (and nndoc-body-end ! (nndoc-search nndoc-body-end)) ! (nndoc-search nndoc-article-begin) ! (progn ! (goto-char (point-max)) ! (when nndoc-file-end ! (and (re-search-backward nndoc-file-end nil t) ! (beginning-of-line))))) ! (setq body-end (point)) ! (push (list (incf i) head-begin head-end body-begin body-end ! (count-lines body-begin body-end)) ! nndoc-dissection-alist)))))) ! ! (defun nndoc-unquote-dashes () ! "Unquote quoted non-separators in digests." ! (while (re-search-forward "^- -"nil t) ! (replace-match "-" t t))) ! ! (defun nndoc-digest-body-end () ! (and (re-search-forward nndoc-article-begin nil t) ! (goto-char (match-beginning 0)))) ! ! (defun nndoc-mbox-body-end () ! (let ((beg (point)) ! len end) ! (when ! (save-excursion ! (and (re-search-backward nndoc-article-begin nil t) ! (setq end (point)) ! (search-forward "\n\n" beg t) ! (re-search-backward ! "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) ! (setq len (string-to-int (match-string 1))) ! (search-forward "\n\n" beg t) ! (or (= (setq len (+ (point) len)) (point-max)) ! (and (< len (point-max)) ! (goto-char len) ! (looking-at nndoc-article-begin))))) ! (goto-char len)))) ! ! (defun nndoc-rnews-body-end () ! (and (re-search-backward nndoc-article-begin nil t) ! (forward-line 1) ! (goto-char (+ (point) (string-to-int (match-string 1)))))) ! ! (defun nndoc-transform-clari-briefs (article) ! (goto-char (point-min)) ! (when (looking-at " *\\*\\(.*\\)\n") ! (replace-match "" t t)) ! (nndoc-generate-clari-briefs-head article)) ! ! (defun nndoc-generate-clari-briefs-head (article) ! (let ((entry (cdr (assq article nndoc-dissection-alist))) ! subject from) ! (save-excursion ! (set-buffer nndoc-current-buffer) ! (save-restriction ! (narrow-to-region (car entry) (nth 3 entry)) (goto-char (point-min)) ! (when (looking-at " *\\*\\(.*\\)$") ! (setq subject (match-string 1)) ! (when (string-match "[ \t]+$" subject) ! (setq subject (substring subject 0 (match-beginning 0))))) ! (when ! (let ((case-fold-search nil)) ! (re-search-forward ! "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) ! (setq from (match-string 1))))) ! (insert "From: " "clari@clari.net (" (or from "unknown") ")" ! "\nSubject: " (or subject "(no subject)") "\n"))) ! ! (defun nndoc-babyl-body-begin () ! (re-search-forward "^\n" nil t) ! (when (looking-at "\*\*\* EOOH \*\*\*") ! (re-search-forward "^\n" nil t))) ! ! (defun nndoc-babyl-head-begin () ! (when (re-search-forward "^[0-9].*\n" nil t) ! (when (looking-at "\*\*\* EOOH \*\*\*") ! (forward-line 1)) ! t)) (provide 'nndoc) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nneething.el emacs-19.32/lisp/nneething.el *** emacs-19.31/lisp/nneething.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nneething.el Fri Jun 28 20:11:49 1996 *************** *** 1,5 **** ;;; nneething.el --- random file access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nneething.el --- random file access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 34,71 **** (require 'nnheader) (require 'nnmail) ! (defvar nneething-map-file-directory "~/.nneething/" ! "*Map files directory.") ! (defvar nneething-exclude-files "~$" ! "*Regexp saying what files to exclude from the group.") ! (defvar nneething-map-file ".nneething" ! "*Name of map files.") (defconst nneething-version "nneething 1.0" "nneething version.") ! (defvar nneething-current-directory nil "Current news group directory.") ! (defvar nneething-status-string "") ! (defvar nneething-group-alist nil) ! ! (defvar nneething-directory nil) ! (defvar nneething-group nil) ! (defvar nneething-map nil) ! (defvar nneething-read-only nil) ! (defvar nneething-active nil) ! (defvar nneething-server-variables ! (list ! (list 'nneething-directory nneething-directory) ! '(nneething-current-directory nil) ! '(nneething-status-string "") ! '(nneething-group-alist))) --- 33,72 ---- (require 'nnheader) (require 'nnmail) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nneething) ! (defvoo nneething-map-file-directory "~/.nneething/" ! "*Where nneething stores the map files.") ! (defvoo nneething-map-file ".nneething" ! "*Name of the map files.") ! (defvoo nneething-exclude-files nil ! "*Regexp saying what files to exclude from the group. ! If this variable is nil, no files will be excluded.") + ;;; Internal variables. + (defconst nneething-version "nneething 1.0" "nneething version.") ! (defvoo nneething-current-directory nil "Current news group directory.") ! (defvoo nneething-status-string "") ! (defvoo nneething-group-alist nil) ! (defvoo nneething-message-id-number 0) ! (defvoo nneething-work-buffer " *nneething work*") ! (defvoo nneething-directory nil) ! (defvoo nneething-group nil) ! (defvoo nneething-map nil) ! (defvoo nneething-read-only nil) ! (defvoo nneething-active nil) *************** *** 73,83 **** ;;; Interface functions. ! (defun nneething-retrieve-headers (sequence &optional newsgroup server) ! (nneething-possibly-change-directory newsgroup) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let* ((number (length sequence)) (count 0) (large (and (numberp nnmail-large-newsgroup) --- 74,86 ---- ;;; Interface functions. ! (nnoo-define-basics nneething) ! ! (deffoo nneething-retrieve-headers (articles &optional group server fetch-old) ! (nneething-possibly-change-directory group) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let* ((number (length articles)) (count 0) (large (and (numberp nnmail-large-newsgroup) *************** *** 85,104 **** article file) ! (if (stringp (car sequence)) 'headers ! (while sequence ! (setq article (car sequence)) (setq file (nneething-file-name article)) ! (if (and (file-exists-p file) ! (not (zerop (nth 7 (file-attributes file))))) ! (progn ! (insert (format "221 %d Article retrieved.\n" article)) ! (nneething-insert-head file) ! (insert ".\n"))) ! (setq sequence (cdr sequence) ! count (1+ count)) (and large --- 88,105 ---- article file) ! (if (stringp (car articles)) 'headers ! (while (setq article (pop articles)) (setq file (nneething-file-name article)) ! (when (and (file-exists-p file) ! (or (file-directory-p file) ! (not (zerop (nnheader-file-size file))))) ! (insert (format "221 %d Article retrieved.\n" article)) ! (nneething-insert-head file) ! (insert ".\n")) ! (incf count) (and large *************** *** 107,134 **** (/ (* count 100) number)))) ! (and large (message "nneething: Receiving headers...done")) ! ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) 'headers)))) ! (defun nneething-open-server (server &optional defs) ! (setq nneething-status-string "") ! (nnheader-init-server-buffer)) ! ! (defun nneething-close-server (&optional server) ! t) ! ! (defun nneething-server-opened (&optional server) ! t) ! ! (defun nneething-status-message (&optional server) ! nneething-status-string) ! ! (defun nneething-request-article (id &optional newsgroup server buffer) ! (nneething-possibly-change-directory newsgroup) ! (let ((file (if (stringp id) nil (nneething-file-name id))) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) ; We did not request by Message-ID. --- 108,120 ---- (/ (* count 100) number)))) ! (when large ! (message "nneething: Receiving headers...done")) ! (nnheader-fold-continuation-lines) 'headers)))) ! (deffoo nneething-request-article (id &optional group server buffer) ! (nneething-possibly-change-directory group) ! (let ((file (unless (stringp id) (nneething-file-name id))) (nntp-server-buffer (or buffer nntp-server-buffer))) (and (stringp file) ; We did not request by Message-ID. *************** *** 140,179 **** (progn (goto-char (point-min)) ! (nneething-make-head file) ; ... or we fake some headers. (insert "\n"))) t)))) ! (defun nneething-request-group (group &optional dir dont-check) (nneething-possibly-change-directory group dir) ! (or dont-check (nneething-create-mapping)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) (if (> (car nneething-active) (cdr nneething-active)) ! (insert (format "211 0 1 0 %s\n" group)) ! (insert (format "211 %d %d %d %s\n" ! (- (1+ (cdr nneething-active)) (car nneething-active)) ! (car nneething-active) (cdr nneething-active) ! group))) ! t)) ! ! (defun nneething-request-list (&optional server dir) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer)) ! nil) ! (defun nneething-request-newgroups (date &optional server) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer)) ! nil) ! (defun nneething-request-post (&optional server) ! (mail-send-and-exit nil)) ! (defalias 'nneething-request-post-buffer 'nnmail-request-post-buffer) ! (defun nneething-close-group (group &optional server) t) --- 126,157 ---- (progn (goto-char (point-min)) ! (nneething-make-head file (current-buffer)) ; ... or we fake some headers. (insert "\n"))) t)))) ! (deffoo nneething-request-group (group &optional dir dont-check) (nneething-possibly-change-directory group dir) ! (unless dont-check ! (nneething-create-mapping) (if (> (car nneething-active) (cdr nneething-active)) ! (nnheader-insert "211 0 1 0 %s\n" group) ! (nnheader-insert ! "211 %d %d %d %s\n" ! (- (1+ (cdr nneething-active)) (car nneething-active)) ! (car nneething-active) (cdr nneething-active) ! group))) ! t) ! (deffoo nneething-request-list (&optional server dir) ! (nnheader-report 'nneething "LIST is not implemented.")) ! (deffoo nneething-request-newgroups (date &optional server) ! (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) ! (deffoo nneething-request-type (group &optional article) ! 'unknown) ! (deffoo nneething-close-group (group &optional server) ! (setq nneething-current-directory nil) t) *************** *** 182,187 **** (defun nneething-possibly-change-directory (group &optional dir) ! (if (not group) ! () (if (and nneething-group (string= group nneething-group)) --- 160,164 ---- (defun nneething-possibly-change-directory (group &optional dir) ! (when group (if (and nneething-group (string= group nneething-group)) *************** *** 199,209 **** (setq nneething-active (cons 1 0)) (nneething-create-mapping) ! (setq nneething-group-alist ! (cons (list group dir nneething-map nneething-active) ! nneething-group-alist))))))) (defun nneething-map-file () ;; We make sure that the .nneething directory exists. ! (make-directory nneething-map-file-directory 'parents) ;; We store it in a special directory under the user's home dir. (concat (file-name-as-directory nneething-map-file-directory) --- 176,186 ---- (setq nneething-active (cons 1 0)) (nneething-create-mapping) ! (push (list group dir nneething-map nneething-active) ! nneething-group-alist)))))) (defun nneething-map-file () ;; We make sure that the .nneething directory exists. ! (unless (file-exists-p nneething-map-file-directory) ! (make-directory nneething-map-file-directory 'parents)) ;; We store it in a special directory under the user's home dir. (concat (file-name-as-directory nneething-map-file-directory) *************** *** 211,218 **** (defun nneething-create-mapping () ! ;; Read nneething-active and nneething-map (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) ! touched) (if (file-exists-p map-file) (condition-case nil --- 188,195 ---- (defun nneething-create-mapping () ! ;; Read nneething-active and nneething-map. (let ((map-file (nneething-map-file)) (files (directory-files nneething-directory)) ! touched map-files) (if (file-exists-p map-file) (condition-case nil *************** *** 220,238 **** (error nil))) (or nneething-active (setq nneething-active (cons 1 0))) ! ;; Remove files matching that regexp. ! (let ((f files) ! prev) ! (while f ! (if (string-match nneething-exclude-files (car f)) ! (if prev (setcdr prev (cdr f)) ! (setq files (cdr files))) ! (setq prev f)) ! (setq f (cdr f)))) ! ;; Remove files that have disappeared from the map. (let ((map nneething-map) prev) (while map ! (if (member (car (car map)) files) ! (setq prev map) (setq touched t) (if prev --- 197,231 ---- (error nil))) (or nneething-active (setq nneething-active (cons 1 0))) ! ;; Old nneething had a different map format. ! (when (and (cdar nneething-map) ! (atom (cdar nneething-map))) ! (setq nneething-map ! (mapcar (lambda (n) ! (list (cdr n) (car n) ! (nth 5 (file-attributes ! (nneething-file-name (car n)))))) ! nneething-map))) ! ;; Remove files matching the exclusion regexp. ! (when nneething-exclude-files ! (let ((f files) ! prev) ! (while f ! (if (string-match nneething-exclude-files (car f)) ! (if prev (setcdr prev (cdr f)) ! (setq files (cdr files))) ! (setq prev f)) ! (setq f (cdr f))))) ! ;; Remove deleted files from the map. (let ((map nneething-map) prev) (while map ! (if (and (member (cadar map) files) ! ;; We also remove files that have changed mod times. ! (equal (nth 5 (file-attributes ! (nneething-file-name (cadar map)))) ! (caddar map))) ! (progn ! (push (cadar map) map-files) ! (setq prev map)) (setq touched t) (if prev *************** *** 242,258 **** ;; Find all new files and enter them into the map. (while files ! (or (assoc (car files) nneething-map) ; If already in the map, ignore. ! (progn ! (setq touched t) ! (setcdr nneething-active (1+ (cdr nneething-active))) ! (setq nneething-map ! (cons (cons (car files) (cdr nneething-active)) nneething-map)))) (setq files (cdr files))) ! (if (or (not touched) nneething-read-only) ! () (save-excursion ! (set-buffer (get-buffer-create " *nneething map*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" "(setq nneething-active '" (prin1-to-string nneething-active) --- 235,251 ---- ;; Find all new files and enter them into the map. (while files ! (unless (member (car files) map-files) ! ;; This file is not in the map, so we enter it. ! (setq touched t) ! (setcdr nneething-active (1+ (cdr nneething-active))) ! (push (list (cdr nneething-active) (car files) ! (nth 5 (file-attributes ! (nneething-file-name (car files))))) ! nneething-map)) (setq files (cdr files))) ! (when (and touched ! (not nneething-read-only)) (save-excursion ! (nnheader-set-temp-buffer " *nneething map*") (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" "(setq nneething-active '" (prin1-to-string nneething-active) *************** *** 261,299 **** (kill-buffer (current-buffer)))))) - (defvar nneething-message-id-number 0) - (defvar nneething-work-buffer " *nneething work*") - (defun nneething-insert-head (file) ! (and (nneething-get-head file) ! (insert-buffer-substring nneething-work-buffer))) ! (defun nneething-make-head (file) (let ((atts (file-attributes file))) ! (insert "Subject: " (file-name-nondirectory file) "\n" ! "Message-ID: \n" ! "Date: " (current-time-string (nth 5 atts)) "\n" ! (nneething-from-line (nth 2 atts)) ! "Chars: " (int-to-string (nth 7 atts)) "\n"))) ! ! (defun nneething-from-line (uid) ! (let ((login (condition-case nil ! (user-login-name uid) (error ! (cond ((= uid (user-uid)) (user-login-name)) ! ((zerop uid) "root") ! (t (int-to-string uid)))))) ! (name (condition-case nil ! (user-full-name uid) ! (error ! (cond ((= uid (user-uid)) (user-full-name)) ! ((zerop uid) "Ms. Root")))))) ! (concat "From: " login "@" (system-name) (if name (concat " (" name ")") "") "\n"))) (defun nneething-get-head (file) (save-excursion (set-buffer (get-buffer-create nneething-work-buffer)) --- 254,319 ---- (kill-buffer (current-buffer)))))) (defun nneething-insert-head (file) ! "Insert the head of FILE." ! (when (nneething-get-head file) ! (insert-buffer-substring nneething-work-buffer) ! (goto-char (point-max)))) ! (defun nneething-make-head (file &optional buffer) ! "Create a head by looking at the file attributes of FILE." (let ((atts (file-attributes file))) ! (insert ! "Subject: " (file-name-nondirectory file) "\n" ! "Message-ID: \n" ! (if (equal '(0 0) (nth 5 atts)) "" ! (concat "Date: " (current-time-string (nth 5 atts)) "\n")) ! (or (if buffer ! (save-excursion ! (set-buffer buffer) ! (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) ! (concat "From: " (match-string 0) "\n")))) ! (nneething-from-line (nth 2 atts) file)) ! (if (> (string-to-int (int-to-string (nth 7 atts))) 0) ! (concat "Chars: " (int-to-string (nth 7 atts)) "\n") ! "") ! (if buffer ! (save-excursion ! (set-buffer buffer) ! (concat "Lines: " (int-to-string ! (count-lines (point-min) (point-max))) "\n")) ! "") ! ))) ! ! (defun nneething-from-line (uid &optional file) ! "Return a From header based of UID." ! (let* ((login (condition-case nil ! (user-login-name uid) ! (error ! (cond ((= uid (user-uid)) (user-login-name)) ! ((zerop uid) "root") ! (t (int-to-string uid)))))) ! (name (condition-case nil ! (user-full-name uid) (error ! (cond ((= uid (user-uid)) (user-full-name)) ! ((zerop uid) "Ms. Root"))))) ! (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) ! (prog1 ! (substring file ! (match-beginning 1) ! (match-end 1)) ! (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) ! (setq login (substring file ! (match-beginning 2) ! (match-end 2)) ! name nil))) ! (system-name)))) ! (concat "From: " login "@" host (if name (concat " (" name ")") "") "\n"))) (defun nneething-get-head (file) + "Either find the head in FILE or make a head for FILE." (save-excursion (set-buffer (get-buffer-create nneething-work-buffer)) *************** *** 320,333 **** (point-max))) (point-max)) ! (erase-buffer) ! (nneething-make-head file)) t)))) - (defun nneething-number-to-file (number) - (car (rassq number nneething-map))) - (defun nneething-file-name (article) (concat (file-name-as-directory nneething-directory) ! (if (numberp article) (nneething-number-to-file article) article))) --- 340,353 ---- (point-max))) (point-max)) ! (goto-char (point-min)) ! (nneething-make-head file (current-buffer)) ! (delete-region (point) (point-max))) t)))) (defun nneething-file-name (article) + "Return the file name of ARTICLE." (concat (file-name-as-directory nneething-directory) ! (if (numberp article) ! (cadr (assq article nneething-map)) article))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnfolder.el emacs-19.32/lisp/nnfolder.el *** emacs-19.31/lisp/nnfolder.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nnfolder.el Fri Jun 28 20:11:24 1996 *************** *** 1,10 **** ;;; nnfolder.el --- mail folder access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Scott Byer ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ! ;; Keywords: news, mail ;; This file is part of GNU Emacs. --- 1,9 ---- ;;; nnfolder.el --- mail folder access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Scott Byer ;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ! ;; Keywords: mail ;; This file is part of GNU Emacs. *************** *** 35,46 **** (require 'nnheader) ! (require 'rmail) (require 'nnmail) ! (defvar nnfolder-directory (expand-file-name "~/Mail/") ! "The name of the mail box file in the users home directory.") ! (defvar nnfolder-active-file ! (concat (file-name-as-directory nnfolder-directory) "active") "The name of the active file.") --- 34,49 ---- (require 'nnheader) ! (require 'message) (require 'nnmail) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nnfolder) ! (defvoo nnfolder-directory (expand-file-name message-directory) ! "The name of the nnfolder directory.") ! (defvoo nnfolder-active-file ! (nnheader-concat nnfolder-directory "active") "The name of the active file.") *************** *** 48,77 **** ;; style. -SLB ! (defvar 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 scanning an mbox when opening ! it.") ! ! ;; Note that this variable may not be completely implemented yet. -SLB ! ! (defvar nnfolder-always-close nil ! "If non-nil, nnfolder attempts to only ever have one mbox open at a time. ! This is a straight space/performance trade off, as the mboxes will have to ! be scanned every time they are read in. If nil (default), nnfolder will ! attempt to keep the buffers around (saving the nnfolder's buffer upon group ! close, but not killing it), speeding some things up tremendously, especially ! such things as moving mail. All buffers always get killed upon server close.") ! (defvar nnfolder-newsgroups-file ! (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") ! (defvar nnfolder-get-new-mail t "If non-nil, nnfolder will check the incoming mail file and split the mail.") ! (defvar nnfolder-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") --- 51,83 ---- ;; style. -SLB ! (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 ! scanning an mbox when opening it.") ! ! (defvoo nnfolder-distrust-mbox nil ! "If non-nil, causes nnfolder to not trust the user with respect to ! inserting unaccounted for mail in the middle of an mbox file. This can greatly ! slow down scans, which now must scan the entire file for unmarked messages. ! When nil, scans occur forward from the last marked message, a huge ! time saver for large mailboxes.") ! (defvoo nnfolder-newsgroups-file ! (concat (file-name-as-directory nnfolder-directory) "newsgroups") "Mail newsgroups description file.") ! (defvoo nnfolder-get-new-mail t "If non-nil, nnfolder will check the incoming mail file and split the mail.") ! (defvoo nnfolder-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") + (defvoo nnfolder-save-buffer-hook nil + "Hook run before saving the nnfolder mbox buffer.") + + (defvoo nnfolder-inhibit-expiry nil + "If non-nil, inhibit expiry.") + *************** such things as moving mail. All buffers *** 82,111 **** "String used to demarcate what the article number for a message is.") ! (defvar nnfolder-current-group nil) ! (defvar nnfolder-current-buffer nil) ! (defvar nnfolder-status-string "") ! (defvar nnfolder-group-alist nil) ! (defvar nnfolder-buffer-alist nil) ! (defvar nnfolder-active-timestamp nil) ! ! (defmacro nnfolder-article-string (article) ! (` (concat "\n" nnfolder-article-marker (int-to-string (, article)) " "))) ! ! ! ! (defvar nnfolder-current-server nil) ! (defvar nnfolder-server-alist nil) ! (defvar nnfolder-server-variables ! (list ! (list 'nnfolder-directory nnfolder-directory) ! (list 'nnfolder-active-file nnfolder-active-file) ! (list 'nnfolder-newsgroups-file nnfolder-newsgroups-file) ! (list 'nnfolder-get-new-mail nnfolder-get-new-mail) ! '(nnfolder-current-group nil) ! '(nnfolder-current-buffer nil) ! '(nnfolder-status-string "") ! '(nnfolder-group-alist nil) ! '(nnfolder-buffer-alist nil) ! '(nnfolder-active-timestamp nil))) --- 88,97 ---- "String used to demarcate what the article number for a message is.") ! (defvoo nnfolder-current-group nil) ! (defvoo nnfolder-current-buffer nil) ! (defvoo nnfolder-status-string "") ! (defvoo nnfolder-group-alist nil) ! (defvoo nnfolder-buffer-alist nil) ! (defvoo nnfolder-scantime-alist nil) *************** such things as moving mail. All buffers *** 113,244 **** ;;; Interface functions ! (defun nnfolder-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((delim-string (concat "^" rmail-unix-mail-delimiter)) article art-string start stop) ! (nnfolder-possibly-change-group newsgroup) ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-min)) ! (if (stringp (car sequence)) ! 'headers ! (while sequence ! (setq article (car sequence)) ! (setq art-string (nnfolder-article-string article)) ! (set-buffer nnfolder-current-buffer) ! (if (or (search-forward art-string nil t) ! ;; Don't search the whole file twice! Also, articles ! ;; probably have some locality by number, so searching ! ;; backwards will be faster. Especially if we're at the ! ;; beginning of the buffer :-). -SLB ! (search-backward art-string nil t)) ! (progn ! (setq start (or (re-search-backward delim-string nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nnfolder-current-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq sequence (cdr sequence))) ! ! ;; Fold continuation lines. ! (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! 'headers)))) ! ! (defun nnfolder-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nnfolder-current-server) ! t ! (if nnfolder-current-server ! (setq nnfolder-server-alist ! (cons (list nnfolder-current-server ! (nnheader-save-variables nnfolder-server-variables)) ! nnfolder-server-alist))) ! (let ((state (assoc server nnfolder-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nnfolder-server-alist (delq state nnfolder-server-alist))) ! (nnheader-set-init-variables nnfolder-server-variables defs))) ! (setq nnfolder-current-server server))) ! ! (defun nnfolder-close-server (&optional server) ! t) ! ! (defun nnfolder-server-opened (&optional server) ! (and (equal server nnfolder-current-server) ! nntp-server-buffer ! (buffer-name nntp-server-buffer))) ! (defun nnfolder-request-close () (let ((alist nnfolder-buffer-alist)) (while alist ! (nnfolder-close-group (car (car alist)) nil t) (setq alist (cdr alist)))) (setq nnfolder-buffer-alist nil nnfolder-group-alist nil)) ! (defun nnfolder-status-message (&optional server) ! nnfolder-status-string) ! ! (defun nnfolder-request-article (article &optional newsgroup server buffer) ! (nnfolder-possibly-change-group newsgroup) ! (if (stringp article) ! nil ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-min)) ! (if (search-forward (nnfolder-article-string article) nil t) ! (let (start stop) ! (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) ! (setq start (point)) ! (forward-line 1) ! (or (and (re-search-forward ! (concat "^" rmail-unix-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring nnfolder-current-buffer start stop) (goto-char (point-min)) ! (while (looking-at "From ") ! (delete-char 5) ! (insert "X-From-Line: ") ! (forward-line 1)) ! t)))))) ! (defun nnfolder-request-group (group &optional server dont-check) (save-excursion (nnmail-activate 'nnfolder) ! (nnfolder-possibly-change-group group) ! (and (assoc group nnfolder-group-alist) ! (progn ! (if dont-check ! t ! (nnfolder-get-new-mail group) ! (let* ((active (assoc group nnfolder-group-alist)) ! (group (car active)) ! (range (car (cdr active))) ! (minactive (car range)) ! (maxactive (cdr range))) ! ;; I've been getting stray 211 lines in my nnfolder active ! ;; file. So, let's make sure that doesn't happen. -SLB ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if (not active) ! () ! (insert (format "211 %d %d %d %s\n" ! (1+ (- maxactive minactive)) ! minactive maxactive group)) ! t))))))) ;; Don't close the buffer if we're not shutting down the server. This way, --- 99,244 ---- ;;; Interface functions ! (nnoo-define-basics nnfolder) ! ! (deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((delim-string (concat "^" message-unix-mail-delimiter)) article art-string start stop) ! (nnfolder-possibly-change-group group server) ! (when nnfolder-current-buffer ! (set-buffer nnfolder-current-buffer) (goto-char (point-min)) ! (if (stringp (car articles)) ! 'headers ! (while articles ! (setq article (car articles)) ! (setq art-string (nnfolder-article-string article)) ! (set-buffer nnfolder-current-buffer) ! (if (or (search-forward art-string nil t) ! ;; Don't search the whole file twice! Also, articles ! ;; probably have some locality by number, so searching ! ;; backwards will be faster. Especially if we're at the ! ;; beginning of the buffer :-). -SLB ! (search-backward art-string nil t)) ! (progn ! (setq start (or (re-search-backward delim-string nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nnfolder-current-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq articles (cdr articles))) ! ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines) ! 'headers))))) ! ! (deffoo nnfolder-open-server (server &optional defs) ! (nnoo-change-server 'nnfolder server defs) ! (when (not (file-exists-p nnfolder-directory)) ! (condition-case () ! (make-directory nnfolder-directory t) ! (error t))) ! (cond ! ((not (file-exists-p nnfolder-directory)) ! (nnfolder-close-server) ! (nnheader-report 'nnfolder "Couldn't create directory: %s" ! nnfolder-directory)) ! ((not (file-directory-p (file-truename nnfolder-directory))) ! (nnfolder-close-server) ! (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) ! (t ! (nnheader-report 'nnfolder "Opened server %s using directory %s" ! server nnfolder-directory) ! t))) ! (deffoo nnfolder-request-close () (let ((alist nnfolder-buffer-alist)) (while alist ! (nnfolder-close-group (caar alist) nil t) (setq alist (cdr alist)))) + (nnoo-close-server 'nnfolder) (setq nnfolder-buffer-alist nil nnfolder-group-alist nil)) ! (deffoo nnfolder-request-article (article &optional group server buffer) ! (nnfolder-possibly-change-group group server) ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! (goto-char (point-min)) ! (if (search-forward (nnfolder-article-string article) nil t) ! (let (start stop) ! (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) ! (setq start (point)) ! (forward-line 1) ! (or (and (re-search-forward ! (concat "^" message-unix-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring nnfolder-current-buffer start stop) ! (goto-char (point-min)) ! (while (looking-at "From ") ! (delete-char 5) ! (insert "X-From-Line: ") ! (forward-line 1)) ! (if (numberp article) ! (cons nnfolder-current-group article) (goto-char (point-min)) ! (search-forward (concat "\n" nnfolder-article-marker)) ! (cons nnfolder-current-group ! (string-to-int ! (buffer-substring ! (point) (progn (end-of-line) (point))))))))))) ! (deffoo nnfolder-request-group (group &optional server dont-check) (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 ! (nnheader-report 'nnfolder "Selected group %s" group) ! t) ! (let* ((active (assoc group nnfolder-group-alist)) ! (group (car active)) ! (range (cadr active))) ! (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" ! (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 ! (lambda () ! (let ((bufs nnfolder-buffer-alist)) ! (save-excursion ! (while bufs ! (if (not (buffer-name (nth 1 (car bufs)))) ! (setq nnfolder-buffer-alist ! (delq (car bufs) nnfolder-buffer-alist)) ! (set-buffer (nth 1 (car bufs))) ! (nnfolder-save-buffer) ! (kill-buffer (current-buffer))) ! (setq bufs (cdr bufs)))))) ! nnfolder-directory ! group)) ;; Don't close the buffer if we're not shutting down the server. This way, *************** such things as moving mail. All buffers *** 247,309 **** ;; way. ! (defun nnfolder-close-group (group &optional server force) ;; Make sure we _had_ the group open. ! (if (or (assoc group nnfolder-buffer-alist) ! (equal group nnfolder-current-group)) ! (progn ! (nnfolder-possibly-change-group group) ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! ;; If the buffer was modified, write the file out now. ! (and (buffer-modified-p) (save-buffer)) ! (if (or force ! nnfolder-always-close) ! ;; If we're shutting the server down, we need to kill the ! ;; buffer and remove it from the open buffer list. Or, of ! ;; course, if we're trying to minimize our space impact. ! (progn ! (kill-buffer (current-buffer)) ! (setq nnfolder-buffer-alist (delq (assoc group ! nnfolder-buffer-alist) ! nnfolder-buffer-alist))))))) (setq nnfolder-current-group nil nnfolder-current-buffer nil) t) ! (defun nnfolder-request-create-group (group &optional server) (nnmail-activate 'nnfolder) ! (or (assoc group nnfolder-group-alist) ! (let (active) ! (setq nnfolder-group-alist ! (cons (list group (setq active (cons 1 0))) ! nnfolder-group-alist)) ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file))) t) ! (defun nnfolder-request-list (&optional server) ! (if server (nnfolder-get-new-mail)) (save-excursion (nnmail-find-file nnfolder-active-file) (setq nnfolder-group-alist (nnmail-get-active)))) ! (defun nnfolder-request-newgroups (date &optional server) (nnfolder-request-list server)) ! (defun nnfolder-request-list-newsgroups (&optional server) (save-excursion (nnmail-find-file nnfolder-newsgroups-file))) ! (defun nnfolder-request-post (&optional server) ! (mail-send-and-exit nil)) ! ! (defalias 'nnfolder-request-post-buffer 'nnmail-request-post-buffer) ! ! (defun nnfolder-request-expire-articles (articles newsgroup &optional server force) ! (nnfolder-possibly-change-group newsgroup) ! (let* ((days (or (and nnmail-expiry-wait-function ! (funcall nnmail-expiry-wait-function newsgroup)) ! nnmail-expiry-wait)) ! (is-old t) rest) (nnmail-activate 'nnfolder) --- 247,307 ---- ;; way. ! (deffoo nnfolder-close-group (group &optional server force) ;; Make sure we _had_ the group open. ! (when (or (assoc group nnfolder-buffer-alist) ! (equal group nnfolder-current-group)) ! (let ((inf (assoc group nnfolder-buffer-alist))) ! (when inf ! (when nnfolder-current-group ! (push (list nnfolder-current-group nnfolder-current-buffer) ! nnfolder-buffer-alist)) ! (setq nnfolder-buffer-alist ! (delq inf nnfolder-buffer-alist)) ! (setq nnfolder-current-buffer (cadr inf) ! nnfolder-current-group (car inf)))) ! (when (and nnfolder-current-buffer ! (buffer-name nnfolder-current-buffer)) ! (save-excursion ! (set-buffer nnfolder-current-buffer) ! ;; If the buffer was modified, write the file out now. ! (nnfolder-save-buffer) ! ;; If we're shutting the server down, we need to kill the ! ;; buffer and remove it from the open buffer list. Or, of ! ;; course, if we're trying to minimize our space impact. ! (kill-buffer (current-buffer)) ! (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) ! nnfolder-buffer-alist))))) (setq nnfolder-current-group nil nnfolder-current-buffer nil) t) ! (deffoo nnfolder-request-create-group (group &optional server) ! (nnfolder-possibly-change-group nil server) (nnmail-activate 'nnfolder) ! (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))) t) ! (deffoo nnfolder-request-list (&optional server) ! (nnfolder-possibly-change-group nil server) (save-excursion (nnmail-find-file nnfolder-active-file) (setq nnfolder-group-alist (nnmail-get-active)))) ! (deffoo nnfolder-request-newgroups (date &optional server) ! (nnfolder-possibly-change-group nil server) (nnfolder-request-list server)) ! (deffoo nnfolder-request-list-newsgroups (&optional server) ! (nnfolder-possibly-change-group nil server) (save-excursion (nnmail-find-file nnfolder-newsgroups-file))) ! (deffoo nnfolder-request-expire-articles (articles newsgroup &optional server force) ! (nnfolder-possibly-change-group newsgroup server) ! (let* ((is-old t) rest) (nnmail-activate 'nnfolder) *************** such things as moving mail. All buffers *** 314,333 **** (goto-char (point-min)) (if (search-forward (nnfolder-article-string (car articles)) nil t) ! (if (or force ! (setq is-old ! (> (nnmail-days-between ! (current-time-string) ! (buffer-substring ! (point) (progn (end-of-line) (point)))) ! days))) (progn ! (and gnus-verbose-backends ! (message "Deleting article %s..." (car articles))) (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) ! (and (buffer-modified-p) (save-buffer)) ;; Find the lowest active article in this group. ! (let* ((active (car (cdr (assoc newsgroup nnfolder-group-alist)))) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") --- 312,330 ---- (goto-char (point-min)) (if (search-forward (nnfolder-article-string (car articles)) nil t) ! (if (setq is-old ! (nnmail-expired-article-p ! newsgroup ! (buffer-substring ! (point) (progn (end-of-line) (point))) ! force nnfolder-inhibit-expiry)) (progn ! (nnheader-message 5 "Deleting article %d..." ! (car articles) newsgroup) (nnfolder-delete-mail)) (setq rest (cons (car articles) rest)))) (setq articles (cdr articles))) ! (nnfolder-save-buffer) ;; Find the lowest active article in this group. ! (let* ((active (cadr (assoc newsgroup nnfolder-group-alist))) (marker (concat "\n" nnfolder-article-marker)) (number "[0-9]+") *************** such things as moving mail. All buffers *** 344,350 **** (nconc rest articles)))) ! (defun nnfolder-request-move-article (article group server accept-form &optional last) ! (nnfolder-possibly-change-group group) (let ((buf (get-buffer-create " *nnfolder move*")) result) --- 341,347 ---- (nconc rest articles)))) ! (deffoo nnfolder-request-move-article (article group server accept-form &optional last) ! (nnfolder-possibly-change-group group server) (let ((buf (get-buffer-create " *nnfolder move*")) result) *************** such things as moving mail. All buffers *** 366,388 **** result) (save-excursion ! (nnfolder-possibly-change-group group) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last ! (buffer-modified-p) ! (save-buffer)))) result)) ! (defun nnfolder-request-accept-article (group &optional last) (and (stringp group) (nnfolder-possibly-change-group group)) (let ((buf (current-buffer)) result) (goto-char (point-min)) ! (cond ((looking-at "X-From-Line: ") ! (replace-match "From ")) ! ((not (looking-at "From ")) ! (insert "From nobody " (current-time-string) "\n"))) (and (nnfolder-request-list) --- 363,383 ---- result) (save-excursion ! (nnfolder-possibly-change-group group server) (set-buffer nnfolder-current-buffer) (goto-char (point-min)) (if (search-forward (nnfolder-article-string article) nil t) (nnfolder-delete-mail)) ! (and last (nnfolder-save-buffer)))) result)) ! (deffoo nnfolder-request-accept-article (group &optional server last) ! (nnfolder-possibly-change-group group server) ! (nnmail-check-syntax) (and (stringp group) (nnfolder-possibly-change-group group)) (let ((buf (current-buffer)) result) (goto-char (point-min)) ! (when (looking-at "X-From-Line: ") ! (replace-match "From ")) (and (nnfolder-request-list) *************** such things as moving mail. All buffers *** 397,405 **** (save-excursion (set-buffer nnfolder-current-buffer) ! (and last (buffer-modified-p) (save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) result)) ! (defun nnfolder-request-replace-article (article group buffer) (nnfolder-possibly-change-group group) (save-excursion --- 392,402 ---- (save-excursion (set-buffer nnfolder-current-buffer) ! (and last (nnfolder-save-buffer)))) (nnmail-save-active nnfolder-group-alist nnfolder-active-file) + (unless result + (nnheader-report 'nnfolder "Couldn't store article")) result)) ! (deffoo nnfolder-request-replace-article (article group buffer) (nnfolder-possibly-change-group group) (save-excursion *************** such things as moving mail. All buffers *** 410,492 **** (nnfolder-delete-mail t t) (insert-buffer-substring buffer) ! (and (buffer-modified-p) (save-buffer)) t))) ;;; Internal functions. (defun nnfolder-delete-mail (&optional force leave-delim) ! ;; Beginning of the article. (save-excursion ! (save-restriction ! (narrow-to-region ! (save-excursion ! (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) ! (if leave-delim (progn (forward-line 1) (point)) ! (match-beginning 0))) ! (progn ! (forward-line 1) ! (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) ! nil t) ! (if (and (not (bobp)) leave-delim) ! (progn (forward-line -2) (point)) ! (match-beginning 0))) ! (point-max)))) ! (delete-region (point-min) (point-max))))) ! ! (defun nnfolder-possibly-change-group (group) ! (or (file-exists-p nnfolder-directory) ! (make-directory (directory-file-name nnfolder-directory))) ! (nnfolder-possibly-activate-groups nil) ! (or (assoc group nnfolder-group-alist) ! (not (file-exists-p (concat (file-name-as-directory nnfolder-directory) ! group))) ! (progn ! (setq nnfolder-group-alist ! (cons (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. ! (if (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. ! (if (or (not (and nnfolder-current-buffer ! (buffer-name nnfolder-current-buffer))) ! (not (and (bufferp nnfolder-current-buffer) ! (verify-visited-file-modtime ! nnfolder-current-buffer)))) ! (progn ! (if (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))) ! ! (if inf () ! (save-excursion ! (setq file (concat (file-name-as-directory nnfolder-directory) ! group)) ! (if (file-directory-p (file-truename file)) ! () ! (if (not (file-exists-p file)) (write-region 1 1 file t 'nomesg)) ! (setq nnfolder-current-buffer ! (set-buffer (nnfolder-read-folder file))) ! (setq nnfolder-buffer-alist (cons (list group (current-buffer)) ! nnfolder-buffer-alist))))))) ! (setq nnfolder-current-group group)) (defun nnfolder-save-mail (&optional group) --- 407,544 ---- (nnfolder-delete-mail t t) (insert-buffer-substring buffer) ! (nnfolder-save-buffer) t))) + (deffoo nnfolder-request-delete-group (group &optional force server) + (nnfolder-close-group group server t) + ;; Delete all articles in GROUP. + (if (not force) + () ; Don't delete the articles. + ;; Delete the file that holds the group. + (condition-case nil + (delete-file (nnfolder-group-pathname group)) + (error nil))) + ;; Remove the group from all structures. + (setq nnfolder-group-alist + (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) + nnfolder-current-group nil + nnfolder-current-buffer nil) + ;; Save the active file. + (nnmail-save-active nnfolder-group-alist nnfolder-active-file) + t) + + (deffoo nnfolder-request-rename-group (group new-name &optional server) + (nnfolder-possibly-change-group group server) + (save-excursion + (set-buffer nnfolder-current-buffer) + (and (file-writable-p buffer-file-name) + (condition-case () + (progn + (rename-file + buffer-file-name + (nnfolder-group-pathname new-name)) + t) + (error nil)) + ;; That went ok, so we change the internal structures. + (let ((entry (assoc group nnfolder-group-alist))) + (and entry (setcar entry new-name)) + (setq nnfolder-current-buffer nil + nnfolder-current-group nil) + ;; Save the new group alist. + (nnmail-save-active nnfolder-group-alist nnfolder-active-file) + ;; We kill the buffer instead of renaming it and stuff. + (kill-buffer (current-buffer)) + t)))) + ;;; Internal functions. + (defun nnfolder-article-string (article) + (if (numberp article) + (concat "\n" nnfolder-article-marker (int-to-string article) " ") + (concat "\nMessage-ID: " article))) + (defun nnfolder-delete-mail (&optional force leave-delim) ! "Delete the message that point is in." (save-excursion ! (delete-region ! (save-excursion ! (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) ! (if leave-delim (progn (forward-line 1) (point)) ! (match-beginning 0))) ! (progn ! (forward-line 1) ! (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) ! (if (and (not (bobp)) leave-delim) ! (progn (forward-line -2) (point)) ! (match-beginning 0)) ! (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) ! (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)))) ! (unless (file-exists-p nnfolder-directory) ! (make-directory (directory-file-name nnfolder-directory) t)) ! (nnfolder-possibly-activate-groups nil) ! (or (assoc group nnfolder-group-alist) ! (not (file-exists-p ! (nnfolder-group-pathname group))) ! (progn ! (setq nnfolder-group-alist ! (cons (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. ! (if (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. ! (if (or (not (and nnfolder-current-buffer ! (buffer-name nnfolder-current-buffer))) ! (not (and (bufferp nnfolder-current-buffer) ! (verify-visited-file-modtime ! nnfolder-current-buffer)))) ! (progn ! (if (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))) ! ! (if inf ! () ! (save-excursion ! (setq file (nnfolder-group-pathname group)) ! (if (file-directory-p (file-truename file)) ! () ! (unless (file-exists-p file) ! (unless (file-exists-p (file-name-directory file)) ! (make-directory (file-name-directory file) t)) (write-region 1 1 file t 'nomesg)) ! (setq nnfolder-current-buffer ! (nnfolder-read-folder file scanning)) ! (if nnfolder-current-buffer ! (progn ! (set-buffer nnfolder-current-buffer) ! (setq nnfolder-buffer-alist ! (cons (list group nnfolder-current-buffer) ! nnfolder-buffer-alist))))))))) ! (setq nnfolder-current-group group))) (defun nnfolder-save-mail (&optional group) *************** such things as moving mail. All buffers *** 496,503 **** --- 548,567 ---- (group-art-list (nreverse (nnmail-article-group 'nnfolder-active-number))) + (delim (concat "^" message-unix-mail-delimiter)) save-list group-art) + (goto-char (point-min)) + ;; This might come from somewhere else. + (unless (looking-at delim) + (insert "From nobody " (current-time-string) "\n") + (goto-char (point-min))) + ;; Quote all "From " lines in the article. + (forward-line 1) + (while (re-search-forward delim nil t) + (beginning-of-line) + (insert "> ")) (setq save-list group-art-list) (nnmail-insert-lines) (nnmail-insert-xref group-art-list) + (run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnfolder-prepare-save-mail-hook) *************** such things as moving mail. All buffers *** 514,520 **** (delete-region (1+ (point)) (progn (forward-line 2) (point)))) - ;; Insert the new newsgroup marker. (nnfolder-possibly-change-group (car group-art)) (nnfolder-insert-newsgroup-line group-art) (let ((beg (point-min)) (end (point-max)) --- 578,588 ---- (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)) *************** such things as moving mail. All buffers *** 522,525 **** --- 590,596 ---- (set-buffer nnfolder-current-buffer) (goto-char (point-max)) + (unless (eolp) + (insert "\n")) + (insert "\n") (insert-buffer-substring obuf beg end) (set-buffer obuf))) *************** such things as moving mail. All buffers *** 546,565 **** (defun nnfolder-active-number (group) ! (save-excursion ! ;; Find the next article number in GROUP. ! (prog1 ! (let ((active (car (cdr (assoc group nnfolder-group-alist))))) ! (if active ! (setcdr active (1+ (cdr active))) ! ;; This group is new, so we create a new entry for it. ! ;; This might be a bit naughty... creating groups on the drop of ! ;; a hat, but I don't know... ! (setq nnfolder-group-alist ! (cons (list group (setq active (cons 1 1))) ! nnfolder-group-alist))) ! (cdr active)) ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! (nnfolder-possibly-activate-groups group) ! ))) --- 617,636 ---- (defun nnfolder-active-number (group) ! (when group ! (save-excursion ! ;; Find the next article number in GROUP. ! (prog1 ! (let ((active (cadr (assoc group nnfolder-group-alist)))) ! (if active ! (setcdr active (1+ (cdr active))) ! ;; This group is new, so we create a new entry for it. ! ;; This might be a bit naughty... creating groups on the drop of ! ;; a hat, but I don't know... ! (setq nnfolder-group-alist ! (cons (list group (setq active (cons 1 1))) ! nnfolder-group-alist))) ! (cdr active)) ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! (nnfolder-possibly-activate-groups group))))) *************** such things as moving mail. All buffers *** 579,704 **** ;; vulnerable to glitches between the mbox and the active file. ! (defun nnfolder-read-folder (file) ! (save-excursion ! (nnfolder-possibly-activate-groups nil) ! ;; We should be paranoid here and make sure the group is in the alist, ! ;; and add it if it isn't. ! ;;(if (not (assoc nnfoler-current-group nnfolder-group-alist) ! (set-buffer (setq nnfolder-current-buffer ! (nnheader-find-file-noselect file nil 'raw))) ! (buffer-disable-undo (current-buffer)) ! (let ((delim (concat "^" rmail-unix-mail-delimiter)) ! (marker (concat "\n" nnfolder-article-marker)) ! (number "[0-9]+") ! (active (car (cdr (assoc nnfolder-current-group ! nnfolder-group-alist)))) ! activenumber activemin start end) ! (goto-char (point-min)) ! ;; ! ;; Anytime the active number is 1 or 0, it is suspect. In that case, ! ;; search the file manually to find the active number. Or, of course, ! ;; if we're being paranoid. (This would also be the place to build ! ;; other lists from the header markers, such as expunge lists, etc., if ! ;; we ever desired to abandon the active file entirely for mboxes.) ! (setq activenumber (cdr active)) ! (if (or nnfolder-ignore-active-file ! (< activenumber 2)) ! (progn ! (setq activemin (max (1- (lsh 1 23)) ! (1- (lsh 1 24)) ! (1- (lsh 1 25)))) ! (while (and (search-forward marker nil t) ! (re-search-forward number nil t)) ! (let ((newnum (string-to-number (buffer-substring ! (match-beginning 0) ! (match-end 0))))) ! (setq activenumber (max activenumber newnum)) ! (setq activemin (min activemin newnum)))) ! (setcar active (max 1 (min activemin activenumber))) ! (setcdr active (max activenumber (cdr active))) ! (goto-char (point-min)))) ! ! ;; 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. ! (setq end (point-marker)) ! (set-marker end (or (and (re-search-forward delim nil t) ! (match-beginning 0)) ! (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. ! (while (looking-at delim) ! (forward-line 1)) ! (set-marker end (or (and (re-search-forward delim nil t) ! (match-beginning 0)) ! (point-max))) ! (goto-char start) ! (if (not (search-forward marker end t)) ! (progn ! (narrow-to-region start end) ! (nnmail-insert-lines) ! (nnfolder-insert-newsgroup-line ! (cons nil (nnfolder-active-number nnfolder-current-group))) ! (widen)))) ! ! ;; Make absolutely sure that the active list reflects reality! ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! (current-buffer)))) ! ! (defun nnfolder-get-new-mail (&optional group) ! "Read new incoming mail." ! (let* ((spools (nnmail-get-spool-files group)) ! (group-in group) ! incomings incoming) ! (if (or (not nnfolder-get-new-mail) (not nnmail-spool-file)) ! () ! ;; We first activate all the groups. ! (nnfolder-possibly-activate-groups nil) ! ;; The we go through all the existing spool files and split the ! ;; mail from each. ! (while spools ! (and ! (file-exists-p (car spools)) ! (> (nth 7 (file-attributes (car spools))) 0) ! (progn ! (and gnus-verbose-backends ! (message "nnfolder: Reading incoming mail...")) ! (if (not (setq incoming ! (nnmail-move-inbox ! (car spools) ! (concat (file-name-as-directory nnfolder-directory) ! "Incoming")))) ! () ! (setq incomings (cons incoming incomings)) ! (setq group (nnmail-get-split-group (car spools) group-in)) ! (nnmail-split-incoming incoming 'nnfolder-save-mail nil group)))) ! (setq spools (cdr spools))) ! ;; If we did indeed read any incoming spools, we save all info. ! (if incoming ! (progn ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! (run-hooks 'nnmail-read-incoming-hook) ! (and gnus-verbose-backends ! (message "nnfolder: Reading incoming mail...done")))) ! (let ((bufs nnfolder-buffer-alist)) ! (save-excursion ! (while bufs ! (if (not (buffer-name (nth 1 (car bufs)))) ! (setq nnfolder-buffer-alist ! (delq (car bufs) nnfolder-buffer-alist)) ! (set-buffer (nth 1 (car bufs))) ! (and (buffer-modified-p) (save-buffer))) ! (setq bufs (cdr bufs))))) ! (while incomings ! (setq incoming (car incomings)) ! (and ! nnmail-delete-incoming ! (file-writable-p incoming) ! (file-exists-p incoming) ! (delete-file incoming)) ! (setq incomings (cdr incomings)))))) (provide 'nnfolder) --- 650,782 ---- ;; 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 (or (file-attributes file) '(nil nil nil nil nil))))) ! (if (and scanning scantime ! (eq (car scantime) (car modtime)) ! (eq (cdr scantime) (cadr modtime))) ! nil ! (save-excursion ! (nnfolder-possibly-activate-groups nil) ! ;; Read in the file. ! (set-buffer (setq nnfolder-current-buffer ! (nnheader-find-file-noselect file nil 'raw))) ! (buffer-disable-undo (current-buffer)) ! ;; 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)) ! (minid (lsh -1 -1)) ! maxid start end newscantime) ! ! (setq maxid (or (cdr active) 0)) ! (goto-char (point-min)) ! ! ;; Anytime the active number is 1 or 0, it is suspect. In that ! ;; case, search the file manually to find the active number. Or, ! ;; of course, if we're being paranoid. (This would also be the ! ;; place to build other lists from the header markers, such as ! ;; expunge lists, etc., if we ever desired to abandon the active ! ;; file entirely for mboxes.) ! (when (or nnfolder-ignore-active-file ! (< maxid 2)) ! (while (and (search-forward marker nil t) ! (re-search-forward number nil t)) ! (let ((newnum (string-to-number (match-string 0)))) ! (setq maxid (max maxid newnum)) ! (setq minid (min minid newnum)))) ! (setcar active (max 1 (min minid maxid))) ! (setcdr active (max maxid (cdr active))) ! (goto-char (point-min))) ! ! ;; As long as we trust that the user will only insert unmarked mail ! ;; at the end, go to the end and search backwards for the last ! ;; marker. Find the start of that message, and begin to search for ! ;; unmarked messages from there. ! (if (not (or nnfolder-distrust-mbox ! (< maxid 2))) ! (progn ! (goto-char (point-max)) ! (if (not (re-search-backward marker nil t)) ! (goto-char (point-min)) ! (if (not (re-search-backward delim nil t)) ! (goto-char (point-min)))))) ! ! ;; 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. ! (setq end (point-marker)) ! (set-marker end (or (and (re-search-forward delim nil t) ! (match-beginning 0)) ! (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. ! (while (looking-at delim) ! (forward-line 1)) ! (set-marker end (or (and (re-search-forward delim nil t) ! (match-beginning 0)) ! (point-max))) ! (goto-char start) ! (if (not (search-forward marker end t)) ! (progn ! (narrow-to-region start end) ! (nnmail-insert-lines) ! (nnfolder-insert-newsgroup-line ! (cons nil (nnfolder-active-number nnfolder-current-group))) ! (widen)))) ! ! ;; Make absolutely sure that the active list reflects reality! ! (nnmail-save-active nnfolder-group-alist nnfolder-active-file) ! ;; Set the scantime for this group. ! (setq newscantime (visited-file-modtime)) ! (if scantime ! (setcdr scantime (list newscantime)) ! (push (list nnfolder-current-group newscantime) ! nnfolder-scantime-alist)) ! (current-buffer)))))) ! ! ;;;###autoload ! (defun nnfolder-generate-active-file () ! "Look for mbox folders in the nnfolder directory and make them into groups." ! (interactive) ! (nnmail-activate 'nnfolder) ! (let ((files (directory-files nnfolder-directory)) ! file) ! (while (setq file (pop files)) ! (when (and (not (backup-file-name-p file)) ! (nnheader-mail-file-mbox-p file)) ! (nnheader-message 5 "Adding group %s..." file) ! (push (list file (cons 1 0)) nnfolder-group-alist) ! (nnfolder-possibly-change-group file) ! ;; (nnfolder-read-folder file) ! (nnfolder-close-group file)) ! (message "")))) ! ! (defun nnfolder-group-pathname (group) ! "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 ! (file-exists-p (concat dir group))) ! (concat dir group) ! ;; If not, we translate dots into slashes. ! (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) ! ! (defun nnfolder-save-buffer () ! "Save the buffer." ! (when (buffer-modified-p) ! (run-hooks 'nnfolder-save-buffer-hook) ! (save-buffer))) (provide 'nnfolder) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnheader.el emacs-19.32/lisp/nnheader.el *** emacs-19.31/lisp/nnheader.el Tue Feb 20 14:16:33 1996 --- emacs-19.32/lisp/nnheader.el Fri Jun 28 20:10:37 1996 *************** *** 1,5 **** ;;; nnheader.el --- header access macros for Gnus and its backends ! ! ;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA --- 1,4 ---- ;;; nnheader.el --- header access macros for Gnus and its backends ! ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA *************** *** 26,33 **** ;;; Commentary: ! ;; These macros may look very much like the ones in GNUS 4.1. They ;; are, in a way, but you should note that the indices they use have ! ;; been changed from the internal GNUS format to the NOV format. Makes ! ;; it possible to read headers from XOVER much faster. ;; ;; The format of a header is now: --- 25,32 ---- ;;; Commentary: ! ;; These macros may look very much like the ones in GNUS 4.1. They ;; are, in a way, but you should note that the indices they use have ! ;; been changed from the internal GNUS format to the NOV format. The ! ;; makes it possible to read headers from XOVER much faster. ;; ;; The format of a header is now: *************** *** 39,138 **** ;;; Code: ! (defalias 'nntp-header-number 'mail-header-number) (defmacro mail-header-number (header) "Return article number in HEADER." ! (` (aref (, header) 0))) - (defalias 'nntp-set-header-number 'mail-header-set-number) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." ! (` (aset (, header) 0 (, number)))) - (defalias 'nntp-header-subject 'mail-header-subject) (defmacro mail-header-subject (header) "Return subject string in HEADER." ! (` (aref (, header) 1))) - (defalias 'nntp-set-header-subject 'mail-header-set-subject) (defmacro mail-header-set-subject (header subject) "Set article subject of HEADER to SUBJECT." ! (` (aset (, header) 1 (, subject)))) - (defalias 'nntp-header-from 'mail-header-from) (defmacro mail-header-from (header) "Return author string in HEADER." ! (` (aref (, header) 2))) - (defalias 'nntp-set-header-from 'mail-header-set-from) (defmacro mail-header-set-from (header from) "Set article author of HEADER to FROM." ! (` (aset (, header) 2 (, from)))) - (defalias 'nntp-header-date 'mail-header-date) (defmacro mail-header-date (header) "Return date in HEADER." ! (` (aref (, header) 3))) - (defalias 'nntp-set-header-date 'mail-header-set-date) (defmacro mail-header-set-date (header date) "Set article date of HEADER to DATE." ! (` (aset (, header) 3 (, date)))) ! (defalias 'nntp-header-id 'mail-header-id) (defmacro mail-header-id (header) "Return Id in HEADER." ! (` (aref (, header) 4))) ! (defalias 'nntp-set-header-id 'mail-header-set-id) (defmacro mail-header-set-id (header id) "Set article Id of HEADER to ID." ! (` (aset (, header) 4 (, id)))) - (defalias 'nntp-header-references 'mail-header-references) (defmacro mail-header-references (header) "Return references in HEADER." ! (` (aref (, header) 5))) - (defalias 'nntp-set-header-references 'mail-header-set-references) (defmacro mail-header-set-references (header ref) "Set article references of HEADER to REF." ! (` (aset (, header) 5 (, ref)))) - (defalias 'nntp-header-chars 'mail-header-chars) (defmacro mail-header-chars (header) "Return number of chars of article in HEADER." ! (` (aref (, header) 6))) - (defalias 'nntp-set-header-chars 'mail-header-set-chars) (defmacro mail-header-set-chars (header chars) "Set number of chars in article of HEADER to CHARS." ! (` (aset (, header) 6 (, chars)))) - (defalias 'nntp-header-lines 'mail-header-lines) (defmacro mail-header-lines (header) "Return lines in HEADER." ! (` (aref (, header) 7))) - (defalias 'nntp-set-header-lines 'mail-header-set-lines) (defmacro mail-header-set-lines (header lines) "Set article lines of HEADER to LINES." ! (` (aset (, header) 7 (, lines)))) - (defalias 'nntp-header-xref 'mail-header-xref) (defmacro mail-header-xref (header) "Return xref string in HEADER." ! (` (aref (, header) 8))) - (defalias 'nntp-set-header-xref 'mail-header-set-xref) (defmacro mail-header-set-xref (header xref) "Set article xref of HEADER to xref." ! (` (aset (, header) 8 (, xref)))) ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) ! (defvar gnus-verbose-backends t ! "*If non-nil, Gnus backends will generate lots of comments.") (defvar gnus-nov-is-evil nil "If non-nil, Gnus backends will never output headers in the NOV format.") --- 38,263 ---- ;;; Code: ! (require 'mail-utils) ! (eval-when-compile (require 'cl)) ! ! (defvar nnheader-max-head-length 4096 ! "*Max length of the head of articles.") ! ! (defvar nnheader-file-name-translation-alist nil ! "*Alist that says how to translate characters in file names. ! For instance, if \":\" is illegal as a file character in file names ! on your system, you could say something like: ! ! \(setq nnheader-file-name-translation-alist '((?: . ?_)))") ! ! ;;; Header access macros. ! (defmacro mail-header-number (header) "Return article number in HEADER." ! `(aref ,header 0)) (defmacro mail-header-set-number (header number) "Set article number of HEADER to NUMBER." ! `(aset ,header 0 ,number)) (defmacro mail-header-subject (header) "Return subject string in HEADER." ! `(aref ,header 1)) (defmacro mail-header-set-subject (header subject) "Set article subject of HEADER to SUBJECT." ! `(aset ,header 1 ,subject)) (defmacro mail-header-from (header) "Return author string in HEADER." ! `(aref ,header 2)) (defmacro mail-header-set-from (header from) "Set article author of HEADER to FROM." ! `(aset ,header 2 ,from)) (defmacro mail-header-date (header) "Return date in HEADER." ! `(aref ,header 3)) (defmacro mail-header-set-date (header date) "Set article date of HEADER to DATE." ! `(aset ,header 3 ,date)) ! (defalias 'mail-header-message-id 'mail-header-id) (defmacro mail-header-id (header) "Return Id in HEADER." ! `(aref ,header 4)) ! (defalias 'mail-header-set-message-id 'mail-header-set-id) (defmacro mail-header-set-id (header id) "Set article Id of HEADER to ID." ! `(aset ,header 4 ,id)) (defmacro mail-header-references (header) "Return references in HEADER." ! `(aref ,header 5)) (defmacro mail-header-set-references (header ref) "Set article references of HEADER to REF." ! `(aset ,header 5 ,ref)) (defmacro mail-header-chars (header) "Return number of chars of article in HEADER." ! `(aref ,header 6)) (defmacro mail-header-set-chars (header chars) "Set number of chars in article of HEADER to CHARS." ! `(aset ,header 6 ,chars)) (defmacro mail-header-lines (header) "Return lines in HEADER." ! `(aref ,header 7)) (defmacro mail-header-set-lines (header lines) "Set article lines of HEADER to LINES." ! `(aset ,header 7 ,lines)) (defmacro mail-header-xref (header) "Return xref string in HEADER." ! `(aref ,header 8)) (defmacro mail-header-set-xref (header xref) "Set article xref of HEADER to xref." ! `(aset ,header 8 ,xref)) ! ! (defun make-mail-header (&optional init) ! "Create a new mail header structure initialized with INIT." ! (make-vector 9 init)) ! ! ;; Parsing headers and NOV lines. ! ! (defsubst nnheader-header-value () ! (buffer-substring (match-end 0) (gnus-point-at-eol))) + (defvar nnheader-newsgroup-none-id 1) + + (defun nnheader-parse-head (&optional naked) + (let ((case-fold-search t) + (cur (current-buffer)) + (buffer-read-only nil) + end ref in-reply-to lines p) + (goto-char (point-min)) + (when naked + (insert "\n")) + ;; Search to the beginning of the next header. Error messages + ;; do not begin with 2 or 3. + (prog1 + (when (or naked (re-search-forward "^[23][0-9]+ " nil t)) + ;; This implementation of this function, with nine + ;; search-forwards instead of the one re-search-forward and + ;; a case (which basically was the old function) is actually + ;; about twice as fast, even though it looks messier. You + ;; can't have everything, I guess. Speed and elegance + ;; doesn't always go hand in hand. + (vector + ;; Number. + (if naked + (progn + (setq p (point-min)) + 0) + (prog1 + (read cur) + (end-of-line) + (setq p (point)) + (narrow-to-region (point) + (or (and (search-forward "\n.\n" nil t) + (- (point) 2)) + (point))))) + ;; Subject. + (progn + (goto-char p) + (if (search-forward "\nsubject: " nil t) + (nnheader-header-value) "(none)")) + ;; From. + (progn + (goto-char p) + (if (search-forward "\nfrom: " nil t) + (nnheader-header-value) "(nobody)")) + ;; Date. + (progn + (goto-char p) + (if (search-forward "\ndate: " nil t) + (nnheader-header-value) "")) + ;; Message-ID. + (progn + (goto-char p) + (if (search-forward "\nmessage-id: " nil t) + (nnheader-header-value) + ;; If there was no message-id, we just fake one to make + ;; subsequent routines simpler. + (concat "none+" + (int-to-string + (incf nnheader-newsgroup-none-id))))) + ;; References. + (progn + (goto-char p) + (if (search-forward "\nreferences: " nil t) + (nnheader-header-value) + ;; Get the references from the in-reply-to header if there + ;; were no references and the in-reply-to header looks + ;; promising. + (if (and (search-forward "\nin-reply-to: " nil t) + (setq in-reply-to (nnheader-header-value)) + (string-match "<[^>]+>" in-reply-to)) + (substring in-reply-to (match-beginning 0) + (match-end 0)) + ""))) + ;; Chars. + 0 + ;; Lines. + (progn + (goto-char p) + (if (search-forward "\nlines: " nil t) + (if (numberp (setq lines (read cur))) + lines 0) + 0)) + ;; Xref. + (progn + (goto-char p) + (and (search-forward "\nxref: " nil t) + (nnheader-header-value))))) + (when naked + (goto-char (point-min)) + (delete-char 1))))) + + (defun nnheader-insert-nov (header) + (princ (mail-header-number header) (current-buffer)) + (insert + "\t" + (or (mail-header-subject header) "(none)") "\t" + (or (mail-header-from header) "(nobody)") "\t" + (or (mail-header-date header) "") "\t" + (or (mail-header-id header) + (nnmail-message-id)) "\t" + (or (mail-header-references header) "") "\t") + (princ (or (mail-header-chars header) 0) (current-buffer)) + (insert "\t") + (princ (or (mail-header-lines header) 0) (current-buffer)) + (insert "\t") + (when (mail-header-xref header) + (insert "Xref: " (mail-header-xref header) "\t")) + (insert "\n")) + + (defun nnheader-insert-article-line (article) + (goto-char (point-min)) + (insert "220 ") + (princ article (current-buffer)) + (insert " Article retrieved.\n") + (search-forward "\n\n" nil 'move) + (delete-region (point) (point-max)) + (forward-char -1) + (insert ".")) ;; Various cruft the backends and Gnus need to communicate. (defvar nntp-server-buffer nil) ! (defvar gnus-verbose-backends 7 ! "*A number that says how talkative the Gnus backends should be.") (defvar gnus-nov-is-evil nil "If non-nil, Gnus backends will never output headers in the NOV format.") *************** *** 140,146 **** (defvar news-reply-yank-message-id nil) ! ;; All backends use this function, so I moved it to this file. (defun nnheader-init-server-buffer () (save-excursion (setq nntp-server-buffer (get-buffer-create " *nntpd*")) --- 265,272 ---- (defvar news-reply-yank-message-id nil) ! (defvar nnheader-callback-function nil) (defun nnheader-init-server-buffer () + "Initialize the Gnus-backend communication buffer." (save-excursion (setq nntp-server-buffer (get-buffer-create " *nntpd*")) *************** *** 152,211 **** t)) - (defun nnheader-set-init-variables (server defs) - (let ((s server) - val) - ;; First we set the server variables in the sequence required. We - ;; use the definitions from the `defs' list where that is - ;; possible. - (while s - (set (car (car s)) - (if (setq val (assq (car (car s)) defs)) - (nth 1 val) - (nth 1 (car s)))) - (setq s (cdr s))) - ;; The we go through the defs list and set any variables that were - ;; not set in the first sweep. - (while defs - (if (not (assq (car (car defs)) server)) - (set (car (car defs)) - (if (and (symbolp (nth 1 (car defs))) - (not (boundp (nth 1 (car defs))))) - (nth 1 (car defs)) - (eval (nth 1 (car defs)))))) - (setq defs (cdr defs))))) - - (defun nnheader-save-variables (server) - (let (out) - (while server - (setq out (cons (list (car (car server)) - (symbol-value (car (car server)))) - out)) - (setq server (cdr server))) - (nreverse out))) - - (defun nnheader-restore-variables (state) - (while state - (set (car (car state)) (nth 1 (car state))) - (setq state (cdr state)))) ! (defvar nnheader-max-head-length 4096 ! "The maximum length of a HEAD.") (defun nnheader-insert-head (file) "Insert the head of the article." ! (if (eq nnheader-max-head-length t) ! ;; Just read the entire file. ! (insert-file-contents-literally file) ! ;; Read 1K blocks until we find a separator. ! (let ((beg 0) ! (chop 1024)) ! (while (and (eq chop (nth 1 (insert-file-contents-literally ! file nil beg (setq beg (+ beg chop))))) ! (prog1 (not (search-forward "\n\n" nil t)) ! (goto-char (point-max))) ! (or (null nnheader-max-head-length) ! (< beg nnheader-max-head-length))))))) (defun nnheader-article-p () (goto-char (point-min)) (if (not (search-forward "\n\n" nil t)) --- 278,316 ---- t)) ! ;;; Various functions the backends use. ! ! (defun nnheader-file-error (file) ! "Return a string that says what is wrong with FILE." ! (format ! (cond ! ((not (file-exists-p file)) ! "%s does not exist") ! ((file-directory-p file) ! "%s is a directory") ! ((not (file-readable-p file)) ! "%s is not readable")) ! file)) (defun nnheader-insert-head (file) "Insert the head of the article." ! (when (file-exists-p file) ! (if (eq nnheader-max-head-length t) ! ;; Just read the entire file. ! (nnheader-insert-file-contents-literally file) ! ;; Read 1K blocks until we find a separator. ! (let ((beg 0) ! format-alist ! (chop 1024)) ! (while (and (eq chop (nth 1 (insert-file-contents ! file nil beg (incf beg chop)))) ! (prog1 (not (search-forward "\n\n" nil t)) ! (goto-char (point-max))) ! (or (null nnheader-max-head-length) ! (< beg nnheader-max-head-length)))))) ! t)) (defun nnheader-article-p () + "Say whether the current buffer looks like an article." (goto-char (point-min)) (if (not (search-forward "\n\n" nil t)) *************** *** 219,359 **** (widen)))) - ;; Written by Erik Naggum . - (defun nnheader-insert-file-contents-literally (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. - A buffer may be modified in several ways after reading into the buffer due - to advanced Emacs features, such as file-name-handlers, format decoding, - find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ( ; (file-name-handler-alist nil) - (format-alist nil) - (after-insert-file-functions nil) - (find-buffer-file-type-function - (if (fboundp 'find-buffer-file-type) - (symbol-function 'find-buffer-file-type) - nil))) - (unwind-protect - (progn - (fset 'find-buffer-file-type (lambda (filename) t)) - (insert-file-contents filename visit beg end replace)) - (if find-buffer-file-type-function - (fset 'find-buffer-file-type find-buffer-file-type-function) - (fmakunbound 'find-buffer-file-type))))) - - (defun nnheader-find-file-noselect (filename &optional nowarn rawfile) - "Read file FILENAME into a buffer and return the buffer. - If a buffer exists visiting FILENAME, return that one, but - verify that the file has not changed since visited or saved. - The buffer is not selected, just returned to the caller." - (setq filename - (abbreviate-file-name - (expand-file-name filename))) - (if (file-directory-p filename) - (if find-file-run-dired - (dired-noselect filename) - (error "%s is a directory." filename)) - (let* ((buf (get-file-buffer filename)) - (truename (abbreviate-file-name (file-truename filename))) - (number (nthcdr 10 (file-attributes truename))) - ;; Find any buffer for a file which has same truename. - (other (and (not buf) - (if (fboundp 'find-buffer-visiting) - (find-buffer-visiting filename) - (get-file-buffer filename)))) - error) - ;; Let user know if there is a buffer with the same truename. - (if other - (progn - (or nowarn - (string-equal filename (buffer-file-name other)) - (message "%s and %s are the same file" - filename (buffer-file-name other))) - ;; Optionally also find that buffer. - (if (or (and (boundp 'find-file-existing-other-name) - find-file-existing-other-name) - find-file-visit-truename) - (setq buf other)))) - (if buf - (or nowarn - (verify-visited-file-modtime buf) - (cond ((not (file-exists-p filename)) - (error "File %s no longer exists!" filename)) - ((yes-or-no-p - (if (string= (file-name-nondirectory filename) - (buffer-name buf)) - (format - (if (buffer-modified-p buf) - "File %s changed on disk. Discard your edits? " - "File %s changed on disk. Reread from disk? ") - (file-name-nondirectory filename)) - (format - (if (buffer-modified-p buf) - "File %s changed on disk. Discard your edits in %s? " - "File %s changed on disk. Reread from disk into %s? ") - (file-name-nondirectory filename) - (buffer-name buf)))) - (save-excursion - (set-buffer buf) - (revert-buffer t t))))) - (save-excursion - ;;; The truename stuff makes this obsolete. - ;;; (let* ((link-name (car (file-attributes filename))) - ;;; (linked-buf (and (stringp link-name) - ;;; (get-file-buffer link-name)))) - ;;; (if (bufferp linked-buf) - ;;; (message "Symbolic link to file in buffer %s" - ;;; (buffer-name linked-buf)))) - (setq buf (create-file-buffer filename)) - ;; (set-buffer-major-mode buf) - (set-buffer buf) - (erase-buffer) - (if rawfile - (condition-case () - (nnheader-insert-file-contents-literally filename t) - (file-error - ;; Unconditionally set error - (setq error t))) - (condition-case () - (insert-file-contents filename t) - (file-error - ;; Run find-file-not-found-hooks until one returns non-nil. - (or t ; (run-hook-with-args-until-success 'find-file-not-found-hooks) - ;; If they fail too, set error. - (setq error t))))) - ;; Find the file's truename, and maybe use that as visited name. - (setq buffer-file-truename truename) - (setq buffer-file-number number) - ;; On VMS, we may want to remember which directory in a search list - ;; the file was found in. - (and (eq system-type 'vax-vms) - (let (logical) - (if (string-match ":" (file-name-directory filename)) - (setq logical (substring (file-name-directory filename) - 0 (match-beginning 0)))) - (not (member logical find-file-not-true-dirname-list))) - (setq buffer-file-name buffer-file-truename)) - (if find-file-visit-truename - (setq buffer-file-name - (setq filename - (expand-file-name buffer-file-truename)))) - ;; Set buffer's default directory to that of the file. - (setq default-directory (file-name-directory filename)) - ;; Turn off backup files for certain file names. Since - ;; this is a permanent local, the major mode won't eliminate it. - (and (not (funcall backup-enable-predicate buffer-file-name)) - (progn - (make-local-variable 'backup-inhibited) - (setq backup-inhibited t))) - (if rawfile - nil - (after-find-file error (not nowarn))))) - buf))) - (defun nnheader-insert-references (references message-id) (if (and (not references) (not message-id)) ! () ; This is illegal, but not all articles have Message-IDs. (mail-position-on-field "References") ! ;; Fold long references line to follow RFC1036. ! (let ((begin (gnus-point-at-bol)) (fill-column 78) (fill-prefix "\t")) --- 324,333 ---- (widen)))) (defun nnheader-insert-references (references message-id) + "Insert a References header based on REFERENCES and MESSAGE-ID." (if (and (not references) (not message-id)) ! () ; This is illegal, but not all articles have Message-IDs. (mail-position-on-field "References") ! (let ((begin (save-excursion (beginning-of-line) (point))) (fill-column 78) (fill-prefix "\t")) *************** The buffer is not selected, just returne *** 361,367 **** --- 335,618 ---- (if (and references message-id) (insert " ")) (if message-id (insert message-id)) + ;; Fold long References lines to conform to RFC1036 (sort of). ;; The region must end with a newline to fill the region ;; without inserting extra newline. (fill-region-as-paragraph begin (1+ (point)))))) + + (defun nnheader-replace-header (header new-value) + "Remove HEADER and insert the NEW-VALUE." + (save-excursion + (save-restriction + (nnheader-narrow-to-headers) + (prog1 + (message-remove-header header) + (goto-char (point-max)) + (insert header ": " new-value "\n"))))) + + (defun nnheader-narrow-to-headers () + "Narrow to the head of an article." + (widen) + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max))) + (goto-char (point-min))) + + (defun nnheader-set-temp-buffer (name) + "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." + (set-buffer (get-buffer-create name)) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (current-buffer)) + + (defmacro nnheader-temp-write (file &rest forms) + "Create a new buffer, evaluate FORM there, and write the buffer to FILE." + `(save-excursion + (let ((nnheader-temp-file ,file) + (nnheader-temp-cur-buffer + (nnheader-set-temp-buffer + (generate-new-buffer-name " *nnheader temp*")))) + (when (and nnheader-temp-file + (not (file-directory-p (file-name-directory + nnheader-temp-file)))) + (make-directory (file-name-directory nnheader-temp-file) t)) + (unwind-protect + (prog1 + (progn + ,@forms) + (when nnheader-temp-file + (set-buffer nnheader-temp-cur-buffer) + (write-region (point-min) (point-max) + nnheader-temp-file nil 'nomesg))) + (when (buffer-name nnheader-temp-cur-buffer) + (kill-buffer nnheader-temp-cur-buffer)))))) + + (put 'nnheader-temp-write 'lisp-indent-function 1) + (put 'nnheader-temp-write 'lisp-indent-hook 1) + (put 'nnheader-temp-write 'edebug-form-spec '(form body)) + + (defvar jka-compr-compression-info-list) + (defvar nnheader-numerical-files + (if (boundp 'jka-compr-compression-info-list) + (concat "\\([0-9]+\\)\\(" + (mapconcat (lambda (i) (aref i 0)) + jka-compr-compression-info-list "\\|") + "\\)?") + "[0-9]+$") + "Regexp that match numerical files.") + + (defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files) + "Regexp that matches numerical file names.") + + (defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) + "Regexp that matches numerical full file paths.") + + (defsubst nnheader-file-to-number (file) + "Take a file name and return the article number." + (if (not (boundp 'jka-compr-compression-info-list)) + (string-to-int file) + (string-match nnheader-numerical-short-files file) + (string-to-int (match-string 0 file)))) + + (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 + ;; the longest result. + (let ((first (apply 'directory-files args)) + (second (apply 'directory-files args))) + (if (> (length first) (length second)) + first + second))) + + (defun nnheader-directory-articles (dir) + "Return a list of all article files in a directory." + (mapcar 'nnheader-file-to-number + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t))) + + (defun nnheader-article-to-file-alist (dir) + "Return an alist of article/file pairs in DIR." + (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) + (nnheader-directory-files-safe + dir nil nnheader-numerical-short-files t))) + + (defun nnheader-fold-continuation-lines () + "Fold continuation lines in the current buffer." + (goto-char (point-min)) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t))) + + (defun nnheader-translate-file-chars (file) + (if (null nnheader-file-name-translation-alist) + ;; No translation is necessary. + file + ;; We translate -- but only the file name. We leave the directory + ;; alone. + (let* ((i 0) + trans leaf path len) + (if (string-match "/[^/]+\\'" file) + ;; This is needed on NT's and stuff. + (setq leaf (substring file (1+ (match-beginning 0))) + path (substring file 0 (1+ (match-beginning 0)))) + ;; Fall back on this. + (setq leaf (file-name-nondirectory file) + path (file-name-directory file))) + (setq len (length leaf)) + (while (< i len) + (when (setq trans (cdr (assq (aref leaf i) + nnheader-file-name-translation-alist))) + (aset leaf i trans)) + (incf i)) + (concat path leaf)))) + + (defun nnheader-report (backend &rest args) + "Report an error from the BACKEND. + The first string in ARGS can be a format string." + (set (intern (format "%s-status-string" backend)) + (if (< (length args) 2) + (car args) + (apply 'format args))) + nil) + + (defun nnheader-get-report (backend) + (message "%s" (symbol-value (intern (format "%s-status-string" backend))))) + + (defun nnheader-insert (format &rest args) + "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer. + If FORMAT isn't a format string, it and all ARGS will be inserted + without formatting." + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (if (string-match "%" format) + (insert (apply 'format format args)) + (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-literally 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. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (if (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string)) + + (defun nnheader-file-to-group (file &optional top) + "Return a group name based on FILE and TOP." + (nnheader-replace-chars-in-string + (if (not top) + file + (condition-case () + (substring (expand-file-name file) + (length + (expand-file-name + (file-name-as-directory top)))) + (error ""))) + ?/ ?.)) + + (defun nnheader-message (level &rest args) + "Message if the Gnus backends are talkative." + (if (or (not (numberp gnus-verbose-backends)) + (<= level gnus-verbose-backends)) + (apply 'message args) + (apply 'format args))) + + (defun nnheader-be-verbose (level) + "Return whether the backends should be verbose on LEVEL." + (or (not (numberp gnus-verbose-backends)) + (<= level gnus-verbose-backends))) + + (defun nnheader-group-pathname (group dir &optional file) + "Make pathname for GROUP." + (concat + (let ((dir (file-name-as-directory (expand-file-name dir)))) + ;; If this directory exists, we use it directly. + (if (file-directory-p (concat dir group)) + (concat dir group "/") + ;; If not, we translate dots into slashes. + (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) + (cond ((null file) "") + ((numberp file) (int-to-string file)) + (t file)))) + + (defun nnheader-functionp (form) + "Return non-nil if FORM is funcallable." + (or (and (symbolp form) (fboundp form)) + (and (listp form) (eq (car form) 'lambda)))) + + (defun nnheader-concat (dir file) + "Concat DIR as directory to FILE." + (concat (file-name-as-directory dir) file)) + + (defun nnheader-ms-strip-cr () + "Strip ^M from the end of all lines." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (delete-backward-char 1)))) + + (defun nnheader-file-size (file) + "Return the file size of FILE or 0." + (or (nth 7 (file-attributes file)) 0)) + + (defun nnheader-find-etc-directory (package) + "Go through the path and find the \".../etc/PACKAGE\" directory." + (let ((path load-path) + dir result) + ;; We try to find the dir by looking at the load path, + ;; stripping away the last component and adding "etc/". + (while path + (if (and (car path) + (file-exists-p + (setq dir (concat + (file-name-directory + (directory-file-name (car path))) + "etc/" package "/"))) + (file-directory-p dir)) + (setq result dir + path nil) + (setq path (cdr path)))) + result)) + + (defvar ange-ftp-path-format) + (defvar efs-path-regexp) + (defun nnheader-re-read-dir (path) + "Re-read directory PATH if PATH is on a remote system." + (if (boundp 'ange-ftp-path-format) + (when (string-match (car ange-ftp-path-format) path) + (ange-ftp-re-read-dir path)) + (if (boundp 'efs-path-regexp) + (when (string-match efs-path-regexp path) + (efs-re-read-dir path))))) + + (fset 'nnheader-run-at-time 'run-at-time) + (fset 'nnheader-cancel-timer 'cancel-timer) + (fset 'nnheader-find-file-noselect 'find-file-noselect) + (fset 'nnheader-insert-file-contents-literally + 'insert-file-contents-literally) + + (when (string-match "XEmacs\\|Lucid" emacs-version) + (require 'nnheaderxm)) + + (run-hooks 'nnheader-load-hook) (provide 'nnheader) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnkiboze.el emacs-19.32/lisp/nnkiboze.el *** emacs-19.31/lisp/nnkiboze.el Tue Jan 16 19:21:36 1996 --- emacs-19.32/lisp/nnkiboze.el Tue Jun 25 18:20:16 1996 *************** *** 1,5 **** ;;; nnkiboze.el --- select virtual news access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnkiboze.el --- select virtual news access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 35,43 **** (require 'gnus) (require 'gnus-score) ! (defvar nnkiboze-directory ! (expand-file-name (or gnus-article-save-directory "~/News/")) "nnkiboze will put its files in this directory.") --- 34,50 ---- (require 'gnus) (require 'gnus-score) + (require 'nnoo) + (eval-when-compile (require 'cl)) ! (nnoo-declare nnkiboze) ! (defvoo nnkiboze-directory gnus-directory "nnkiboze will put its files in this directory.") + (defvoo nnkiboze-level 9 + "*The maximum level to be searched for articles.") + + (defvoo nnkiboze-remove-read-articles t + "*If non-nil, nnkiboze will remove read articles from the kiboze group.") + *************** *** 45,51 **** "Version numbers of this version of nnkiboze.") ! (defvar nnkiboze-current-group nil) ! (defvar nnkiboze-current-score-group "") ! (defvar nnkiboze-status-string "") --- 52,58 ---- "Version numbers of this version of nnkiboze.") ! (defvoo nnkiboze-current-group nil) ! (defvoo nnkiboze-current-score-group "") ! (defvoo nnkiboze-status-string "") *************** *** 53,57 **** ;;; Interface functions. ! (defun nnkiboze-retrieve-headers (articles &optional group server) (nnkiboze-possibly-change-newsgroups group) (if gnus-nov-is-evil --- 60,66 ---- ;;; Interface functions. ! (nnoo-define-basics nnkiboze) ! ! (deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) (nnkiboze-possibly-change-newsgroups group) (if gnus-nov-is-evil *************** *** 79,105 **** 'nov)))))) ! (defun nnkiboze-open-server (newsgroups &optional something) ! "Open a virtual newsgroup that contains NEWSGROUPS." (gnus-make-directory nnkiboze-directory) (nnheader-init-server-buffer)) ! (defun nnkiboze-close-server (&rest dum) ! "Close news server." ! t) ! ! (defalias 'nnkiboze-request-quit (symbol-function 'nnkiboze-close-server)) ! ! (defun nnkiboze-server-opened (&optional server) ! "Return server process status, T or NIL. ! If the stream is opened, return T, otherwise return NIL." (and nntp-server-buffer (get-buffer nntp-server-buffer))) ! (defun nnkiboze-status-message (&optional server) ! "Return server status response as string." ! nnkiboze-status-string) ! ! (defun nnkiboze-request-article (article &optional newsgroup server buffer) ! "Select article by message number." (nnkiboze-possibly-change-newsgroups newsgroup) (if (not (numberp article)) --- 88,100 ---- 'nov)))))) ! (deffoo nnkiboze-open-server (newsgroups &optional something) (gnus-make-directory nnkiboze-directory) (nnheader-init-server-buffer)) ! (deffoo nnkiboze-server-opened (&optional server) (and nntp-server-buffer (get-buffer nntp-server-buffer))) ! (deffoo nnkiboze-request-article (article &optional newsgroup server buffer) (nnkiboze-possibly-change-newsgroups newsgroup) (if (not (numberp article)) *************** If the stream is opened, return T, other *** 108,112 **** ;; article fetching by message-id at all. (nntp-request-article article newsgroup gnus-nntp-server buffer) ! (let* ((header (gnus-get-header-by-number article)) (xref (mail-header-xref header)) igroup iarticle) --- 103,107 ---- ;; article fetching by message-id at all. (nntp-request-article article newsgroup gnus-nntp-server buffer) ! (let* ((header (gnus-summary-article-header article)) (xref (mail-header-xref header)) igroup iarticle) *************** If the stream is opened, return T, other *** 120,124 **** (gnus-request-article iarticle igroup buffer))))) ! (defun nnkiboze-request-group (group &optional server dont-check) "Make GROUP the current newsgroup." (nnkiboze-possibly-change-newsgroups group) --- 115,119 ---- (gnus-request-article iarticle igroup buffer))))) ! (deffoo nnkiboze-request-group (group &optional server dont-check) "Make GROUP the current newsgroup." (nnkiboze-possibly-change-newsgroups group) *************** If the stream is opened, return T, other *** 145,157 **** t) ! (defun nnkiboze-close-group (group &optional server) (nnkiboze-possibly-change-newsgroups group) ;; Remove NOV lines of articles that are marked as read. ! (if (or (not (file-exists-p (nnkiboze-nov-file-name))) ! (not (eq major-mode 'gnus-summary-mode))) ! () (save-excursion (let ((unreads gnus-newsgroup-unreads) ! (unselected gnus-newsgroup-unselected)) (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) --- 140,153 ---- t) ! (deffoo nnkiboze-close-group (group &optional server) (nnkiboze-possibly-change-newsgroups group) ;; Remove NOV lines of articles that are marked as read. ! (when (and (file-exists-p (nnkiboze-nov-file-name)) ! nnkiboze-remove-read-articles ! (eq major-mode 'gnus-summary-mode)) (save-excursion (let ((unreads gnus-newsgroup-unreads) ! (unselected gnus-newsgroup-unselected) ! (version-control 'never)) (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) *************** If the stream is opened, return T, other *** 171,190 **** (setq nnkiboze-current-group nil))) ! (defun nnkiboze-request-list (&optional server) ! (setq nnkiboze-status-string "nnkiboze: LIST is not implemented.") ! nil) ! (defun nnkiboze-request-newgroups (date &optional server) "List new groups." ! (setq nnkiboze-status-string "NEWGROUPS is not supported.") ! nil) ! (defun nnkiboze-request-list-newsgroups (&optional server) ! (setq nnkiboze-status-string "nnkiboze: LIST NEWSGROUPS is not implemented.") ! nil) ! (defalias 'nnkiboze-request-post 'nntp-request-post) ! ! (defalias 'nnkiboze-request-post-buffer 'nntp-request-post-buffer) --- 167,192 ---- (setq nnkiboze-current-group nil))) ! (deffoo nnkiboze-request-list (&optional server) ! (nnheader-report 'nnkiboze "LIST is not implemented.")) ! (deffoo nnkiboze-request-newgroups (date &optional server) "List new groups." ! (nnheader-report 'nnkiboze "NEWGROUPS is not supported.")) ! (deffoo nnkiboze-request-list-newsgroups (&optional server) ! (nnheader-report 'nnkiboze "LIST NEWSGROUPS is not implemented.")) ! (deffoo nnkiboze-request-delete-group (group &optional force server) ! (nnkiboze-possibly-change-newsgroups group) ! (when force ! (let ((files (list (nnkiboze-nov-file-name) ! (concat nnkiboze-directory group ".newsrc") ! (nnkiboze-score-file group)))) ! (while files ! (and (file-exists-p (car files)) ! (file-writable-p (car files)) ! (delete-file (car files))) ! (setq files (cdr files))))) ! (setq nnkiboze-current-group nil)) *************** Finds out what articles are to be part o *** 208,221 **** (gnus)) (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) ! (newsrc gnus-newsrc-alist)) (while newsrc ! (if (string-match "nnkiboze" (car (car newsrc))) ! (nnkiboze-generate-group (car (car newsrc)))) (setq newsrc (cdr newsrc))))) (defun nnkiboze-score-file (group) (list (expand-file-name ! (concat gnus-kill-files-directory nnkiboze-current-score-group ! "." gnus-score-file-suffix)))) (defun nnkiboze-generate-group (group) --- 210,231 ---- (gnus)) (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) ! (newsrc gnus-newsrc-alist) ! gnus-newsrc-hashtb) ! (gnus-make-hashtable-from-newsrc-alist) ! ;; We have copied all the newsrc alist info over to local copies ! ;; so that we can mess all we want with these lists. (while newsrc ! (if (string-match "nnkiboze" (caar newsrc)) ! ;; For each kiboze group, we call this function to generate ! ;; it. ! (nnkiboze-generate-group (caar newsrc))) (setq newsrc (cdr newsrc))))) (defun nnkiboze-score-file (group) (list (expand-file-name ! (concat (file-name-as-directory gnus-kill-files-directory) ! (nnheader-translate-file-chars ! (concat nnkiboze-current-score-group ! "." gnus-score-file-suffix)))))) (defun nnkiboze-generate-group (group) *************** Finds out what articles are to be part o *** 226,229 **** --- 236,240 ---- (gnus-expert-user t) (gnus-large-newsgroup nil) + (version-control 'never) (gnus-score-find-score-files-function 'nnkiboze-score-file) gnus-select-group-hook gnus-summary-prepare-hook *************** Finds out what articles are to be part o *** 231,238 **** gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active ! ginfo lowest) (setq nnkiboze-current-score-group group) (or info (error "No such group: %s" group)) (and (file-exists-p newsrc-file) (load newsrc-file)) (save-excursion (set-buffer (setq nov-buffer (find-file-noselect nov-file))) --- 242,251 ---- gnus-visual method nnkiboze-newsrc nov-buffer gname newsrc active ! ginfo lowest glevel) (setq nnkiboze-current-score-group group) (or info (error "No such group: %s" group)) + ;; Load the kiboze newsrc file for this group. (and (file-exists-p newsrc-file) (load newsrc-file)) + ;; We also load the nov file for this group. (save-excursion (set-buffer (setq nov-buffer (find-file-noselect nov-file))) *************** Finds out what articles are to be part o *** 242,264 **** (mapatoms (lambda (group) ! (if (and (string-match regexp (setq gname (symbol-name group))) ; Match ! (not (assoc gname nnkiboze-newsrc)) ; It isn't registered ! (numberp (car (symbol-value group))) ; It is active ! (not (string-match "^nnkiboze:" gname))) ; Exclude kibozes ! (setq nnkiboze-newsrc ! (cons (cons gname (1- (car (symbol-value group)))) ! nnkiboze-newsrc)))) gnus-active-hashtb) (setq newsrc nnkiboze-newsrc) (while newsrc (if (not (setq active (gnus-gethash ! (car (car newsrc)) gnus-active-hashtb))) (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) (switch-to-buffer gnus-group-buffer) ! (gnus-group-jump-to-group (car (car newsrc))) ! (if (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) ! gnus-newsrc-hashtb))) ! (nth 3 ginfo)) ! (setcar (nthcdr 3 ginfo) nil)) (if (not (and (or (not ginfo) (> (length (gnus-list-of-unread-articles --- 255,296 ---- (mapatoms (lambda (group) ! (and (string-match regexp (setq gname (symbol-name group))) ; Match ! (not (assoc gname nnkiboze-newsrc)) ; It isn't registered ! (numberp (car (symbol-value group))) ; It is active ! (or (> nnkiboze-level 7) ! (and (setq glevel (nth 1 (nth 2 (gnus-gethash ! gname gnus-newsrc-hashtb)))) ! (>= nnkiboze-level glevel))) ! (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes ! (setq nnkiboze-newsrc ! (cons (cons gname (1- (car (symbol-value group)))) ! nnkiboze-newsrc)))) gnus-active-hashtb) + ;; `newsrc' is set to the list of groups that possibly are + ;; component groups to this kiboze group. This list has elements + ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest + ;; number that has been kibozed in GROUP in this kiboze group. (setq newsrc nnkiboze-newsrc) (while newsrc (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. (switch-to-buffer gnus-group-buffer) ! (gnus-group-jump-to-group (caar newsrc)) ! ;; We set all list of article marks to nil. Since we operate ! ;; on copies of the real lists, we can destroy anything we ! ;; want here. ! (and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name) ! gnus-newsrc-hashtb))) ! (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)'. ! (and ginfo (setcar (nthcdr 2 ginfo) ! (and (not (= lowest 1)) (cons 1 lowest)))) (if (not (and (or (not ginfo) (> (length (gnus-list-of-unread-articles *************** Finds out what articles are to be part o *** 267,289 **** (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode)))) ! () ! (setq lowest (cdr (car newsrc))) (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (and (eq method gnus-select-method) (setq method nil)) (while gnus-newsgroup-scored ! (if (> (car (car gnus-newsgroup-scored)) lowest) (nnkiboze-enter-nov nov-buffer ! (gnus-get-header-by-number (car (car gnus-newsgroup-scored))) (if method (gnus-group-prefixed-name gnus-newsgroup-name method) gnus-newsgroup-name))) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) ! (gnus-summary-quit))) (setcdr (car newsrc) (car active)) (setq newsrc (cdr newsrc))) (set-buffer nov-buffer) (save-buffer) (kill-buffer (current-buffer)) (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) --- 299,328 ---- (gnus-group-select-group nil) (eq major-mode 'gnus-summary-mode)))) ! () ; No unread articles, or we couldn't enter this group. ! ;; We are now in the group where we want to be. (setq method (gnus-find-method-for-group gnus-newsgroup-name)) (and (eq method gnus-select-method) (setq method nil)) + ;; We go through the list of scored articles. (while gnus-newsgroup-scored ! (if (> (caar gnus-newsgroup-scored) lowest) ! ;; If it has a good score, then we enter this article ! ;; into the kiboze group. (nnkiboze-enter-nov nov-buffer ! (gnus-summary-article-header ! (caar gnus-newsgroup-scored)) (if method (gnus-group-prefixed-name gnus-newsgroup-name method) gnus-newsgroup-name))) (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) ! ;; That's it. We exit this group. ! (gnus-summary-exit-no-update))) (setcdr (car newsrc) (car active)) (setq newsrc (cdr newsrc))) + ;; We save the nov file. (set-buffer nov-buffer) (save-buffer) (kill-buffer (current-buffer)) + ;; We save the kiboze newsrc for this group. (set-buffer (get-buffer-create "*nnkiboze work*")) (buffer-disable-undo (current-buffer)) *************** Finds out what articles are to be part o *** 341,346 **** (defun nnkiboze-nov-file-name () ! (concat nnkiboze-directory ! (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")) (provide 'nnkiboze) --- 380,386 ---- (defun nnkiboze-nov-file-name () ! (concat (file-name-as-directory nnkiboze-directory) ! (nnheader-translate-file-chars ! (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) (provide 'nnkiboze) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnmail.el emacs-19.32/lisp/nnmail.el *** emacs-19.31/lisp/nnmail.el Wed Jan 24 19:35:28 1996 --- emacs-19.32/lisp/nnmail.el Fri Jun 28 20:09:24 1996 *************** *** 1,5 **** ;;; nnmail.el --- mail support functions for the Gnus mail backends ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnmail.el --- mail support functions for the Gnus mail backends ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 28,34 **** (require 'nnheader) - (require 'rmail) (require 'timezone) ! (require 'sendmail) (defvar nnmail-split-methods --- 27,33 ---- (require 'nnheader) (require 'timezone) ! (require 'message) ! (eval-when-compile (require 'cl)) (defvar nnmail-split-methods *************** If nil, the first match found will be us *** 67,76 **** ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defvar nnmail-keep-last-article nil ! "*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.") (defvar nnmail-expiry-wait 7 ! "*Articles that are older than `nnmail-expiry-wait' days will be expired.") (defvar nnmail-expiry-wait-function nil --- 66,83 ---- ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). (defvar nnmail-keep-last-article nil ! "*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.") + (defvar nnmail-use-long-file-names nil + "*If non-nil the mail backends will use long file and directory names. + If nil, groups like \"mail.misc\" will end up in directories like + \"mail/misc/\".") + (defvar nnmail-expiry-wait 7 ! "*Expirable articles that are older than this will be expired. ! This variable can either be a number (which will be interpreted as a ! number of days) -- this doesn't have to be an integer. This variable ! can also be `immediate' and `never'.") (defvar nnmail-expiry-wait-function nil *************** new mail into folder numbers that Gnus h *** 79,83 **** expiry is to be performed in, and it should return an integer that says how many days an article can be stored before it is considered ! 'old'. Eg.: --- 86,90 ---- expiry is to be performed in, and it should return an integer that says how many days an article can be stored before it is considered ! \"old\". It can also return the values `never' and `immediate'. Eg.: *************** Eg.: *** 87,90 **** --- 94,98 ---- (cond ((string-match \"private\" newsgroup) 31) ((string-match \"junk\" newsgroup) 1) + ((string-match \"important\" newsgroup) 'never) (t 7))))") *************** If this variable is a list, all files me *** 98,101 **** --- 106,112 ---- used as incoming mailboxes.") + (defvar nnmail-crash-box "~/.gnus-crash-box" + "*File where Gnus will store mail while processing it.") + (defvar nnmail-use-procmail nil "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. *************** The file(s) in `nnmail-spool-file' will *** 106,110 **** The Gnus mail backends will read the mail from this directory.") ! (defvar nnmail-procmail-suffix ".spool" "*Suffix of files created by procmail (and the like). This variable might be a suffix-regexp to match the suffixes of --- 117,121 ---- The Gnus mail backends will read the mail from this directory.") ! (defvar nnmail-procmail-suffix "\\.spool" "*Suffix of files created by procmail (and the like). This variable might be a suffix-regexp to match the suffixes of *************** several files - eg. \".spool[0-9]*\".") *** 114,121 **** --- 125,144 ---- "*If non-nil, re-split incoming procmail sorted mail.") + (defvar nnmail-delete-file-function 'delete-file + "Function called to delete files in some mail backends.") + + (defvar nnmail-crosspost-link-function 'add-name-to-file + "Function called to create a copy of a file. + This is `add-name-to-file' by default, which means that crossposts + will use hard links. If your file system doesn't allow hard + links, you could set this variable to `copy-file' instead.") + (defvar nnmail-movemail-program "movemail" "*A command to be executed to move mail from the inbox. The default is \"movemail\".") + (defvar nnmail-pop-password-required nil + "*Non-nil if a password is required when reading mail using POP.") + (defvar nnmail-read-incoming-hook nil "*Hook that will be run after the incoming mail has been transferred. *************** running (\"xwatch\", etc.) *** 128,135 **** Eg. ! (add-hook 'nnmail-read-incoming-hook (lambda () (start-process \"mailsend\" nil ! \"/local/bin/mailsend\" \"read\" \"mbox\")))") ;; Suggested by Erik Selberg . --- 151,173 ---- Eg. ! \(add-hook 'nnmail-read-incoming-hook (lambda () (start-process \"mailsend\" nil ! \"/local/bin/mailsend\" \"read\" \"mbox\"))) ! ! If you have xwatch running, this will alert it that mail has been ! read. ! ! If you use `display-time', you could use something like this: ! ! \(add-hook 'nnmail-read-incoming-hook ! (lambda () ! ;; Update the displayed time, since that will clear out ! ;; the flag that says you have mail. ! (if (eq (process-status \"display-time\") 'run) ! (display-time-filter display-time-process \"\"))))") ! ! (when (eq system-type 'windows-nt) ! (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr)) ;; Suggested by Erik Selberg . *************** Eg. *** 138,141 **** --- 176,185 ---- The hook is run in a buffer with all the new, incoming mail.") + (defvar nnmail-pre-get-new-mail-hook nil + "Hook called just before starting to handle new incoming mail.") + + (defvar nnmail-post-get-new-mail-hook nil + "Hook called just after finishing handling new incoming mail.") + ;; Suggested by Mejia Pablo J . (defvar nnmail-tmp-directory nil *************** GROUP: Mail will be stored in GROUP (a s *** 166,171 **** FIELD must match a complete field name. VALUE must match a complete ! word according to the fundamental mode syntax table. 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 --- 210,215 ---- 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. FIELD and VALUE can also be lisp symbols, in that case they are expanded *************** performed.") *** 210,215 **** "*The file name of the nnmail Message-ID cache.") ! (defvar nnmail-delete-duplicates nil ! "*If non-nil, nnmail will delete any duplicate mails it sees.") --- 254,284 ---- "*The file name of the nnmail Message-ID cache.") ! (defvar nnmail-treat-duplicates 'warn ! "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. ! Three values are legal: nil, which means that nnmail is not to keep a ! Message-ID cache; `warn', which means that nnmail should insert extra ! headers to warn the user about the duplication (this is the default); ! and `delete', which means that nnmail will delete duplicated mails. ! ! This variable can also be a function. It will be called from a buffer ! narrowed to the article in question with the Message-ID as a ! parameter. It should return nil, `warn' or `delete'.") ! ! ;;; Internal variables. ! ! (defvar nnmail-pop-password nil ! "*Password to use when reading mail from a POP server, if required.") ! ! (defvar nnmail-split-fancy-syntax-table ! (copy-syntax-table (standard-syntax-table)) ! "Syntax table used by `nnmail-split-fancy'.") ! ! (defvar nnmail-prepare-save-mail-hook nil ! "Hook called before saving mail.") ! ! (defvar nnmail-moved-inboxes nil ! "List of inboxes that have been moved.") ! ! (defvar nnmail-internal-password nil) *************** performed.") *** 223,427 **** (mail-send-and-exit nil)) - (defun nnmail-request-post-buffer (post group subject header article-buffer - info follow-to respect-poster) - (let ((method-address (cdr (assq 'to-address (nth 5 info)))) - from date to reply-to message-of - references message-id cc new-cc sendto elt) - (setq method-address - (if (and (stringp method-address) - (string= method-address "")) - nil method-address)) - (save-excursion - (set-buffer (get-buffer-create "*mail*")) - (mail-mode) - (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) - (if (and (buffer-modified-p) - (> (buffer-size) 0) - (not (y-or-n-p "Unsent mail being composed; erase it? "))) - () - (erase-buffer) - (if post - (progn - (mail-setup method-address subject nil nil nil nil) - (auto-save-mode auto-save-default)) - (save-excursion - (set-buffer article-buffer) - (goto-char (point-min)) - (narrow-to-region (point-min) - (progn (search-forward "\n\n") (point))) - (let ((buffer-read-only nil)) - (set-text-properties (point-min) (point-max) nil)) - (setq from (mail-header-from header)) - (setq date (mail-header-date header)) - (and from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (setq message-of - (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of " date)))) - (setq cc (mail-strip-quoted-names (or (mail-fetch-field "cc") ""))) - (setq to (mail-strip-quoted-names (or (mail-fetch-field "to") ""))) - (setq new-cc (rmail-dont-reply-to - (concat (or to "") - (if cc (concat (if to ", " "") cc) "")))) - (let ((rmail-dont-reply-to-names - (regexp-quote (mail-strip-quoted-names - (or method-address reply-to from ""))))) - (setq new-cc (rmail-dont-reply-to new-cc))) - (setq subject (mail-header-subject header)) - (or (string-match "^[Rr][Ee]:" subject) - (setq subject (concat "Re: " subject))) - (setq reply-to (mail-fetch-field "reply-to")) - (setq references (mail-header-references header)) - (setq message-id (mail-header-id header)) - (widen)) - (setq news-reply-yank-from from) - (setq news-reply-yank-message-id message-id) - - ;; Gather the "to" addresses out of the follow-to list and remove - ;; them as we go. - (if (and follow-to (listp follow-to)) - (while (setq elt (assoc "To" follow-to)) - (setq sendto (concat sendto (and sendto ", ") (cdr elt))) - (setq follow-to (delq elt follow-to)))) - (mail-setup (if (and follow-to (listp follow-to)) - sendto - (or method-address reply-to from "")) - subject message-of - (if (zerop (length new-cc)) nil new-cc) - article-buffer nil) - (auto-save-mode auto-save-default) - ;; Note that "To" elements should already be in the message. - (if (and follow-to (listp follow-to)) - (progn - (goto-char (point-min)) - (re-search-forward "^To:" nil t) - (beginning-of-line) - (forward-line 1) - (while follow-to - (insert - (car (car follow-to)) ": " (cdr (car follow-to)) "\n") - (setq follow-to (cdr follow-to))))) - (nnheader-insert-references references message-id))) - (current-buffer)))) - (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (erase-buffer) ! (condition-case () ! (progn (insert-file-contents file) t) ! (file-error nil))) ! (defun nnmail-article-pathname (group mail-dir) "Make pathname for GROUP." ! (concat (file-name-as-directory (expand-file-name mail-dir)) ! (nnmail-replace-chars-in-string group ?. ?/) "/")) ! ! (defun nnmail-replace-chars-in-string (string from to) ! "Replace characters in STRING from FROM to TO." ! (let ((string (substring string 0)) ;Copy string. ! (len (length string)) ! (idx 0)) ! ;; Replace all occurrences of FROM with TO. ! (while (< idx len) ! (if (= (aref string idx) from) ! (aset string idx to)) ! (setq idx (1+ idx))) ! string)) ! ! (defun nnmail-days-between (date1 date2) ! ;; Return the number of days between date1 and date2. ! (let ((d1 (mapcar (lambda (s) (and s (string-to-int s)) ) ! (timezone-parse-date date1))) ! (d2 (mapcar (lambda (s) (and s (string-to-int s)) ) ! (timezone-parse-date date2)))) ! (- (timezone-absolute-from-gregorian ! (nth 1 d1) (nth 2 d1) (car d1)) ! (timezone-absolute-from-gregorian ! (nth 1 d2) (nth 2 d2) (car d2))))) ! ! ;; Function taken from rmail.el. ! (defun nnmail-move-inbox (inbox tofile) (let ((inbox (file-truename (expand-file-name (substitute-in-file-name inbox)))) ! movemail popmail errors) ! ;; Check whether the inbox is to be moved to the special tmp dir. ! (if nnmail-tmp-directory ! (setq tofile (concat (file-name-as-directory nnmail-tmp-directory) ! (file-name-nondirectory tofile)))) ! ;; Make the filename unique. ! (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile))) ! ;; We create the directory the tofile is to reside in if it ! ;; doesn't exist. ! (or (file-exists-p (file-name-directory tofile)) ! (make-directory tofile 'parents)) ;; If getting from mail spool directory, ;; use movemail to move rather than just renaming, ;; so as to interlock with the mailer. ! (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox))) ! (setq movemail t)) ! (if popmail (setq inbox (file-name-nondirectory inbox))) ! (if movemail ! ;; On some systems, /usr/spool/mail/foo is a directory ! ;; and the actual inbox is /usr/spool/mail/foo/foo. ! (if (file-directory-p inbox) ! (setq inbox (expand-file-name (user-login-name) inbox)))) ! (if popmail ! (message "Getting mail from post office ...") ! (if (or (and (file-exists-p tofile) ! (/= 0 (nth 7 (file-attributes tofile)))) ! (and (file-exists-p inbox) ! (/= 0 (nth 7 (file-attributes inbox))))) (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 ((or (file-exists-p tofile) (and (not popmail) ! (not (file-exists-p inbox)))) ! nil) ! ((and (not movemail) (not popmail)) ! ;; Try copying. If that fails (perhaps no space), ! ;; rename instead. ! (condition-case nil ! (copy-file inbox tofile nil) ! (error ! ;; Third arg is t so we can replace existing file TOFILE. ! (rename-file inbox tofile t))) ! ;; Make the real inbox file empty. ! ;; Leaving it deleted could cause lossage ! ;; because mailers often won't create the file. ! (condition-case () ! (write-region (point) (point) inbox) ! (file-error nil))) ! (t ! (unwind-protect ! (save-excursion ! (setq errors (generate-new-buffer " *nnmail loss*")) ! (buffer-disable-undo errors) ! (call-process ! (expand-file-name nnmail-movemail-program exec-directory) ! nil errors nil inbox tofile) ! (if (not (buffer-modified-p errors)) ! ;; No output => movemail won ! nil ! (set-buffer errors) ! (subst-char-in-region (point-min) (point-max) ?\n ?\ ) ! (goto-char (point-max)) ! (skip-chars-backward " \t") ! (delete-region (point) (point-max)) ! (goto-char (point-min)) ! (if (looking-at "movemail: ") ! (delete-region (point-min) (match-end 0))) ! (beep t) ! (message "movemail: %s" ! (buffer-substring (point-min) ! (point-max))) ! (sit-for 3) ! nil))))) ! (and errors ! (buffer-name errors) ! (kill-buffer errors)) ! tofile)) ! (defun nnmail-get-active () --- 292,451 ---- (mail-send-and-exit nil)) (defun nnmail-find-file (file) "Insert FILE in server buffer safely." (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((format-alist nil) ! (after-insert-file-functions nil)) ! (condition-case () ! (progn (insert-file-contents file) t) ! (file-error nil)))) ! (defun nnmail-group-pathname (group dir &optional file) "Make pathname for GROUP." ! (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 ! (file-directory-p (concat dir group))) ! (concat dir group "/") ! ;; If not, we translate dots into slashes. ! (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) ! (or file ""))) ! ! (defun nnmail-date-to-time (date) ! "Convert DATE into time." ! (let* ((d1 (timezone-parse-date date)) ! (t1 (timezone-parse-time (aref d1 3)))) ! (apply 'encode-time ! (mapcar (lambda (el) ! (and el (string-to-number el))) ! (list ! (aref t1 2) (aref t1 1) (aref t1 0) ! (aref d1 2) (aref d1 1) (aref d1 0) ! (aref d1 4)))))) ! ! (defun nnmail-time-less (t1 t2) ! "Say whether time T1 is less than time T2." ! (or (< (car t1) (car t2)) ! (and (= (car t1) (car t2)) ! (< (nth 1 t1) (nth 1 t2))))) ! ! (defun nnmail-days-to-time (days) ! "Convert DAYS into time." ! (let* ((seconds (* 1.0 days 60 60 24)) ! (rest (expt 2 16)) ! (ms (condition-case nil (round (/ seconds rest)) ! (range-error (expt 2 16))))) ! (list ms (condition-case nil (round (- seconds (* ms rest))) ! (range-error (expt 2 16)))))) ! ! (defun nnmail-time-since (time) ! "Return the time since TIME, which is either an internal time or a date." ! (when (stringp time) ! ;; Convert date strings to internal time. ! (setq time (nnmail-date-to-time time))) ! (let* ((current (current-time)) ! (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16)))) ! (list (- (+ (car current) (if rest -1 0)) (car time)) ! (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) ! ! ;; Function rewritten from rmail.el. ! (defun nnmail-move-inbox (inbox) ! "Move INBOX to `nnmail-crash-box'." (let ((inbox (file-truename (expand-file-name (substitute-in-file-name inbox)))) ! (tofile (file-truename (expand-file-name ! (substitute-in-file-name nnmail-crash-box)))) ! movemail popmail errors password) ;; If getting from mail spool directory, ;; use movemail to move rather than just renaming, ;; so as to interlock with the mailer. ! (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox))) ! (setq movemail t)) ! (when popmail ! (setq inbox (file-name-nondirectory inbox))) ! (when (and movemail ! ;; On some systems, /usr/spool/mail/foo is a directory ! ;; and the actual inbox is /usr/spool/mail/foo/foo. ! (file-directory-p inbox)) ! (setq inbox (expand-file-name (user-login-name) inbox))) ! (if (member inbox nnmail-moved-inboxes) ! nil ! (if popmail ! (progn ! (setq nnmail-internal-password nnmail-pop-password) ! (when (and nnmail-pop-password-required (not nnmail-pop-password)) ! (setq nnmail-internal-password ! (nnmail-read-passwd ! (format "Password for %s: " ! (substring inbox (+ popmail 3)))))) ! (message "Getting mail from post office ...")) ! (when (or (and (file-exists-p tofile) ! (/= 0 (nnheader-file-size tofile))) ! (and (file-exists-p inbox) ! (/= 0 (nnheader-file-size inbox)))) (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 ! ((file-exists-p tofile) ! ;; The crash box exists already. ! t) ! ((and (not popmail) ! (not (file-exists-p inbox))) ! ;; There is no inbox. ! (setq tofile nil)) ! ((and (not movemail) (not popmail)) ! ;; Try copying. If that fails (perhaps no space), ! ;; rename instead. ! (condition-case nil ! (copy-file inbox tofile nil) ! (error ! ;; Third arg is t so we can replace existing file TOFILE. ! (rename-file inbox tofile t))) ! (push inbox nnmail-moved-inboxes) ! ;; Make the real inbox file empty. ! ;; Leaving it deleted could cause lossage ! ;; because mailers often won't create the file. ! (condition-case () ! (write-region (point) (point) inbox) ! (file-error nil))) ! (t ! ;; Use movemail. ! (unwind-protect ! (save-excursion ! (setq errors (generate-new-buffer " *nnmail loss*")) ! (buffer-disable-undo errors) ! (let ((default-directory "/")) ! (apply ! 'call-process ! (append ! (list ! (expand-file-name nnmail-movemail-program exec-directory) ! nil errors nil inbox tofile) ! (when nnmail-internal-password ! (list nnmail-internal-password))))) ! (if (not (buffer-modified-p errors)) ! ;; No output => movemail won ! (push inbox nnmail-moved-inboxes) ! (set-buffer errors) ! (subst-char-in-region (point-min) (point-max) ?\n ?\ ) ! (goto-char (point-max)) ! (skip-chars-backward " \t") ! (delete-region (point) (point-max)) ! (goto-char (point-min)) ! (if (looking-at "movemail: ") ! (delete-region (point-min) (match-end 0))) ! (beep t) ! (message (concat "movemail: " ! (buffer-substring (point-min) ! (point-max)))) ! (sit-for 3) ! (setq tofile nil)))))) ! (and errors ! (buffer-name errors) ! (kill-buffer errors)) ! tofile))) (defun nnmail-get-active () *************** nn*-request-list should have been called *** 435,474 **** (while (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) ! (setq group-assoc ! (cons (list (buffer-substring (match-beginning 1) ! (match-end 1)) ! (cons (string-to-int ! (buffer-substring (match-beginning 3) ! (match-end 3))) ! (string-to-int ! (buffer-substring (match-beginning 2) ! (match-end 2))))) ! group-assoc)))) ! ! ;; ;; In addition, add all groups mentioned in `nnmail-split-methods'. ! ;; (let ((methods (and (not (symbolp nnmail-split-methods)) ! ;; nnmail-split-methods))) ! ;; (while methods ! ;; (if (not (assoc (car (car methods)) group-assoc)) ! ;; (setq group-assoc ! ;; (cons (list (car (car methods)) (cons 1 0)) ! ;; group-assoc))) ! ;; (setq methods (cdr methods))) ! group-assoc)) (defun nnmail-save-active (group-assoc file-name) ! (let (group) ! (save-excursion ! (set-buffer (get-buffer-create " *nnmail active*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (while group-assoc ! (setq group (car group-assoc)) ! (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) ! (car (car (cdr group))))) ! (setq group-assoc (cdr group-assoc))) ! (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) ! (kill-buffer (current-buffer))))) (defun nnmail-get-split-group (file group) --- 459,485 ---- (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) ! (cons (string-to-int (match-string 3)) ! (string-to-int (match-string 2)))) ! group-assoc))) group-assoc)) (defun nnmail-save-active (group-assoc file-name) ! "Save GROUP-ASSOC in ACTIVE-FILE." ! (when file-name ! (let (group) ! (save-excursion ! (set-buffer (get-buffer-create " *nnmail active*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (while group-assoc ! (setq group (pop group-assoc)) ! (insert (format "%s %d %d y\n" (car group) (cdadr group) ! (caadr group)))) ! (unless (file-exists-p (file-name-directory file-name)) ! (make-directory (file-name-directory file-name) t)) ! (write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg) ! (kill-buffer (current-buffer)))))) (defun nnmail-get-split-group (file group) *************** nn*-request-list should have been called *** 479,483 **** (file-name-as-directory nnmail-procmail-directory)) ! "\\(.*\\)" nnmail-procmail-suffix "$") (expand-file-name file)) (substring (expand-file-name file) --- 490,494 ---- (file-name-as-directory nnmail-procmail-directory)) ! "\\([^/]*\\)" nnmail-procmail-suffix "$") (expand-file-name file)) (substring (expand-file-name file) *************** nn*-request-list should have been called *** 487,495 **** group)) ! (defun nnmail-split-incoming (incoming func &optional dont-kill group) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail." ! (let ((delim (concat "^" rmail-unix-mail-delimiter)) ! ;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group --- 498,719 ---- group)) ! (defun nnmail-process-babyl-mail-format (func) ! (let ((case-fold-search t) ! start message-id content-length do-search end) ! (while (not (eobp)) ! (goto-char (point-min)) ! (re-search-forward ! " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t) ! (goto-char (match-end 0)) ! (delete-region (match-beginning 0) (match-end 0)) ! (setq start (point)) ! ;; Skip all the headers in case there are more "From "s... ! (or (search-forward "\n\n" nil t) ! (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t) ! (search-forward " ")) ! ;; Find the Message-ID header. ! (save-excursion ! (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) ! (setq message-id (buffer-substring (match-beginning 1) ! (match-end 1))) ! ;; There is no Message-ID here, so we create one. ! (save-excursion ! (when (re-search-backward "^Message-ID:" nil t) ! (beginning-of-line) ! (insert "Original-"))) ! (forward-line -1) ! (insert "Message-ID: " (setq message-id (nnmail-message-id)) ! "\n"))) ! ;; Look for a Content-Length header. ! (if (not (save-excursion ! (and (re-search-backward ! "^Content-Length:[ \t]*\\([0-9]+\\)" start t) ! (setq content-length (string-to-int ! (buffer-substring ! (match-beginning 1) ! (match-end 1)))) ! ;; 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. ! (progn (insert "X-") t)))) ! (setq do-search t) ! (if (or (= (+ (point) content-length) (point-max)) ! (save-excursion ! (goto-char (+ (point) content-length)) ! (looking-at ""))) ! (progn ! (goto-char (+ (point) content-length)) ! (setq do-search nil)) ! (setq do-search t))) ! ;; Go to the beginning of the next article - or to the end ! ;; of the buffer. ! (if do-search ! (if (re-search-forward "^" nil t) ! (goto-char (match-beginning 0)) ! (goto-char (1- (point-max))))) ! (delete-char 1) ; delete ^_ ! (save-excursion ! (save-restriction ! (narrow-to-region start (point)) ! (goto-char (point-min)) ! (nnmail-check-duplication message-id func) ! (setq end (point-max)))) ! (goto-char end)))) ! ! (defun nnmail-search-unix-mail-delim () ! "Put point at the beginning of the next message." ! (let ((case-fold-search t) ! (delim (concat "^" message-unix-mail-delimiter)) ! found) ! (while (not found) ! (if (re-search-forward delim nil t) ! (when (or (looking-at "[^\n :]+ *:") ! (looking-at delim) ! (looking-at (concat ">" message-unix-mail-delimiter))) ! (forward-line -1) ! (setq found 'yes)) ! (setq found 'no))) ! (eq found 'yes))) ! ! (defun nnmail-process-unix-mail-format (func) ! (let ((case-fold-search t) ! (delim (concat "^" message-unix-mail-delimiter)) ! start message-id content-length end skip head-end) ! (goto-char (point-min)) ! (if (not (and (re-search-forward delim nil t) ! (goto-char (match-beginning 0)))) ! ;; Possibly wrong format? ! (error "Error, unknown mail format! (Possibly corrupted.)") ! ;; Carry on until the bitter end. ! (while (not (eobp)) ! (setq start (point) ! end nil) ! ;; Find the end of the head. ! (narrow-to-region ! start ! (if (search-forward "\n\n" nil t) ! (1- (point)) ! ;; This will never happen, but just to be on the safe side -- ! ;; if there is no head-body delimiter, we search a bit manually. ! (while (and (looking-at "From \\|[^ \t]+:") ! (not (eobp))) ! (forward-line 1) ! (point)))) ! ;; Find the Message-ID header. ! (goto-char (point-min)) ! (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) ! (setq message-id (match-string 1)) ! (save-excursion ! (when (re-search-forward "^Message-ID:" nil t) ! (beginning-of-line) ! (insert "Original-"))) ! ;; There is no Message-ID here, so we create one. ! (forward-line 1) ! (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) ! ;; Look for a Content-Length header. ! (goto-char (point-min)) ! (if (not (re-search-forward ! "^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 ! ;; use it, and we do not want to confuse other mailers by ! ;; having a (possibly) faulty header. ! (beginning-of-line) ! (insert "X-")) ! ;; Find the end of this article. ! (goto-char (point-max)) ! (widen) ! (setq head-end (point)) ! ;; We try the Content-Length value. The idea: skip over the header ! ;; separator, then check what happens content-length bytes into the ! ;; message body. This should be either the end ot the buffer, the ! ;; message separator or a blank line followed by the separator. ! ;; The blank line should probably be deleted. If neither of the ! ;; three is met, the content-length header is probably invalid. ! (when content-length ! (forward-line 1) ! (setq skip (+ (point) content-length)) ! (goto-char skip) ! (cond ((or (= skip (point-max)) ! (= (1+ skip) (point-max))) ! (setq end (point-max))) ! ((looking-at delim) ! (setq end skip)) ! ((looking-at ! (concat "[ \t]*\n\\(" delim "\\)")) ! (setq end (match-beginning 1))) ! (t (setq end nil)))) ! (if end ! (goto-char end) ! ;; 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) ! (goto-char (point-max)))) ! ;; Allow the backend to save the article. ! (save-excursion ! (save-restriction ! (narrow-to-region start (point)) ! (goto-char (point-min)) ! (nnmail-check-duplication message-id func) ! (setq end (point-max)))) ! (goto-char end))))) ! ! (defun nnmail-process-mmdf-mail-format (func) ! (let ((delim "^\^A\^A\^A\^A$") ! (case-fold-search t) ! start message-id end) ! (goto-char (point-min)) ! (if (not (and (re-search-forward delim nil t) ! (forward-line 1))) ! ;; Possibly wrong format? ! (error "Error, unknown mail format! (Possibly corrupted.)") ! ;; Carry on until the bitter end. ! (while (not (eobp)) ! (setq start (point)) ! ;; Find the end of the head. ! (narrow-to-region ! start ! (if (search-forward "\n\n" nil t) ! (1- (point)) ! ;; This will never happen, but just to be on the safe side -- ! ;; if there is no head-body delimiter, we search a bit manually. ! (while (and (looking-at "From \\|[^ \t]+:") ! (not (eobp))) ! (forward-line 1) ! (point)))) ! ;; Find the Message-ID header. ! (goto-char (point-min)) ! (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t) ! (setq message-id (match-string 1)) ! ;; There is no Message-ID here, so we create one. ! (save-excursion ! (when (re-search-backward "^Message-ID:" nil t) ! (beginning-of-line) ! (insert "Original-"))) ! (forward-line 1) ! (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) ! ;; Find the end of this article. ! (goto-char (point-max)) ! (widen) ! (if (re-search-forward delim nil t) ! (beginning-of-line) ! (goto-char (point-max))) ! ;; Allow the backend to save the article. ! (save-excursion ! (save-restriction ! (narrow-to-region start (point)) ! (goto-char (point-min)) ! (nnmail-check-duplication message-id func) ! (setq end (point-max)))) ! (goto-char end) ! (forward-line 2))))) ! ! (defun nnmail-split-incoming (incoming func &optional exit-func group) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail." ! (let (;; If this is a group-specific split, we bind the split ;; methods to just this group. (nnmail-split-methods (if (and group *************** FUNC will be called with the buffer narr *** 498,575 **** (not nnmail-resplit-incoming)) (list (list group "")) ! nnmail-split-methods)) ! start end content-length do-search message-id) (save-excursion - ;; Open the message-id cache. - (nnmail-cache-open) ;; Insert the incoming file. (set-buffer (get-buffer-create " *nnmail incoming*")) (buffer-disable-undo (current-buffer)) (erase-buffer) ! (insert-file-contents incoming) ! (goto-char (point-min)) ! (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) ! ;; Go to the beginning of the first mail... ! (if (and (re-search-forward delim nil t) ! (goto-char (match-beginning 0))) ! ;; and then carry on until the bitter end. ! (while (not (eobp)) ! (setq start (point)) ! ;; Skip all the headers in case there are more "From "s... ! (if (not (search-forward "\n\n" nil t)) ! (forward-line 1)) ! ;; Find the Message-ID header. ! (save-excursion ! (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t) ! (setq message-id (buffer-substring (match-beginning 1) ! (match-end 1))) ! ;; There is no Message-ID here, so we create one. ! (forward-line -1) ! (insert "Message-ID: " (setq message-id (nnmail-message-id)) ! "\n"))) ! ;; Look for a Content-Length header. ! (if (not (save-excursion ! (and (re-search-backward ! "^Content-Length: \\([0-9]+\\)" start t) ! (setq content-length (string-to-int ! (buffer-substring ! (match-beginning 1) ! (match-end 1)))) ! ;; 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. ! (progn (insert "X-") t)))) ! (setq do-search t) ! (if (or (= (+ (point) content-length) (point-max)) ! (save-excursion ! (goto-char (+ (point) content-length)) ! (looking-at delim))) ! (progn ! (goto-char (+ (point) content-length)) ! (setq do-search nil)) ! (setq do-search t))) ! ;; Go to the beginning of the next article - or to the end ! ;; of the buffer. ! (if do-search ! (if (re-search-forward delim nil t) ! (goto-char (match-beginning 0)) ! (goto-char (point-max)))) ! (save-excursion ! (save-restriction ! (narrow-to-region start (point)) ! (goto-char (point-min)) ! ;; If this is a duplicate message, then we do not save it. ! (if (nnmail-cache-id-exists-p message-id) ! (delete-region (point-min) (point-max)) ! (nnmail-cache-insert message-id) ! (funcall func)) ! (setq end (point-max)))) ! (goto-char end))) ! ;; Close the message-id cache. ! (nnmail-cache-close) ! (if dont-kill ! (current-buffer) ! (kill-buffer (current-buffer)))))) ;; Mail crossposts suggested by Brian Edmonds . --- 722,747 ---- (not nnmail-resplit-incoming)) (list (list group "")) ! nnmail-split-methods))) (save-excursion ;; Insert the incoming file. (set-buffer (get-buffer-create " *nnmail incoming*")) (buffer-disable-undo (current-buffer)) (erase-buffer) ! (nnheader-insert-file-contents-literally incoming) ! (unless (zerop (buffer-size)) ! (goto-char (point-min)) ! (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) ! ;; Handle both babyl, MMDF and unix mail formats, since movemail will ! ;; use the former when fetching from a mailbox, the latter when ! ;; fetches from a file. ! (cond ((or (looking-at "\^L") ! (looking-at "BABYL OPTIONS:")) ! (nnmail-process-babyl-mail-format func)) ! ((looking-at "\^A\^A\^A\^A") ! (nnmail-process-mmdf-mail-format func)) ! (t ! (nnmail-process-unix-mail-format func)))) ! (if exit-func (funcall exit-func)) ! (kill-buffer (current-buffer))))) ;; Mail crossposts suggested by Brian Edmonds . *************** FUNC will be called with the group name *** 580,590 **** (obuf (current-buffer)) (beg (point-min)) ! end group-art) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. (setq group-art ! (list (cons (car (car methods)) ! (funcall func (car (car methods)))))) ;; We do actual comparison. (save-excursion --- 752,761 ---- (obuf (current-buffer)) (beg (point-min)) ! end group-art method) (if (and (sequencep methods) (= (length methods) 1)) ;; If there is only just one group to put everything in, we ;; just return a list with just this one method in. (setq group-art ! (list (cons (caar methods) (funcall func (caar methods))))) ;; We do actual comparison. (save-excursion *************** FUNC will be called with the group name *** 592,597 **** (goto-char beg) (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) ! (set-buffer (get-buffer-create " *nnmail work*")) ! (buffer-disable-undo (current-buffer)) (erase-buffer) ;; Copy the headers into the work buffer. --- 763,767 ---- (goto-char beg) (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) ! (set-buffer nntp-server-buffer) (erase-buffer) ;; Copy the headers into the work buffer. *************** FUNC will be called with the group name *** 603,614 **** (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) (setq group-art (mapcar (lambda (group) (cons group (funcall func group))) (condition-case nil ! (funcall nnmail-split-methods) (error ! (message "\ ! Problems with `nnmail-split-methods', using `bogus' mail group") (sit-for 1) '("bogus"))))) --- 773,787 ---- (if (and (symbolp nnmail-split-methods) (fboundp nnmail-split-methods)) + ;; `nnmail-split-methods' is a function, so we just call + ;; this function here and use the result. (setq group-art (mapcar (lambda (group) (cons group (funcall func group))) (condition-case nil ! (or (funcall nnmail-split-methods) ! '("bogus")) (error ! (message ! "Error in `nnmail-split-methods'; using `bogus' mail group") (sit-for 1) '("bogus"))))) *************** Problems with `nnmail-split-methods', us *** 616,659 **** (while (and methods (or nnmail-crosspost (not group-art))) (goto-char (point-max)) ! (if (or (cdr methods) ! (not (equal "" (nth 1 (car methods))))) ! (if (and (condition-case () ! (if (stringp (nth 1 (car methods))) ! (re-search-backward ! (car (cdr (car methods))) nil t) ! ;; Suggested by Brian Edmonds ! ;; . ! (funcall (nth 1 (car methods)) ! (car (car methods)))) ! (error nil)) ! ;; Don't enter the article into the same group twice. ! (not (assoc (car (car methods)) group-art))) ! (setq group-art ! (cons (cons (car (car methods)) ! (funcall func (car (car methods)))) ! group-art))) ! (or group-art ! (setq group-art ! (list (cons (car (car methods)) ! (funcall func (car (car methods)))))))) ! (setq methods (cdr methods)))) ! (kill-buffer (current-buffer)) group-art)))) (defun nnmail-insert-lines () ! "Insert how many lines and chars there are in the body of the mail." (let (lines chars) (save-excursion (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (progn ! (setq chars (- (point-max) (point))) ! (setq lines (- (count-lines (point) (point-max)) 1)) ! (forward-char -1) ! (save-excursion ! (if (re-search-backward "^Lines: " nil t) ! (delete-region (point) (progn (forward-line 1) (point))))) ! (insert (format "Lines: %d\n" lines)) ! chars))))) (defun nnmail-insert-xref (group-alist) --- 789,831 ---- (while (and methods (or nnmail-crosspost (not group-art))) (goto-char (point-max)) ! (setq method (pop methods)) ! (if (or methods ! (not (equal "" (nth 1 method)))) ! (when (and ! (condition-case () ! (if (stringp (nth 1 method)) ! (re-search-backward (cadr method) nil t) ! ;; Function to say whether this is a match. ! (funcall (nth 1 method) (car method))) ! (error nil)) ! ;; 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 ! ;; catch-all. ! (unless group-art ! (setq group-art ! (list (cons (car method) ! (funcall func (car method))))))))) group-art)))) (defun nnmail-insert-lines () ! "Insert how many lines there are in the body of the mail. ! Return the number of characters in the body." (let (lines chars) (save-excursion (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (setq chars (- (point-max) (point))) ! (setq lines (count-lines (point) (point-max))) ! (forward-char -1) ! (save-excursion ! (when (re-search-backward "^Lines: " nil t) ! (delete-region (point) (progn (forward-line 1) (point))))) ! (beginning-of-line) ! (insert (format "Lines: %d\n" (max lines 0))) ! chars)))) (defun nnmail-insert-xref (group-alist) *************** Problems with `nnmail-split-methods', us *** 661,676 **** (save-excursion (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (progn ! (forward-char -1) ! (if (re-search-backward "^Xref: " nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! (insert (format "Xref: %s" (system-name))) ! (while group-alist ! (insert (format " %s:%d" (car (car group-alist)) ! (cdr (car group-alist)))) ! (setq group-alist (cdr group-alist))) ! (insert "\n"))))) ;; Written by byer@mv.us.adobe.com (Scott Byer). --- 833,846 ---- (save-excursion (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (forward-char -1) ! (when (re-search-backward "^Xref: " nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! (insert (format "Xref: %s" (system-name))) ! (while group-alist ! (insert (format " %s:%d" (caar group-alist) (cdar group-alist))) ! (setq group-alist (cdr group-alist))) ! (insert "\n")))) ;; Written by byer@mv.us.adobe.com (Scott Byer). *************** Problems with `nnmail-split-methods', us *** 688,692 **** "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for documentation." ! (nnmail-split-it nnmail-split-fancy)) (defvar nnmail-split-cache nil) --- 858,867 ---- "Fancy splitting method. See the documentation for the variable `nnmail-split-fancy' for documentation." ! (let ((syntab (syntax-table))) ! (unwind-protect ! (progn ! (set-syntax-table nnmail-split-fancy-syntax-table) ! (nnmail-split-it nnmail-split-fancy)) ! (set-syntax-table syntab)))) (defvar nnmail-split-cache nil) *************** See the documentation for the variable ` *** 705,710 **** (setq split (cdr split) done (nnmail-split-it (car split)))) ! done)) ((assq split nnmail-split-cache) ! ;; A compiled match expression. (goto-char (point-max)) (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) --- 880,886 ---- (setq split (cdr split) done (nnmail-split-it (car split)))) ! done)) ! ((assq split nnmail-split-cache) ! ;; A compiled match expression. (goto-char (point-max)) (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) *************** See the documentation for the variable ` *** 724,728 **** nnmail-split-abbrev-alist)) value) ! "\\>\\)"))) (setq nnmail-split-cache (cons (cons split regexp) nnmail-split-cache)) --- 900,904 ---- nnmail-split-abbrev-alist)) value) ! "\\)\\>"))) (setq nnmail-split-cache (cons (cons split regexp) nnmail-split-cache)) *************** See the documentation for the variable ` *** 735,761 **** (if (null nnmail-spool-file) ;; No spool file whatsoever. ! nil) ! (let* ((procmails ! ;; If procmail is used to get incoming mail, the files ! ;; are stored in this directory. ! (and (file-exists-p nnmail-procmail-directory) ! (directory-files ! nnmail-procmail-directory ! t (concat (if group group "") ! nnmail-procmail-suffix "$") t))) ! (p procmails)) ! ;; Remove any directories that inadvertently match the procmail ! ;; suffix, which might happen if the suffix is "". ! (while p ! (and (or (file-directory-p (car p)) ! (file-symlink-p (car p))) ! (setq procmails (delete (car p) procmails))) ! (setq p (cdr p))) ! (cond ((listp nnmail-spool-file) ! (append nnmail-spool-file procmails)) ! ((stringp nnmail-spool-file) ! (cons nnmail-spool-file procmails)) ! (t ! procmails)))) ;; Activate a backend only if it isn't already activated. --- 911,955 ---- (if (null nnmail-spool-file) ;; No spool file whatsoever. ! nil ! (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 ! t (concat (if group (concat "^" group) "") ! nnmail-procmail-suffix "$") t))) ! (p procmails) ! (crash (when (and (file-exists-p nnmail-crash-box) ! (> (nnheader-file-size ! (file-truename nnmail-crash-box)) 0)) ! (list nnmail-crash-box)))) ! ;; Remove any directories that inadvertantly match the procmail ! ;; 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 ! crash ! (cond ((and group ! (or (eq nnmail-spool-file 'procmail) ! nnmail-use-procmail) ! procmails) ! procmails) ! ((and group ! (eq nnmail-spool-file 'procmail)) ! nil) ! ((listp nnmail-spool-file) ! (append nnmail-spool-file procmails)) ! ((stringp nnmail-spool-file) ! (cons nnmail-spool-file procmails)) ! ((eq nnmail-spool-file 'pop) ! (cons (format "po:%s" (user-login-name)) procmails)) ! (t ! procmails)))))) ;; Activate a backend only if it isn't already activated. *************** See the documentation for the variable ` *** 793,820 **** (defun nnmail-message-id () ! (concat "<" (nnmail-unique-id) "@totally-fudged-out-message-id>")) ! ! (defvar nnmail-unique-id-char nil) ! ! (defun nnmail-number-base36 (num len) ! (if (if (< len 0) (<= num 0) (= len 0)) ! "" ! (concat (nnmail-number-base36 (/ num 36) (1- len)) ! (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" ! (% num 36)))))) ! ! (defun nnmail-unique-id () ! (setq nnmail-unique-id-char ! (% (1+ (or nnmail-unique-id-char (logand (random t) (1- (lsh 1 20))))) ! ;; (current-time) returns 16-bit ints, ! ;; and 2^16*25 just fits into 4 digits i base 36. ! (* 25 25))) ! (let ((tm (if (fboundp 'current-time) ! (current-time) '(12191 46742 287898)))) ! (concat ! (nnmail-number-base36 (+ (car tm) ! (lsh (% nnmail-unique-id-char 25) 16)) 4) ! (nnmail-number-base36 (+ (nth 1 tm) ! (lsh (/ nnmail-unique-id-char 25) 16)) 4)))) ;;; --- 987,991 ---- (defun nnmail-message-id () ! (concat "<" (message-unique-id) "@totally-fudged-out-message-id>")) ;;; *************** See the documentation for the variable ` *** 825,829 **** (defun nnmail-cache-open () ! (if (or (not nnmail-delete-duplicates) (and nnmail-cache-buffer (buffer-name nnmail-cache-buffer))) --- 996,1000 ---- (defun nnmail-cache-open () ! (if (or (not nnmail-treat-duplicates) (and nnmail-cache-buffer (buffer-name nnmail-cache-buffer))) *************** See the documentation for the variable ` *** 836,847 **** (and (file-exists-p nnmail-message-id-cache-file) (insert-file-contents nnmail-message-id-cache-file)) (current-buffer)))) (defun nnmail-cache-close () ! (if (or (not nnmail-cache-buffer) ! (not nnmail-delete-duplicates) ! (not (buffer-name nnmail-cache-buffer)) ! (not (buffer-modified-p nnmail-cache-buffer))) ! () ; The buffer is closed. (save-excursion (set-buffer nnmail-cache-buffer) --- 1007,1018 ---- (and (file-exists-p nnmail-message-id-cache-file) (insert-file-contents nnmail-message-id-cache-file)) + (set-buffer-modified-p nil) (current-buffer)))) (defun nnmail-cache-close () ! (when (and nnmail-cache-buffer ! nnmail-treat-duplicates ! (buffer-name nnmail-cache-buffer) ! (buffer-modified-p nnmail-cache-buffer)) (save-excursion (set-buffer nnmail-cache-buffer) *************** See the documentation for the variable ` *** 858,878 **** (write-region (point-min) (point-max) nnmail-message-id-cache-file nil 'silent) ! (set-buffer-modified-p nil)))) (defun nnmail-cache-insert (id) ! (and nnmail-delete-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (insert id "\n")))) (defun nnmail-cache-id-exists-p (id) ! (and nnmail-delete-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (search-backward id nil t)))) (provide 'nnmail) --- 1029,1200 ---- (write-region (point-min) (point-max) nnmail-message-id-cache-file nil 'silent) ! (set-buffer-modified-p nil) ! (setq nnmail-cache-buffer nil) ! ;;(kill-buffer (current-buffer)) ! ))) (defun nnmail-cache-insert (id) ! (when nnmail-treat-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (insert id "\n")))) (defun nnmail-cache-id-exists-p (id) ! (when nnmail-treat-duplicates ! (save-excursion ! (set-buffer nnmail-cache-buffer) ! (goto-char (point-max)) ! (search-backward id nil t)))) + (defun nnmail-check-duplication (message-id func) + ;; If this is a duplicate message, then we do not save it. + (let* ((duplication (nnmail-cache-id-exists-p message-id)) + (action (when duplication + (cond + ((memq nnmail-treat-duplicates '(warn delete)) + nnmail-treat-duplicates) + ((nnheader-functionp nnmail-treat-duplicates) + (funcall nnmail-treat-duplicates message-id)) + (t + nnmail-treat-duplicates))))) + (cond + ((not duplication) + (nnmail-cache-insert message-id) + (funcall func)) + ((eq action 'delete) + (delete-region (point-min) (point-max))) + ((eq action 'warn) + ;; We insert a warning. + (let ((case-fold-search t) + (newid (nnmail-message-id))) + (goto-char (point-min)) + (when (re-search-forward "^message-id:" nil t) + (beginning-of-line) + (insert "Original-")) + (beginning-of-line) + (insert + "Message-ID: " newid "\n" + "Gnus-Warning: This is a duplicate of message " message-id "\n") + (nnmail-cache-insert newid) + (funcall func))) + (t + (funcall func))))) + + ;;; Get new mail. + + (defun nnmail-get-value (&rest args) + (let ((sym (intern (apply 'format args)))) + (when (boundp sym) + (symbol-value sym)))) + + (defun nnmail-get-new-mail (method exit-func temp + &optional group spool-func) + "Read new incoming mail." + (let* ((spools (nnmail-get-spool-files group)) + (group-in group) + incoming incomings spool) + (when (and (nnmail-get-value "%s-get-new-mail" method) + nnmail-spool-file) + ;; We first activate all the groups. + (nnmail-activate method) + ;; Allow the user to hook. + (run-hooks 'nnmail-pre-get-new-mail-hook) + ;; Open the message-id cache. + (nnmail-cache-open) + ;; The we go through all the existing spool files and split the + ;; mail from each. + (while spools + (setq spool (pop spools)) + ;; We read each spool file if either the spool is a POP-mail + ;; spool, or the file exists. We can't check for the + ;; existance of POPped mail. + (when (or (string-match "^po:" spool) + (and (file-exists-p spool) + (> (nnheader-file-size (file-truename spool)) 0))) + (nnheader-message 3 "%s: Reading incoming mail..." method) + (when (and (nnmail-move-inbox spool) + (file-exists-p nnmail-crash-box)) + ;; There is new mail. We first find out if all this mail + ;; 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-crash-box (intern (format "%s-save-mail" method)) + spool-func group) + ;; Check whether the inbox is to be moved to the special tmp dir. + (setq incoming + (nnmail-make-complex-temp-name + (expand-file-name + (if nnmail-tmp-directory + (concat + (file-name-as-directory nnmail-tmp-directory) + (file-name-nondirectory (concat temp "Incoming"))) + (concat temp "Incoming"))))) + (rename-file nnmail-crash-box incoming t) + (push incoming incomings)))) + ;; If we did indeed read any incoming spools, we save all info. + (when incomings + (nnmail-save-active + (nnmail-get-value "%s-group-alist" method) + (nnmail-get-value "%s-active-file" method)) + (when exit-func + (funcall exit-func)) + (run-hooks 'nnmail-read-incoming-hook) + (nnheader-message 3 "%s: Reading incoming mail...done" method)) + ;; Close the message-id cache. + (nnmail-cache-close) + ;; Allow the user to hook. + (run-hooks 'nnmail-post-get-new-mail-hook) + ;; Delete all the temporary files. + (while incomings + (setq incoming (pop incomings)) + (and nnmail-delete-incoming + (file-exists-p incoming) + (file-writable-p incoming) + (delete-file incoming)))))) + + (defun nnmail-expired-article-p (group time force &optional inhibit) + "Say whether an article that is TIME old in GROUP should be expired." + (if force + t + (let ((days (or (and nnmail-expiry-wait-function + (funcall nnmail-expiry-wait-function group)) + nnmail-expiry-wait))) + (cond ((or (eq days 'never) + (and (not force) + inhibit)) + ;; This isn't an expirable group. + nil) + ((eq days 'immediate) + ;; We expire all articles on sight. + t) + ((equal time '(0 0)) + ;; This is an ange-ftp group, and we don't have any dates. + nil) + ((numberp days) + (setq days (nnmail-days-to-time days)) + ;; Compare the time with the current time. + (nnmail-time-less days (nnmail-time-since time))))))) + + (defvar nnmail-read-passwd nil) + (defun nnmail-read-passwd (prompt) + (unless nnmail-read-passwd + (if (load "passwd" t) + (setq nnmail-read-passwd 'read-passwd) + (autoload 'ange-ftp-read-passwd "ange-ftp") + (setq nnmail-read-passwd 'ange-ftp-read-passwd))) + (funcall nnmail-read-passwd prompt)) + + (defun nnmail-check-syntax () + "Check (and modify) the syntax of the message in the current buffer." + (save-restriction + (message-narrow-to-head) + (let ((case-fold-search t)) + (unless (re-search-forward "^Message-Id:" nil t) + (insert "Message-ID: " (nnmail-message-id) "\n"))))) + (run-hooks 'nnmail-load-hook) + (provide 'nnmail) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnmbox.el emacs-19.32/lisp/nnmbox.el *** emacs-19.31/lisp/nnmbox.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nnmbox.el Fri Jun 28 20:08:56 1996 *************** *** 1,5 **** ;;; nnmbox.el --- mail mbox access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnmbox.el --- mail mbox access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 32,48 **** (require 'nnheader) ! (require 'rmail) (require 'nnmail) ! (defvar nnmbox-mbox-file (expand-file-name "~/mbox") "The name of the mail box file in the user's home directory.") ! (defvar nnmbox-active-file (expand-file-name "~/.mbox-active") "The name of the active file for the mail box.") ! (defvar nnmbox-get-new-mail t "If non-nil, nnmbox will check the incoming mail file and split the mail.") ! (defvar nnmbox-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") --- 31,51 ---- (require 'nnheader) ! (require 'message) (require 'nnmail) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nnmbox) ! (defvoo nnmbox-mbox-file (expand-file-name "~/mbox") "The name of the mail box file in the user's home directory.") ! (defvoo nnmbox-active-file (expand-file-name "~/.mbox-active") "The name of the active file for the mail box.") ! (defvoo nnmbox-get-new-mail t "If non-nil, nnmbox will check the incoming mail file and split the mail.") ! (defvoo nnmbox-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") *************** *** 52,77 **** "nnmbox version.") ! (defvar nnmbox-current-group nil "Current nnmbox news group directory.") (defconst nnmbox-mbox-buffer nil) ! (defvar nnmbox-status-string "") ! (defvar nnmbox-group-alist nil) ! (defvar nnmbox-active-timestamp nil) ! ! ! ! (defvar nnmbox-current-server nil) ! (defvar nnmbox-server-alist nil) ! (defvar nnmbox-server-variables ! (list ! (list 'nnmbox-mbox-file nnmbox-mbox-file) ! (list 'nnmbox-active-file nnmbox-active-file) ! (list 'nnmbox-get-new-mail nnmbox-get-new-mail) ! '(nnmbox-current-group nil) ! '(nnmbox-status-string "") ! '(nnmbox-group-alist nil))) --- 55,67 ---- "nnmbox version.") ! (defvoo nnmbox-current-group nil "Current nnmbox news group directory.") (defconst nnmbox-mbox-buffer nil) ! (defvoo nnmbox-status-string "") ! (defvoo nnmbox-group-alist nil) ! (defvoo nnmbox-active-timestamp nil) *************** *** 79,83 **** ;;; Interface functions ! (defun nnmbox-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) --- 69,75 ---- ;;; Interface functions ! (nnoo-define-basics nnmbox) ! ! (deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old) (save-excursion (set-buffer nntp-server-buffer) *************** *** 86,155 **** (count 0) article art-string start stop) ! (nnmbox-possibly-change-newsgroup newsgroup) ! (if (stringp (car sequence)) ! 'headers ! (while sequence ! (setq article (car sequence)) ! (setq art-string (nnmbox-article-string article)) ! (set-buffer nnmbox-mbox-buffer) ! (if (or (search-forward art-string nil t) ! (progn (goto-char (point-min)) ! (search-forward art-string nil t))) ! (progn ! (setq start ! (save-excursion ! (re-search-backward ! (concat "^" rmail-unix-mail-delimiter) nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nnmbox-mbox-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq sequence (cdr sequence)) ! (setq count (1+ count)) ! (and (numberp nnmail-large-newsgroup) ! (> number nnmail-large-newsgroup) ! (zerop (% count 20)) ! gnus-verbose-backends ! (message "nnmbox: Receiving headers... %d%%" ! (/ (* count 100) number)))) ! (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! gnus-verbose-backends ! (message "nnmbox: Receiving headers...done")) ! ! ;; Fold continuation lines. ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! 'headers)))) ! ! (defun nnmbox-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nnmbox-current-server) ! t ! (if nnmbox-current-server ! (setq nnmbox-server-alist ! (cons (list nnmbox-current-server ! (nnheader-save-variables nnmbox-server-variables)) ! nnmbox-server-alist))) ! (let ((state (assoc server nnmbox-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nnmbox-server-alist (delq state nnmbox-server-alist))) ! (nnheader-set-init-variables nnmbox-server-variables defs))) ! (setq nnmbox-current-server server))) ! ! (defun nnmbox-close-server (&optional server) t) ! (defun nnmbox-server-opened (&optional server) ! (and (equal server nnmbox-current-server) nnmbox-mbox-buffer (buffer-name nnmbox-mbox-buffer) --- 78,141 ---- (count 0) article art-string start stop) ! (nnmbox-possibly-change-newsgroup newsgroup server) ! (while sequence ! (setq article (car sequence)) ! (setq art-string (nnmbox-article-string article)) ! (set-buffer nnmbox-mbox-buffer) ! (if (or (search-forward art-string nil t) ! (progn (goto-char (point-min)) ! (search-forward art-string nil t))) ! (progn ! (setq start ! (save-excursion ! (re-search-backward ! (concat "^" message-unix-mail-delimiter) nil t) ! (point))) ! (search-forward "\n\n" nil t) ! (setq stop (1- (point))) ! (set-buffer nntp-server-buffer) ! (insert (format "221 %d Article retrieved.\n" article)) ! (insert-buffer-substring nnmbox-mbox-buffer start stop) ! (goto-char (point-max)) ! (insert ".\n"))) ! (setq sequence (cdr sequence)) ! (setq count (1+ count)) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! (zerop (% count 20)) ! (nnheader-message 5 "nnmbox: Receiving headers... %d%%" ! (/ (* count 100) number)))) ! ! (and (numberp nnmail-large-newsgroup) ! (> number nnmail-large-newsgroup) ! (nnheader-message 5 "nnmbox: Receiving headers...done")) ! ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines) ! 'headers))) ! ! (deffoo nnmbox-open-server (server &optional defs) ! (nnoo-change-server 'nnmbox server defs) ! (cond ! ((not (file-exists-p nnmbox-mbox-file)) ! (nnmbox-close-server) ! (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) ! ((file-directory-p nnmbox-mbox-file) ! (nnmbox-close-server) ! (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file)) ! (t ! (nnheader-report 'nnmbox "Opened server %s using mbox %s" server ! nnmbox-mbox-file) ! t))) ! ! (deffoo nnmbox-close-server (&optional server) ! (when (and nnmbox-mbox-buffer ! (buffer-name nnmbox-mbox-buffer)) ! (kill-buffer nnmbox-mbox-buffer)) ! (nnoo-close-server 'nnmbox server) t) ! (deffoo nnmbox-server-opened (&optional server) ! (and (nnoo-current-server-p 'nnmbox server) nnmbox-mbox-buffer (buffer-name nnmbox-mbox-buffer) *************** *** 157,240 **** (buffer-name nntp-server-buffer))) ! (defun nnmbox-status-message (&optional server) ! nnmbox-status-string) ! ! (defun nnmbox-request-article (article &optional newsgroup server buffer) ! (nnmbox-possibly-change-newsgroup newsgroup) ! (if (stringp article) ! nil ! (save-excursion ! (set-buffer nnmbox-mbox-buffer) ! (goto-char (point-min)) ! (if (search-forward (nnmbox-article-string article) nil t) ! (let (start stop) ! (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) ! (setq start (point)) ! (forward-line 1) ! (or (and (re-search-forward ! (concat "^" rmail-unix-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring nnmbox-mbox-buffer start stop) ! (goto-char (point-min)) ! (while (looking-at "From ") ! (delete-char 5) ! (insert "X-From-Line: ") ! (forward-line 1)) ! t)))))) ! ! (defun nnmbox-request-group (group &optional server dont-check) (save-excursion ! (if (nnmbox-possibly-change-newsgroup group) ! (if dont-check ! t ! (nnmbox-get-new-mail group) ! (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let ((active (assoc group nnmbox-group-alist))) ! (insert (format "211 %d %d %d %s\n" ! (1+ (- (cdr (car (cdr active))) ! (car (car (cdr active))))) ! (car (car (cdr active))) ! (cdr (car (cdr active))) ! (car active)))) ! t))))) ! (defun nnmbox-close-group (group &optional server) t) ! (defun nnmbox-request-list (&optional server) ! (if server (nnmbox-get-new-mail)) (save-excursion ! (or (nnmail-find-file nnmbox-active-file) ! (progn ! (setq nnmbox-group-alist (nnmail-get-active)) ! (nnmail-save-active nnmbox-group-alist nnmbox-active-file) ! (nnmail-find-file nnmbox-active-file))))) ! (defun nnmbox-request-newgroups (date &optional server) (nnmbox-request-list server)) ! (defun nnmbox-request-list-newsgroups (&optional server) ! (setq nnmbox-status-string "nnmbox: LIST NEWSGROUPS is not implemented.") ! nil) ! (defun nnmbox-request-post (&optional server) ! (mail-send-and-exit nil)) ! ! (defalias 'nnmbox-request-post-buffer 'nnmail-request-post-buffer) ! ! (defun nnmbox-request-expire-articles (articles newsgroup &optional server force) ! (nnmbox-possibly-change-newsgroup newsgroup) ! (let* ((days (or (and nnmail-expiry-wait-function ! (funcall nnmail-expiry-wait-function newsgroup)) ! nnmail-expiry-wait)) ! (is-old t) rest) (nnmail-activate 'nnmbox) --- 143,224 ---- (buffer-name nntp-server-buffer))) ! (deffoo nnmbox-request-article (article &optional newsgroup server buffer) ! (nnmbox-possibly-change-newsgroup newsgroup server) (save-excursion ! (set-buffer nnmbox-mbox-buffer) ! (goto-char (point-min)) ! (if (search-forward (nnmbox-article-string article) nil t) ! (let (start stop) ! (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) ! (setq start (point)) ! (forward-line 1) ! (or (and (re-search-forward ! (concat "^" message-unix-mail-delimiter) nil t) ! (forward-line -1)) ! (goto-char (point-max))) ! (setq stop (point)) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer))) (set-buffer nntp-server-buffer) (erase-buffer) ! (insert-buffer-substring nnmbox-mbox-buffer start stop) ! (goto-char (point-min)) ! (while (looking-at "From ") ! (delete-char 5) ! (insert "X-From-Line: ") ! (forward-line 1)) ! (if (numberp article) ! (cons nnmbox-current-group article) ! (nnmbox-article-group-number))))))) ! ! (deffoo nnmbox-request-group (group &optional server dont-check) ! (let ((active (cadr (assoc group nnmbox-group-alist)))) ! (cond ! ((or (null active) ! (null (nnmbox-possibly-change-newsgroup group server))) ! (nnheader-report 'nnmbox "No such group: %s" group)) ! (dont-check ! (nnheader-report 'nnmbox "Selected group %s" group) ! (nnheader-insert "")) ! (t ! (nnheader-report 'nnmbox "Selected group %s" group) ! (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-read-mbox) ! (nnmail-get-new-mail ! 'nnmbox ! (lambda () ! (save-excursion ! (set-buffer nnmbox-mbox-buffer) ! (save-buffer))) ! nnmbox-mbox-file group ! (lambda () ! (save-excursion ! (let ((in-buf (current-buffer))) ! (set-buffer nnmbox-mbox-buffer) ! (goto-char (point-max)) ! (insert-buffer-substring in-buf))) ! (nnmail-save-active nnmbox-group-alist nnmbox-active-file)))) ! (deffoo nnmbox-close-group (group &optional server) t) ! (deffoo nnmbox-request-list (&optional server) (save-excursion ! (nnmail-find-file nnmbox-active-file) ! (setq nnmbox-group-alist (nnmail-get-active)))) ! (deffoo nnmbox-request-newgroups (date &optional server) (nnmbox-request-list server)) ! (deffoo nnmbox-request-list-newsgroups (&optional server) ! (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) ! (deffoo nnmbox-request-expire-articles (articles newsgroup &optional server force) ! (nnmbox-possibly-change-newsgroup newsgroup server) ! (let* ((is-old t) rest) (nnmail-activate 'nnmbox) *************** *** 245,258 **** (goto-char (point-min)) (if (search-forward (nnmbox-article-string (car articles)) nil t) ! (if (or force ! (setq is-old ! (> (nnmail-days-between ! (current-time-string) ! (buffer-substring ! (point) (progn (end-of-line) (point)))) ! days))) (progn ! (and gnus-verbose-backends ! (message "Deleting article %s..." (car articles))) (nnmbox-delete-mail)) (setq rest (cons (car articles) rest)))) --- 229,240 ---- (goto-char (point-min)) (if (search-forward (nnmbox-article-string (car articles)) nil t) ! (if (setq is-old ! (nnmail-expired-article-p ! newsgroup ! (buffer-substring ! (point) (progn (end-of-line) (point))) force)) (progn ! (nnheader-message 5 "Deleting article %d in %s..." ! (car articles) newsgroup) (nnmbox-delete-mail)) (setq rest (cons (car articles) rest)))) *************** *** 270,276 **** (nconc rest articles)))) ! (defun nnmbox-request-move-article (article group server accept-form &optional last) ! (nnmbox-possibly-change-newsgroup group) (let ((buf (get-buffer-create " *nnmbox move*")) result) --- 252,258 ---- (nconc rest articles)))) ! (deffoo nnmbox-request-move-article (article group server accept-form &optional last) ! (nnmbox-possibly-change-newsgroup group server) (let ((buf (get-buffer-create " *nnmbox move*")) result) *************** *** 299,303 **** result)) ! (defun nnmbox-request-accept-article (group &optional last) (let ((buf (current-buffer)) result) --- 281,287 ---- result)) ! (deffoo nnmbox-request-accept-article (group &optional server last) ! (nnmbox-possibly-change-newsgroup group server) ! (nnmail-check-syntax) (let ((buf (current-buffer)) result) *************** *** 318,321 **** --- 302,306 ---- (save-excursion (set-buffer nnmbox-mbox-buffer) + (goto-char (point-max)) (insert-buffer-substring buf) (and last (save-buffer)) *************** *** 324,328 **** (car result))) ! (defun nnmbox-request-replace-article (article group buffer) (nnmbox-possibly-change-newsgroup group) (save-excursion --- 309,313 ---- (car result))) ! (deffoo nnmbox-request-replace-article (article group buffer) (nnmbox-possibly-change-newsgroup group) (save-excursion *************** *** 336,339 **** --- 321,366 ---- t))) + (deffoo nnmbox-request-delete-group (group &optional force server) + (nnmbox-possibly-change-newsgroup group server) + ;; Delete all articles in GROUP. + (if (not force) + () ; Don't delete the articles. + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-min)) + ;; Delete all articles in this group. + (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) + found) + (while (search-forward ident nil t) + (setq found t) + (nnmbox-delete-mail)) + (and found (save-buffer))))) + ;; Remove the group from all structures. + (setq nnmbox-group-alist + (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) + nnmbox-current-group nil) + ;; Save the active file. + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + t) + + (deffoo nnmbox-request-rename-group (group new-name &optional server) + (nnmbox-possibly-change-newsgroup group server) + (save-excursion + (set-buffer nnmbox-mbox-buffer) + (goto-char (point-min)) + (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) + (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) + found) + (while (search-forward ident nil t) + (replace-match new-ident t t) + (setq found t)) + (and found (save-buffer)))) + (let ((entry (assoc group nnmbox-group-alist))) + (and entry (setcar entry new-name)) + (setq nnmbox-current-group nil) + ;; Save the new group alist. + (nnmail-save-active nnmbox-group-alist nnmbox-active-file) + t)) + ;;; Internal functions. *************** *** 353,362 **** (narrow-to-region (save-excursion ! (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn (forward-line 1) ! (or (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) --- 380,389 ---- (narrow-to-region (save-excursion ! (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) (if leave-delim (progn (forward-line 1) (point)) (match-beginning 0))) (progn (forward-line 1) ! (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) (if (and (not (bobp)) leave-delim) *************** *** 369,373 **** (delete-region (point-min) (point-max)))))) ! (defun nnmbox-possibly-change-newsgroup (newsgroup) (if (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) --- 396,403 ---- (delete-region (point-min) (point-max)))))) ! (defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) ! (when (and server ! (not (nnmbox-server-opened server))) ! (nnmbox-open-server server)) (if (or (not nnmbox-mbox-buffer) (not (buffer-name nnmbox-mbox-buffer))) *************** *** 381,389 **** (if newsgroup (if (assoc newsgroup nnmbox-group-alist) ! (setq nnmbox-current-group newsgroup)))) (defun nnmbox-article-string (article) ! (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" ! (int-to-string article) " ")) (defun nnmbox-save-mail (&optional group) --- 411,431 ---- (if newsgroup (if (assoc newsgroup nnmbox-group-alist) ! (setq nnmbox-current-group newsgroup)) ! t)) (defun nnmbox-article-string (article) ! (if (numberp article) ! (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" ! (int-to-string article) " ") ! (concat "\nMessage-ID: " article))) ! ! (defun nnmbox-article-group-number () ! (save-excursion ! (goto-char (point-min)) ! (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " ! nil t) ! (cons (buffer-substring (match-beginning 1) (match-end 1)) ! (string-to-int ! (buffer-substring (match-beginning 2) (match-end 2))))))) (defun nnmbox-save-mail (&optional group) *************** *** 391,399 **** (let* ((nnmail-split-methods (if group (list (list group "")) nnmail-split-methods)) ! (group-art (nreverse (nnmail-article-group 'nnmbox-active-number)))) (nnmail-insert-lines) (nnmail-insert-xref group-art) (nnmbox-insert-newsgroup-line group-art) ! (run-hooks 'nnml-prepare-save-mail-hook) group-art)) --- 433,453 ---- (let* ((nnmail-split-methods (if group (list (list group "")) nnmail-split-methods)) ! (group-art (nreverse (nnmail-article-group 'nnmbox-active-number))) ! (delim (concat "^" message-unix-mail-delimiter))) ! (goto-char (point-min)) ! ;; This might come from somewhere else. ! (unless (looking-at delim) ! (insert "From nobody " (current-time-string) "\n") ! (goto-char (point-min))) ! ;; Quote all "From " lines in the article. ! (forward-line 1) ! (while (re-search-forward delim nil t) ! (beginning-of-line) ! (insert "> ")) (nnmail-insert-lines) (nnmail-insert-xref group-art) (nnmbox-insert-newsgroup-line group-art) ! (run-hooks 'nnmail-prepare-save-mail-hook) ! (run-hooks 'nnmbox-prepare-save-mail-hook) group-art)) *************** *** 406,410 **** (while group-art (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" ! (car (car group-art)) (cdr (car group-art)) (current-time-string))) (setq group-art (cdr group-art))))) --- 460,464 ---- (while group-art (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" ! (caar group-art) (cdar group-art) (current-time-string))) (setq group-art (cdr group-art))))) *************** *** 413,417 **** (defun nnmbox-active-number (group) ;; Find the next article number in GROUP. ! (let ((active (car (cdr (assoc group nnmbox-group-alist))))) (if active (setcdr active (1+ (cdr active))) --- 467,471 ---- (defun nnmbox-active-number (group) ;; Find the next article number in GROUP. ! (let ((active (cadr (assoc group nnmbox-group-alist)))) (if active (setcdr active (1+ (cdr active))) *************** *** 431,443 **** (save-excursion (set-buffer nnmbox-mbox-buffer) ! (= (buffer-size) (nth 7 (file-attributes nnmbox-mbox-file))))) () (save-excursion ! (let ((delim (concat "^" rmail-unix-mail-delimiter)) ! start end) (set-buffer (setq nnmbox-mbox-buffer ! (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) (goto-char (point-min)) (while (re-search-forward delim nil t) --- 485,514 ---- (save-excursion (set-buffer nnmbox-mbox-buffer) ! (= (buffer-size) (nnheader-file-size nnmbox-mbox-file)))) () (save-excursion ! (let ((delim (concat "^" message-unix-mail-delimiter)) ! (alist nnmbox-group-alist) ! start end number) (set-buffer (setq nnmbox-mbox-buffer ! (nnheader-find-file-noselect nnmbox-mbox-file nil 'raw))) (buffer-disable-undo (current-buffer)) + + ;; Go through the group alist and compare against + ;; the mbox file. + (while alist + (goto-char (point-max)) + (when (and (re-search-backward + (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " + (caar alist)) nil t) + (>= (setq 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) *************** *** 457,508 **** (nnmbox-save-mail)))) (goto-char end)))))) - - (defun nnmbox-get-new-mail (&optional group) - "Read new incoming mail." - (let* ((spools (nnmail-get-spool-files group)) - (group-in group) - incoming incomings) - (nnmbox-read-mbox) - (if (or (not nnmbox-get-new-mail) (not nnmail-spool-file)) - () - ;; We go through all the existing spool files and split the - ;; mail from each. - (while spools - (and - (file-exists-p (car spools)) - (> (nth 7 (file-attributes (car spools))) 0) - (progn - (and gnus-verbose-backends - (message "nnmbox: Reading incoming mail...")) - (if (not (setq incoming - (nnmail-move-inbox - (car spools) - (concat nnmbox-mbox-file "-Incoming")))) - () - (setq incomings (cons incoming incomings)) - (save-excursion - (setq group (nnmail-get-split-group (car spools) group-in)) - (let ((in-buf (nnmail-split-incoming - incoming 'nnmbox-save-mail t group))) - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-max)) - (insert-buffer-substring in-buf) - (kill-buffer in-buf)))))) - (setq spools (cdr spools))) - ;; If we did indeed read any incoming spools, we save all info. - (and (buffer-modified-p nnmbox-mbox-buffer) - (save-excursion - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - (set-buffer nnmbox-mbox-buffer) - (save-buffer))) - (if incomings (run-hooks 'nnmail-read-incoming-hook)) - (while incomings - (setq incoming (car incomings)) - (and nnmail-delete-incoming - (file-exists-p incoming) - (file-writable-p incoming) - (delete-file incoming)) - (setq incomings (cdr incomings)))))) - (provide 'nnmbox) --- 528,531 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnmh.el emacs-19.32/lisp/nnmh.el *** emacs-19.31/lisp/nnmh.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nnmh.el Fri Jun 28 20:08:31 1996 *************** *** 1,5 **** ;;; nnmh.el --- mhspool access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnmh.el --- mhspool access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 33,50 **** (require 'nnheader) - (require 'rmail) (require 'nnmail) (require 'gnus) ! (defvar nnmh-directory "~/Mail/" "*Mail spool directory.") ! (defvar nnmh-get-new-mail t "*If non-nil, nnmh will check the incoming mail file and split the mail.") ! (defvar nnmh-prepare-save-mail-hook nil "*Hook run narrowed to an article before saving.") ! (defvar nnmh-be-safe nil "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") --- 32,52 ---- (require 'nnheader) (require 'nnmail) (require 'gnus) + (require 'nnoo) + (eval-and-compile (require 'cl)) + + (nnoo-declare nnmh) ! (defvoo nnmh-directory message-directory "*Mail spool directory.") ! (defvoo nnmh-get-new-mail t "*If non-nil, nnmh will check the incoming mail file and split the mail.") ! (defvoo nnmh-prepare-save-mail-hook nil "*Hook run narrowed to an article before saving.") ! (defvoo nnmh-be-safe nil "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") *************** *** 54,74 **** "nnmh version.") ! (defvar nnmh-current-directory nil "Current news group directory.") ! (defvar nnmh-status-string "") ! (defvar nnmh-group-alist nil) ! ! ! ! (defvar nnmh-current-server nil) ! (defvar nnmh-server-alist nil) ! (defvar nnmh-server-variables ! (list ! (list 'nnmh-directory nnmh-directory) ! (list 'nnmh-get-new-mail nnmh-get-new-mail) ! '(nnmh-current-directory nil) ! '(nnmh-status-string "") ! '(nnmh-group-alist))) --- 56,64 ---- "nnmh version.") ! (defvoo nnmh-current-directory nil "Current news group directory.") ! (defvoo nnmh-status-string "") ! (defvoo nnmh-group-alist nil) *************** *** 76,110 **** ;;; Interface functions. ! (defun nnmh-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let* ((file nil) ! (number (length sequence)) (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) (count 0) beg article) ! (nnmh-possibly-change-directory newsgroup) ! (if (stringp (car sequence)) 'headers ! (while sequence ! (setq article (car sequence)) ! (setq file ! (concat nnmh-current-directory (int-to-string article))) ! (if (and (file-exists-p file) ! (not (file-directory-p file))) ! (progn ! (insert (format "221 %d Article retrieved.\n" article)) ! (setq beg (point)) ! (nnheader-insert-head file) ! (goto-char beg) ! (if (search-forward "\n\n" nil t) ! (forward-char -1) ! (goto-char (point-max)) ! (insert "\n\n")) ! (insert ".\n") ! (delete-region (point) (point-max)))) ! (setq sequence (cdr sequence)) (setq count (1+ count)) --- 66,102 ---- ;;; Interface functions. ! (nnoo-define-basics nnmh) ! ! (deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old) (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) (let* ((file nil) ! (number (length articles)) (large (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup))) (count 0) beg article) ! (nnmh-possibly-change-directory newsgroup server) ! ;; We don't support fetching by Message-ID. ! (if (stringp (car articles)) 'headers ! (while articles ! (when (and (file-exists-p ! (setq file (concat (file-name-as-directory ! nnmh-current-directory) ! (int-to-string ! (setq article (pop articles)))))) ! (not (file-directory-p file))) ! (insert (format "221 %d Article retrieved.\n" article)) ! (setq beg (point)) ! (nnheader-insert-head file) ! (goto-char beg) ! (if (search-forward "\n\n" nil t) ! (forward-char -1) ! (goto-char (point-max)) ! (insert "\n\n")) ! (insert ".\n") ! (delete-region (point) (point-max))) (setq count (1+ count)) *************** *** 116,155 **** (and large (message "nnmh: Receiving headers...done")) ! ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) 'headers)))) ! (defun nnmh-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nnmh-current-server) ! t ! (if nnmh-current-server ! (setq nnmh-server-alist ! (cons (list nnmh-current-server ! (nnheader-save-variables nnmh-server-variables)) ! nnmh-server-alist))) ! (let ((state (assoc server nnmh-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nnmh-server-alist (delq state nnmh-server-alist))) ! (nnheader-set-init-variables nnmh-server-variables defs))) ! (setq nnmh-current-server server))) ! ! (defun nnmh-close-server (&optional server) ! t) ! ! (defun nnmh-server-opened (&optional server) ! (and (equal server nnmh-current-server) ! nntp-server-buffer ! (buffer-name nntp-server-buffer))) ! ! (defun nnmh-status-message (&optional server) ! nnmh-status-string) ! (defun nnmh-request-article (id &optional newsgroup server buffer) ! (nnmh-possibly-change-directory newsgroup) (let ((file (if (stringp id) nil --- 108,134 ---- (and large (message "nnmh: Receiving headers...done")) ! (nnheader-fold-continuation-lines) 'headers)))) ! (deffoo nnmh-open-server (server &optional defs) ! (nnoo-change-server 'nnmh server defs) ! (when (not (file-exists-p nnmh-directory)) ! (condition-case () ! (make-directory nnmh-directory t) ! (error t))) ! (cond ! ((not (file-exists-p nnmh-directory)) ! (nnmh-close-server) ! (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) ! ((not (file-directory-p (file-truename nnmh-directory))) ! (nnmh-close-server) ! (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory)) ! (t ! (nnheader-report 'nnmh "Opened server %s using directory %s" ! server nnmh-directory) ! t))) ! (deffoo nnmh-request-article (id &optional newsgroup server buffer) ! (nnmh-possibly-change-directory newsgroup server) (let ((file (if (stringp id) nil *************** *** 159,255 **** (file-exists-p file) (not (file-directory-p file)) ! (save-excursion (nnmail-find-file file))))) ! (defun nnmh-request-group (group &optional server dont-check) ! (and nnmh-get-new-mail (or dont-check (nnmh-get-new-mail group))) ! (let ((pathname (nnmh-article-pathname group nnmh-directory)) dir) ! (if (file-directory-p pathname) ! (progn ! (setq nnmh-current-directory pathname) ! (and nnmh-get-new-mail ! nnmh-be-safe ! (nnmh-update-gnus-unreads group)) ! (or dont-check ! (progn ! (setq dir ! (sort ! (mapcar ! (function ! (lambda (name) ! (string-to-int name))) ! (directory-files pathname nil "^[0-9]+$" t)) ! '<)) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if dir ! (insert (format "211 %d %d %d %s\n" (length dir) ! (car dir) ! (progn (while (cdr dir) ! (setq dir (cdr dir))) ! (car dir)) ! group)) ! (insert (format "211 0 1 0 %s\n" group)))))) ! t) ! (setq nnmh-status-string "No such group") ! nil))) ! (defun nnmh-request-list (&optional server dir) ! (or dir ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (setq dir (file-truename (file-name-as-directory nnmh-directory))))) (setq dir (expand-file-name dir)) ;; Recurse down all directories. (let ((dirs (and (file-readable-p dir) (> (nth 1 (file-attributes (file-chase-links dir))) 2) ! (directory-files dir t nil t)))) ! (while dirs ! (if (and (not (string-match "/\\.\\.?$" (car dirs))) ! (file-directory-p (car dirs)) ! (file-readable-p (car dirs))) ! (nnmh-request-list nil (car dirs))) ! (setq dirs (cdr dirs)))) ;; For each directory, generate an active file line. ! (if (not (string= (expand-file-name nnmh-directory) dir)) ! (let ((files (mapcar ! (lambda (name) (string-to-int name)) ! (directory-files dir nil "^[0-9]+$" t)))) ! (if (null files) ! () ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-max)) ! (insert ! (format ! "%s %d %d y\n" ! (progn ! (string-match ! (file-truename (file-name-as-directory ! (expand-file-name nnmh-directory))) dir) ! (nnmail-replace-chars-in-string ! (substring dir (match-end 0)) ?/ ?.)) ! (apply (function max) files) ! (apply (function min) files))))))) ! (setq nnmh-group-alist (nnmail-get-active)) ! (and server nnmh-get-new-mail (nnmh-get-new-mail)) t) ! (defun nnmh-request-newgroups (date &optional server) (nnmh-request-list server)) ! (defun nnmh-request-post (&optional server) ! (mail-send-and-exit nil)) ! ! (defalias 'nnmh-request-post-buffer 'nnmail-request-post-buffer) ! ! (defun nnmh-request-expire-articles (articles newsgroup &optional server force) ! (nnmh-possibly-change-directory newsgroup) ! (let* ((days (or (and nnmail-expiry-wait-function ! (funcall nnmail-expiry-wait-function newsgroup)) ! nnmail-expiry-wait)) ! (active-articles (mapcar (function --- 138,233 ---- (file-exists-p file) (not (file-directory-p file)) ! (save-excursion (nnmail-find-file file)) ! (string-to-int (file-name-nondirectory file))))) ! (deffoo nnmh-request-group (group &optional server dont-check) ! (let ((pathname (nnmail-group-pathname group nnmh-directory)) dir) ! (cond ! ((not (file-directory-p pathname)) ! (nnheader-report ! 'nnmh "Can't select group (no such directory): %s" group)) ! (t ! (setq nnmh-current-directory pathname) ! (and nnmh-get-new-mail ! nnmh-be-safe ! (nnmh-update-gnus-unreads group)) ! (cond ! (dont-check ! (nnheader-report 'nnmh "Selected group %s" group) ! t) ! (t ! ;; Re-scan the directory if it's on a foreign system. ! (nnheader-re-read-dir pathname) ! (setq dir ! (sort ! (mapcar (lambda (name) (string-to-int name)) ! (directory-files pathname nil "^[0-9]+$" t)) ! '<)) ! (cond ! (dir ! (nnheader-report 'nnmh "Selected group %s" group) ! (nnheader-insert ! "211 %d %d %d %s\n" (length dir) (car dir) ! (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) ! group)) ! (t ! (nnheader-report 'nnmh "Empty group %s" group) ! (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) ! ! (deffoo nnmh-request-scan (&optional group server) ! (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) ! ! (deffoo nnmh-request-list (&optional server dir) ! (nnheader-insert "") ! (let ((nnmh-toplev ! (or dir (file-truename (file-name-as-directory nnmh-directory))))) ! (nnmh-request-list-1 nnmh-toplev)) ! (setq nnmh-group-alist (nnmail-get-active)) ! t) ! (defvar nnmh-toplev) ! (defun nnmh-request-list-1 (dir) (setq dir (expand-file-name dir)) ;; Recurse down all directories. (let ((dirs (and (file-readable-p dir) (> (nth 1 (file-attributes (file-chase-links dir))) 2) ! (directory-files dir t nil t))) ! dir) ! ;; Recurse down directories. ! (while (setq dir (pop dirs)) ! (when (and (not (member (file-name-nondirectory dir) '("." ".."))) ! (file-directory-p dir) ! (file-readable-p dir)) ! (nnmh-request-list-1 dir)))) ;; For each directory, generate an active file line. ! (unless (string= (expand-file-name nnmh-toplev) dir) ! (let ((files (mapcar ! (lambda (name) (string-to-int name)) ! (directory-files dir nil "^[0-9]+$" t)))) ! (when files ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-max)) ! (insert ! (format ! "%s %d %d y\n" ! (progn ! (string-match ! (regexp-quote ! (file-truename (file-name-as-directory ! (expand-file-name nnmh-toplev)))) dir) ! (nnheader-replace-chars-in-string ! (substring dir (match-end 0)) ?/ ?.)) ! (apply 'max files) ! (apply 'min files))))))) t) ! (deffoo nnmh-request-newgroups (date &optional server) (nnmh-request-list server)) ! (deffoo nnmh-request-expire-articles (articles newsgroup &optional server force) ! (nnmh-possibly-change-directory newsgroup server) ! (let* ((active-articles (mapcar (function *************** *** 257,261 **** (string-to-int name))) (directory-files nnmh-current-directory nil "^[0-9]+$" t))) - (max-article (and active-articles (apply 'max active-articles))) (is-old t) article rest mod-time) --- 235,238 ---- *************** *** 266,285 **** (int-to-string (car articles)))) (if (setq mod-time (nth 5 (file-attributes article))) ! (if (and (or (not nnmail-keep-last-article) ! (not max-article) ! (not (= (car articles) max-article))) ! (not (equal mod-time '(0 0))) ! (or force ! (setq is-old ! (> (nnmail-days-between ! (current-time-string) ! (current-time-string mod-time)) ! days)))) (progn ! (and gnus-verbose-backends ! (message "Deleting article %s..." article)) (condition-case () ! (delete-file article) (file-error (setq rest (cons (car articles) rest))))) (setq rest (cons (car articles) rest)))) --- 243,257 ---- (int-to-string (car articles)))) (if (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..." ! article newsgroup) (condition-case () ! (funcall nnmail-delete-file-function article) (file-error + (nnheader-message 1 "Couldn't delete article %s in %s" + article newsgroup) (setq rest (cons (car articles) rest))))) (setq rest (cons (car articles) rest)))) *************** *** 288,299 **** (nconc rest articles))) ! (defun nnmh-close-group (group &optional server) t) ! (defun nnmh-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) (and (nnmh-request-article article group server) (save-excursion --- 260,272 ---- (nconc rest articles))) ! (deffoo nnmh-close-group (group &optional server) t) ! (deffoo nnmh-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnmh move*")) result) (and + (nnmh-deletable-article-p group article) (nnmh-request-article article group server) (save-excursion *************** *** 303,313 **** (kill-buffer (current-buffer)) result) ! (condition-case () ! (delete-file (concat nnmh-current-directory ! (int-to-string article))) ! (file-error nil))) result)) ! (defun nnmh-request-accept-article (group &optional last) (if (stringp group) (and --- 276,290 ---- (kill-buffer (current-buffer)) result) ! (progn ! (nnmh-possibly-change-directory group server) ! (condition-case () ! (funcall nnmail-delete-file-function ! (concat nnmh-current-directory (int-to-string article))) ! (file-error nil)))) result)) ! (deffoo nnmh-request-accept-article (group &optional server last noinsert) ! (nnmh-possibly-change-directory group server) ! (nnmail-check-syntax) (if (stringp group) (and *************** *** 316,325 **** ;; group is available. (let ((nnmail-split-methods (list (list group "")))) ! (car (nnmh-save-mail)))) (and (nnmail-activate 'nnmh) ! (car (nnmh-save-mail))))) ! (defun nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) (save-excursion --- 293,302 ---- ;; group is available. (let ((nnmail-split-methods (list (list group "")))) ! (car (nnmh-save-mail noinsert)))) (and (nnmail-activate 'nnmh) ! (car (nnmh-save-mail noinsert))))) ! (deffoo nnmh-request-replace-article (article group buffer) (nnmh-possibly-change-directory group) (save-excursion *************** *** 328,343 **** (condition-case () (progn ! (write-region (point-min) (point-max) ! (concat nnmh-current-directory (int-to-string article)) ! nil (if gnus-verbose-backends nil 'nomesg)) t) (error nil)))) ;;; Internal functions. ! (defun nnmh-possibly-change-directory (newsgroup) (if newsgroup ! (let ((pathname (nnmh-article-pathname newsgroup nnmh-directory))) (if (file-directory-p pathname) (setq nnmh-current-directory pathname) --- 305,384 ---- (condition-case () (progn ! (write-region ! (point-min) (point-max) ! (concat nnmh-current-directory (int-to-string article)) ! nil (if (nnheader-be-verbose 5) nil 'nomesg)) t) (error nil)))) + (deffoo nnmh-request-create-group (group &optional server) + (nnmail-activate 'nnmh) + (or (assoc group nnmh-group-alist) + (let (active) + (setq nnmh-group-alist (cons (list group (setq active (cons 1 0))) + nnmh-group-alist)) + (nnmh-possibly-create-directory group) + (nnmh-possibly-change-directory group server) + (let ((articles (mapcar + (lambda (file) + (string-to-int file)) + (directory-files + nnmh-current-directory nil "^[0-9]+$")))) + (and articles + (progn + (setcar active (apply 'min articles)) + (setcdr active (apply 'max articles))))))) + t) + + (deffoo nnmh-request-delete-group (group &optional force server) + (nnmh-possibly-change-directory group server) + ;; Delete all articles in GROUP. + (if (not force) + () ; Don't delete the articles. + (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) + (while articles + (and (file-writable-p (car articles)) + (progn + (nnheader-message 5 "Deleting article %s in %s..." + (car articles) group) + (funcall nnmail-delete-file-function (car articles)))) + (setq articles (cdr articles)))) + ;; Try to delete the directory itself. + (condition-case () + (delete-directory nnmh-current-directory) + (error nil))) + ;; Remove the group from all structures. + (setq nnmh-group-alist + (delq (assoc group nnmh-group-alist) nnmh-group-alist) + nnmh-current-directory nil) + t) + + (deffoo nnmh-request-rename-group (group new-name &optional server) + (nnmh-possibly-change-directory group server) + ;; Rename directory. + (and (file-writable-p nnmh-current-directory) + (condition-case () + (progn + (rename-file + (directory-file-name nnmh-current-directory) + (directory-file-name + (nnmail-group-pathname new-name nnmh-directory))) + t) + (error nil)) + ;; That went ok, so we change the internal structures. + (let ((entry (assoc group nnmh-group-alist))) + (and entry (setcar entry new-name)) + (setq nnmh-current-directory nil) + t))) + ;;; Internal functions. ! (defun nnmh-possibly-change-directory (newsgroup &optional server) ! (when (and server ! (not (nnmh-server-opened server))) ! (nnmh-open-server server)) (if newsgroup ! (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) (if (file-directory-p pathname) (setq nnmh-current-directory pathname) *************** *** 346,350 **** (defun nnmh-possibly-create-directory (group) (let (dir dirs) ! (setq dir (nnmh-article-pathname group nnmh-directory)) (while (not (file-directory-p dir)) (setq dirs (cons dir dirs)) --- 387,391 ---- (defun nnmh-possibly-create-directory (group) (let (dir dirs) ! (setq dir (nnmail-group-pathname group nnmh-directory)) (while (not (file-directory-p dir)) (setq dirs (cons dir dirs)) *************** *** 353,365 **** (if (make-directory (directory-file-name (car dirs))) (error "Could not create directory %s" (car dirs))) ! (and gnus-verbose-backends ! (message "Creating mail directory %s" (car dirs))) (setq dirs (cdr dirs))))) ! (defun nnmh-save-mail () "Called narrowed to an article." (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))) ! (nnmail-insert-lines) ! (nnmail-insert-xref group-art) (run-hooks 'nnmh-prepare-save-mail-hook) (goto-char (point-min)) --- 394,407 ---- (if (make-directory (directory-file-name (car dirs))) (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 (&optional noinsert) "Called narrowed to an article." (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number)))) ! (unless noinsert ! (nnmail-insert-lines) ! (nnmail-insert-xref group-art)) ! (run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnmh-prepare-save-mail-hook) (goto-char (point-min)) *************** *** 371,381 **** first) (while ga ! (nnmh-possibly-create-directory (car (car ga))) ! (let ((file (concat (nnmh-article-pathname ! (car (car ga)) nnmh-directory) ! (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. ! (add-name-to-file first file t) ;; Save the article. (write-region (point-min) (point-max) file nil nil) --- 413,423 ---- first) (while ga ! (nnmh-possibly-create-directory (caar ga)) ! (let ((file (concat (nnmail-group-pathname ! (caar ga) nnmh-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. (write-region (point-min) (point-max) file nil nil) *************** *** 386,390 **** (defun nnmh-active-number (group) "Compute the next article number in GROUP." ! (let ((active (car (cdr (assoc group nnmh-group-alist))))) ;; The group wasn't known to nnmh, so we just create an active ;; entry for it. --- 428,432 ---- (defun nnmh-active-number (group) "Compute the next article number in GROUP." ! (let ((active (cadr (assoc group nnmh-group-alist)))) ;; The group wasn't known to nnmh, so we just create an active ;; entry for it. *************** *** 395,451 **** (setcdr active (1+ (cdr active))) (while (file-exists-p ! (concat (nnmh-article-pathname group nnmh-directory) (int-to-string (cdr active)))) (setcdr active (1+ (cdr active)))) (cdr active))) - (defun nnmh-article-pathname (group mail-dir) - "Make pathname for GROUP." - (let ((mail-dir (file-name-as-directory (expand-file-name mail-dir)))) - (if (file-directory-p (concat mail-dir group)) - (concat mail-dir group "/") - (concat mail-dir (nnmail-replace-chars-in-string group ?. ?/) "/")))) - - (defun nnmh-get-new-mail (&optional group) - "Read new incoming mail." - (let* ((spools (nnmail-get-spool-files group)) - (group-in group) - incoming incomings) - (if (or (not nnmh-get-new-mail) (not nnmail-spool-file)) - () - ;; We first activate all the groups. - (or nnmh-group-alist - (nnmh-request-list)) - ;; The we go through all the existing spool files and split the - ;; mail from each. - (while spools - (and - (file-exists-p (car spools)) - (> (nth 7 (file-attributes (car spools))) 0) - (progn - (and gnus-verbose-backends - (message "nnmh: Reading incoming mail...")) - (if (not (setq incoming - (nnmail-move-inbox - (car spools) - (concat (file-name-as-directory nnmh-directory) - "Incoming")))) - () - (setq incomings (cons incoming incomings)) - (setq group (nnmail-get-split-group (car spools) group-in)) - (nnmail-split-incoming incoming 'nnmh-save-mail nil group)))) - (setq spools (cdr spools))) - ;; If we did indeed read any incoming spools, we save all info. - (if incoming - (message "nnmh: Reading incoming mail...done")) - (while incomings - (setq incoming (car incomings)) - (and nnmail-delete-incoming - (file-exists-p incoming) - (file-writable-p incoming) - (delete-file incoming)) - (setq incomings (cdr incomings)))))) - - (defun nnmh-update-gnus-unreads (group) ;; Go through the .nnmh-articles file and compare with the actual --- 437,445 ---- (setcdr active (1+ (cdr active))) (while (file-exists-p ! (concat (nnmail-group-pathname group nnmh-directory) (int-to-string (cdr active)))) (setcdr active (1+ (cdr active)))) (cdr active))) (defun nnmh-update-gnus-unreads (group) ;; Go through the .nnmh-articles file and compare with the actual *************** *** 472,476 **** (let ((art articles)) (while art ! (if (not (memq (car (car art)) files)) (setq articles (delq (car art) articles))) (setq art (cdr art)))) --- 466,470 ---- (let ((art articles)) (while art ! (if (not (memq (caar art) files)) (setq articles (delq (car art) articles))) (setq art (cdr art)))) *************** *** 481,488 **** (not (equal (nth 5 (file-attributes ! (concat dir (int-to-string (car (car art)))))) ! (cdr (car art))))) (setq articles (delq (car art) articles)) ! (setq new (cons (car (car art)) new)) (setq art (cdr art)))) ;; Go through all the new articles and add them, and their --- 475,482 ---- (not (equal (nth 5 (file-attributes ! (concat dir (int-to-string (caar art))))) ! (cdar art)))) (setq articles (delq (car art) articles)) ! (setq new (cons (caar art) new)) (setq art (cdr art)))) ;; Go through all the new articles and add them, and their *************** *** 513,516 **** --- 507,518 ---- (write-region (point-min) (point-max) nnmh-file nil 'nomesg) (kill-buffer (current-buffer))))) + + (defun nnmh-deletable-article-p (group article) + "Say whether ARTICLE in GROUP can be deleted." + (let ((path (concat nnmh-current-directory (int-to-string article)))) + (and (file-writable-p path) + (or (not nnmail-keep-last-article) + (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) + article)))))) (provide 'nnmh) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnml.el emacs-19.32/lisp/nnml.el *** emacs-19.31/lisp/nnml.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nnml.el Fri Jun 28 20:08:06 1996 *************** *** 1,5 **** ;;; nnml.el --- mail spool access for Gnus ! ! ;; Copyright (C) 1995 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnml.el --- mail spool access for Gnus ! ;; Copyright (C) 1995,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 34,51 **** (require 'nnheader) (require 'nnmail) ! (defvar nnml-directory "~/Mail/" "Mail spool directory.") ! (defvar nnml-active-file (concat nnml-directory "active") "Mail active file.") ! (defvar nnml-newsgroups-file (concat nnml-directory "newsgroups") "Mail newsgroups description file.") ! (defvar nnml-get-new-mail t "If non-nil, nnml will check the incoming mail file and split the mail.") ! (defvar nnml-nov-is-evil nil "If non-nil, Gnus will never generate and use nov databases for mail groups. Using nov databases will speed up header fetching considerably. --- 33,56 ---- (require 'nnheader) (require 'nnmail) + (require 'nnoo) + (require 'cl) + + (nnoo-declare nnml) ! (defvoo nnml-directory message-directory "Mail spool directory.") ! (defvoo nnml-active-file ! (concat (file-name-as-directory nnml-directory) "active") "Mail active file.") ! (defvoo nnml-newsgroups-file ! (concat (file-name-as-directory nnml-directory) "newsgroups") "Mail newsgroups description file.") ! (defvoo nnml-get-new-mail t "If non-nil, nnml will check the incoming mail file and split the mail.") ! (defvoo nnml-nov-is-evil nil "If non-nil, Gnus will never generate and use nov databases for mail groups. Using nov databases will speed up header fetching considerably. *************** through all nnml directories and generat *** 56,62 **** all. This may very well take some time.") ! (defvar nnml-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") --- 61,71 ---- all. This may very well take some time.") ! (defvoo nnml-prepare-save-mail-hook nil "Hook run narrowed to an article before saving.") + (defvoo nnml-inhibit-expiry nil + "If non-nil, inhibit expiry.") + + *************** all. This may very well take some time." *** 64,94 **** "nnml version.") ! (defvar nnml-nov-file-name ".overview") ! ! (defvar nnml-current-directory nil) ! (defvar nnml-status-string "") ! (defvar nnml-nov-buffer-alist nil) ! (defvar nnml-group-alist nil) ! (defvar nnml-active-timestamp nil) ! ! ! ;; Server variables. ! (defvar nnml-current-server nil) ! (defvar nnml-server-alist nil) ! (defvar nnml-server-variables ! (list ! (list 'nnml-directory nnml-directory) ! (list 'nnml-active-file nnml-active-file) ! (list 'nnml-newsgroups-file nnml-newsgroups-file) ! (list 'nnml-get-new-mail nnml-get-new-mail) ! (list 'nnml-nov-is-evil nnml-nov-is-evil) ! (list 'nnml-nov-file-name nnml-nov-file-name) ! '(nnml-current-directory nil) ! '(nnml-status-string "") ! '(nnml-nov-buffer-alist nil) ! '(nnml-group-alist nil) ! '(nnml-active-timestamp nil))) --- 73,87 ---- "nnml version.") ! (defvoo nnml-nov-file-name ".overview") ! (defvoo nnml-current-directory nil) ! (defvoo nnml-current-group nil) ! (defvoo nnml-status-string "") ! (defvoo nnml-nov-buffer-alist nil) ! (defvoo nnml-group-alist nil) ! (defvoo nnml-active-timestamp nil) ! (defvoo nnml-article-file-alist nil) ! (defvoo nnml-generate-active-function 'nnml-generate-active-info) *************** all. This may very well take some time." *** 96,100 **** ;;; Interface functions. ! (defun nnml-retrieve-headers (sequence &optional newsgroup server) (save-excursion (set-buffer nntp-server-buffer) --- 89,95 ---- ;;; Interface functions. ! (nnoo-define-basics nnml) ! ! (deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old) (save-excursion (set-buffer nntp-server-buffer) *************** all. This may very well take some time." *** 106,116 **** (if (stringp (car sequence)) 'headers ! (nnml-possibly-change-directory newsgroup) ! (if (nnml-retrieve-headers-with-nov sequence) 'nov (while sequence (setq article (car sequence)) ! (setq file ! (concat nnml-current-directory (int-to-string article))) (if (and (file-exists-p file) (not (file-directory-p file))) --- 101,116 ---- (if (stringp (car sequence)) 'headers ! (nnml-possibly-change-directory newsgroup server) ! (unless nnml-article-file-alist ! (setq nnml-article-file-alist ! (nnheader-article-to-file-alist nnml-current-directory))) ! (if (nnml-retrieve-headers-with-nov sequence fetch-old) 'nov (while sequence (setq article (car sequence)) ! (setq file ! (concat nnml-current-directory ! (or (cdr (assq article nnml-article-file-alist)) ! ""))) (if (and (file-exists-p file) (not (file-directory-p file))) *************** all. This may very well take some time." *** 131,218 **** (> number nnmail-large-newsgroup) (zerop (% count 20)) ! gnus-verbose-backends ! (message "nnml: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! gnus-verbose-backends ! (message "nnml: Receiving headers...done")) ! ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) 'headers))))) ! (defun nnml-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nnml-current-server) ! t ! (if nnml-current-server ! (setq nnml-server-alist ! (cons (list nnml-current-server ! (nnheader-save-variables nnml-server-variables)) ! nnml-server-alist))) ! (let ((state (assoc server nnml-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nnml-server-alist (delq state nnml-server-alist))) ! (nnheader-set-init-variables nnml-server-variables defs))) ! (setq nnml-current-server server))) ! ! (defun nnml-close-server (&optional server) ! t) ! ! (defun nnml-server-opened (&optional server) ! (and (equal server nnml-current-server) ! nntp-server-buffer ! (buffer-name nntp-server-buffer))) ! ! (defun nnml-status-message (&optional server) ! nnml-status-string) ! ! (defun nnml-request-article (id &optional newsgroup server buffer) ! (nnml-possibly-change-directory newsgroup) ! (let ((file (if (stringp id) ! nil ! (concat nnml-current-directory (int-to-string id)))) ! (nntp-server-buffer (or buffer nntp-server-buffer))) ! (if (and (stringp file) ! (file-exists-p file) ! (not (file-directory-p file))) ! (save-excursion ! (nnmail-find-file file))))) ! ! (defun nnml-request-group (group &optional server dont-check) ! (if (not (nnml-possibly-change-directory group)) ! (progn ! (setq nnml-status-string "Invalid group (no such directory)") ! nil) ! (if dont-check ! t ! (nnml-get-new-mail group) ! (nnmail-activate 'nnml) ! (let ((active (nth 1 (assoc group nnml-group-alist)))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if (not active) ! () ! (insert (format "211 %d %d %d %s\n" ! (max (1+ (- (cdr active) (car active))) 0) ! (car active) (cdr active) group)) ! t)))))) ! ! (defun nnml-close-group (group &optional server) ! t) ! (defun nnml-request-close () ! (setq nnml-current-server nil) ! (setq nnml-server-alist nil) t) ! (defun nnml-request-create-group (group &optional server) (nnmail-activate 'nnml) (or (assoc group nnml-group-alist) --- 131,223 ---- (> number nnmail-large-newsgroup) (zerop (% count 20)) ! (nnheader-message 6 "nnml: Receiving headers... %d%%" ! (/ (* count 100) number)))) (and (numberp nnmail-large-newsgroup) (> number nnmail-large-newsgroup) ! (nnheader-message 6 "nnml: Receiving headers...done")) ! (nnheader-fold-continuation-lines) 'headers))))) ! (deffoo nnml-open-server (server &optional defs) ! (nnoo-change-server 'nnml server defs) ! (when (not (file-exists-p nnml-directory)) ! (condition-case () ! (make-directory nnml-directory t) ! (error t))) ! (cond ! ((not (file-exists-p nnml-directory)) ! (nnml-close-server) ! (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory)) ! ((not (file-directory-p (file-truename nnml-directory))) ! (nnml-close-server) ! (nnheader-report 'nnml "Not a directory: %s" nnml-directory)) ! (t ! (nnheader-report 'nnml "Opened server %s using directory %s" ! server nnml-directory) ! t))) ! ! (deffoo nnml-request-article (id &optional newsgroup server buffer) ! (nnml-possibly-change-directory newsgroup server) ! (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) ! file path gpath group-num) ! (if (stringp id) ! (when (and (setq group-num (nnml-find-group-number id)) ! (setq file (cdr ! (assq (cdr group-num) ! (nnheader-article-to-file-alist ! (setq gpath ! (nnmail-group-pathname ! (car group-num) ! nnml-directory))))))) ! (setq path (concat gpath (int-to-string (cdr group-num))))) ! (unless nnml-article-file-alist ! (setq nnml-article-file-alist ! (nnheader-article-to-file-alist nnml-current-directory))) ! (when (setq file (cdr (assq id nnml-article-file-alist))) ! (setq path (concat nnml-current-directory file)))) ! (cond ! ((not path) ! (nnheader-report 'nnml "No such article: %s" id)) ! ((not (file-exists-p path)) ! (nnheader-report 'nnml "No such file: %s" path)) ! ((file-directory-p path) ! (nnheader-report 'nnml "File is a directory: %s" path)) ! ((not (save-excursion (nnmail-find-file path))) ! (nnheader-report 'nnml "Couldn't read file: %s" path)) ! (t ! (nnheader-report 'nnml "Article %s retrieved" id) ! ;; We return the article number. ! (cons newsgroup (string-to-int (file-name-nondirectory path))))))) ! ! (deffoo nnml-request-group (group &optional server dont-check) ! (cond ! ((not (nnml-possibly-change-directory group server)) ! (nnheader-report 'nnml "Invalid group (no such directory)")) ! ((not (file-directory-p nnml-current-directory)) ! (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) ! (dont-check ! (nnheader-report 'nnml "Group %s selected" group) ! t) ! (t ! (nnmail-activate 'nnml) ! (let ((active (nth 1 (assoc group nnml-group-alist)))) ! (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" ! (max (1+ (- (cdr active) (car active))) 0) ! (car active) (cdr active) group)))))) ! ! (deffoo nnml-request-scan (&optional group server) ! (setq nnml-article-file-alist nil) ! (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) ! (deffoo nnml-close-group (group &optional server) ! (setq nnml-article-file-alist nil) t) ! (deffoo nnml-request-create-group (group &optional server) (nnmail-activate 'nnml) (or (assoc group nnml-group-alist) *************** all. This may very well take some time." *** 221,230 **** nnml-group-alist)) (nnml-possibly-create-directory group) ! (nnml-possibly-change-directory group) ! (let ((articles (mapcar ! (lambda (file) ! (string-to-int file)) ! (directory-files ! nnml-current-directory nil "^[0-9]+$")))) (and articles (progn --- 226,232 ---- nnml-group-alist)) (nnml-possibly-create-directory group) ! (nnml-possibly-change-directory group server) ! (let ((articles ! (nnheader-directory-articles nnml-current-directory ))) (and articles (progn *************** all. This may very well take some time." *** 234,301 **** t) ! (defun nnml-request-list (&optional server) ! (if server (nnml-get-new-mail)) (save-excursion (nnmail-find-file nnml-active-file) (setq nnml-group-alist (nnmail-get-active)))) ! (defun nnml-request-newgroups (date &optional server) (nnml-request-list server)) ! (defun nnml-request-list-newsgroups (&optional server) (save-excursion (nnmail-find-file nnml-newsgroups-file))) ! (defun nnml-request-post (&optional server) ! (mail-send-and-exit nil)) ! ! (defalias 'nnml-request-post-buffer 'nnmail-request-post-buffer) ! ! (defun nnml-request-expire-articles (articles newsgroup &optional server force) ! (nnml-possibly-change-directory newsgroup) ! (let* ((days (or (and nnmail-expiry-wait-function ! (funcall nnmail-expiry-wait-function newsgroup)) ! nnmail-expiry-wait)) ! (active-articles ! (mapcar ! (function ! (lambda (name) ! (string-to-int name))) ! (directory-files nnml-current-directory nil "^[0-9]+$" t))) ! (max-article (and active-articles (apply 'max active-articles))) (is-old t) ! article rest mod-time) (nnmail-activate 'nnml) (while (and articles is-old) (setq article (concat nnml-current-directory ! (int-to-string (car articles)))) ! (if (setq mod-time (nth 5 (file-attributes article))) ! (if (and (or (not nnmail-keep-last-article) ! (not max-article) ! (not (= (car articles) max-article))) ! (or force ! (and (not (equal mod-time '(0 0))) ! (setq is-old ! (> (nnmail-days-between ! (current-time-string) ! (current-time-string mod-time)) ! days))))) ! (progn ! (and gnus-verbose-backends ! (message "Deleting article %s..." article)) ! (condition-case () ! (delete-file article) ! (file-error ! (setq rest (cons (car articles) rest)))) ! (setq active-articles (delq (car articles) active-articles)) ! (nnml-nov-delete-article newsgroup (car articles))) ! (setq rest (cons (car articles) rest)))) ! (setq articles (cdr articles))) (let ((active (nth 1 (assoc newsgroup nnml-group-alist)))) ! (and active ! (setcar active (or (and active-articles ! (apply 'min active-articles)) ! 0))) (nnmail-save-active nnml-group-alist nnml-active-file)) (nnml-save-nov) --- 236,287 ---- t) ! (deffoo nnml-request-list (&optional server) (save-excursion (nnmail-find-file nnml-active-file) (setq nnml-group-alist (nnmail-get-active)))) ! (deffoo nnml-request-newgroups (date &optional server) (nnml-request-list server)) ! (deffoo nnml-request-list-newsgroups (&optional server) (save-excursion (nnmail-find-file nnml-newsgroups-file))) ! (deffoo nnml-request-expire-articles (articles newsgroup &optional server force) ! (nnml-possibly-change-directory newsgroup server) ! (let* ((active-articles ! (nnheader-directory-articles nnml-current-directory)) (is-old t) ! article rest mod-time number) (nnmail-activate 'nnml) + (unless nnml-article-file-alist + (setq nnml-article-file-alist + (nnheader-article-to-file-alist nnml-current-directory))) + (while (and articles is-old) (setq article (concat nnml-current-directory ! (int-to-string ! (setq number (pop articles))))) ! (when (setq mod-time (nth 5 (file-attributes article))) ! (if (and (nnml-deletable-article-p newsgroup number) ! (setq is-old ! (nnmail-expired-article-p newsgroup mod-time force ! nnml-inhibit-expiry))) ! (progn ! (nnheader-message 5 "Deleting article %s in %s..." ! article newsgroup) ! (condition-case () ! (funcall nnmail-delete-file-function article) ! (file-error ! (push number rest))) ! (setq active-articles (delq number active-articles)) ! (nnml-nov-delete-article newsgroup number)) ! (push number rest)))) (let ((active (nth 1 (assoc newsgroup nnml-group-alist)))) ! (when active ! (setcar active (or (and active-articles ! (apply 'min active-articles)) ! (1+ (cdr active))))) (nnmail-save-active nnml-group-alist nnml-active-file)) (nnml-save-nov) *************** all. This may very well take some time." *** 303,311 **** (nconc rest articles))) ! (defun nnml-request-move-article (article group server accept-form &optional last) (let ((buf (get-buffer-create " *nnml move*")) result) (and (nnml-request-article article group server) (save-excursion --- 289,302 ---- (nconc rest articles))) ! (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) + (unless nnml-article-file-alist + (setq nnml-article-file-alist + (nnheader-article-to-file-alist nnml-current-directory))) (and + (nnml-deletable-article-p group article) (nnml-request-article article group server) (save-excursion *************** all. This may very well take some time." *** 316,322 **** result) (progn (condition-case () ! (delete-file (concat nnml-current-directory ! (int-to-string article))) (file-error nil)) (nnml-nov-delete-article group article) --- 307,315 ---- result) (progn + (nnml-possibly-change-directory group server) (condition-case () ! (funcall nnmail-delete-file-function ! (concat nnml-current-directory ! (int-to-string article))) (file-error nil)) (nnml-nov-delete-article group article) *************** all. This may very well take some time." *** 324,328 **** result)) ! (defun nnml-request-accept-article (group &optional last) (let (result) (if (stringp group) --- 317,323 ---- result)) ! (deffoo nnml-request-accept-article (group &optional server last) ! (nnml-possibly-change-directory group server) ! (nnmail-check-syntax) (let (result) (if (stringp group) *************** all. This may very well take some time." *** 344,365 **** result)) ! (defun nnml-request-replace-article (article group buffer) (nnml-possibly-change-directory group) (save-excursion (set-buffer buffer) (nnml-possibly-create-directory group) ! (if (not (condition-case () ! (progn ! (write-region (point-min) (point-max) ! (concat nnml-current-directory ! (int-to-string article)) ! nil (if gnus-verbose-backends nil 'nomesg)) ! t) ! (error nil))) ! () ! (let ((chars (nnmail-insert-lines)) ! (art (concat (int-to-string article) "\t")) ! nov-line) ! (setq nov-line (nnml-make-nov-line chars)) ;; Replace the NOV line in the NOV file. (save-excursion --- 339,359 ---- result)) ! (deffoo nnml-request-replace-article (article group buffer) (nnml-possibly-change-directory group) (save-excursion (set-buffer buffer) (nnml-possibly-create-directory group) ! (let ((chars (nnmail-insert-lines)) ! (art (concat (int-to-string article) "\t")) ! headers) ! (when (condition-case () ! (progn ! (write-region ! (point-min) (point-max) ! (concat nnml-current-directory (int-to-string article)) ! nil (if (nnheader-be-verbose 5) nil 'nomesg)) ! t) ! (error nil)) ! (setq headers (nnml-parse-head chars article)) ;; Replace the NOV line in the NOV file. (save-excursion *************** all. This may very well take some time." *** 381,393 **** (zerop (forward-line 1))))) (beginning-of-line) ! (insert (int-to-string article) nov-line) (nnml-save-nov) t))))) ! ;;; Internal functions ! (defun nnml-retrieve-headers-with-nov (articles) (if (or gnus-nov-is-evil nnml-nov-is-evil) nil --- 375,494 ---- (zerop (forward-line 1))))) (beginning-of-line) ! (nnheader-insert-nov headers) (nnml-save-nov) t))))) + (deffoo nnml-request-delete-group (group &optional force server) + (nnml-possibly-change-directory group server) + (when force + ;; Delete all articles in GROUP. + (let ((articles + (directory-files + nnml-current-directory t + (concat nnheader-numerical-short-files + "\\|" (regexp-quote nnml-nov-file-name) "$"))) + article) + (while articles + (setq article (pop articles)) + (when (file-writable-p article) + (nnheader-message 5 "Deleting article %s in %s..." article group) + (funcall nnmail-delete-file-function article)))) + ;; Try to delete the directory itself. + (condition-case () + (delete-directory nnml-current-directory) + (error nil))) + ;; Remove the group from all structures. + (setq nnml-group-alist + (delq (assoc group nnml-group-alist) nnml-group-alist) + nnml-current-group nil + nnml-current-directory nil) + ;; Save the active file. + (nnmail-save-active nnml-group-alist nnml-active-file) + t) + + (deffoo nnml-request-rename-group (group new-name &optional server) + (nnml-possibly-change-directory group server) + ;; Rename directory. + (and (file-writable-p nnml-current-directory) + (condition-case () + (let ((parent + (file-name-directory + (directory-file-name + (nnmail-group-pathname new-name nnml-directory))))) + (unless (file-exists-p parent) + (make-directory parent t)) + (rename-file + (directory-file-name nnml-current-directory) + (directory-file-name + (nnmail-group-pathname new-name nnml-directory))) + t) + (error nil)) + ;; That went ok, so we change the internal structures. + (let ((entry (assoc group nnml-group-alist))) + (and entry (setcar entry new-name)) + (setq nnml-current-directory nil + nnml-current-group nil) + ;; Save the new group alist. + (nnmail-save-active nnml-group-alist nnml-active-file) + t))) ! ;;; Internal functions. ! ! (defun nnml-deletable-article-p (group article) ! "Say whether ARTICLE in GROUP can be deleted." ! (let (file path) ! (when (setq file (cdr (assq article nnml-article-file-alist))) ! (setq path (concat nnml-current-directory file)) ! (and (file-writable-p path) ! (or (not nnmail-keep-last-article) ! (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) ! article))))))) ! ;; 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*")) ! (buffer-disable-undo (current-buffer)) ! (let ((alist nnml-group-alist) ! 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. ! (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. ! (while (and (not number) ! alist) ! (or (string= (caar alist) nnml-current-group) ! (setq number (nnml-find-id (caar alist) id))) ! (or number ! (setq alist (cdr alist)))) ! (and number ! (cons (caar alist) number)))))) ! ! (defun nnml-find-id (group id) ! (erase-buffer) ! (let ((nov (concat (nnmail-group-pathname group nnml-directory) ! nnml-nov-file-name)) ! number found) ! (when (file-exists-p nov) ! (insert-file-contents nov) ! (while (and (not found) ! (search-forward id nil t)) ; We find the ID. ! ;; And the id is in the fourth field. ! (if (search-backward ! "\t" (save-excursion (beginning-of-line) (point)) t 4) ! (progn ! (beginning-of-line) ! (setq found t) ! ;; We return the article number. ! (setq number ! (condition-case () ! (read (current-buffer)) ! (error nil)))))) ! number))) ! ! (defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) (if (or gnus-nov-is-evil nnml-nov-is-evil) nil *************** all. This may very well take some time." *** 396,406 **** (car articles))) (nov (concat nnml-current-directory nnml-nov-file-name))) ! (if (file-exists-p nov) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-file-contents nov) (goto-char (point-min)) ! (while (and (not (eobp)) (< first (read (current-buffer)))) (forward-line 1)) (beginning-of-line) --- 497,512 ---- (car articles))) (nov (concat nnml-current-directory nnml-nov-file-name))) ! (when (file-exists-p nov) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-file-contents nov) ! (if (and fetch-old ! (not (numberp fetch-old))) ! t ; Don't remove anything. ! (if fetch-old ! (setq first (max 1 (- first fetch-old)))) (goto-char (point-min)) ! (while (and (not (eobp)) (> first (read (current-buffer)))) (forward-line 1)) (beginning-of-line) *************** all. This may very well take some time." *** 410,425 **** (beginning-of-line) (if (not (eobp)) (delete-region (point) (point-max))) ! t))))) ! (defun nnml-possibly-change-directory (newsgroup &optional force) ! (if newsgroup ! (let ((pathname (nnmail-article-pathname newsgroup nnml-directory))) ! (and (or force (file-directory-p pathname)) ! (setq nnml-current-directory pathname))) ! t)) (defun nnml-possibly-create-directory (group) (let (dir dirs) ! (setq dir (nnmail-article-pathname group nnml-directory)) (while (not (file-directory-p dir)) (setq dirs (cons dir dirs)) --- 516,536 ---- (beginning-of-line) (if (not (eobp)) (delete-region (point) (point-max))) ! t)))))) ! (defun nnml-possibly-change-directory (group &optional server) ! (when (and server ! (not (nnml-server-opened server))) ! (nnml-open-server server)) ! (when group ! (let ((pathname (nnmail-group-pathname group nnml-directory))) ! (when (not (equal pathname nnml-current-directory)) ! (setq nnml-current-directory pathname ! nnml-current-group group ! nnml-article-file-alist nil)))) ! t) (defun nnml-possibly-create-directory (group) (let (dir dirs) ! (setq dir (nnmail-group-pathname group nnml-directory)) (while (not (file-directory-p dir)) (setq dirs (cons dir dirs)) *************** all. This may very well take some time." *** 427,432 **** (while dirs (make-directory (directory-file-name (car dirs))) ! (and gnus-verbose-backends ! (message "Creating mail directory %s" (car dirs))) (setq dirs (cdr dirs))))) --- 538,542 ---- (while dirs (make-directory (directory-file-name (car dirs))) ! (nnheader-message 5 "Creating mail directory %s" (car dirs)) (setq dirs (cdr dirs))))) *************** all. This may very well take some time." *** 434,440 **** "Called narrowed to an article." (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number))) ! chars nov-line) (setq chars (nnmail-insert-lines)) (nnmail-insert-xref group-art) (run-hooks 'nnml-prepare-save-mail-hook) (goto-char (point-min)) --- 544,551 ---- "Called narrowed to an article." (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number))) ! chars headers) (setq chars (nnmail-insert-lines)) (nnmail-insert-xref group-art) + (run-hooks 'nnmail-prepare-save-mail-hook) (run-hooks 'nnml-prepare-save-mail-hook) (goto-char (point-min)) *************** all. This may very well take some time." *** 446,459 **** first) (while ga ! (nnml-possibly-create-directory (car (car ga))) ! (let ((file (concat (nnmail-article-pathname ! (car (car ga)) nnml-directory) ! (int-to-string (cdr (car ga)))))) (if first ;; It was already saved, so we just make a hard link. ! (add-name-to-file first file t) ;; Save the article. (write-region (point-min) (point-max) file nil ! (if gnus-verbose-backends nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) --- 557,570 ---- first) (while ga ! (nnml-possibly-create-directory (caar ga)) ! (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. (write-region (point-min) (point-max) file nil ! (if (nnheader-be-verbose 5) nil 'nomesg)) (setq first file))) (setq ga (cdr ga)))) *************** all. This may very well take some time." *** 461,469 **** ;; line after saving, because nov generation destroys the ;; header. ! (setq nov-line (nnml-make-nov-line chars)) ;; Output the nov line to all nov databases that should have it. (let ((ga group-art)) (while ga ! (nnml-add-nov (car (car ga)) (cdr (car ga)) nov-line) (setq ga (cdr ga)))) group-art)) --- 572,580 ---- ;; line after saving, because nov generation destroys the ;; header. ! (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. (let ((ga group-art)) (while ga ! (nnml-add-nov (caar ga) (cdar ga) headers) (setq ga (cdr ga)))) group-art)) *************** all. This may very well take some time." *** 471,604 **** (defun nnml-active-number (group) "Compute the next article number in GROUP." ! (let ((active (car (cdr (assoc group nnml-group-alist))))) ;; The group wasn't known to nnml, so we just create an active ;; entry for it. ! (or active ! (progn ! (setq active (cons 1 0)) ! (setq nnml-group-alist (cons (list group active) nnml-group-alist)))) (setcdr active (1+ (cdr active))) (while (file-exists-p ! (concat (nnmail-article-pathname group nnml-directory) (int-to-string (cdr active)))) (setcdr active (1+ (cdr active)))) (cdr active))) ! (defun nnml-get-new-mail (&optional group) ! "Read new incoming mail." ! (let* ((spools (nnmail-get-spool-files group)) ! (group-in group) ! incoming incomings) ! (if (or (not nnml-get-new-mail) (not nnmail-spool-file)) ! () ! ;; We first activate all the groups. ! (nnmail-activate 'nnml) ! ;; The we go through all the existing spool files and split the ! ;; mail from each. ! (while spools ! (and ! (file-exists-p (car spools)) ! (> (nth 7 (file-attributes (car spools))) 0) ! (progn ! (and gnus-verbose-backends ! (message "nnml: Reading incoming mail...")) ! (if (not (setq incoming ! (nnmail-move-inbox ! (car spools) (concat nnml-directory "Incoming")))) ! () ! (setq group (nnmail-get-split-group (car spools) group-in)) ! (nnmail-split-incoming incoming 'nnml-save-mail nil group) ! (setq incomings (cons incoming incomings))))) ! (setq spools (cdr spools))) ! ;; If we did indeed read any incoming spools, we save all info. ! (if incoming ! (progn ! (nnmail-save-active nnml-group-alist nnml-active-file) ! (nnml-save-nov) ! (run-hooks 'nnmail-read-incoming-hook) ! (and gnus-verbose-backends ! (message "nnml: Reading incoming mail...done")))) ! (while incomings ! (setq incoming (car incomings)) ! (and nnmail-delete-incoming ! (file-exists-p incoming) ! (file-writable-p incoming) ! (delete-file incoming)) ! (setq incomings (cdr incomings)))))) ! ! ! (defun nnml-add-nov (group article line) "Add a nov line for the GROUP base." (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-max)) ! (insert (int-to-string article) line))) (defsubst nnml-header-value () ! (buffer-substring (match-end 0) (save-excursion (end-of-line) (point)))) ! (defun nnml-make-nov-line (chars) ! "Create a nov from the current headers." ! (let ((case-fold-search t) ! subject from date id references lines xref in-reply-to char) ! (save-excursion ! (save-restriction ! (goto-char (point-min)) ! (narrow-to-region ! (point) ! (1- (or (search-forward "\n\n" nil t) (point-max)))) ! ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! (subst-char-in-region (point-min) (point-max) ?\t ? ) ! ;; [number subject from date id references chars lines xref] ! (save-excursion ! (goto-char (point-min)) ! (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): " ! nil t) ! (beginning-of-line) ! (setq char (downcase (following-char))) ! (cond ! ((eq char ?s) ! (setq subject (nnml-header-value))) ! ((eq char ?f) ! (setq from (nnml-header-value))) ! ((eq char ?x) ! (setq xref (nnml-header-value))) ! ((eq char ?l) ! (setq lines (nnml-header-value))) ! ((eq char ?d) ! (setq date (nnml-header-value))) ! ((eq char ?m) ! (setq id (setq id (nnml-header-value)))) ! ((eq char ?r) ! (setq references (nnml-header-value))) ! ((eq char ?i) ! (setq in-reply-to (nnml-header-value)))) ! (forward-line 1)) ! ! (and (not references) ! in-reply-to ! (string-match "<[^>]+>" in-reply-to) ! (setq references ! (substring in-reply-to (match-beginning 0) ! (match-end 0))))) ! ;; [number subject from date id references chars lines xref] ! (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\t\n" ! (or subject "(none)") ! (or from "(nobody)") (or date "") ! (or id (concat "nnml-dummy-id-" ! (mapconcat ! (lambda (time) (int-to-string time)) ! (current-time) "-"))) ! (or references "") ! (or chars 0) (or lines "0") (or xref "")))))) (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) (let ((buffer (find-file-noselect ! (concat (nnmail-article-pathname ! group nnml-directory) nnml-nov-file-name)))) (save-excursion (set-buffer buffer) --- 582,646 ---- (defun nnml-active-number (group) "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. ! (unless active ! ;; Perhaps the active file was corrupt? See whether ! ;; there are any articles in this group. ! (nnml-possibly-create-directory group) ! (nnml-possibly-change-directory group) ! (unless nnml-article-file-alist ! (setq nnml-article-file-alist ! (sort ! (nnheader-article-to-file-alist nnml-current-directory) ! (lambda (a1 a2) (< (car a1) (car a2)))))) ! (setq active ! (if nnml-article-file-alist ! (cons (caar nnml-article-file-alist) ! (caar (last nnml-article-file-alist))) ! (cons 1 0))) ! (setq nnml-group-alist (cons (list group active) nnml-group-alist))) (setcdr active (1+ (cdr active))) (while (file-exists-p ! (concat (nnmail-group-pathname group nnml-directory) (int-to-string (cdr active)))) (setcdr active (1+ (cdr active)))) (cdr active))) ! (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." (save-excursion (set-buffer (nnml-open-nov group)) (goto-char (point-max)) ! (mail-header-set-number headers article) ! (nnheader-insert-nov headers))) (defsubst nnml-header-value () ! (buffer-substring (match-end 0) (progn (end-of-line) (point)))) ! (defun nnml-parse-head (chars &optional number) ! "Parse the head of the current buffer." ! (save-excursion ! (save-restriction ! (goto-char (point-min)) ! (narrow-to-region ! (point) ! (1- (or (search-forward "\n\n" nil t) (point-max)))) ! ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) ! ;; Remove any tabs; they are too confusing. ! (subst-char-in-region (point-min) (point-max) ?\t ? ) ! (let ((headers (nnheader-parse-head t))) ! (mail-header-set-chars headers chars) ! (mail-header-set-number headers number) ! headers)))) (defun nnml-open-nov (group) (or (cdr (assoc group nnml-nov-buffer-alist)) (let ((buffer (find-file-noselect ! (concat (nnmail-group-pathname group nnml-directory) ! nnml-nov-file-name)))) (save-excursion (set-buffer buffer) *************** all. This may very well take some time." *** 611,693 **** (save-excursion (while nnml-nov-buffer-alist ! (if (buffer-name (cdr (car nnml-nov-buffer-alist))) ! (progn ! (set-buffer (cdr (car nnml-nov-buffer-alist))) ! (and (buffer-modified-p) ! (write-region ! 1 (point-max) (buffer-file-name) nil 'nomesg)) ! (set-buffer-modified-p nil) ! (kill-buffer (current-buffer)))) (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) ;;;###autoload ! (defun nnml-generate-nov-databases (dir) ! "Generate nov databases in all nnml mail newsgroups." ! (interactive ! (progn ! (setq nnml-group-alist nil) ! (list nnml-directory))) ! (nnml-open-server (or nnml-current-server "")) ! (let ((dirs (directory-files dir t nil t))) (while dirs ! (if (and (not (string-match "/\\.\\.$" (car dirs))) ! (not (string-match "/\\.$" (car dirs))) ! (file-directory-p (car dirs))) ! (nnml-generate-nov-databases (car dirs))) ! (setq dirs (cdr dirs)))) (let ((files (sort (mapcar ! (function ! (lambda (name) ! (string-to-int name))) (directory-files dir nil "^[0-9]+$" t)) ! (function <))) ! (nov (concat dir "/" nnml-nov-file-name)) ! (nov-buffer (get-buffer-create "*nov*")) ! nov-line chars) ! (if files ! (setq nnml-group-alist ! (cons (list (nnmail-replace-chars-in-string ! (substring (expand-file-name dir) ! (length (expand-file-name ! nnml-directory))) ! ?/ ?.) ! (cons (car files) ! (let ((f files)) ! (while (cdr f) (setq f (cdr f))) ! (car f)))) ! nnml-group-alist))) ! (if files ! (save-excursion ! (set-buffer nntp-server-buffer) ! (if (file-exists-p nov) ! (delete-file nov)) ! (save-excursion ! (set-buffer nov-buffer) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer)) ! (while files ! (erase-buffer) ! (insert-file-contents (concat dir "/" (int-to-string (car files)))) (goto-char (point-min)) ! (narrow-to-region 1 (save-excursion (search-forward "\n\n" nil t) ! (setq chars (- (point-max) ! (point))) ! (point))) ! (if (not (= 0 chars)) ; none of them empty files... ! (progn ! (setq nov-line (nnml-make-nov-line chars)) ! (save-excursion ! (set-buffer nov-buffer) ! (goto-char (point-max)) ! (insert (int-to-string (car files)) nov-line)))) ! (widen) ! (setq files (cdr files))) ! (save-excursion ! (set-buffer nov-buffer) ! (write-region 1 (point-max) (expand-file-name nov) nil ! 'nomesg) ! (kill-buffer (current-buffer))))) ! (nnmail-save-active nnml-group-alist nnml-active-file))) (defun nnml-nov-delete-article (group article) --- 653,754 ---- (save-excursion (while nnml-nov-buffer-alist ! (when (buffer-name (cdar nnml-nov-buffer-alist)) ! (set-buffer (cdar nnml-nov-buffer-alist)) ! (and (buffer-modified-p) ! (write-region ! 1 (point-max) (buffer-file-name) nil 'nomesg)) ! (set-buffer-modified-p nil) ! (kill-buffer (current-buffer))) (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) ;;;###autoload ! (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 ! ;; numbers in empty groups. ! (nnmail-activate 'nnml) ! (nnml-open-server (or (nnoo-current-server 'nnml) "")) ! (setq nnml-directory (expand-file-name nnml-directory)) ! ;; Recurse down the directories. ! (nnml-generate-nov-databases-1 nnml-directory) ! ;; Save the active file. ! (nnmail-save-active nnml-group-alist nnml-active-file)) ! ! (defun nnml-generate-nov-databases-1 (dir) ! (setq dir (file-name-as-directory dir)) ! ;; We descend recursively ! (let ((dirs (directory-files dir t nil t)) ! dir) (while dirs ! (setq dir (pop dirs)) ! (when (and (not (member (file-name-nondirectory dir) '("." ".."))) ! (file-directory-p dir)) ! (nnml-generate-nov-databases-1 dir)))) ! ;; Do this directory. (let ((files (sort (mapcar ! (lambda (name) (string-to-int name)) (directory-files dir nil "^[0-9]+$" t)) ! '<))) ! (when files ! (funcall nnml-generate-active-function dir) ! ;; Generate the nov file. ! (nnml-generate-nov-file dir files)))) ! ! (defvar files) ! (defun nnml-generate-active-info (dir) ! ;; Update the active info for this 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)) ! (push (list group ! (cons (car files) ! (let ((f files)) ! (while (cdr f) (setq f (cdr f))) ! (car f)))) ! nnml-group-alist))) ! ! (defun nnml-generate-nov-file (dir files) ! (let* ((dir (file-name-as-directory dir)) ! (nov (concat dir nnml-nov-file-name)) ! (nov-buffer (get-buffer-create " *nov*")) ! nov-line chars file headers) ! (save-excursion ! ;; Init the nov buffer. ! (set-buffer nov-buffer) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (set-buffer nntp-server-buffer) ! ;; Delete the old NOV file. ! (when (file-exists-p nov) ! (funcall nnmail-delete-file-function nov)) ! (while files ! (unless (file-directory-p ! (setq file (concat dir (int-to-string (car files))))) ! (erase-buffer) ! (insert-file-contents file) ! (narrow-to-region ! (goto-char (point-min)) ! (progn ! (search-forward "\n\n" nil t) ! (setq chars (- (point-max) (point))) ! (max 1 (1- (point))))) ! (when (and (not (= 0 chars)) ; none of them empty files... ! (not (= (point-min) (point-max)))) (goto-char (point-min)) ! (setq headers (nnml-parse-head chars (car files))) ! (save-excursion ! (set-buffer nov-buffer) ! (goto-char (point-max)) ! (nnheader-insert-nov headers))) ! (widen)) ! (setq files (cdr files))) ! (save-excursion ! (set-buffer nov-buffer) ! (write-region 1 (point-max) (expand-file-name nov) nil ! 'nomesg) ! (kill-buffer (current-buffer)))))) (defun nnml-nov-delete-article (group article) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnoo.el emacs-19.32/lisp/nnoo.el *** emacs-19.31/lisp/nnoo.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/nnoo.el Fri Jun 28 20:07:22 1996 *************** *** 0 **** --- 1,251 ---- + ;;; nnoo.el --- OO Gnus Backends + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (eval-when-compile (require 'cl)) + + (defvar nnoo-definition-alist nil) + (defvar nnoo-state-alist nil) + + (defmacro defvoo (var init &optional doc &rest map) + "The same as `defvar', only takes list of variables to MAP to." + `(prog1 + ,(if doc + `(defvar ,var ,init ,doc) + `(defvar ,var ,init)) + (nnoo-define ',var ',map))) + (put 'defvoo 'lisp-indent-function 2) + (put 'defvoo 'lisp-indent-hook 2) + (put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map)) + + (defmacro deffoo (func args &rest forms) + "The same as `defun', only register FUNC." + `(prog1 + (defun ,func ,args ,@forms) + (nnoo-register-function ',func))) + (put 'deffoo 'lisp-indent-function 2) + (put 'deffoo 'lisp-indent-hook 2) + (put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) + + (defun nnoo-register-function (func) + (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) + nnoo-definition-alist)))) + (unless funcs + (error "%s belongs to a backend that hasn't been declared" func)) + (setcar funcs (cons func (car funcs))))) + + (defmacro nnoo-declare (backend &rest parents) + `(eval-and-compile + (push (list ',backend + (mapcar (lambda (p) (list p)) ',parents) + nil nil) + nnoo-definition-alist))) + (put 'nnoo-declare 'lisp-indent-function 1) + (put 'nnoo-declare 'lisp-indent-hook 1) + + (defun nnoo-parents (backend) + (nth 1 (assoc backend nnoo-definition-alist))) + + (defun nnoo-variables (backend) + (nth 2 (assoc backend nnoo-definition-alist))) + + (defun nnoo-functions (backend) + (nth 3 (assoc backend nnoo-definition-alist))) + + (defmacro nnoo-import (backend &rest imports) + `(nnoo-import-1 ',backend ',imports)) + (put 'nnoo-import 'lisp-indent-function 1) + (put 'nnoo-import 'lisp-indent-hook 1) + + (defun nnoo-import-1 (backend imports) + (let ((call-function + (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function)) + imp functions function) + (while (setq imp (pop imports)) + (setq functions + (or (cdr imp) + (nnoo-functions (car imp)))) + (while functions + (unless (fboundp (setq function + (nnoo-symbol backend (nnoo-rest-symbol + (car functions))))) + (eval `(deffoo ,function (&rest args) + (,call-function ',backend ',(car functions) args)))) + (pop functions))))) + + (defun nnoo-parent-function (backend function args) + (let* ((pbackend (nnoo-backend function))) + (nnoo-change-server pbackend (nnoo-current-server backend) + (cdr (assq pbackend (nnoo-parents backend)))) + (apply function args))) + + (defun nnoo-execute (backend function &rest args) + "Execute FUNCTION on behalf of BACKEND." + (let* ((pbackend (nnoo-backend function))) + (nnoo-change-server pbackend (nnoo-current-server backend) + (cdr (assq pbackend (nnoo-parents backend)))) + (apply function args))) + + (defmacro nnoo-map-functions (backend &rest maps) + `(nnoo-map-functions-1 ',backend ',maps)) + (put 'nnoo-map-functions 'lisp-indent-function 1) + (put 'nnoo-map-functions 'lisp-indent-hook 1) + + (defun nnoo-map-functions-1 (backend maps) + (let (m margs i) + (while (setq m (pop maps)) + (setq i 0 + margs nil) + (while (< i (length (cdr m))) + (if (numberp (nth i (cdr m))) + (push `(nth ,i args) margs) + (push (nth i (cdr m)) margs)) + (incf i)) + (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) + (&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))))) + + (defun nnoo-rest-symbol (symbol) + (string-match "^[^-]+-" (symbol-name symbol)) + (intern (substring (symbol-name symbol) (match-end 0)))) + + (defun nnoo-symbol (backend symbol) + (intern (format "%s-%s" backend symbol))) + + (defun nnoo-define (var map) + (let* ((backend (nnoo-backend var)) + (def (assq backend nnoo-definition-alist)) + (parents (nth 1 def))) + (unless def + (error "%s belongs to a backend that hasn't been declared." var)) + (setcar (nthcdr 2 def) + (delq (assq var (nth 2 def)) (nth 2 def))) + (setcar (nthcdr 2 def) + (cons (cons var (symbol-value var)) + (nth 2 def))) + (while map + (nconc (assq (nnoo-backend (car map)) parents) + (list (list (pop map) var)))))) + + (defun nnoo-change-server (backend server defs) + (let* ((bstate (cdr (assq backend nnoo-state-alist))) + (sdefs (assq backend nnoo-definition-alist)) + (current (car bstate)) + (parents (nnoo-parents backend)) + state) + (unless bstate + (push (setq bstate (list backend nil)) + nnoo-state-alist) + (pop bstate)) + (if (equal server current) + t + (nnoo-push-server backend current) + (setq state (or (cdr (assoc server (cddr bstate))) + (nnoo-variables backend))) + (while state + (set (caar state) (cdar state)) + (pop state)) + (setcar bstate server) + (unless (cdr (assoc server (cddr bstate))) + (while defs + (set (caar defs) (cadar defs)) + (pop defs))) + (while parents + (nnoo-change-server + (caar parents) server + (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) + (cdar parents))) + (pop parents)))) + t) + + (defun nnoo-push-server (backend current) + (let ((bstate (assq backend nnoo-state-alist)) + (defs (nnoo-variables backend))) + ;; Remove the old definition. + (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) + (let (state) + (while defs + (push (cons (caar defs) (symbol-value (caar defs))) + state) + (pop defs)) + (nconc bstate (list (cons current state)))))) + + (defun nnoo-current-server-p (backend server) + (equal (nnoo-current-server backend) server)) + + (defun nnoo-current-server (backend) + (nth 1 (assq backend nnoo-state-alist))) + + (defun nnoo-close-server (backend &optional server) + (unless server + (setq server (nnoo-current-server backend))) + (when server + (let* ((bstate (cdr (assq backend nnoo-state-alist))) + (defs (assoc server (cdr bstate)))) + (when bstate + (setcar bstate nil) + (setcdr bstate (delq defs (cdr bstate))) + (pop defs) + (while defs + (set (car (pop defs)) nil))))) + t) + + (defun nnoo-close (backend) + (setq nnoo-state-alist + (delq (assq backend nnoo-state-alist) + nnoo-state-alist)) + t) + + (defun nnoo-status-message (backend server) + (nnheader-get-report backend)) + + (defun nnoo-server-opened (backend server) + (and (nnoo-current-server-p backend server) + nntp-server-buffer + (buffer-name nntp-server-buffer))) + + (defmacro nnoo-define-basics (backend) + `(eval-and-compile + (nnoo-define-basics-1 ',backend))) + + (defun nnoo-define-basics-1 (backend) + (let ((functions '(close-server server-opened status-message))) + (while functions + (eval `(deffoo ,(nnoo-symbol backend (car functions)) + (&optional server) + (,(nnoo-symbol 'nnoo (pop functions)) ',backend server))))) + (eval `(deffoo ,(nnoo-symbol backend 'open-server) + (server &optional defs) + (nnoo-change-server ',backend server defs)))) + + (provide 'nnoo) + + ;;; nnoo.el ends here. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnsoup.el emacs-19.32/lisp/nnsoup.el *** emacs-19.31/lisp/nnsoup.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/nnsoup.el Tue Jun 25 18:32:34 1996 *************** *** 0 **** --- 1,747 ---- + ;;; nnsoup.el --- SOUP access for Gnus + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Masanobu UMEDA + ;; Keywords: news, mail + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'nnheader) + (require 'nnmail) + (require 'gnus-soup) + (require 'gnus-msg) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nnsoup) + + (defvoo nnsoup-directory "~/SOUP/" + "*SOUP packet directory.") + + (defvoo nnsoup-tmp-directory "/tmp/" + "*Where nnsoup will store temporary files.") + + (defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/") + "*Directory where outgoing packets will be composed.") + + (defvoo nnsoup-replies-format-type ?n + "*Format of the replies packages.") + + (defvoo nnsoup-replies-index-type ?n + "*Index type of the replies packages.") + + (defvoo nnsoup-active-file (concat nnsoup-directory "active") + "Active file.") + + (defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz" + "Format string command for packing a SOUP packet. + The SOUP files will be inserted where the %s is in the string. + This string MUST contain both %s and %d. The file number will be + inserted where %d appears.") + + (defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -" + "*Format string command for unpacking a SOUP packet. + The SOUP packet file name will be inserted at the %s.") + + (defvoo nnsoup-packet-directory "~/" + "*Where nnsoup will look for incoming packets.") + + (defvoo nnsoup-packet-regexp "Soupout" + "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") + + + + (defconst nnsoup-version "nnsoup 0.0" + "nnsoup version.") + + (defvoo nnsoup-status-string "") + (defvoo nnsoup-group-alist nil) + (defvoo nnsoup-current-prefix 0) + (defvoo nnsoup-replies-list nil) + (defvoo nnsoup-buffers nil) + (defvoo nnsoup-current-group nil) + (defvoo nnsoup-group-alist-touched nil) + + + + ;;; Interface functions. + + (nnoo-define-basics nnsoup) + + (deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old) + (nnsoup-possibly-change-group group) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist))) + (articles sequence) + (use-nov t) + useful-areas this-area-seq msg-buf) + (if (stringp (car sequence)) + ;; We don't support fetching by Message-ID. + 'headers + ;; We go through all the areas and find which files the + ;; articles in SEQUENCE come from. + (while (and areas sequence) + ;; Peel off areas that are below sequence. + (while (and areas (< (cdaar areas) (car sequence))) + (setq areas (cdr areas))) + (when areas + ;; This is a useful area. + (push (car areas) useful-areas) + (setq this-area-seq nil) + ;; We take note whether this MSG has a corresponding IDX + ;; for later use. + (when (or (= (gnus-soup-encoding-index + (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) + (not (file-exists-p + (nnsoup-file + (gnus-soup-area-prefix (nth 1 (car areas))))))) + (setq use-nov nil)) + ;; We assign the portion of `sequence' that is relevant to + ;; this MSG packet to this packet. + (while (and sequence (<= (car sequence) (cdaar areas))) + (push (car sequence) this-area-seq) + (setq sequence (cdr sequence))) + (setcar useful-areas (cons (nreverse this-area-seq) + (car useful-areas))))) + + ;; We now have a list of article numbers and corresponding + ;; areas. + (setq useful-areas (nreverse useful-areas)) + + ;; Two different approaches depending on whether all the MSG + ;; files have corresponding IDX files. If they all do, we + ;; simply return the relevant IDX files and let Gnus sort out + ;; what lines are relevant. If some of the IDX files are + ;; missing, we must return HEADs for all the articles. + (if use-nov + ;; We have IDX files for all areas. + (progn + (while useful-areas + (goto-char (point-max)) + (let ((b (point)) + (number (car (nth 1 (car useful-areas)))) + (index-buffer (nnsoup-index-buffer + (gnus-soup-area-prefix + (nth 2 (car useful-areas)))))) + (when index-buffer + (insert-buffer-substring index-buffer) + (goto-char b) + ;; We have to remove the index number entires and + ;; insert article numbers instead. + (while (looking-at "[0-9]+") + (replace-match (int-to-string number) t t) + (incf number) + (forward-line 1)))) + (setq useful-areas (cdr useful-areas))) + 'nov) + ;; We insert HEADs. + (while useful-areas + (setq articles (caar useful-areas) + useful-areas (cdr useful-areas)) + (while articles + (when (setq msg-buf + (nnsoup-narrow-to-article + (car articles) (cdar useful-areas) 'head)) + (goto-char (point-max)) + (insert (format "221 %d Article retrieved.\n" (car articles))) + (insert-buffer-substring msg-buf) + (goto-char (point-max)) + (insert ".\n")) + (setq articles (cdr articles)))) + + (nnheader-fold-continuation-lines) + 'headers))))) + + (deffoo nnsoup-open-server (server &optional defs) + (nnoo-change-server 'nnsoup server defs) + (when (not (file-exists-p nnsoup-directory)) + (condition-case () + (make-directory nnsoup-directory t) + (error t))) + (cond + ((not (file-exists-p nnsoup-directory)) + (nnsoup-close-server) + (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) + ((not (file-directory-p (file-truename nnsoup-directory))) + (nnsoup-close-server) + (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory)) + (t + (nnsoup-read-active-file) + (nnheader-report 'nnsoup "Opened server %s using directory %s" + server nnsoup-directory) + t))) + + (deffoo nnsoup-request-close () + (nnsoup-write-active-file) + (nnsoup-write-replies) + (gnus-soup-save-areas) + ;; Kill all nnsoup buffers. + (let (buffer) + (while nnsoup-buffers + (setq buffer (cdr (pop nnsoup-buffers))) + (and buffer + (buffer-name buffer) + (kill-buffer buffer)))) + (setq nnsoup-group-alist nil + nnsoup-group-alist-touched nil + nnsoup-current-group nil + nnsoup-replies-list nil) + (nnoo-close-server 'nnoo) + t) + + (deffoo nnsoup-request-article (id &optional newsgroup server buffer) + (nnsoup-possibly-change-group newsgroup) + (let (buf) + (save-excursion + (set-buffer (or buffer nntp-server-buffer)) + (erase-buffer) + (when (and (not (stringp id)) + (setq buf (nnsoup-narrow-to-article id))) + (insert-buffer-substring buf) + t)))) + + (deffoo nnsoup-request-group (group &optional server dont-check) + (nnsoup-possibly-change-group group) + (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" + (max (1+ (- (cdr active) (car active))) 0) + (car active) (cdr active) group))))) + + (deffoo nnsoup-request-type (group &optional article) + (nnsoup-possibly-change-group group) + (if (not article) + 'unknown + (let ((kind (gnus-soup-encoding-kind + (gnus-soup-area-encoding + (nth 1 (nnsoup-article-to-area + article nnsoup-current-group)))))) + (cond ((= kind ?m) 'mail) + ((= kind ?n) 'news) + (t 'unknown))))) + + (deffoo nnsoup-close-group (group &optional server) + ;; Kill all nnsoup buffers. + (let ((buffers nnsoup-buffers) + elem) + (while buffers + (when (equal (car (setq elem (pop buffers))) group) + (setq nnsoup-buffers (delq elem nnsoup-buffers)) + (and (cdr elem) (buffer-name (cdr elem)) + (kill-buffer (cdr elem)))))) + t) + + (deffoo nnsoup-request-list (&optional server) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (unless nnsoup-group-alist + (nnsoup-read-active-file)) + (let ((alist nnsoup-group-alist) + (standard-output (current-buffer)) + entry) + (while (setq entry (pop alist)) + (insert (car entry) " ") + (princ (cdadr entry)) + (insert " ") + (princ (caadr entry)) + (insert " y\n")) + t))) + + (deffoo nnsoup-request-scan (group &optional server) + (nnsoup-unpack-packets)) + + (deffoo nnsoup-request-newgroups (date &optional server) + (nnsoup-request-list)) + + (deffoo nnsoup-request-list-newsgroups (&optional server) + nil) + + (deffoo nnsoup-request-post (&optional server) + (nnsoup-store-reply "news") + t) + + (deffoo nnsoup-request-mail (&optional server) + (nnsoup-store-reply "mail") + t) + + (deffoo nnsoup-request-expire-articles (articles group &optional server force) + (nnsoup-possibly-change-group group) + (let* ((total-infolist (assoc group nnsoup-group-alist)) + (active (cadr total-infolist)) + (infolist (cddr total-infolist)) + info range-list mod-time prefix) + (while infolist + (setq info (pop infolist) + range-list (gnus-uncompress-range (car info)) + prefix (gnus-soup-area-prefix (nth 1 info))) + (when ;; All the articles in this file are marked for expiry. + (and (or (setq mod-time (nth 5 (file-attributes + (nnsoup-file prefix)))) + (setq mod-time (nth 5 (file-attributes + (nnsoup-file prefix t))))) + (gnus-sublist-p articles range-list) + ;; This file is old enough. + (nnmail-expired-article-p group mod-time force)) + ;; Ok, we delete this file. + (when (condition-case nil + (progn + (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 + 5 "Deleting %s in group %s..." (nnsoup-file prefix t) + group) + (when (file-exists-p (nnsoup-file prefix t)) + (delete-file (nnsoup-file prefix t))) + t) + (error nil)) + (setcdr (cdr total-infolist) (delq info (cddr total-infolist))) + (setq articles (gnus-sorted-complement articles range-list)))) + (when (not mod-time) + (setcdr (cdr total-infolist) (delq info (cddr total-infolist))))) + (if (cddr total-infolist) + (setcar active (caaadr (cdr total-infolist))) + (setcar active (1+ (cdr active)))) + (nnsoup-write-active-file t) + ;; Return the articles that weren't expired. + articles)) + + + ;;; Internal functions + + (defun nnsoup-possibly-change-group (group &optional force) + (if group + (setq nnsoup-current-group group) + t)) + + (defun nnsoup-read-active-file () + (setq nnsoup-group-alist nil) + (when (file-exists-p nnsoup-active-file) + (condition-case () + (load nnsoup-active-file t t t) + (error nil)) + ;; Be backwards compatible. + (when (and nnsoup-group-alist + (not (atom (caadar nnsoup-group-alist)))) + (let ((alist nnsoup-group-alist) + entry e min max) + (while (setq e (cdr (setq entry (pop alist)))) + (setq min (caaar e)) + (while (cdr e) + (setq e (cdr e))) + (setq max (cdaar e)) + (setcdr entry (cons (cons min max) (cdr entry))))) + (setq nnsoup-group-alist-touched t)) + nnsoup-group-alist)) + + (defun nnsoup-write-active-file (&optional force) + (when (and nnsoup-group-alist + (or force + nnsoup-group-alist-touched)) + (setq nnsoup-group-alist-touched nil) + (nnheader-temp-write nnsoup-active-file + (let ((standard-output (current-buffer))) + (prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) + (insert "\n") + (prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) + (insert "\n"))))) + + (defun nnsoup-next-prefix () + "Return the next free prefix." + (let (prefix) + (while (or (file-exists-p + (nnsoup-file (setq prefix (int-to-string + nnsoup-current-prefix)))) + (file-exists-p (nnsoup-file prefix t))) + (incf nnsoup-current-prefix)) + (incf nnsoup-current-prefix) + prefix)) + + (defun nnsoup-read-areas () + (save-excursion + (set-buffer nntp-server-buffer) + (let ((areas (gnus-soup-parse-areas (concat nnsoup-tmp-directory "AREAS"))) + entry number area lnum cur-prefix file) + ;; Go through all areas in the new AREAS file. + (while (setq area (pop areas)) + ;; 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 + (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 + (gnus-soup-area-prefix area) ".MSG"))) + (rename-file file (nnsoup-file cur-prefix t)) + (gnus-soup-set-area-prefix area cur-prefix) + ;; Find the number of new articles in this area. + (setq number (nnsoup-number-of-articles area)) + (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. + (push (list (gnus-soup-area-name area) + (cons 1 number) + (list (cons 1 number) area)) + nnsoup-group-alist) + ;; There are already articles in this group, so we add this + ;; info to the end of the entry. + (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry))) + (+ lnum number)) + area))) + (setcdr (cadr entry) (+ lnum number)))))) + (nnsoup-write-active-file t) + (delete-file (concat nnsoup-tmp-directory "AREAS")))) + + (defun nnsoup-number-of-articles (area) + (save-excursion + (cond + ;; If the number is in the area info, we just return it. + ((gnus-soup-area-number area) + (gnus-soup-area-number area)) + ;; If there is an index file, we just count the lines. + ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n) + (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. + (t + (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) + (goto-char (point-min)) + (let ((regexp (nnsoup-header (gnus-soup-encoding-format + (gnus-soup-area-encoding area)))) + (num 0)) + (while (re-search-forward regexp nil t) + (setq num (1+ num))) + num))))) + + (defun nnsoup-index-buffer (prefix &optional message) + (let* ((file (concat prefix (if message ".MSG" ".IDX"))) + (buffer-name (concat " *nnsoup " file "*"))) + (or (get-buffer buffer-name) ; File aready loaded. + (when (file-exists-p (concat nnsoup-directory file)) + (save-excursion ; Load the file. + (set-buffer (get-buffer-create buffer-name)) + (buffer-disable-undo (current-buffer)) + (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) + (insert-file-contents (concat nnsoup-directory file)) + (current-buffer)))))) + + (defun nnsoup-file (prefix &optional message) + (expand-file-name + (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))) + + (defun nnsoup-message-buffer (prefix) + (nnsoup-index-buffer prefix 'msg)) + + (defun nnsoup-unpack-packets () + "Unpack all packets in `nnsoup-packet-directory'." + (let ((packets (directory-files + nnsoup-packet-directory t nnsoup-packet-regexp)) + packet) + (while (setq packet (pop packets)) + (message (format "nnsoup: unpacking %s..." packet)) + (if (not (gnus-soup-unpack-packet + nnsoup-tmp-directory nnsoup-unpacker packet)) + (message "Couldn't unpack %s" packet) + (delete-file packet) + (nnsoup-read-areas) + (message "Unpacking...done"))))) + + (defun nnsoup-narrow-to-article (article &optional area head) + (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) + (prefix (and area (gnus-soup-area-prefix (nth 1 area)))) + (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg))) + beg end) + (when area + (save-excursion + (cond + ;; 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 + (gnus-soup-area-encoding (nth 1 area))) + ?c) + (file-exists-p (nnsoup-file prefix))) + (set-buffer (nnsoup-index-buffer prefix)) + (widen) + (goto-char (point-min)) + (forward-line (- article (caar area))) + (setq beg (read (current-buffer))) + (forward-line 1) + (if (looking-at "[0-9]+") + (progn + (setq end (read (current-buffer))) + (set-buffer msg-buf) + (widen) + (let ((format (gnus-soup-encoding-format + (gnus-soup-area-encoding (nth 1 area))))) + (goto-char end) + (if (or (= format ?n) (= format ?m)) + (setq end (progn (forward-line -1) (point)))))) + (set-buffer msg-buf)) + (widen) + (narrow-to-region beg (or end (point-max)))) + (t + (set-buffer msg-buf) + (widen) + (goto-char (point-min)) + (let ((header (nnsoup-header + (gnus-soup-encoding-format + (gnus-soup-area-encoding (nth 1 area)))))) + (re-search-forward header nil t (- article (caar area))) + (narrow-to-region + (match-beginning 0) + (if (re-search-forward header nil t) + (match-beginning 0) + (point-max)))))) + (goto-char (point-min)) + (if (not head) + () + (narrow-to-region + (point-min) + (if (search-forward "\n\n" nil t) + (1- (point)) + (point-max)))) + msg-buf)))) + + (defun nnsoup-header (format) + (cond + ((= format ?n) + "^#! *rnews +[0-9]+ *$") + ((= format ?m) + (concat "^" message-unix-mail-delimiter)) + ((= format ?M) + "^\^A\^A\^A\^A\n") + (t + (error "Unknown format: %c" format)))) + + ;;;###autoload + (defun nnsoup-pack-replies () + "Make an outbound package of SOUP replies." + (interactive) + ;; Write all data buffers. + (gnus-soup-save-areas) + ;; Write the active file. + (nnsoup-write-active-file) + ;; Write the REPLIES file. + (nnsoup-write-replies) + ;; Pack all these files into a SOUP packet. + (gnus-soup-pack nnsoup-replies-directory nnsoup-packer)) + + (defun nnsoup-write-replies () + "Write the REPLIES file." + (when nnsoup-replies-list + (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list) + (setq nnsoup-replies-list nil))) + + (defun nnsoup-article-to-area (article group) + "Return the area that ARTICLE in GROUP is located in." + (let ((areas (cddr (assoc group nnsoup-group-alist)))) + (while (and areas (< (cdaar areas) article)) + (setq areas (cdr areas))) + (and areas (car areas)))) + + (defvar nnsoup-old-functions + (list message-send-mail-function message-send-news-function)) + + ;;;###autoload + (defun nnsoup-set-variables () + "Use the SOUP methods for posting news and mailing mail." + (interactive) + (setq message-send-news-function 'nnsoup-request-post) + (setq message-send-mail-function 'nnsoup-request-mail)) + + ;;;###autoload + (defun nnsoup-revert-variables () + "Revert posting and mailing methods to the standard Emacs methods." + (interactive) + (setq message-send-mail-function (car nnsoup-old-functions)) + (setq message-send-news-function (cadr nnsoup-old-functions))) + + (defun nnsoup-store-reply (kind) + ;; Mostly stolen from `message.el'. + (require 'mail-utils) + (let ((tembuf (generate-new-buffer " message temp")) + (case-fold-search nil) + (news (message-news-p)) + (resend-to-addresses (mail-fetch-field "resent-to")) + delimline + (mailbuf (current-buffer))) + (unwind-protect + (save-excursion + (save-restriction + (message-narrow-to-headers) + (if (equal kind "mail") + (message-generate-headers message-required-mail-headers) + (message-generate-headers message-required-news-headers))) + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + ;; Remove some headers. + (save-restriction + (message-narrow-to-headers) + ;; Remove some headers. + (message-remove-header message-ignored-mail-headers t)) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + (when (and news + (equal kind "mail") + (or (mail-fetch-field "cc") + (mail-fetch-field "to"))) + (message-insert-courtesy-copy)) + (let ((case-fold-search t)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (when (eval message-mailer-swallows-blank-line) + (newline)) + (let ((msg-buf + (gnus-soup-store + nnsoup-replies-directory + (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type + nnsoup-replies-index-type)) + (num 0)) + (when (and msg-buf (bufferp msg-buf)) + (save-excursion + (set-buffer msg-buf) + (goto-char (point-min)) + (while (re-search-forward "^#! *rnews" nil t) + (incf num))) + (message "Stored %d messages" num))) + (nnsoup-write-replies) + (kill-buffer tembuf)))))) + + (defun nnsoup-kind-to-prefix (kind) + (unless nnsoup-replies-list + (setq nnsoup-replies-list + (gnus-soup-parse-replies + (concat nnsoup-replies-directory "REPLIES")))) + (let ((replies nnsoup-replies-list)) + (while (and replies + (not (string= kind (gnus-soup-reply-kind (car replies))))) + (setq replies (cdr replies))) + (if replies + (gnus-soup-reply-prefix (car replies)) + (setq nnsoup-replies-list + (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory) + kind + (format "%c%c%c" + nnsoup-replies-format-type + nnsoup-replies-index-type + (if (string= kind "news") + ?n ?m))) + nnsoup-replies-list)) + (gnus-soup-reply-prefix (car nnsoup-replies-list))))) + + (defun nnsoup-make-active () + "(Re-)create the SOUP active file." + (interactive) + (let ((files (sort (directory-files nnsoup-directory t "IDX$") + (lambda (f1 f2) + (< (progn (string-match "/\\([0-9]+\\)\\." f1) + (string-to-int (match-string 1 f1))) + (progn (string-match "/\\([0-9]+\\)\\." f2) + (string-to-int (match-string 1 f2))))))) + active group lines ident elem min) + (set-buffer (get-buffer-create " *nnsoup work*")) + (buffer-disable-undo (current-buffer)) + (while files + (message "Doing %s..." (car files)) + (erase-buffer) + (insert-file-contents (car files)) + (goto-char (point-min)) + (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) + (setq group "unknown") + (setq group (match-string 2))) + (setq lines (count-lines (point-min) (point-max))) + (setq ident (progn (string-match + "/\\([0-9]+\\)\\." (car files)) + (substring + (car files) (match-beginning 1) + (match-end 1)))) + (if (not (setq elem (assoc group active))) + (push (list group (cons 1 lines) + (list (cons 1 lines) + (vector ident group "ncm" "" lines))) + active) + (nconc elem + (list + (list (cons (1+ (setq min (cdadr elem))) + (+ min lines)) + (vector ident group "ncm" "" lines)))) + (setcdr (cadr elem) (+ min lines))) + (setq files (cdr files))) + (message "") + (setq nnsoup-group-alist active) + (nnsoup-write-active-file t))) + + (defun nnsoup-delete-unreferenced-message-files () + "Delete any *.MSG and *.IDX files that aren't known by nnsoup." + (interactive) + (let* ((known (apply 'nconc (mapcar + (lambda (ga) + (mapcar + (lambda (area) + (gnus-soup-area-prefix (cadr area))) + (cddr ga))) + nnsoup-group-alist))) + (regexp "\\.MSG$\\|\\.IDX$") + (files (directory-files nnsoup-directory nil regexp)) + non-files file) + ;; Find all files that aren't known by nnsoup. + (while (setq file (pop files)) + (string-match regexp file) + (unless (member (substring file 0 (match-beginning 0)) known) + (push file non-files))) + ;; Sort and delete the files. + (setq non-files (sort non-files 'string<)) + (map-y-or-n-p "Delete file %s? " + (lambda (file) (delete-file (concat nnsoup-directory file))) + non-files))) + + (provide 'nnsoup) + + ;;; nnsoup.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnspool.el emacs-19.32/lisp/nnspool.el *** emacs-19.31/lisp/nnspool.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nnspool.el Fri Jun 28 20:04:04 1996 *************** *** 1,5 **** ;;; nnspool.el --- spool access for GNU Emacs ! ! ;; Copyright (C) 1988,89,90,93,94,95 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA --- 1,4 ---- ;;; nnspool.el --- spool access for GNU Emacs ! ;; Copyright (C) 1988,89,90,93,94,95,96 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA *************** *** 31,73 **** (require 'nntp) (require 'timezone) ! (defvar nnspool-inews-program news-inews-program "Program to post news. This is most commonly `inews' or `injnews'.") ! (defvar nnspool-inews-switches '("-h") "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") ! (defvar nnspool-spool-directory news-path "Local news spool directory.") ! (defvar nnspool-nov-directory (concat nnspool-spool-directory "over.view/") "Local news nov directory.") ! (defvar nnspool-lib-dir "/usr/lib/news/" "Where the local news library files are stored.") ! (defvar nnspool-active-file (concat nnspool-lib-dir "active") "Local news active file.") ! (defvar nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") "Local news newsgroups file.") ! (defvar nnspool-distributions-file (concat nnspool-lib-dir "distributions") "Local news distributions file.") ! (defvar nnspool-history-file (concat nnspool-lib-dir "history") "Local news history file.") ! (defvar nnspool-active-times-file (concat nnspool-lib-dir "active.times") "Local news active date file.") ! (defvar nnspool-large-newsgroup 50 "The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") ! (defvar nnspool-nov-is-evil nil "Non-nil means that nnspool will never return NOV lines instead of headers.") --- 30,76 ---- (require 'nntp) (require 'timezone) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nnspool) ! (defvoo nnspool-inews-program news-inews-program "Program to post news. This is most commonly `inews' or `injnews'.") ! (defvoo nnspool-inews-switches '("-h" "-S") "Switches for nnspool-request-post to pass to `inews' for posting news. If you are using Cnews, you probably should set this variable to nil.") ! (defvoo nnspool-spool-directory (file-name-as-directory news-path) "Local news spool directory.") ! (defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") "Local news nov directory.") ! (defvoo nnspool-lib-dir "/usr/lib/news/" "Where the local news library files are stored.") ! (defvoo nnspool-active-file (concat nnspool-lib-dir "active") "Local news active file.") ! (defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") "Local news newsgroups file.") ! (defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat") "Local news distributions file.") ! (defvoo nnspool-history-file (concat nnspool-lib-dir "history") "Local news history file.") ! (defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times") "Local news active date file.") ! (defvoo nnspool-large-newsgroup 50 "The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") ! (defvoo nnspool-nov-is-evil nil "Non-nil means that nnspool will never return NOV lines instead of headers.") *************** If nil, nnspool will load the entire fil *** 77,80 **** --- 80,86 ---- there.") + (defvoo nnspool-rejected-article-hook nil + "*A hook that will be run when an article has been rejected by the server.") + *************** there.") *** 82,288 **** "Version numbers of this version of NNSPOOL.") ! (defvar nnspool-current-directory nil "Current news group directory.") ! (defvar nnspool-current-group nil) ! (defvar nnspool-status-string "") ! ! ! ! (defvar nnspool-current-server nil) ! (defvar nnspool-server-alist nil) ! (defvar nnspool-server-variables ! (list ! (list 'nnspool-inews-program nnspool-inews-program) ! (list 'nnspool-inews-switches nnspool-inews-switches) ! (list 'nnspool-spool-directory nnspool-spool-directory) ! (list 'nnspool-nov-directory nnspool-nov-directory) ! (list 'nnspool-lib-dir nnspool-lib-dir) ! (list 'nnspool-active-file nnspool-active-file) ! (list 'nnspool-newsgroups-file nnspool-newsgroups-file) ! (list 'nnspool-distributions-file nnspool-distributions-file) ! (list 'nnspool-history-file nnspool-history-file) ! (list 'nnspool-active-times-file nnspool-active-times-file) ! (list 'nnspool-large-newsgroup nnspool-large-newsgroup) ! (list 'nnspool-nov-is-evil nnspool-nov-is-evil) ! (list 'nnspool-sift-nov-with-sed nnspool-sift-nov-with-sed) ! '(nnspool-current-directory nil) ! '(nnspool-current-group nil) ! '(nnspool-status-string ""))) ;;; Interface functions. ! (defun nnspool-retrieve-headers (sequence &optional newsgroup server) ! "Retrieve the headers for the articles in SEQUENCE. ! Newsgroup must be selected before calling this function." (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (let* ((number (length sequence)) ! (count 0) ! (do-message (and (numberp nnspool-large-newsgroup) ! (> number nnspool-large-newsgroup))) ! file beg article) ! (if (not (nnspool-possibly-change-directory newsgroup)) ! () ! (if (and (numberp (car sequence)) ! (nnspool-retrieve-headers-with-nov sequence)) 'nov ! (while sequence ! (setq article (car sequence)) (if (stringp article) ! (progn ! (setq file (nnspool-find-article-by-message-id article)) ! (setq article 0)) ! (setq file (concat nnspool-current-directory ! (int-to-string article)))) ! (and file (file-exists-p file) ! (progn ! (insert (format "221 %d Article retrieved.\n" article)) ! (setq beg (point)) ! (nnheader-insert-head file) ! (goto-char beg) ! (search-forward "\n\n" nil t) ! (forward-char -1) ! (insert ".\n") ! (delete-region (point) (point-max)))) ! (setq sequence (cdr sequence)) (and do-message ! (zerop (% (setq count (1+ count)) 20)) ! (message "NNSPOOL: Receiving headers... %d%%" (/ (* count 100) number)))) ! (and do-message (message "NNSPOOL: Receiving headers...done")) ;; Fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " " t t)) 'headers))))) ! (defun nnspool-open-server (server &optional defs) ! (nnheader-init-server-buffer) ! (if (equal server nnspool-current-server) ! t ! (if nnspool-current-server ! (setq nnspool-server-alist ! (cons (list nnspool-current-server ! (nnheader-save-variables nnspool-server-variables)) ! nnspool-server-alist))) ! (let ((state (assoc server nnspool-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nnspool-server-alist (delq state nnspool-server-alist))) ! (nnheader-set-init-variables nnspool-server-variables defs))) ! (setq nnspool-current-server server))) ! ! (defun nnspool-close-server (&optional server) ! t) ! ! (defun nnspool-server-opened (&optional server) ! (and (equal server nnspool-current-server) ! nntp-server-buffer ! (buffer-name nntp-server-buffer))) ! ! (defun nnspool-status-message (&optional server) ! "Return server status response as string." ! nnspool-status-string) ! (defun nnspool-request-article (id &optional newsgroup server buffer) "Select article by message ID (or number)." ! (nnspool-possibly-change-directory newsgroup) ! (let ((file (if (stringp id) ! (nnspool-find-article-by-message-id id) ! (concat nnspool-current-directory (prin1-to-string id)))) ! (nntp-server-buffer (or buffer nntp-server-buffer))) ! (if (and (stringp file) ! (file-exists-p file) ! (not (file-directory-p file))) ! (save-excursion ! (nnspool-find-file file))))) ! ! (defun nnspool-request-body (id &optional newsgroup server) "Select article body by message ID (or number)." ! (nnspool-possibly-change-directory newsgroup) ! (if (nnspool-request-article id) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (delete-region (point-min) (point))) ! t))) ! (defun nnspool-request-head (id &optional newsgroup server) "Select article head by message ID (or number)." ! (nnspool-possibly-change-directory newsgroup) ! (if (nnspool-request-article id) (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (if (search-forward "\n\n" nil t) ! (delete-region (1- (point)) (point-max))) ! t))) ! (defun nnspool-request-group (group &optional server dont-check) "Select news GROUP." ! (let ((pathname (nnspool-article-pathname ! (nnspool-replace-chars-in-string group ?. ?/))) dir) (if (not (file-directory-p pathname)) ! (progn ! (setq nnspool-status-string ! "Invalid group name (no such directory)") ! nil) (setq nnspool-current-directory pathname) ! (setq nnspool-status-string "") ! (if (not dont-check) (progn ! (setq dir (directory-files pathname nil "^[0-9]+$" t)) ! ;; yes, completely empty spool directories *are* possible ! ;; Fix by Sudish Joseph ! (and dir ! (setq dir ! (sort ! (mapcar ! (function ! (lambda (name) ! (string-to-int name))) ! dir) ! '<))) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if dir ! (insert ! (format "211 %d %d %d %s\n" (length dir) (car dir) ! (progn (while (cdr dir) (setq dir (cdr dir))) ! (car dir)) ! group)) ! (insert (format "211 0 0 0 %s\n" group)))))) ! t))) ! (defun nnspool-close-group (group &optional server) t) ! (defun nnspool-request-list (&optional server) "List active newsgroups." (save-excursion ! (nnspool-find-file nnspool-active-file))) ! (defun nnspool-request-list-newsgroups (&optional server) "List newsgroups (defined in NNTP2)." (save-excursion ! (nnspool-find-file nnspool-newsgroups-file))) ! (defun nnspool-request-list-distributions (&optional server) "List distributions (defined in NNTP2)." (save-excursion ! (nnspool-find-file nnspool-distributions-file))) ;; Suggested by Hallvard B Furuseth . ! (defun nnspool-request-newgroups (date &optional server) "List groups created after DATE." (if (nnspool-find-file nnspool-active-times-file) --- 88,272 ---- "Version numbers of this version of NNSPOOL.") ! (defvoo nnspool-current-directory nil "Current news group directory.") ! (defvoo nnspool-current-group nil) ! (defvoo nnspool-status-string "") ;;; Interface functions. ! (nnoo-define-basics nnspool) ! ! (deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) ! "Retrieve the headers of ARTICLES." (save-excursion (set-buffer nntp-server-buffer) (erase-buffer) ! (when (nnspool-possibly-change-directory group) ! (let* ((number (length articles)) ! (count 0) ! (default-directory nnspool-current-directory) ! (do-message (and (numberp nnspool-large-newsgroup) ! (> number nnspool-large-newsgroup))) ! file beg article ag) ! (if (and (numberp (car articles)) ! (nnspool-retrieve-headers-with-nov articles fetch-old)) ! ;; We successfully retrieved the NOV headers. 'nov ! ;; No NOV headers here, so we do it the hard way. ! (while (setq article (pop articles)) (if (stringp article) ! ;; This is a Message-ID. ! (setq ag (nnspool-find-id article) ! file (and ag (nnspool-article-pathname ! (car ag) (cdr ag))) ! article (cdr ag)) ! ;; This is an article in the current group. ! (setq file (int-to-string article))) ! ;; Insert the head of the article. ! (when (and file ! (file-exists-p file)) ! (insert "221 ") ! (princ article (current-buffer)) ! (insert " Article retrieved.\n") ! (setq beg (point)) ! (inline (nnheader-insert-head file)) ! (goto-char beg) ! (search-forward "\n\n" nil t) ! (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)))) ! (and 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 ! ((not (file-exists-p nnspool-spool-directory)) ! (nnspool-close-server) ! (nnheader-report 'nnspool "Spool directory doesn't exist: %s" ! nnspool-spool-directory)) ! ((not (file-directory-p ! (directory-file-name ! (file-truename nnspool-spool-directory)))) ! (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" ! nnspool-active-file)) ! (t ! (nnheader-report 'nnspool "Opened server %s using directory %s" ! server nnspool-spool-directory) ! t))) ! (deffoo nnspool-request-article (id &optional group server buffer) "Select article by message ID (or number)." ! (nnspool-possibly-change-directory group) ! (let ((nntp-server-buffer (or buffer nntp-server-buffer)) ! file ag) ! (if (stringp 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))) ! (and file ! (file-exists-p file) ! (not (file-directory-p file)) ! (save-excursion (nnspool-find-file file)) ! ;; We return the article number and group name. ! (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) ! (let ((res (nnspool-request-article id))) ! (when res (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (delete-region (point-min) (point))) ! res)))) ! (deffoo nnspool-request-head (id &optional group server) "Select article head by message ID (or number)." ! (nnspool-possibly-change-directory group) ! (let ((res (nnspool-request-article id))) ! (when res (save-excursion (set-buffer nntp-server-buffer) (goto-char (point-min)) ! (when (search-forward "\n\n" nil t) ! (delete-region (1- (point)) (point-max))) ! (nnheader-fold-continuation-lines))) ! res)) ! (deffoo nnspool-request-group (group &optional server dont-check) "Select news GROUP." ! (let ((pathname (nnspool-article-pathname group)) dir) (if (not (file-directory-p pathname)) ! (nnheader-report ! 'nnspool "Invalid group name (no such directory): %s" group) (setq nnspool-current-directory pathname) ! (nnheader-report 'nnspool "Selected group %s" group) ! (if dont-check (progn ! (nnheader-report 'nnspool "Selected group %s" group) ! t) ! ;; Yes, completely empty spool directories *are* possible. ! ;; Fix by Sudish Joseph ! (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) ! (setq dir ! (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) ! (if dir ! (nnheader-insert ! "211 %d %d %d %s\n" (length dir) (car dir) ! (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) ! group) ! (nnheader-report 'nnspool "Empty group %s" group) ! (nnheader-insert "211 0 0 0 %s\n" group)))))) ! ! (deffoo nnspool-request-type (group &optional article) ! 'news) ! (deffoo nnspool-close-group (group &optional server) t) ! (deffoo nnspool-request-list (&optional server) "List active newsgroups." (save-excursion ! (or (nnspool-find-file nnspool-active-file) ! (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) ! (deffoo nnspool-request-list-newsgroups (&optional server) "List newsgroups (defined in NNTP2)." (save-excursion ! (or (nnspool-find-file nnspool-newsgroups-file) ! (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 ! nnspool-distributions-file))))) ;; Suggested by Hallvard B Furuseth . ! (deffoo nnspool-request-newgroups (date &optional server) "List groups created after DATE." (if (nnspool-find-file nnspool-active-times-file) *************** Newsgroup must be selected before callin *** 318,336 **** nil)) ! (defun nnspool-request-post (&optional server) "Post a new news in current buffer." (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) ! (proc (apply 'start-process "*nnspool inews*" inews-buffer ! nnspool-inews-program nnspool-inews-switches))) ! (set-process-sentinel proc 'nnspool-inews-sentinel) ! (process-send-region proc (point-min) (point-max)) ! ;; We slap a condition-case around this, because the process may ! ;; have exited already... ! (condition-case nil ! (process-send-eof proc) ! (error nil)) ! t))) (defun nnspool-inews-sentinel (proc status) --- 302,332 ---- nil)) ! (deffoo nnspool-request-post (&optional server) "Post a new news in current buffer." (save-excursion (let* ((process-connection-type nil) ; t bugs out on Solaris (inews-buffer (generate-new-buffer " *nnspool post*")) ! (proc ! (condition-case err ! (apply 'start-process "*nnspool inews*" inews-buffer ! nnspool-inews-program nnspool-inews-switches) ! (error ! (nnheader-report 'nnspool "inews error: %S" err))))) ! (if (not proc) ! ;; The inews program failed. ! () ! (nnheader-report 'nnspool "") ! (set-process-sentinel proc 'nnspool-inews-sentinel) ! (process-send-region proc (point-min) (point-max)) ! ;; We slap a condition-case around this, because the process may ! ;; have exited already... ! (condition-case nil ! (process-send-eof proc) ! (error nil)) ! t)))) ! ! ! ! ;;; Internal functions. (defun nnspool-inews-sentinel (proc status) *************** Newsgroup must be selected before callin *** 341,407 **** (search-forward "spooled" nil t)) (kill-buffer (current-buffer)) ! ;; Make status message by unfolding lines. ! (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) ! (setq nnspool-status-string (buffer-string)) (message "nnspool: %s" nnspool-status-string) ! ;(kill-buffer (current-buffer)) ! ))) ! ! (defalias 'nnspool-request-post-buffer 'nntp-request-post-buffer) ! ! ! ;;; Internal functions. ! (defun nnspool-retrieve-headers-with-nov (articles) (if (or gnus-nov-is-evil nnspool-nov-is-evil) nil ! (let ((nov (concat (file-name-as-directory nnspool-nov-directory) ! (nnspool-replace-chars-in-string ! nnspool-current-group ?. ?/) ! "/.overview")) ! article) ! (if (file-exists-p nov) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if nnspool-sift-nov-with-sed ! (nnspool-sift-nov-with-sed articles nov) ! (insert-file-contents nov) ! ;; First we find the first wanted line. We issue a number ! ;; of search-forwards - the first article we are looking ! ;; for may be expired, so we have to go on searching until ! ;; we find one of the articles we want. ! (while (and articles ! (setq article (concat (int-to-string ! (car articles)) "\t")) ! (not (or (looking-at article) ! (search-forward (concat "\n" article) ! nil t)))) ! (setq articles (cdr articles))) ! (if (not articles) ! () ! (beginning-of-line) ! (delete-region (point-min) (point)) ! ;; Then we find the last wanted line. We go to the end ! ;; of the buffer and search backward much the same way ! ;; we did to find the first article. ! ;; !!! Perhaps it would be better just to do a (last articles), ! ;; and go forward successively over each line and ! ;; compare to avoid this (reverse), like this: ! ;; (while (and (>= last (read nntp-server-buffer))) ! ;; (zerop (forward-line 1)))) ! (setq articles (reverse articles)) ! (goto-char (point-max)) ! (while (and articles ! (not (search-backward ! (concat "\n" (int-to-string (car articles)) ! "\t") nil t))) ! (setq articles (cdr articles))) ! (if articles ! (progn ! (forward-line 2) ! (delete-region (point) (point-max))))) ! (or articles (progn (erase-buffer) nil)))))))) (defun nnspool-sift-nov-with-sed (articles file) (let ((first (car articles)) --- 337,452 ---- (search-forward "spooled" nil t)) (kill-buffer (current-buffer)) ! ;; Make status message by folding lines. ! (while (re-search-forward "[ \t\n]+" nil t) ! (replace-match " " t t)) ! (nnheader-report 'nnspool "%s" (buffer-string)) (message "nnspool: %s" nnspool-status-string) ! (ding) ! (run-hooks 'nnspool-rejected-article-hook)))) ! (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 ! nnspool-current-group nnspool-nov-directory ".overview")) ! (arts articles) ! last) ! (if (not (file-exists-p nov)) ! () ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if nnspool-sift-nov-with-sed ! (nnspool-sift-nov-with-sed articles nov) ! (insert-file-contents nov) ! (if (and fetch-old ! (not (numberp fetch-old))) ! t ; We want all the headers. ! (condition-case () ! (progn ! ;; First we find the first wanted line. ! (nnspool-find-nov-line ! (if fetch-old (max 1 (- (car articles) fetch-old)) ! (car articles))) ! (delete-region (point-min) (point)) ! ;; Then we find the last wanted line. ! (if (nnspool-find-nov-line ! (progn (while (cdr articles) ! (setq articles (cdr articles))) ! (car articles))) ! (forward-line 1)) ! (delete-region (point) (point-max)) ! ;; If the buffer is empty, this wasn't very successful. ! (unless (zerop (buffer-size)) ! ;; 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) ! (setq last (read (current-buffer))) ! (if (= last (car articles)) ! ;; Yup, it's all there. ! t ! ;; Perhaps not. We try to find the missing articles. ! (while (and arts ! (<= last (car arts))) ! (pop arts)) ! ;; The articles in `arts' are missing from the buffer. ! (while arts ! (nnspool-insert-nov-head (pop arts))) ! t))) ! ;; The NOV file was corrupted. ! (error nil))))))))) + (defun nnspool-insert-nov-head (article) + "Read the head of ARTICLE, convert to NOV headers, and insert." + (save-excursion + (let ((cur (current-buffer)) + buf) + (setq buf (nnheader-set-temp-buffer " *nnspool head*")) + (when (nnheader-insert-head + (nnspool-article-pathname nnspool-current-group article)) + (nnheader-insert-article-line article) + (let ((headers (nnheader-parse-head))) + (set-buffer cur) + (goto-char (point-max)) + (nnheader-insert-nov headers))) + (kill-buffer buf)))) + + (defun nnspool-find-nov-line (article) + (let ((max (point-max)) + (min (goto-char (point-min))) + (cur (current-buffer)) + (prev (point-min)) + num found) + (while (not found) + (goto-char (/ (+ max min) 2)) + (beginning-of-line) + (if (or (= (point) prev) + (eobp)) + (setq found t) + (setq prev (point)) + (cond ((> (setq num (read cur)) article) + (setq max (point))) + ((< num article) + (setq min (point))) + (t + (setq found 'yes))))) + ;; Now we may have found the article we're looking for, or we + ;; may be somewhere near it. + (when (and (not (eq found 'yes)) + (not (eq num article))) + (setq found (point)) + (while (and (< (point) max) + (or (not (numberp num)) + (< num article))) + (forward-line 1) + (setq found (point)) + (or (eobp) + (= (setq num (read cur)) article))) + (unless (eq num article) + (goto-char found))) + (beginning-of-line) + (eq num article))) + (defun nnspool-sift-nov-with-sed (articles file) (let ((first (car articles)) *************** Newsgroup must be selected before callin *** 414,430 **** ;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). ! (defun nnspool-find-article-by-message-id (id) ! "Return full pathname of an article identified by message-ID." (save-excursion ! (let ((buf (get-buffer-create " *nnspool work*"))) ! (set-buffer buf) ! (erase-buffer) ! (call-process "grep" nil t nil id nnspool-history-file) ! (goto-char (point-min)) ! (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ \t\n]*\\)") ! (concat nnspool-spool-directory ! (nnspool-replace-chars-in-string ! (buffer-substring (match-beginning 1) (match-end 1)) ! ?. ?/)))))) (defun nnspool-find-file (file) --- 459,476 ---- ;; 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 ! (set-buffer (get-buffer-create " *nnspool work*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (condition-case () ! (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file) ! (error nil)) ! (goto-char (point-min)) ! (prog1 ! (if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") ! (cons (match-string 1) (string-to-int (match-string 2)))) ! (kill-buffer (current-buffer))))) (defun nnspool-find-file (file) *************** Newsgroup must be selected before callin *** 433,481 **** (erase-buffer) (condition-case () ! (progn (insert-file-contents file) t) (file-error nil))) ! (defun nnspool-possibly-change-directory (newsgroup) ! (if newsgroup ! (let ((pathname (nnspool-article-pathname ! (nnspool-replace-chars-in-string newsgroup ?. ?/)))) ! (if (file-directory-p pathname) ! (progn ! (setq nnspool-current-directory pathname) ! (setq nnspool-current-group newsgroup)) ! (setq nnspool-status-string ! (format "No such newsgroup: %s" newsgroup)) ! nil)) ! t)) ! ! (defun nnspool-article-pathname (group) ! "Make pathname for GROUP." ! (concat (file-name-as-directory nnspool-spool-directory) group "/")) ! ! (defun nnspool-replace-chars-in-string (string from to) ! "Replace characters in STRING from FROM to TO." ! (let ((string (substring string 0)) ;Copy string. ! (len (length string)) ! (idx 0)) ! ;; Replace all occurrences of FROM with TO. ! (while (< idx len) ! (if (= (aref string idx) from) ! (aset string idx to)) ! (setq idx (1+ idx))) ! string)) ! ! (defun nnspool-number-base-10 (num pos) ! (if (<= pos 0) "" ! (setcdr num (+ (* (% (car num) 10) 65536) (cdr num))) ! (apply ! 'concat ! (reverse ! (list ! (char-to-string ! (aref "0123456789" (% (cdr num) 10))) ! (progn ! (setcdr num (/ (cdr num) 10)) ! (setcar num (/ (car num) 10)) ! (nnspool-number-base-10 num (1- pos)))))))) (defun nnspool-seconds-since-epoch (date) --- 479,497 ---- (erase-buffer) (condition-case () ! (progn (nnheader-insert-file-contents-literally file) t) (file-error nil))) ! (defun nnspool-possibly-change-directory (group) ! (if (not group) ! t ! (let ((pathname (nnspool-article-pathname group))) ! (if (file-directory-p pathname) ! (setq nnspool-current-directory pathname ! nnspool-current-group group) ! (nnheader-report 'nnspool "No such newsgroup: %s" group))))) ! ! (defun nnspool-article-pathname (group &optional article) ! "Find the path for GROUP." ! (nnheader-group-pathname group nnspool-spool-directory article)) (defun nnspool-seconds-since-epoch (date) *************** Newsgroup must be selected before callin *** 486,492 **** (aref (timezone-parse-date date) 3)))) (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) ! (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) (nth 4 tdate)))) (+ (* (car unix) 65536.0) ! (car (cdr unix))))) (provide 'nnspool) --- 502,509 ---- (aref (timezone-parse-date date) 3)))) (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) ! (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) ! (nth 4 tdate)))) (+ (* (car unix) 65536.0) ! (cadr unix)))) (provide 'nnspool) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nntp.el emacs-19.32/lisp/nntp.el *** emacs-19.31/lisp/nntp.el Fri Feb 23 19:33:36 1996 --- emacs-19.32/lisp/nntp.el Tue Jun 25 18:24:01 1996 *************** *** 1,4 **** ;;; nntp.el --- nntp access for Gnus - ;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc. --- 1,3 ---- *************** *** 28,41 **** ;;; Code: - (require 'rnews) - (require 'sendmail) (require 'nnheader) (eval-when-compile (require 'cl)) (eval-and-compile - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'nnmail-request-post-buffer "nnmail") (autoload 'cancel-timer "timer") (autoload 'telnet "telnet" nil t) --- 27,43 ---- ;;; Code: (require 'nnheader) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nntp) + + (eval-and-compile + (unless (fboundp 'open-network-stream) + (require 'tcp))) (eval-when-compile (require 'cl)) (eval-and-compile (autoload 'cancel-timer "timer") (autoload 'telnet "telnet" nil t) *************** *** 43,47 **** (autoload 'timezone-parse-date "timezone")) ! (defvar nntp-server-hook nil "*Hooks for the NNTP server. If the kanji code of the NNTP server is different from the local kanji --- 45,49 ---- (autoload 'timezone-parse-date "timezone")) ! (defvoo nntp-server-hook nil "*Hooks for the NNTP server. If the kanji code of the NNTP server is different from the local kanji *************** If you'd like to change something depend *** 59,63 **** hook, use the variable `nntp-address'.") ! (defvar nntp-server-opened-hook nil "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd --- 61,65 ---- hook, use the variable `nntp-address'.") ! (defvoo nntp-server-opened-hook '(nntp-send-mode-reader) "*Hook used for sending commands to the server at startup. The default value is `nntp-send-mode-reader', which makes an innd *************** do on servers that use strict access con *** 68,72 **** (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) ! (defvar nntp-open-server-function 'nntp-open-network-stream "*Function used for connecting to a remote system. It will be called with the address of the remote system. --- 70,86 ---- (add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader) ! (defvoo nntp-server-action-alist ! '(("nntpd 1\\.5\\.11t" ! (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))) ! "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 ! to innd, you could say something like: ! ! \(setq nntp-server-action-alist ! '((\"innd\" (ding)))) ! ! You probably don't want to do that, though.") ! ! (defvoo nntp-open-server-function 'nntp-open-network-stream "*Function used for connecting to a remote system. It will be called with the address of the remote system. *************** does an rlogin on the remote system, and *** 78,101 **** NNTP server available there (see nntp-rlogin-parameters).") ! (defvar nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") "*Parameters to `nntp-open-login'. That function may be used as `nntp-open-server-function'. In that case, this list will be used as the parameter list given to rsh.") ! (defvar nntp-rlogin-user-name nil "*User name on remote system when using the rlogin connect method.") ! (defvar nntp-address nil "*The name of the NNTP server.") ! (defvar nntp-port-number "nntp" "*Port number to connect to.") ! (defvar nntp-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") ! (defvar nntp-buggy-select (memq system-type '(fujitsu-uts)) "*t if your select routine is buggy. If the select routine signals error or fall into infinite loop while --- 92,120 ---- NNTP server available there (see nntp-rlogin-parameters).") ! (defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp") "*Parameters to `nntp-open-login'. That function may be used as `nntp-open-server-function'. In that case, this list will be used as the parameter list given to rsh.") ! (defvoo nntp-rlogin-user-name nil "*User name on remote system when using the rlogin connect method.") ! (defvoo nntp-address nil "*The name of the NNTP server.") ! (defvoo nntp-port-number "nntp" "*Port number to connect to.") ! (defvoo nntp-end-of-line "\r\n" ! "String to use on the end of lines when talking to the NNTP server. ! This is \"\\r\\n\" by default, but should be \"\\n\" when ! using rlogin to communicate with the server.") ! ! (defvoo nntp-large-newsgroup 50 "*The number of the articles which indicates a large newsgroup. If the number of the articles is greater than the value, verbose messages will be shown to indicate the current status.") ! (defvoo nntp-buggy-select (memq system-type '(fujitsu-uts)) "*t if your select routine is buggy. If the select routine signals error or fall into infinite loop while *************** case of Fujitsu UTS, it is set to T sinc *** 104,120 **** doesn't work properly.") ! (defvar nntp-maximum-request 400 "*The maximum number of the requests sent to the NNTP server at one time. If Emacs hangs up while retrieving headers, set the variable to a lower value.") ! (defvar nntp-debug-read 10000 "*Display '...' every 10Kbytes of a message being received if it is non-nil. If it is a number, dots are displayed per the number.") ! (defvar nntp-nov-is-evil nil "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") ! (defvar nntp-xover-commands '("XOVER" "XOVERVIEW") "*List of strings that are used as commands to fetch NOV lines from a server. The strings are tried in turn until a positive response is gotten. If --- 123,139 ---- doesn't work properly.") ! (defvoo nntp-maximum-request 400 "*The maximum number of the requests sent to the NNTP server at one time. If Emacs hangs up while retrieving headers, set the variable to a lower value.") ! (defvoo nntp-debug-read 10000 "*Display '...' every 10Kbytes of a message being received if it is non-nil. If it is a number, dots are displayed per the number.") ! (defvoo nntp-nov-is-evil nil "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") ! (defvoo nntp-xover-commands '("XOVER" "XOVERVIEW") "*List of strings that are used as commands to fetch NOV lines from a server. The strings are tried in turn until a positive response is gotten. If *************** none of the commands are successful, nnt *** 122,138 **** by one.") ! (defvar nntp-nov-gap 20 "*Maximum allowed gap between two articles. If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests.") ! (defvar nntp-connection-timeout nil "*Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set.") ! (defvar nntp-news-default-headers nil "*If non-nil, override `mail-default-headers' when posting news.") ! (defvar nntp-prepare-server-hook nil "*Hook run before a server is opened. If can be used to set up a server remotely, for instance. Say you --- 141,164 ---- by one.") ! (defvoo nntp-nov-gap 20 "*Maximum allowed gap between two articles. If the gap between two consecutive articles is bigger than this variable, split the XOVER request into two requests.") ! (defvoo nntp-connection-timeout nil "*Number of seconds to wait before an nntp connection times out. If this variable is nil, which is the default, no timers are set.") ! (defvoo nntp-command-timeout nil ! "*Number of seconds to wait for a response when sending a command. ! If this variable is nil, which is the default, no timers are set.") ! ! (defvoo nntp-retry-on-break nil ! "*If non-nil, re-send the command when the user types `C-g'.") ! ! (defvoo nntp-news-default-headers nil "*If non-nil, override `mail-default-headers' when posting news.") ! (defvoo nntp-prepare-server-hook nil "*Hook run before a server is opened. If can be used to set up a server remotely, for instance. Say you *************** then use this hook to rsh to the remote *** 142,148 **** server there that you can connect to.") ! (defvar nntp-async-number 5 "*How many articles should be prefetched when in asynchronous mode.") --- 168,176 ---- server there that you can connect to.") ! (defvoo nntp-async-number 5 "*How many articles should be prefetched when in asynchronous mode.") + (defvoo nntp-warn-about-losing-connection t + "*If non-nil, beep when a server closes connection.") *************** server there that you can connect to.") *** 154,218 **** "Buffer associated with the NNTP server process.") ! (defvar nntp-server-process nil "The NNTP server process. You'd better not use this variable in NNTP front-end program, but instead use `nntp-server-buffer'.") ! (defvar nntp-status-string nil ! "Save the server response message. ! You'd better not use this variable in NNTP front-end program but ! instead call function `nntp-status-message' to get status message.") (defvar nntp-opened-connections nil "All (possibly) opened connections.") ! (defvar nntp-server-xover 'try) ! (defvar nntp-server-list-active-group 'try) ! (defvar nntp-current-group "") ! (defvar nntp-timeout-servers nil) ! ! (defvar nntp-async-process nil) ! (defvar nntp-async-buffer nil) ! (defvar nntp-async-articles nil) ! (defvar nntp-async-fetched nil) ! (defvar nntp-async-group-alist nil) ! ! ! ! (defvar nntp-current-server nil) ! (defvar nntp-server-alist nil) ! (defvar nntp-server-variables ! (list ! (list 'nntp-server-hook nntp-server-hook) ! (list 'nntp-server-opened-hook nntp-server-opened-hook) ! (list 'nntp-port-number nntp-port-number) ! (list 'nntp-address nntp-address) ! (list 'nntp-large-newsgroup nntp-large-newsgroup) ! (list 'nntp-buggy-select nntp-buggy-select) ! (list 'nntp-maximum-request nntp-maximum-request) ! (list 'nntp-debug-read nntp-debug-read) ! (list 'nntp-nov-is-evil nntp-nov-is-evil) ! (list 'nntp-xover-commands nntp-xover-commands) ! (list 'nntp-connection-timeout nntp-connection-timeout) ! (list 'nntp-news-default-headers nntp-news-default-headers) ! (list 'nntp-prepare-server-hook nntp-prepare-server-hook) ! (list 'nntp-async-number nntp-async-number) ! '(nntp-async-process nil) ! '(nntp-async-buffer nil) ! '(nntp-async-articles nil) ! '(nntp-async-fetched nil) ! '(nntp-async-group-alist nil) ! '(nntp-server-process nil) ! '(nntp-status-string nil) ! '(nntp-server-xover try) ! '(nntp-server-list-active-group try) ! '(nntp-current-group ""))) ;;; Interface functions. ! (defun nntp-retrieve-headers (sequence &optional newsgroup server) ! "Retrieve the headers to the articles in SEQUENCE." ! (nntp-possibly-change-server newsgroup server) (save-excursion (set-buffer nntp-server-buffer) --- 182,215 ---- "Buffer associated with the NNTP server process.") ! (defvoo nntp-server-process nil "The NNTP server process. You'd better not use this variable in NNTP front-end program, but instead use `nntp-server-buffer'.") ! (defvoo nntp-status-string nil ! "Save the server response message.") (defvar nntp-opened-connections nil "All (possibly) opened connections.") ! (defvoo nntp-server-xover 'try) ! (defvoo nntp-server-list-active-group 'try) ! (defvoo nntp-current-group "") ! (defvoo nntp-server-type nil) ! ! (defvoo nntp-async-process nil) ! (defvoo nntp-async-buffer nil) ! (defvoo nntp-async-articles nil) ! (defvoo nntp-async-fetched nil) ! (defvoo nntp-async-group-alist nil) ;;; Interface functions. ! (nnoo-define-basics nntp) ! ! (deffoo nntp-retrieve-headers (articles &optional group server fetch-old) ! "Retrieve the headers of ARTICLES." ! (nntp-possibly-change-server group server) (save-excursion (set-buffer nntp-server-buffer) *************** instead call function `nntp-status-messa *** 220,295 **** (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) ! (nntp-retrieve-headers-with-xover sequence)) 'nov ! (let ((number (length sequence)) (count 0) (received 0) (last-point (point-min))) ;; Send HEAD command. ! (while sequence (nntp-send-strings-to-server ! "HEAD" (if (numberp (car sequence)) (int-to-string (car sequence)) ! (car sequence))) ! (setq sequence (cdr sequence) count (1+ count)) ! ;; Every 400 header requests we have to read stream in order ! ;; to avoid deadlock. ! (if (or (null sequence) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (progn ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! ;; If number of headers is greater than 100, give ! ;; informative messages. ! (and (numberp nntp-large-newsgroup) ! (> number nntp-large-newsgroup) ! (zerop (% received 20)) ! (message "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) ! (nntp-accept-response))))) ;; Wait for text of last command. (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) ! (if (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (message "NNTP: Receiving headers...done")) ! ;; Now all of replies are received. ! (setq received number) ! ;; First, fold continuation lines. ! (goto-char (point-min)) ! (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) ! (replace-match " ")) ! ;; Remove all "\r"'s (goto-char (point-min)) (while (search-forward "\r" nil t) ! (replace-match "")) 'headers)))) ! (defun nntp-retrieve-groups (groups &optional server) (nntp-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) ! (and (eq nntp-server-list-active-group 'try) ! (nntp-try-list-active (car groups))) (erase-buffer) (let ((count 0) (received 0) (last-point (point-min)) ! (command (if nntp-server-list-active-group ! "LIST ACTIVE" "GROUP"))) (while groups (nntp-send-strings-to-server command (car groups)) (setq groups (cdr groups)) --- 217,297 ---- (if (and (not gnus-nov-is-evil) (not nntp-nov-is-evil) ! (nntp-retrieve-headers-with-xover articles fetch-old)) ! ;; We successfully retrieved the headers via XOVER. 'nov ! ;; XOVER didn't work, so we do it the hard, slow and inefficient ! ;; way. ! (let ((number (length articles)) (count 0) (received 0) + (message-log-max nil) (last-point (point-min))) ;; Send HEAD command. ! (while articles (nntp-send-strings-to-server ! "HEAD" (if (numberp (car articles)) ! (int-to-string (car articles)) ! ;; `articles' is either a list of article numbers ! ;; or a list of article IDs. ! (car articles))) ! (setq articles (cdr articles) count (1+ count)) ! ;; Every 400 header requests we have to read the stream in ! ;; order to avoid deadlocks. ! (when (or (null articles) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! ;; If number of headers is greater than 100, give ! ;; informative messages. ! (and (numberp nntp-large-newsgroup) ! (> number nntp-large-newsgroup) ! (zerop (% received 20)) ! (nnheader-message 7 "NNTP: Receiving headers... %d%%" ! (/ (* received 100) number))) ! (nntp-accept-response)))) ;; Wait for text of last command. (goto-char (point-max)) (re-search-backward "^[0-9]" nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) ! (nnheader-message 7 "NNTP: Receiving headers...done")) ! ;; Now all of replies are received. Fold continuation lines. ! (nnheader-fold-continuation-lines) ! ;; Remove all "\r"'s. (goto-char (point-min)) (while (search-forward "\r" nil t) ! (replace-match "" t t)) 'headers)))) ! (deffoo nntp-retrieve-groups (groups &optional server) ! "Retrieve group info on GROUPS." (nntp-possibly-change-server nil server) (save-excursion (set-buffer nntp-server-buffer) ! ;; The first time this is run, this variable is `try'. So we ! ;; try. ! (when (eq nntp-server-list-active-group 'try) ! (nntp-try-list-active (car groups))) (erase-buffer) (let ((count 0) (received 0) (last-point (point-min)) ! (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) (while groups + ;; Send the command to the server. (nntp-send-strings-to-server command (car groups)) (setq groups (cdr groups)) *************** instead call function `nntp-status-messa *** 297,323 **** ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (if (or (null groups) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (progn ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (nntp-accept-response))))) ;; Wait for the reply from the final command. ! (if nntp-server-list-active-group ! (progn ! (goto-char (point-max)) ! (re-search-backward "^[0-9]" nil t) ! (if (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))))) ;; Now all replies are received. We remove CRs. --- 299,323 ---- ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (when (or (null groups) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (nntp-accept-response) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9]" nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (nntp-accept-response)))) ;; Wait for the reply from the final command. ! (when nntp-server-list-active-group ! (goto-char (point-max)) ! (re-search-backward "^[0-9]" nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (- (point-max) 3)) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response)))) ;; Now all replies are received. We remove CRs. *************** instead call function `nntp-status-messa *** 326,377 **** (replace-match "" t t)) ! (if nntp-server-list-active-group ! (progn ! ;; We have read active entries, so we just delete the ! ;; superfluous gunk. ! (goto-char (point-min)) ! (while (re-search-forward "^[.2-5]" nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! 'active) ! 'group)))) ! (defun nntp-open-server (server &optional defs connectionless) "Open the virtual server SERVER. If CONNECTIONLESS is non-nil, don't attempt to connect to any physical servers." ! (nnheader-init-server-buffer) (if (nntp-server-opened server) t ! (if (or (stringp (car defs)) ! (numberp (car defs))) ! (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) ! (or (assq 'nntp-address defs) ! (setq defs (append defs (list (list 'nntp-address server))))) ! (if (and nntp-current-server ! (not (equal server nntp-current-server))) ! (setq nntp-server-alist ! (cons (list nntp-current-server ! (nnheader-save-variables nntp-server-variables)) ! nntp-server-alist))) ! (let ((state (assoc server nntp-server-alist))) ! (if state ! (progn ! (nnheader-restore-variables (nth 1 state)) ! (setq nntp-server-alist (delq state nntp-server-alist))) ! (nnheader-set-init-variables nntp-server-variables defs))) ! (setq nntp-current-server server) ! ;; We have now changed to the proper virtual server. We then ! ;; check that the physical server is opened. ! (if (or (nntp-server-opened server) ! connectionless) ! t ! (if (member nntp-address nntp-timeout-servers) ! nil ! ;; We open a connection to the physical nntp server. ! (run-hooks 'nntp-prepare-server-hook) ! (nntp-open-server-semi-internal nntp-address nntp-port-number))))) ! (defun nntp-close-server (&optional server) "Close connection to SERVER." (nntp-possibly-change-server nil server t) --- 326,360 ---- (replace-match "" t t)) ! (if (not nntp-server-list-active-group) ! 'group ! ;; We have read active entries, so we just delete the ! ;; superfluos gunk. ! (goto-char (point-min)) ! (while (re-search-forward "^[.2-5]" nil t) ! (delete-region (match-beginning 0) ! (progn (forward-line 1) (point)))) ! 'active)))) ! (deffoo nntp-open-server (server &optional defs connectionless) "Open the virtual server SERVER. If CONNECTIONLESS is non-nil, don't attempt to connect to any physical servers." ! ;; Called with just a port number as the defs. ! (when (or (stringp (car defs)) ! (numberp (car defs))) ! (setq defs `((nntp-port-number ,(car defs))))) ! (unless (assq 'nntp-address defs) ! (setq defs (append defs `((nntp-address ,server))))) ! (nnoo-change-server 'nntp server defs) (if (nntp-server-opened server) t ! (or (nntp-server-opened server) ! connectionless ! (prog2 ! (run-hooks 'nntp-prepare-server-hook) ! (nntp-open-server-semi-internal nntp-address nntp-port-number) ! (nnheader-insert ""))))) ! (deffoo nntp-close-server (&optional server) "Close connection to SERVER." (nntp-possibly-change-server nil server t) *************** servers." *** 384,416 **** (set-process-sentinel nntp-server-process nil)) ;; We cannot send QUIT command unless the process is running. ! (if (nntp-server-opened) ! (nntp-send-command nil "QUIT"))) ! (nntp-close-server-internal server) ! (setq nntp-timeout-servers (delete server nntp-timeout-servers)))) ! ! (defalias 'nntp-request-quit (symbol-function 'nntp-close-server)) ! (defun nntp-request-close () "Close all server connections." (let (proc) (while nntp-opened-connections ! (setq proc (pop nntp-opened-connections)) ! (and proc (delete-process proc))) (and nntp-async-buffer ! (get-buffer nntp-async-buffer) (kill-buffer nntp-async-buffer)) ! (while nntp-server-alist ! (and (setq proc (nth 1 (assq 'nntp-async-buffer ! (car nntp-server-alist)))) ! (buffer-name proc) ! (kill-buffer proc)) ! (setq nntp-server-alist (cdr nntp-server-alist))) ! (setq nntp-current-server nil ! nntp-timeout-servers nil ! nntp-async-group-alist nil))) ! (defun nntp-server-opened (&optional server) "Say whether a connection to SERVER has been opened." ! (and (equal server nntp-current-server) nntp-server-buffer (buffer-name nntp-server-buffer) --- 367,407 ---- (set-process-sentinel nntp-server-process nil)) ;; We cannot send QUIT command unless the process is running. ! (when (nntp-server-opened server) ! (nntp-send-command nil "QUIT") ! ;; Give the QUIT time to arrive. ! (sleep-for 1))) ! (nntp-close-server-internal server))) ! (deffoo nntp-request-close () "Close all server connections." (let (proc) (while nntp-opened-connections ! (when (setq proc (pop nntp-opened-connections)) ! ;; Un-set default sentinel function before closing connection. ! (when (eq 'nntp-default-sentinel (process-sentinel proc)) ! (set-process-sentinel proc nil)) ! (condition-case () ! (process-send-string proc (concat "QUIT" nntp-end-of-line)) ! (error nil)) ! ;; Give the QUIT time to reach the server before we close ! ;; down the process. ! (sleep-for 1) ! (delete-process proc))) (and nntp-async-buffer ! (buffer-name nntp-async-buffer) (kill-buffer nntp-async-buffer)) ! (let ((alist (cddr (assq 'nntp nnoo-state-alist))) ! entry) ! (while (setq entry (pop alist)) ! (and (setq proc (cdr (assq 'nntp-async-buffer entry))) ! (buffer-name proc) ! (kill-buffer proc)))) ! (nnoo-close-server 'nntp) ! (setq nntp-async-group-alist nil ! nntp-async-articles nil))) ! (deffoo nntp-server-opened (&optional server) "Say whether a connection to SERVER has been opened." ! (and (nnoo-current-server-p 'nntp server) nntp-server-buffer (buffer-name nntp-server-buffer) *************** servers." *** 418,422 **** (memq (process-status nntp-server-process) '(open run)))) ! (defun nntp-status-message (&optional server) "Return server status as a string." (if (and nntp-status-string --- 409,413 ---- (memq (process-status nntp-server-process) '(open run)))) ! (deffoo nntp-status-message (&optional server) "Return server status as a string." (if (and nntp-status-string *************** servers." *** 428,447 **** (or nntp-status-string ""))) ! (defun nntp-request-article (id &optional newsgroup server buffer) ! "Request article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (let (found) ;; First we see whether we can get the article from the async buffer. ! (if (and (numberp id) ! nntp-async-articles ! (memq id nntp-async-fetched)) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (let ((opoint (point)) ! (art (if (numberp id) (int-to-string id) id)) ! beg end) ! (if (and (or (re-search-forward (concat "^2.. +" art) nil t) (progn (goto-char (point-min)) --- 419,438 ---- (or nntp-status-string ""))) ! (deffoo nntp-request-article (id &optional group server buffer) ! "Request article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (let (found) ;; First we see whether we can get the article from the async buffer. ! (when (and (numberp id) ! nntp-async-articles ! (memq id nntp-async-fetched)) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (let ((opoint (point)) ! (art (if (numberp id) (int-to-string id) id)) ! beg end) ! (when (and (or (re-search-forward (concat "^2.. +" art) nil t) (progn (goto-char (point-min)) *************** servers." *** 451,468 **** (setq beg (point) end (re-search-forward "^\\.\r?\n" nil t)))) ! (progn ! (setq found t) ! (save-excursion ! (set-buffer (or buffer nntp-server-buffer)) ! (erase-buffer) ! (insert-buffer-substring nntp-async-buffer beg end) ! (let ((nntp-server-buffer (current-buffer))) ! (nntp-decode-text))) ! (delete-region beg end) ! (and nntp-async-articles ! (nntp-async-fetch-articles id))))))) (if found ! t ;; The article was not in the async buffer, so we fetch it now. (unwind-protect --- 442,458 ---- (setq beg (point) end (re-search-forward "^\\.\r?\n" nil t)))) ! (setq found t) ! (save-excursion ! (set-buffer (or buffer nntp-server-buffer)) ! (erase-buffer) ! (insert-buffer-substring nntp-async-buffer beg end) ! (let ((nntp-server-buffer (current-buffer))) ! (nntp-decode-text))) ! (delete-region beg end) ! (when nntp-async-articles ! (nntp-async-fetch-articles id)))))) (if found ! id ;; The article was not in the async buffer, so we fetch it now. (unwind-protect *************** servers." *** 471,485 **** (let ((nntp-server-buffer (or buffer nntp-server-buffer)) (art (or (and (numberp id) (int-to-string id)) id))) - ;; If NEmacs, end of message may look like: "\256\215" (".^M") (prog1 ! (nntp-send-command "^\\.\r?\n" "ARTICLE" art) (nntp-decode-text) (and nntp-async-articles (nntp-async-fetch-articles id))))) ! (if buffer (set-process-buffer ! nntp-server-process nntp-server-buffer)))))) ! (defun nntp-request-body (id &optional newsgroup server) ! "Request body of article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") --- 461,480 ---- (let ((nntp-server-buffer (or buffer nntp-server-buffer)) (art (or (and (numberp id) (int-to-string id)) id))) (prog1 ! (and (nntp-send-command ! ;; A bit odd regexp to ensure working over rlogin. ! "^\\.\r?\n" "ARTICLE" art) ! (if (numberp id) ! (cons nntp-current-group id) ! ;; We find out what the article number was. ! (nntp-find-group-and-number))) (nntp-decode-text) (and nntp-async-articles (nntp-async-fetch-articles id))))) ! (when buffer ! (set-process-buffer nntp-server-process nntp-server-buffer)))))) ! (deffoo nntp-request-body (id &optional group server) ! "Request body of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (prog1 ;; If NEmacs, end of message may look like: "\256\215" (".^M") *************** servers." *** 488,538 **** (nntp-decode-text))) ! (defun nntp-request-head (id &optional newsgroup server) ! "Request head of article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (prog1 ! (nntp-send-command ! "^\\.\r?\n" "HEAD" (or (and (numberp id) (int-to-string id)) id)) ! (nntp-decode-text))) ! (defun nntp-request-stat (id &optional newsgroup server) ! "Request STAT of article ID (message-id or number)." ! (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) ! (defun nntp-request-group (group &optional server dont-check) ! "Select GROUP." ! (nntp-send-command "^.*\r?\n" "GROUP" group) ! (setq nntp-current-group group) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (goto-char (point-min)) ! (looking-at "[23]"))) ! (defun nntp-request-asynchronous (group &optional server articles) ! (and nntp-async-articles (nntp-async-request-group group)) ! (and ! nntp-async-number ! (if (not (or (nntp-async-server-opened) ! (nntp-async-open-server))) ! (progn ! (message "Can't open second connection to %s" nntp-address) ! (ding) ! (setq nntp-async-articles nil) ! (sit-for 2)) ! (setq nntp-async-articles articles) ! (setq nntp-async-fetched nil) ! (save-excursion ! (set-buffer nntp-async-buffer) ! (erase-buffer)) ! (nntp-async-send-strings "GROUP" group) ! t))) ! (defun nntp-list-active-group (group &optional server) (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) ! (defun nntp-request-group-description (group &optional server) ! "Get description of GROUP." (nntp-possibly-change-server nil server) (prog1 --- 483,547 ---- (nntp-decode-text))) ! (deffoo nntp-request-head (id &optional group server) ! "Request head of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (prog1 ! (when (nntp-send-command ! "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id)) ! (if (numberp id) id ! ;; We find out what the article number was. ! (nntp-find-group-and-number))) ! (nntp-decode-text) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (nnheader-fold-continuation-lines)))) ! (deffoo nntp-request-stat (id &optional group server) ! "Request STAT of article ID (Message-ID or number)." ! (nntp-possibly-change-server group server) (nntp-send-command "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id))) ! (deffoo nntp-request-type (group &optional article) ! 'news) ! (deffoo nntp-request-group (group &optional server dont-check) ! "Select GROUP." ! (nntp-possibly-change-server nil server) ! (setq nntp-current-group ! (when (nntp-send-command "^2.*\r?\n" "GROUP" group) ! group))) ! ! (deffoo nntp-request-asynchronous (group &optional server articles) ! "Enable pre-fetch in GROUP." ! (when nntp-async-articles ! (nntp-async-request-group group)) ! (when nntp-async-number ! (if (not (or (nntp-async-server-opened) ! (nntp-async-open-server))) ! ;; Couldn't open the second connection ! (progn ! (message "Can't open second connection to %s" nntp-address) ! (ding) ! (setq nntp-async-articles nil) ! (sit-for 2)) ! ;; We opened the second connection (or it was opened already). ! (setq nntp-async-articles articles) ! (setq nntp-async-fetched nil) ! ;; Clear any old data. ! (save-excursion ! (set-buffer nntp-async-buffer) ! (erase-buffer)) ! ;; Select the correct current group on this server. ! (nntp-async-send-strings "GROUP" group) ! t))) ! (deffoo nntp-list-active-group (group &optional server) ! "Return the active info on GROUP (which can be a regexp." ! (nntp-possibly-change-server group server) (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) ! (deffoo nntp-request-group-description (group &optional server) ! "Get the description of GROUP." (nntp-possibly-change-server nil server) (prog1 *************** servers." *** 540,549 **** (nntp-decode-text))) ! (defun nntp-close-group (group &optional server) (setq nntp-current-group nil) t) ! (defun nntp-request-list (&optional server) ! "List active groups." (nntp-possibly-change-server nil server) (prog1 --- 549,559 ---- (nntp-decode-text))) ! (deffoo nntp-close-group (group &optional server) ! "Close GROUP." (setq nntp-current-group nil) t) ! (deffoo nntp-request-list (&optional server) ! "List all active groups." (nntp-possibly-change-server nil server) (prog1 *************** servers." *** 551,556 **** (nntp-decode-text))) ! (defun nntp-request-list-newsgroups (&optional server) ! "List groups." (nntp-possibly-change-server nil server) (prog1 --- 561,566 ---- (nntp-decode-text))) ! (deffoo nntp-request-list-newsgroups (&optional server) ! "Get descriptions on all groups on SERVER." (nntp-possibly-change-server nil server) (prog1 *************** servers." *** 558,563 **** (nntp-decode-text))) ! (defun nntp-request-newgroups (date &optional server) ! "List new groups." (nntp-possibly-change-server nil server) (let* ((date (timezone-parse-date date)) --- 568,573 ---- (nntp-decode-text))) ! (deffoo nntp-request-newgroups (date &optional server) ! "List groups that have arrived since DATE." (nntp-possibly-change-server nil server) (let* ((date (timezone-parse-date date)) *************** servers." *** 572,576 **** (nntp-decode-text)))) ! (defun nntp-request-list-distributions (&optional server) "List distributions." (nntp-possibly-change-server nil server) --- 582,586 ---- (nntp-decode-text)))) ! (deffoo nntp-request-list-distributions (&optional server) "List distributions." (nntp-possibly-change-server nil server) *************** servers." *** 579,689 **** (nntp-decode-text))) ! (defun nntp-request-last (&optional newsgroup server) "Decrease the current article pointer." ! (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "LAST")) ! (defun nntp-request-next (&optional newsgroup server) "Advance the current article pointer." ! (nntp-possibly-change-server newsgroup server) (nntp-send-command "^[23].*\r?\n" "NEXT")) ! (defun nntp-request-post (&optional server) "Post the current buffer." (nntp-possibly-change-server nil server) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer)) ! (if (nntp-send-command "^[23].*\r?\n" "POST") ! (progn ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer)) ! (nntp-encode-text) ! (nntp-send-region-to-server (point-min) (point-max)) ! ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not ! ;; appended to end of the status message. ! (nntp-wait-for-response "^[23].*\n")))) ! ! (defun nntp-request-post-buffer ! (post group subject header article-buffer info follow-to respect-poster) ! "Request a buffer suitable for composing an article. ! If POST, this is an original article; otherwise it's a followup. ! GROUP is the group to be posted to, the article should have subject ! SUBJECT. HEADER is a Gnus header vector. ARTICLE-BUFFER contains the ! article being followed up. INFO is a Gnus info list. If FOLLOW-TO, ! post to this group instead. If RESPECT-POSTER, heed the special ! \"poster\" value of the Followup-to header." ! (if (assq 'to-address (nth 5 info)) ! (nnmail-request-post-buffer ! post group subject header article-buffer info follow-to respect-poster) ! (let ((mail-default-headers ! (or nntp-news-default-headers mail-default-headers)) ! from date to followup-to newsgroups message-of ! references distribution message-id) ! (save-excursion ! (set-buffer (get-buffer-create "*post-news*")) ! (news-reply-mode) ! (if (and (buffer-modified-p) ! (> (buffer-size) 0) ! (not (y-or-n-p "Unsent article being composed; erase it? "))) ! () ! (erase-buffer) ! (if post ! (news-setup nil subject nil group nil) ! (save-excursion ! (set-buffer article-buffer) ! (goto-char (point-min)) ! (narrow-to-region (point-min) ! (progn (search-forward "\n\n") (point))) ! (setq from (mail-header-from header)) ! (setq date (mail-header-date header)) ! (and from ! (let ((stop-pos ! (string-match " *at \\| *@ \\| *(\\| *<" from))) ! (setq ! message-of ! (concat (if stop-pos (substring from 0 stop-pos) from) ! "'s message of " date)))) ! (setq subject (or subject (mail-header-subject header))) ! (or (string-match "^[Rr][Ee]:" subject) ! (setq subject (concat "Re: " subject))) ! (setq followup-to (mail-fetch-field "followup-to")) ! (if (or (null respect-poster) ;Ignore followup-to: field. ! (string-equal "" followup-to) ;Bogus header. ! (string-equal "poster" followup-to);Poster ! (and (eq respect-poster 'ask) ! followup-to ! (not (y-or-n-p (concat "Followup to " ! followup-to "? "))))) ! (setq followup-to nil)) ! (setq newsgroups ! (or follow-to followup-to (mail-fetch-field "newsgroups"))) ! (setq references (mail-header-references header)) ! (setq distribution (mail-fetch-field "distribution")) ! ;; Remove bogus distribution. ! (and (stringp distribution) ! (string-match "world" distribution) ! (setq distribution nil)) ! (setq message-id (mail-header-id header)) ! (widen)) ! (setq news-reply-yank-from from) ! (setq news-reply-yank-message-id message-id) ! (news-setup to subject message-of ! (if (stringp newsgroups) newsgroups "") ! article-buffer) ! (if (and newsgroups (listp newsgroups)) ! (progn ! (goto-char (point-min)) ! (while newsgroups ! (insert (car (car newsgroups)) ": " ! (cdr (car newsgroups)) "\n") ! (setq newsgroups (cdr newsgroups))))) ! (nnheader-insert-references references message-id) ! (if distribution ! (progn ! (mail-position-on-field "Distribution") ! (insert distribution))))) ! (current-buffer))))) ;;; Internal functions. --- 589,612 ---- (nntp-decode-text))) ! (deffoo nntp-request-last (&optional group server) "Decrease the current article pointer." ! (nntp-possibly-change-server group server) (nntp-send-command "^[23].*\r?\n" "LAST")) ! (deffoo nntp-request-next (&optional group server) "Advance the current article pointer." ! (nntp-possibly-change-server group server) (nntp-send-command "^[23].*\r?\n" "NEXT")) ! (deffoo nntp-request-post (&optional server) "Post the current buffer." (nntp-possibly-change-server nil server) ! (when (nntp-send-command "^[23].*\r?\n" "POST") ! (nnheader-insert "") ! (nntp-encode-text) ! (nntp-send-region-to-server (point-min) (point-max)) ! ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not ! ;; appended to end of the status message. ! (nntp-wait-for-response "^[23].*\n"))) ;;; Internal functions. *************** reading." *** 696,699 **** --- 619,631 ---- (nntp-send-command "^.*\r?\n" "MODE READER")) + (defun nntp-send-nosy-authinfo () + "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 "^.*\r?\n" "AUTHINFO USER" + (read-string "NNTP user name: ")) + (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" + (read-string "NNTP password: "))) + (defun nntp-send-authinfo () "Send the AUTHINFO to the nntp server. *************** It will prompt for a password." *** 708,725 **** This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (and (file-exists-p "~/.nntp-authinfo") ! (save-excursion ! (set-buffer (get-buffer-create " *tull*")) ! (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" ! (buffer-substring (point) ! (progn (end-of-line) (point)))) ! (kill-buffer (current-buffer))))) (defun nntp-default-sentinel (proc status) "Default sentinel function for NNTP server process." ! (let ((servers nntp-server-alist) server) ;; Go through the alist of server names and find the name of the --- 640,659 ---- This function is supposed to be called from `nntp-server-opened-hook'. It will prompt for a password." ! (when (file-exists-p "~/.nntp-authinfo") ! (save-excursion ! (set-buffer (get-buffer-create " *authinfo*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (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" ! (buffer-substring (point) (progn (end-of-line) (point)))) ! (kill-buffer (current-buffer))))) (defun nntp-default-sentinel (proc status) "Default sentinel function for NNTP server process." ! (let ((servers (cddr (assq 'nntp nnoo-state-alist))) server) ;; Go through the alist of server names and find the name of the *************** It will prompt for a password." *** 729,749 **** (setq server nntp-address) (while (and servers ! (not (equal proc (nth 1 (assq 'nntp-server-process ! (car servers)))))) (setq servers (cdr servers))) ! (setq server (car (car servers)))) ! (and server ! (progn ! (message "nntp: Connection closed to server %s" server) ! (ding))))) (defun nntp-kill-connection (server) ! (let ((proc (nth 1 (assq 'nntp-server-process ! (assoc server nntp-server-alist))))) ! (and proc (delete-process (process-name proc))) (nntp-close-server server) ! (setq nntp-timeout-servers (cons server nntp-timeout-servers)) ! (setq nntp-status-string ! (message "Connection timed out to server %s." server)) (ding) (sit-for 1))) --- 663,686 ---- (setq server nntp-address) (while (and servers ! (not (equal proc (cdr (assq 'nntp-server-process ! (car servers)))))) (setq servers (cdr servers))) ! (setq server (caar servers))) ! (when (and server ! nntp-warn-about-losing-connection) ! (nnheader-message 3 "nntp: Connection closed to server %s" server) ! (setq nntp-current-group "") ! (ding)))) (defun nntp-kill-connection (server) ! "Choke the connection to SERVER." ! (let ((proc (cdr (assq 'nntp-server-process ! (assoc server (cddr ! (assq 'nntp nnoo-state-alist))))))) ! (when proc ! (delete-process (process-name proc))) (nntp-close-server server) ! (nnheader-report ! 'nntp (message "Connection timed out to server %s" server)) (ding) (sit-for 1))) *************** It will prompt for a password." *** 763,779 **** (or (bolp) (insert "\n")) ;; Delete status line. ! (goto-char (point-min)) ! (delete-region (point) (progn (forward-line 1) (point))) ! ;; Delete `^M' at the end of lines. ! (while (not (eobp)) ! (end-of-line) ! (and (= (preceding-char) ?\r) ! (delete-char -1)) ! (forward-line 1)) ;; Delete `.' at end of the buffer (end of text mark). (goto-char (point-max)) (forward-line -1) ! (if (looking-at "^\\.\n") ! (delete-region (point) (progn (forward-line 1) (point)))) ;; Replace `..' at beginning of line with `.'. (goto-char (point-min)) --- 700,712 ---- (or (bolp) (insert "\n")) ;; Delete status line. ! (delete-region (goto-char (point-min)) (progn (forward-line 1) (point))) ! ;; Delete `^M's. ! (while (search-forward "\r" nil t) ! (replace-match "" t t)) ;; Delete `.' at end of the buffer (end of text mark). (goto-char (point-max)) (forward-line -1) ! (when (looking-at "^\\.\n") ! (delete-region (point) (progn (forward-line 1) (point)))) ;; Replace `..' at beginning of line with `.'. (goto-char (point-min)) *************** It will prompt for a password." *** 787,809 **** 2. Insert `.' at end of buffer (end of text mark)." (save-excursion - ;; Insert newline at end of buffer. - (goto-char (point-max)) - (or (bolp) (insert "\n")) ;; Replace `.' at beginning of line with `..'. (goto-char (point-min)) - ;; (replace-regexp "^\\." "..") (while (search-forward "\n." nil t) (insert ".")) - ;; Insert `.' at end of buffer (end of text mark). (goto-char (point-max)) ! (insert ".\r\n"))) ;;; ! ;;; Synchronous Communication with NNTP Server. ;;; (defun nntp-send-command (response cmd &rest args) "Wait for server RESPONSE after sending CMD and optional ARGS to server." (save-excursion ;; Clear communication buffer. --- 720,790 ---- 2. Insert `.' at end of buffer (end of text mark)." (save-excursion ;; Replace `.' at beginning of line with `..'. (goto-char (point-min)) (while (search-forward "\n." nil t) (insert ".")) (goto-char (point-max)) ! ;; Insert newline at end of buffer. ! (or (bolp) (insert "\n")) ! ;; Insert `.' at end of buffer (end of text mark). ! (insert "." nntp-end-of-line))) ;;; ! ;;; Synchronous Communication with NNTP servers. ;;; + (defvar nntp-retry-command) + (defun nntp-send-command (response cmd &rest args) "Wait for server RESPONSE after sending CMD and optional ARGS to server." + (let ((timer + (and nntp-command-timeout + (nnheader-run-at-time + nntp-command-timeout nil 'nntp-kill-command + (nnoo-current-server 'nntp)))) + (nntp-retry-command t) + result) + (unwind-protect + (save-excursion + (while nntp-retry-command + (setq nntp-retry-command nil) + ;; Clear communication buffer. + (set-buffer nntp-server-buffer) + (widen) + (erase-buffer) + (if nntp-retry-on-break + (condition-case () + (progn + (apply 'nntp-send-strings-to-server cmd args) + (setq result + (if response + (nntp-wait-for-response response) + t))) + (quit (setq nntp-retry-command t))) + (apply 'nntp-send-strings-to-server cmd args) + (setq result + (if response + (nntp-wait-for-response response) + t)))) + result) + (when timer + (nnheader-cancel-timer timer))))) + + (defun nntp-kill-command (server) + "Kill and restart the connection to SERVER." + (let ((proc (cdr (assq + 'nntp-server-process + (assoc server (cddr (assq 'nntp nnoo-state-alist))))))) + (when proc + (delete-process (process-name proc))) + (nntp-close-server server) + (nntp-open-server server) + (when nntp-current-group + (nntp-request-group nntp-current-group)) + (setq nntp-retry-command t))) + + (defun nntp-send-command-old (response cmd &rest args) + "Wait for server RESPONSE after sending CMD and optional ARGS to server." (save-excursion ;; Clear communication buffer. *************** It will prompt for a password." *** 855,883 **** (end-of-line) (setq nntp-status-string ! (buffer-substring (point-min) (point))) ! (if status ! (progn ! (setq wait t) ! (while wait ! (goto-char (point-max)) ! (forward-line -1) ;(beginning-of-line) ! ;;(message (buffer-substring ! ;; (point) ! ;; (save-excursion (end-of-line) (point)))) ! (if (looking-at regexp) ! (setq wait nil) ! (if nntp-debug-read ! (let ((newnum (/ (buffer-size) dotsize))) ! (if (not (= dotnum newnum)) ! (progn ! (setq dotnum newnum) ! (message "NNTP: Reading %s" ! (make-string dotnum ?.)))))) ! (nntp-accept-response))) ! ;; Remove "...". ! (if (and nntp-debug-read (> dotnum 0)) ! (message "")) ! ;; Successfully received server response. ! t))))) --- 836,861 ---- (end-of-line) (setq nntp-status-string ! (nnheader-replace-chars-in-string ! (buffer-substring (point-min) (point)) ?\r ? )) ! (when status ! (setq wait t) ! (while wait ! (goto-char (point-max)) ! (if (bolp) (forward-line -1) (beginning-of-line)) ! (if (looking-at regexp) ! (setq wait nil) ! (when nntp-debug-read ! (let ((newnum (/ (buffer-size) dotsize)) ! (message-log-max nil)) ! (unless (= dotnum newnum) ! (setq dotnum newnum) ! (nnheader-message 7 "NNTP: Reading %s" ! (make-string dotnum ?.))))) ! (nntp-accept-response))) ! ;; Remove "...". ! (when (and nntp-debug-read (> dotnum 0)) ! (message "")) ! ;; Successfully received server response. ! t)))) *************** It will prompt for a password." *** 887,891 **** ;;; ! (defun nntp-retrieve-headers-with-xover (sequence) (erase-buffer) (cond --- 865,908 ---- ;;; ! (defun nntp-find-group-and-number () ! (save-excursion ! (save-restriction ! (set-buffer nntp-server-buffer) ! (narrow-to-region (goto-char (point-min)) ! (or (search-forward "\n\n" nil t) (point-max))) ! (goto-char (point-min)) ! ;; We first find the number by looking at the status line. ! (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") ! (string-to-int ! (buffer-substring (match-beginning 1) ! (match-end 1))))) ! group newsgroups xref) ! (and number (zerop number) (setq number nil)) ! ;; Then we find the group name. ! (setq group ! (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. ! ((and (setq newsgroups (mail-fetch-field "newsgroups")) ! (not (string-match "," newsgroups))) ! newsgroups) ! ;; If there is more than one group in the Newsgroups ! ;; header, then the Xref header should be filled out. ! ;; We hazard a guess that the group that has this ! ;; 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. ! ((and (setq xref (mail-fetch-field "xref")) ! number ! (string-match (format "\\([^ :]+\\):%d" number) xref)) ! (substring xref (match-beginning 1) (match-end 1))) ! (t ""))) ! (when (string-match "\r" group) ! (setq group (substring group 0 (match-beginning 0)))) ! (cons group number))))) ! ! (defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) (erase-buffer) (cond *************** It will prompt for a password." *** 896,912 **** ;; We don't care about gaps. ! ((not nntp-nov-gap) (nntp-send-xover-command ! (car sequence) (nntp-last-element sequence) 'wait) (goto-char (point-min)) ! (if (looking-at "[1-5][0-9][0-9] ") ! (delete-region (point) (progn (forward-line 1) (point)))) (while (search-forward "\r" nil t) (replace-match "" t t)) (goto-char (point-max)) (forward-line -1) ! (if (looking-at "\\.") ! (delete-region (point) (progn (forward-line 1) (point))))) ;; We do it the hard way. For each gap, an XOVER command is sent --- 913,935 ---- ;; We don't care about gaps. ! ((or (not nntp-nov-gap) ! fetch-old) (nntp-send-xover-command ! (if fetch-old ! (if (numberp fetch-old) ! (max 1 (- (car articles) fetch-old)) ! 1) ! (car articles)) ! (nntp-last-element articles) 'wait) (goto-char (point-min)) ! (when (looking-at "[1-5][0-9][0-9] ") ! (delete-region (point) (progn (forward-line 1) (point)))) (while (search-forward "\r" nil t) (replace-match "" t t)) (goto-char (point-max)) (forward-line -1) ! (when (looking-at "\\.") ! (delete-region (point) (progn (forward-line 1) (point))))) ;; We do it the hard way. For each gap, an XOVER command is sent *************** It will prompt for a password." *** 924,972 **** ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. ! (while (and nntp-server-xover sequence) ! (setq first (car sequence)) ;; Search forward until we find a gap, or until we run out of ;; articles. ! (while (and (cdr sequence) ! (< (- (nth 1 sequence) (car sequence)) nntp-nov-gap)) ! (setq sequence (cdr sequence))) ! ! (if (not (nntp-send-xover-command first (car sequence))) ! () ! (setq sequence (cdr sequence) count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (if (or (null sequence) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (progn ! (accept-process-output) ! ;; 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. ! (set-buffer buf) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9][0-9][0-9] " nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (accept-process-output) ! (set-buffer buf)))))) ! (if (not nntp-server-xover) ! () ;; Wait for the reply from the final command. (goto-char (point-max)) (re-search-backward "^[0-9][0-9][0-9] " nil t) ! (if (looking-at "^[23]") ! (while (progn ! (goto-char (point-max)) ! (forward-line -1) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) ;; We remove any "." lines and status lines. --- 947,992 ---- ;; that means that the server does not understand XOVER, but we ;; won't know that until we try. ! (while (and nntp-server-xover articles) ! (setq first (car articles)) ;; Search forward until we find a gap, or until we run out of ;; articles. ! (while (and (cdr articles) ! (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) ! (setq articles (cdr articles))) ! ! (when (nntp-send-xover-command first (car articles)) ! (setq articles (cdr articles) count (1+ count)) ;; Every 400 requests we have to read the stream in ;; order to avoid deadlocks. ! (when (or (null articles) ;All requests have been sent. ! (zerop (% count nntp-maximum-request))) ! (accept-process-output) ! ;; 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. ! (set-buffer buf) ! (while (progn ! (goto-char last-point) ! ;; Count replies. ! (while (re-search-forward "^[0-9][0-9][0-9] " nil t) ! (setq received (1+ received))) ! (setq last-point (point)) ! (< received count)) ! (accept-process-output) ! (set-buffer buf))))) ! (when nntp-server-xover ;; Wait for the reply from the final command. (goto-char (point-max)) (re-search-backward "^[0-9][0-9][0-9] " nil t) ! (when (looking-at "^[23]") ! (while (progn ! (goto-char (point-max)) ! (forward-line -1) ! (not (looking-at "^\\.\r?\n"))) ! (nntp-accept-response))) ;; We remove any "." lines and status lines. *************** It will prompt for a password." *** 980,984 **** (defun nntp-send-xover-command (beg end &optional wait-for-reply) ! (let ((range (format "%d-%d" beg end))) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this --- 1000,1005 ---- (defun nntp-send-xover-command (beg end &optional wait-for-reply) ! "Send the XOVER command to the server." ! (let ((range (format "%d-%d" (or beg 1) (or end beg 1)))) (if (stringp nntp-server-xover) ;; If `nntp-server-xover' is a string, then we just send this *************** It will prompt for a password." *** 987,993 **** (nntp-send-command "^\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. ! (progn ! (nntp-send-strings-to-server nntp-server-xover range) ! t)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. --- 1008,1012 ---- (nntp-send-command "^\\.\r?\n" nntp-server-xover range) ;; We do not wait for the reply. ! (nntp-send-strings-to-server nntp-server-xover range)) (let ((commands nntp-xover-commands)) ;; `nntp-xover-commands' is a list of possible XOVER commands. *************** It will prompt for a password." *** 1008,1027 **** (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. ! (if (eq nntp-server-xover 'try) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (setq nntp-server-xover nil))) nntp-server-xover)))) (defun nntp-send-strings-to-server (&rest strings) ! "Send list of STRINGS to news server as command and its arguments." ! (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) ;; We open the nntp server if it is down. ! (or (nntp-server-opened nntp-current-server) ! (nntp-open-server nntp-current-server) ! (error "%s" (nntp-status-message))) ;; Send the strings. ! (process-send-string nntp-server-process cmd))) (defun nntp-send-region-to-server (begin end) --- 1027,1047 ---- (setq commands (cdr commands))) ;; If none of the commands worked, we disable XOVER. ! (when (eq nntp-server-xover 'try) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (setq nntp-server-xover nil))) nntp-server-xover)))) (defun nntp-send-strings-to-server (&rest strings) ! "Send STRINGS to the server." ! (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line))) ;; We open the nntp server if it is down. ! (or (nntp-server-opened (nnoo-current-server 'nntp)) ! (nntp-open-server (nnoo-current-server 'nntp)) ! (error (nntp-status-message))) ;; Send the strings. ! (process-send-string nntp-server-process cmd) ! t)) (defun nntp-send-region-to-server (begin end) *************** It will prompt for a password." *** 1030,1036 **** (let ((cur (current-buffer))) ;; Copy the buffer over to the send buffer. ! (set-buffer (get-buffer-create " *nntp send*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) (insert-buffer-substring cur begin end) (save-excursion --- 1050,1054 ---- (let ((cur (current-buffer))) ;; Copy the buffer over to the send buffer. ! (nnheader-set-temp-buffer " *nntp send*") (insert-buffer-substring cur begin end) (save-excursion *************** It will prompt for a password." *** 1041,1045 **** (let ((last (point-min)) (size 100)) ;Size of text sent at once. ! (while (/= last (point-max)) (process-send-region nntp-server-process --- 1059,1064 ---- (let ((last (point-min)) (size 100)) ;Size of text sent at once. ! (while (and (/= last (point-max)) ! (memq (process-status nntp-server-process) '(open run))) (process-send-region nntp-server-process *************** It will prompt for a password." *** 1053,1075 **** If SERVER is nil, use value of environment variable `NNTPSERVER'. If SERVICE, this this as the port number." (let ((server (or server (getenv "NNTPSERVER"))) (status nil) (timer (and nntp-connection-timeout ! (cond ! ((fboundp 'run-at-time) ! (run-at-time nntp-connection-timeout ! nil 'nntp-kill-connection server)) ! ((fboundp 'start-itimer) ! ;; Not sure if this will work or not, only one way to ! ;; find out ! (eval '(start-itimer "nntp-timeout" ! (lambda () ! (nntp-kill-connection server)) ! nntp-connection-timeout nil))))))) (save-excursion (set-buffer nntp-server-buffer) (setq nntp-status-string "") ! (message "nntp: Connecting to server on %s..." server) (cond ((and server (nntp-open-server-internal server service)) (setq nntp-address server) --- 1072,1086 ---- If SERVER is nil, use value of environment variable `NNTPSERVER'. If SERVICE, this this as the port number." + (nnheader-insert "") (let ((server (or server (getenv "NNTPSERVER"))) (status nil) (timer (and nntp-connection-timeout ! (nnheader-run-at-time nntp-connection-timeout ! nil 'nntp-kill-connection server)))) (save-excursion (set-buffer nntp-server-buffer) (setq nntp-status-string "") ! (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address) (cond ((and server (nntp-open-server-internal server service)) (setq nntp-address server) *************** If SERVICE, this this as the port number *** 1079,1126 **** (error nil) (quit nil))) ! (or status (nntp-close-server-internal server)) ! (and nntp-server-process ! (progn ! (set-process-sentinel ! nntp-server-process 'nntp-default-sentinel) ! ;; You can send commands at startup like AUTHINFO here. ! ;; Added by Hallvard B Furuseth ! (run-hooks 'nntp-server-opened-hook)))) ((null server) ! (setq nntp-status-string "NNTP server is not specified.")) (t ; We couldn't open the server. ! (setq nntp-status-string ! (buffer-substring (point-min) (point-max))) ! (setq nntp-timeout-servers (cons server nntp-timeout-servers)))) ! (and timer (cancel-timer timer)) (message "") ! (or status ! (setq nntp-current-server nil ! nntp-async-number nil)) status))) (defun nntp-open-server-internal (server &optional service) "Open connection to news server on SERVER by SERVICE (default is nntp)." (let (proc) (save-excursion - ;; Use TCP/IP stream emulation package if needed. - (or (fboundp 'open-network-stream) - (require 'tcp)) - ;; Initialize communication buffer. - (nnheader-init-server-buffer) (set-buffer nntp-server-buffer) ! (if (setq proc ! (condition-case nil ! (funcall nntp-open-server-function server) ! (error nil))) ! (progn ! (setq nntp-server-process proc) ! ;; Suggested by Hallvard B Furuseth . ! (process-kill-without-query proc) ! (setq nntp-address server) ! ;; It is possible to change kanji-fileio-code in this hook. ! (run-hooks 'nntp-server-hook) ! (push proc nntp-opened-connections) ! nntp-server-process))))) (defun nntp-open-network-stream (server) --- 1090,1172 ---- (error nil) (quit nil))) ! (unless status ! (nntp-close-server-internal server) ! (nnheader-report ! 'nntp "Couldn't open connection to %s" ! (if (and nntp-address ! (not (equal nntp-address ""))) ! nntp-address server))) ! (when nntp-server-process ! (set-process-sentinel ! nntp-server-process 'nntp-default-sentinel) ! ;; You can send commands at startup like AUTHINFO here. ! ;; Added by Hallvard B Furuseth ! (run-hooks 'nntp-server-opened-hook))) ((null server) ! (nnheader-report 'nntp "NNTP server is not specified.")) (t ; We couldn't open the server. ! (nnheader-report ! 'nntp (buffer-substring (point-min) (point-max))))) ! (when timer ! (nnheader-cancel-timer timer)) (message "") ! (unless status ! (nnoo-close-server 'nntp server) ! (setq nntp-async-number nil)) status))) + (defvar nntp-default-directories '("~" "/tmp" "/") + "Directories to as current directory in the nntp server buffer.") + (defun nntp-open-server-internal (server &optional service) "Open connection to news server on SERVER by SERVICE (default is nntp)." (let (proc) (save-excursion (set-buffer nntp-server-buffer) ! ;; Make sure we have a valid current directory for the ! ;; nntp server buffer. ! (unless (file-exists-p default-directory) ! (let ((dirs nntp-default-directories)) ! (while dirs ! (when (file-exists-p (car dirs)) ! (setq default-directory (car dirs) ! dirs nil)) ! (setq dirs (cdr dirs))))) ! (cond ! ((and (setq proc ! (condition-case nil ! (funcall nntp-open-server-function server) ! (error nil))) ! (memq (process-status proc) '(open run))) ! (setq nntp-server-process proc) ! (setq nntp-address server) ! ;; Suggested by Hallvard B Furuseth . ! (process-kill-without-query proc) ! (run-hooks 'nntp-server-hook) ! (push proc nntp-opened-connections) ! (condition-case () ! (nntp-read-server-type) ! (error ! (nnheader-report 'nntp "Couldn't open server %s" server) ! (nntp-close-server))) ! nntp-server-process) ! (t ! (nnheader-report 'nntp "Couldn't open server %s" server)))))) ! ! (defun nntp-read-server-type () ! "Find out what the name of the server we have connected to is." ! ;; Wait for the status string to arrive. ! (nntp-wait-for-response "^.*\n" t) ! (setq nntp-server-type (buffer-string)) ! (let ((alist nntp-server-action-alist) ! entry) ! ;; Run server-specific commmands. ! (while alist ! (setq entry (pop alist)) ! (when (string-match (car entry) nntp-server-type) ! (if (and (listp (cadr entry)) ! (not (eq 'lambda (caadr entry)))) ! (eval (cadr entry)) ! (funcall (cadr entry))))))) (defun nntp-open-network-stream (server) *************** If SERVICE, this this as the port number *** 1129,1136 **** (defun nntp-open-rlogin (server) ! (let ((proc (start-process "nntpd" nntp-server-buffer "rsh" server))) ! (process-send-string proc (mapconcat 'identity nntp-rlogin-parameters ! " ")) ! (process-send-string proc "\n"))) (defun nntp-telnet-to-machine () --- 1175,1189 ---- (defun nntp-open-rlogin (server) ! (let ((proc (if nntp-rlogin-user-name ! (start-process ! "nntpd" nntp-server-buffer "rsh" ! "-l" nntp-rlogin-user-name server ! (mapconcat 'identity ! nntp-rlogin-parameters " ")) ! (start-process ! "nntpd" nntp-server-buffer "rsh" server ! (mapconcat 'identity ! nntp-rlogin-parameters " "))))) ! proc)) (defun nntp-telnet-to-machine () *************** defining this function as macro." *** 1178,1184 **** ;; Fujitsu UTS requires messages during sleep-for. ;; I don't know why. ! (message "NNTP: Reading...") (sleep-for 1) ! (message "")) (condition-case errorcode (accept-process-output nntp-server-process 1) --- 1231,1237 ---- ;; Fujitsu UTS requires messages during sleep-for. ;; I don't know why. ! (nnheader-message 5 "NNTP: Reading...") (sleep-for 1) ! (nnheader-message 5 "")) (condition-case errorcode (accept-process-output nntp-server-process 1) *************** defining this function as macro." *** 1200,1212 **** (defun nntp-possibly-change-server (newsgroup server &optional connectionless) "Check whether the virtual server needs changing." ! (if (and server ! (not (nntp-server-opened server))) ! ;; This virtual server isn't open, so we (re)open it here. ! (nntp-open-server server nil t)) ! (if (and newsgroup ! (not (equal newsgroup nntp-current-group))) ! ;; Set the proper current group. ! (nntp-request-group newsgroup server))) ! (defun nntp-try-list-active (group) (nntp-list-active-group group) --- 1253,1265 ---- (defun nntp-possibly-change-server (newsgroup server &optional connectionless) "Check whether the virtual server needs changing." ! (when (and server ! (not (nntp-server-opened server))) ! ;; This virtual server isn't open, so we (re)open it here. ! (nntp-open-server server nil t)) ! (when (and newsgroup ! (not (equal newsgroup nntp-current-group))) ! ;; Set the proper current group. ! (nntp-request-group newsgroup server))) ! (defun nntp-try-list-active (group) (nntp-list-active-group group) *************** defining this function as macro." *** 1249,1253 **** (while (and (>= (setq max (1- max)) 0) articles) ! (or (memq (setq nart (car (car articles))) nntp-async-fetched) (progn (nntp-async-send-strings "ARTICLE " (int-to-string nart)) --- 1302,1306 ---- (while (and (>= (setq max (1- max)) 0) articles) ! (or (memq (setq nart (caar articles)) nntp-async-fetched) (progn (nntp-async-send-strings "ARTICLE " (int-to-string nart)) *************** defining this function as macro." *** 1256,1263 **** (defun nntp-async-send-strings (&rest strings) ! (let ((cmd (concat (mapconcat 'identity strings " ") "\r\n"))) (or (nntp-async-server-opened) (nntp-async-open-server) ! (error "%s" (nntp-status-message))) (process-send-string nntp-async-process cmd))) --- 1309,1316 ---- (defun nntp-async-send-strings (&rest strings) ! (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line))) (or (nntp-async-server-opened) (nntp-async-open-server) ! (error (nntp-status-message))) (process-send-string nntp-async-process cmd))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/nnvirtual.el emacs-19.32/lisp/nnvirtual.el *** emacs-19.31/lisp/nnvirtual.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/nnvirtual.el Tue Jun 25 18:24:41 1996 *************** *** 1,5 **** ;;; nnvirtual.el --- virtual newsgroups access for Gnus ! ! ;; Copyright (C) 1994,95 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen --- 1,4 ---- ;;; nnvirtual.el --- virtual newsgroups access for Gnus ! ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen *************** *** 35,52 **** (require 'nnheader) (require 'gnus) ! (defconst nnvirtual-version "nnvirtual 1.0" ! "Version number of this version of nnvirtual.") ! (defvar nnvirtual-group-alist nil) ! (defvar nnvirtual-current-group nil) ! (defvar nnvirtual-current-groups nil) ! (defvar nnvirtual-current-mapping nil) ! (defvar nnvirtual-do-not-open nil) ! (defvar nnvirtual-status-string "") --- 34,64 ---- (require 'nnheader) (require 'gnus) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nnvirtual) + + (defvoo nnvirtual-always-rescan nil + "*If non-nil, always scan groups for unread articles when entering a group. + If this variable is nil (which is the default) and you read articles + in a component group after the virtual group has been activated, the + read articles from the component group will show up when you enter the + virtual group.") + + (defvoo nnvirtual-component-regexp nil + "*Regexp to match component groups.") ! (defconst nnvirtual-version "nnvirtual 1.0") ! (defvoo nnvirtual-current-group nil) ! (defvoo nnvirtual-component-groups nil) ! (defvoo nnvirtual-mapping nil) ! (defvoo nnvirtual-status-string "") ! (eval-and-compile ! (autoload 'gnus-cache-articles-in-group "gnus-cache")) *************** *** 54,476 **** ;;; Interface functions. ! (defun nnvirtual-retrieve-headers (sequence &optional newsgroup server) ! "Retrieve the headers for the articles in SEQUENCE." ! (nnvirtual-possibly-change-newsgroups newsgroup server t) ! (save-excursion ! (set-buffer (get-buffer-create "*virtual headers*")) ! (buffer-disable-undo (current-buffer)) ! (erase-buffer) ! (if (stringp (car sequence)) ! 'headers ! (let ((map nnvirtual-current-mapping) ! (offset 0) ! articles beg group active top article result prefix ! fetched-articles group-method) ! (while sequence ! (while (< (car (car map)) (car sequence)) ! (setq offset (car (car map))) ! (setq map (cdr map))) ! (setq top (car (car map))) ! (setq group (nth 1 (car map))) ! (setq prefix (gnus-group-real-prefix group)) ! (setq active (nth 2 (car map))) ! (setq articles nil) ! (while (and sequence (<= (car sequence) top)) ! (setq articles (cons (- (+ active (car sequence)) offset) ! articles)) ! (setq sequence (cdr sequence))) ! (setq articles (nreverse articles)) ! (if (and articles ! (setq result ! (progn ! (setq group-method ! (gnus-find-method-for-group group)) ! (and (or (gnus-server-opened group-method) ! (gnus-open-server group-method)) ! (gnus-request-group group t) ! (gnus-retrieve-headers articles group))))) (save-excursion (set-buffer nntp-server-buffer) ! ;; If we got HEAD headers, we convert them into NOV ! ;; headers. This is slow, inefficient and, come to think ! ;; of it, downright evil. So sue me. I couldn't be ! ;; bothered to write a header parse routine that could ! ;; parse a mixed HEAD/NOV buffer. ! (and (eq result 'headers) (nnvirtual-convert-headers)) ! (goto-char (point-min)) ! (setq fetched-articles nil) ! (while (not (eobp)) ! (setq beg (point) ! article (read nntp-server-buffer) ! fetched-articles (cons article fetched-articles)) ! (delete-region beg (point)) ! (insert (int-to-string (+ (- article active) offset))) ! (beginning-of-line) ! (looking-at ! "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") ! (goto-char (match-end 0)) ! (or (search-forward ! "\t" (save-excursion (end-of-line) (point)) t) ! (end-of-line)) ! (while (= (char-after (1- (point))) ? ) ! (forward-char -1) ! (delete-char 1)) ! (if (eolp) ! (progn ! (end-of-line) ! (or (= (char-after (1- (point))) ?\t) ! (insert ?\t)) ! (insert (format "Xref: %s %s:%d\t" (system-name) ! group article))) ! (if (not (string= "" prefix)) ! (while (re-search-forward ! "[^ ]+:[0-9]+" ! (save-excursion (end-of-line) (point)) t) ! (save-excursion ! (goto-char (match-beginning 0)) ! (insert prefix)))) ! (end-of-line) ! (or (= (char-after (1- (point))) ?\t) ! (insert ?\t))) ! (forward-line 1)))) ! (goto-char (point-max)) ! (insert-buffer-substring nntp-server-buffer) ! ;; We have now massaged and inserted the headers from one ! ;; group. In case some of the articles have expired or been ! ;; cancelled, we have to mark them as read in the component ! ;; group. ! (let ((unfetched (gnus-sorted-complement ! articles (nreverse fetched-articles)))) ! (and unfetched ! (gnus-group-make-articles-read group unfetched nil)))) ! ;; The headers are ready for reading, so they are inserted into ! ;; the nntp-server-buffer, which is where Gnus expects to find ! ;; them. ! (prog1 (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring "*virtual headers*") ! 'nov) ! (kill-buffer (current-buffer))))))) ! ! (defun nnvirtual-open-server (newsgroups &optional something) ! "Open a virtual newsgroup that contains NEWSGROUPS." ! (nnheader-init-server-buffer)) ! ! (defun nnvirtual-close-server (&rest dum) ! "Close news server." t) ! (defun nnvirtual-request-close () ! (setq nnvirtual-current-group nil ! nnvirtual-current-groups nil ! nnvirtual-current-mapping nil ! nnvirtual-group-alist nil) ! t) ! (defun nnvirtual-server-opened (&optional server) ! "Return server process status, T or NIL. ! If the stream is opened, return T, otherwise return NIL." ! (and nntp-server-buffer ! (get-buffer nntp-server-buffer))) ! ! (defun nnvirtual-status-message (&optional server) ! "Return server status response as string." ! nnvirtual-status-string) ! ! (defun nnvirtual-request-article (article &optional newsgroup server buffer) ! "Select article by message number." ! (nnvirtual-possibly-change-newsgroups newsgroup server t) ! (and (numberp article) ! (let ((map nnvirtual-current-mapping) ! (offset 0) ! group-method) ! (while (< (car (car map)) article) ! (setq offset (car (car map))) ! (setq map (cdr map))) ! (setq group-method (gnus-find-method-for-group (nth 1 (car map)))) ! (or (gnus-server-opened group-method) ! (gnus-open-server group-method)) ! (gnus-request-group (nth 1 (car map)) t) ! (gnus-request-article (- (+ (nth 2 (car map)) article) offset) ! (nth 1 (car map)) buffer)))) ! ! (defun nnvirtual-request-group (group &optional server dont-check) ! "Make GROUP the current newsgroup." ! (nnvirtual-possibly-change-newsgroups group server dont-check) ! (let ((map nnvirtual-current-mapping)) (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if map ! (progn ! (while (cdr map) ! (setq map (cdr map))) ! (insert (format "211 %d 1 %d %s\n" (car (car map)) ! (car (car map)) group)) ! t) ! (setq nnvirtual-status-string "No component groups") ! (setq nnvirtual-current-group nil) ! nil)))) ! ! (defun nnvirtual-close-group (group &optional server) ! (if (not nnvirtual-current-group) ! () ! (nnvirtual-possibly-change-newsgroups group server t) ! (nnvirtual-update-marked) ! (setq nnvirtual-current-group nil ! nnvirtual-current-groups nil ! nnvirtual-current-mapping nil) ! (setq nnvirtual-group-alist ! (delq (assoc group nnvirtual-group-alist) nnvirtual-group-alist)))) ! ! (defun nnvirtual-request-list (&optional server) ! (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.") ! nil) ! ! (defun nnvirtual-request-newgroups (date &optional server) ! "List new groups." ! (setq nnvirtual-status-string "NEWGROUPS is not supported.") ! nil) ! ! (defun nnvirtual-request-list-newsgroups (&optional server) ! (setq nnvirtual-status-string ! "nnvirtual: LIST NEWSGROUPS is not implemented.") ! nil) ! ! (defalias 'nnvirtual-request-post 'nntp-request-post) ! ! (defun nnvirtual-request-post-buffer ! (post group subject header article-buffer info follow-to respect-poster) ! (nntp-request-post-buffer post "" subject header article-buffer ! info follow-to respect-poster)) ;;; Internal functions. - ;; Convert HEAD headers into NOV headers. (defun nnvirtual-convert-headers () (save-excursion (set-buffer nntp-server-buffer) ! (let* ((gnus-newsgroup-dependencies (make-vector 100 0)) ! (headers (gnus-get-newsgroup-headers)) header) (erase-buffer) ! (while headers ! (setq header (car headers) ! headers (cdr headers)) ! (insert (int-to-string (mail-header-number header)) "\t" ! (or (mail-header-subject header) "") "\t" ! (or (mail-header-from header) "") "\t" ! (or (mail-header-date header) "") "\t" ! (or (mail-header-id header) "") "\t" ! (or (mail-header-references header) "") "\t" ! (int-to-string (or (mail-header-chars header) 0)) "\t" ! (int-to-string (or (mail-header-lines header) 0)) "\t" ! (if (mail-header-xref header) ! (concat "Xref: " (mail-header-xref header) "\t") ! "") "\n"))))) ! ! (defun nnvirtual-possibly-change-newsgroups (group regexp &optional check) ! (let ((inf t)) ! (or (not group) ! (and nnvirtual-current-group ! (string= group nnvirtual-current-group)) ! (and (setq inf (assoc group nnvirtual-group-alist)) ! (string= (nth 3 inf) regexp) ! (progn ! (setq nnvirtual-current-group (car inf)) ! (setq nnvirtual-current-groups (nth 1 inf)) ! (setq nnvirtual-current-mapping (nth 2 inf))))) ! (if (or (not check) (not inf)) ! (progn ! (and inf (setq nnvirtual-group-alist ! (delq inf nnvirtual-group-alist))) ! (setq nnvirtual-current-mapping nil) ! (setq nnvirtual-current-group group) ! (let ((newsrc gnus-newsrc-alist) ! (virt-group (gnus-group-prefixed-name ! nnvirtual-current-group '(nnvirtual "")))) ! (setq nnvirtual-current-groups nil) ! (while newsrc ! (and (string-match regexp (car (car newsrc))) ! (not (string= (car (car newsrc)) virt-group)) ! (setq nnvirtual-current-groups ! (cons (car (car newsrc)) nnvirtual-current-groups))) ! (setq newsrc (cdr newsrc)))) ! (if nnvirtual-current-groups ! (progn ! (nnvirtual-create-mapping group) ! (setq nnvirtual-group-alist ! (cons (list group nnvirtual-current-groups ! nnvirtual-current-mapping regexp) ! nnvirtual-group-alist))) ! (setq nnvirtual-status-string ! (format ! "nnvirtual: No newsgroups for this virtual newsgroup")))))) ! nnvirtual-current-groups) ! ! (defun nnvirtual-create-mapping (group) ! (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual ""))) ! (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) ! (groups nnvirtual-current-groups) ! (offset 0) ! reads unread igroup itotal ireads) ! ;; The virtual group doesn't exist. (?) ! (or info (error "No such group: %s" group)) ! (setq nnvirtual-current-mapping nil) ! (while groups ! ;; Added by Sudish Joseph . ! (setq igroup (car groups)) ! (let ((info (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb))) ! (active (gnus-gethash igroup gnus-active-hashtb))) ! ;; See if the group has had its active list read this session ! ;; if not, we do it now. ! (if (null active) ! (if (gnus-activate-group igroup) ! (progn ! (gnus-get-unread-articles-in-group ! info (gnus-gethash igroup gnus-active-hashtb)) ! (setq active (gnus-gethash igroup gnus-active-hashtb))) ! (message "Couldn't open component group %s" igroup))) ! (if (null active) ! () ! ;; And then we do the mapping for this component group. If ! ;; you feel tempted to cast your eyes to the soup below - ! ;; don't. It'll hurt your soul. Suffice to say that it ! ;; assigns ranges of nnvirtual article numbers to the ! ;; different component groups. To get the article number ! ;; from the nnvirtual number, one does something like ! ;; (+ (- number offset) (car active)), where `offset' is the ! ;; slice the mess below assigns, and active is the lowest ! ;; active article in the component group. ! (setq itotal (1+ (- (cdr active) (car active)))) ! (if (setq ireads (nth 2 info)) ! (let ((itreads ! (if (not (listp (cdr ireads))) ! (setq ireads (list (cons (car ireads) (cdr ireads)))) ! (setq ireads (copy-alist ireads))))) ! (if (< (or (and (numberp (car ireads)) (car ireads)) ! (cdr (car ireads))) (car active)) ! (setq ireads (setq itreads (cdr ireads)))) ! (if (and ireads (< (or (and (numberp (car ireads)) ! (car ireads)) ! (car (car ireads))) (car active))) ! (setcar (or (and (numberp (car ireads)) ireads) ! (car ireads)) (1+ (car active)))) ! (while itreads ! (setcar (or (and (numberp (car itreads)) itreads) ! (car itreads)) ! (+ (max ! 1 (- (if (numberp (car itreads)) ! (car itreads) ! (car (car itreads))) ! (car active))) ! offset)) ! (if (not (numberp (car itreads))) ! (setcdr (car itreads) ! (+ (- (cdr (car itreads)) (car active)) offset))) ! (setq itreads (cdr itreads))) ! (setq reads (nconc reads ireads)))) ! (setq offset (+ offset (1- itotal))) ! (setq nnvirtual-current-mapping ! (cons (list offset igroup (car active)) ! nnvirtual-current-mapping))) ! (setq groups (cdr groups)))) ! (setq nnvirtual-current-mapping ! (nreverse nnvirtual-current-mapping)) ! ;; Set Gnus active info. ! (gnus-sethash group (cons 1 (1- offset)) gnus-active-hashtb) ! ;; Set Gnus read info. ! (setcar (nthcdr 2 info) reads) ! ! ;; Then we deal with the marks. ! (let ((map nnvirtual-current-mapping) ! (marks '(tick dormant reply expire score)) ! (offset 0) ! tick dormant reply expire score marked active) ! (while map ! (setq igroup (nth 1 (car map))) ! (setq active (nth 2 (car map))) ! (setq marked (nth 3 (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb)))) ! (let ((m marks)) ! (while m ! (and (assq (car m) marked) ! (set (car m) ! (nconc (mapcar ! (lambda (art) ! (if (numberp art) ! (if (< art active) ! 0 (+ (- art active) offset)) ! (cons (+ (- (car art) active) offset) ! (cdr art)))) ! (cdr (assq (car m) marked))) ! (symbol-value (car m))))) ! (setq m (cdr m)))) ! (setq offset (car (car map))) ! (setq map (cdr map))) ! ;; Put the list of marked articles in the info of the virtual group. ! (let ((m marks) ! marked) ! (while m ! (and (symbol-value (car m)) ! (setq marked (cons (cons (car m) (symbol-value (car m))) ! marked))) ! (setq m (cdr m))) ! (if (nthcdr 3 info) ! (setcar (nthcdr 3 info) marked) ! (setcdr (nthcdr 2 info) (list marked))))))) (defun nnvirtual-update-marked () ! (let ((mark-lists '((gnus-newsgroup-marked . tick) ! (gnus-newsgroup-dormant . dormant) ! (gnus-newsgroup-expirable . expire) ! (gnus-newsgroup-replied . reply))) ! marks art-group group-alist g) ! (while mark-lists ! (setq marks (symbol-value (car (car mark-lists)))) ! ;; Find out what groups the mark belong to. ! (while marks ! (setq art-group (nnvirtual-art-group (car marks))) ! (if (setq g (assoc (car art-group) group-alist)) ! (nconc g (list (cdr art-group))) ! (setq group-alist (cons (list (car art-group) (cdr art-group)) ! group-alist))) ! (setq marks (cdr marks))) ! ;; The groups that don't have marks must have no marks. (Yup.) ! (let ((groups nnvirtual-current-groups)) ! (while groups ! (or (assoc (car groups) group-alist) ! (setq group-alist (cons (list (car groups)) group-alist))) ! (setq groups (cdr groups)))) ! ;; The we update the list of marks. ! (while group-alist (gnus-add-marked-articles ! (car (car group-alist)) (cdr (car mark-lists)) ! (cdr (car group-alist)) nil t) ! (gnus-group-update-group (car (car group-alist)) t) ! (setq group-alist (cdr group-alist))) ! (setq mark-lists (cdr mark-lists))))) ! ! (defun nnvirtual-art-group (article) ! (let ((map nnvirtual-current-mapping) ! (offset 0)) ! (while (< (car (car map)) (if (numberp article) article (car article))) ! (setq offset (car (car map)) ! map (cdr map))) ! (cons (nth 1 (car map)) ! (if (numberp article) ! (- (+ article (nth 2 (car map))) offset) ! (cons (- (+ (car article) (nth 2 (car map))) offset) ! (cdr article)))))) ! ! (defun nnvirtual-catchup-group (group &optional server all) ! (nnvirtual-possibly-change-newsgroups group server) ! (let ((gnus-group-marked nnvirtual-current-groups) ! (gnus-expert-user t)) ! (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-catchup-current nil all)))) (provide 'nnvirtual) --- 66,407 ---- ;;; Interface functions. ! (nnoo-define-basics nnvirtual) ! ! (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup ! server fetch-old) ! (when (nnvirtual-possibly-change-server server) ! (save-excursion ! (set-buffer nntp-server-buffer) ! (erase-buffer) ! (if (stringp (car articles)) ! 'headers ! (let ((vbuf (nnheader-set-temp-buffer ! (get-buffer-create " *virtual headers*"))) ! (unfetched (mapcar (lambda (g) (list g)) ! nnvirtual-component-groups)) ! (system-name (system-name)) ! cgroup article result prefix) ! (while articles ! (setq article (assq (pop articles) nnvirtual-mapping)) ! (when (and (setq cgroup (cadr article)) ! (gnus-check-server ! (gnus-find-method-for-group cgroup) t) ! (gnus-request-group cgroup t)) ! (setq prefix (gnus-group-real-prefix cgroup)) ! (when (setq result (gnus-retrieve-headers ! (list (caddr article)) cgroup nil)) ! (set-buffer nntp-server-buffer) ! (if (zerop (buffer-size)) ! (nconc (assq cgroup unfetched) (list (caddr article))) ! ;; If we got HEAD headers, we convert them into NOV ! ;; headers. This is slow, inefficient and, come to think ! ;; of it, downright evil. So sue me. I couldn't be ! ;; bothered to write a header parse routine that could ! ;; parse a mixed HEAD/NOV buffer. ! (when (eq result 'headers) ! (nnvirtual-convert-headers)) ! (goto-char (point-min)) ! (while (not (eobp)) ! (delete-region ! (point) (progn (read nntp-server-buffer) (point))) ! (princ (car article) (current-buffer)) ! (beginning-of-line) ! (looking-at ! "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") ! (goto-char (match-end 0)) ! (or (search-forward ! "\t" (save-excursion (end-of-line) (point)) t) ! (end-of-line)) ! (while (= (char-after (1- (point))) ? ) ! (forward-char -1) ! (delete-char 1)) ! (if (eolp) ! (progn ! (end-of-line) ! (or (= (char-after (1- (point))) ?\t) ! (insert ?\t)) ! (insert "Xref: " system-name " " cgroup ":") ! (princ (caddr article) (current-buffer)) ! (insert "\t")) ! (insert "Xref: " system-name " " cgroup ":") ! (princ (caddr article) (current-buffer)) ! (insert " ") ! (if (not (string= "" prefix)) ! (while (re-search-forward ! "[^ ]+:[0-9]+" ! (save-excursion (end-of-line) (point)) t) ! (save-excursion ! (goto-char (match-beginning 0)) ! (insert prefix)))) ! (end-of-line) ! (or (= (char-after (1- (point))) ?\t) ! (insert ?\t))) ! (forward-line 1)) ! (set-buffer vbuf) ! (goto-char (point-max)) ! (insert-buffer-substring nntp-server-buffer))))) ! ! ;; In case some of the articles have expired or been ! ;; cancelled, we have to mark them as read in the ! ;; component group. ! (while unfetched ! (when (cdar unfetched) ! (gnus-group-make-articles-read ! (caar unfetched) (sort (cdar unfetched) '<))) ! (setq unfetched (cdr unfetched))) ! ! ;; The headers are ready for reading, so they are inserted into ! ;; the nntp-server-buffer, which is where Gnus expects to find ! ;; them. ! (prog1 (save-excursion (set-buffer nntp-server-buffer) ! (erase-buffer) ! (insert-buffer-substring vbuf) ! 'nov) ! (kill-buffer vbuf))))))) ! ! (deffoo nnvirtual-request-article (article &optional group server buffer) ! (when (and (nnvirtual-possibly-change-server server) ! (numberp article)) ! (let* ((amap (assq article nnvirtual-mapping)) ! (cgroup (cadr amap))) ! (cond ! ((not amap) ! (nnheader-report 'nnvirtual "No such article: %s" article)) ! ((not (gnus-check-group cgroup)) ! (nnheader-report ! 'nnvirtual "Can't open server where %s exists" cgroup)) ! ((not (gnus-request-group cgroup t)) ! (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) ! (t ! (if buffer (save-excursion ! (set-buffer buffer) ! (gnus-request-article-this-buffer (caddr amap) cgroup)) ! (gnus-request-article (caddr amap) cgroup))))))) ! ! (deffoo nnvirtual-open-server (server &optional defs) ! (unless (assq 'nnvirtual-component-regexp defs) ! (push `(nnvirtual-component-regexp ,server) ! defs)) ! (nnoo-change-server 'nnvirtual server defs) ! (if nnvirtual-component-groups ! t ! (setq nnvirtual-mapping nil) ! ;; Go through the newsrc alist and find all component groups. ! (let ((newsrc (cdr gnus-newsrc-alist)) ! group) ! (while (setq group (car (pop newsrc))) ! (when (string-match nnvirtual-component-regexp group) ; Match ! ;; Add this group to the list of component groups. ! (setq nnvirtual-component-groups ! (cons group (delete group nnvirtual-component-groups)))))) ! (if (not nnvirtual-component-groups) ! (nnheader-report 'nnvirtual "No component groups: %s" server) ! t))) ! ! (deffoo nnvirtual-request-group (group &optional server dont-check) ! (nnvirtual-possibly-change-server server) ! (setq nnvirtual-component-groups ! (delete (nnvirtual-current-group) nnvirtual-component-groups)) ! (cond ! ((null nnvirtual-component-groups) ! (setq nnvirtual-current-group nil) ! (nnheader-report 'nnvirtual "No component groups in %s" group)) ! (t ! (unless dont-check ! (nnvirtual-create-mapping)) ! (setq nnvirtual-current-group group) ! (let ((len (length nnvirtual-mapping))) ! (nnheader-insert "211 %d 1 %d %s\n" len len group))))) ! ! (deffoo nnvirtual-request-type (group &optional article) ! (if (not article) ! 'unknown ! (let ((mart (assq article nnvirtual-mapping))) ! (when mart ! (gnus-request-type (cadr mart) (car mart)))))) ! ! (deffoo nnvirtual-request-update-mark (group article mark) ! (let* ((nart (assq article nnvirtual-mapping)) ! (cgroup (cadr nart)) ! ;; The component group might be a virtual group. ! (nmark (gnus-request-update-mark cgroup (caddr nart) mark))) ! (when (and nart ! (= mark nmark) ! (gnus-group-auto-expirable-p cgroup)) ! (setq mark gnus-expirable-mark))) ! mark) ! ! (deffoo nnvirtual-close-group (group &optional server) ! (when (nnvirtual-possibly-change-server server) ! ;; Copy (un)read articles. ! (nnvirtual-update-reads) ! ;; We copy the marks from this group to the component ! ;; groups here. ! (nnvirtual-update-marked)) t) + + (deffoo nnvirtual-request-list (&optional server) + (nnheader-report 'nnvirtual "LIST is not implemented.")) ! (deffoo nnvirtual-request-newgroups (date &optional server) ! (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) ! (deffoo nnvirtual-request-list-newsgroups (&optional server) ! (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) ! ! (deffoo nnvirtual-request-update-info (group info &optional server) ! (when (nnvirtual-possibly-change-server server) ! (let ((map nnvirtual-mapping) ! (marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists)) ! reads mr m op) ! ;; Go through the mapping. ! (while map ! (unless (nth 3 (setq m (pop map))) ! ;; Read article. ! (push (car m) reads)) ! ;; Copy marks. ! (when (setq mr (nth 4 m)) ! (while mr ! (setcdr (setq op (assq (pop mr) marks)) (cons (car m) (cdr op)))))) ! ;; Compress the marks and the reads. ! (setq mr marks) ! (while mr ! (setcdr (car mr) (gnus-compress-sequence (sort (cdr (pop mr)) '<)))) ! (setcar (cddr info) (gnus-compress-sequence (nreverse reads))) ! ;; Remove empty marks lists. ! (while (and marks (not (cdar marks))) ! (setq marks (cdr marks))) ! (setq mr marks) ! (while (cdr mr) ! (if (cdadr mr) ! (setq mr (cdr mr)) ! (setcdr mr (cddr mr)))) ! ! ;; Enter these new marks into the info of the group. ! (if (nthcdr 3 info) ! (setcar (nthcdr 3 info) marks) ! ;; Add the marks lists to the end of the info. ! (when marks ! (setcdr (nthcdr 2 info) (list marks)))) ! t))) ! ! (deffoo nnvirtual-catchup-group (group &optional server all) ! (nnvirtual-possibly-change-server server) ! (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) ! (gnus-expert-user t)) ! ;; Make sure all groups are activated. ! (mapcar ! (lambda (g) ! (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb)))) ! (gnus-activate-group g))) ! nnvirtual-component-groups) (save-excursion ! (set-buffer gnus-group-buffer) ! (gnus-group-catchup-current nil all)))) ! ! (deffoo nnvirtual-find-group-art (group article) ! "Return the real group and article for virtual GROUP and ARTICLE." ! (let ((mart (assq article nnvirtual-mapping))) ! (when mart ! (cons (cadr mart) (caddr mart))))) ;;; Internal functions. (defun nnvirtual-convert-headers () + "Convert HEAD headers into NOV headers." (save-excursion (set-buffer nntp-server-buffer) ! (let* ((dependencies (make-vector 100 0)) ! (headers (gnus-get-newsgroup-headers dependencies)) header) (erase-buffer) ! (while (setq header (pop headers)) ! (nnheader-insert-nov header))))) ! ! (defun nnvirtual-possibly-change-server (server) ! (or (not server) ! (nnoo-current-server-p 'nnvirtual server) ! (nnvirtual-open-server server))) (defun nnvirtual-update-marked () ! "Copy marks from the virtual group to the component groups." ! (let ((mark-lists gnus-article-mark-lists) ! (marks (gnus-info-marks (gnus-get-info (nnvirtual-current-group)))) ! type list mart cgroups) ! (while (setq type (cdr (pop mark-lists))) ! (setq list (gnus-uncompress-range (cdr (assq type marks)))) ! (setq cgroups ! (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) ! (while list ! (nconc (assoc (cadr (setq mart (assq (pop list) nnvirtual-mapping))) ! cgroups) ! (list (caddr mart)))) ! (while cgroups (gnus-add-marked-articles ! (caar cgroups) type (cdar cgroups) nil t) ! (gnus-group-update-group (car (pop cgroups)) t))))) ! ! (defun nnvirtual-update-reads () ! "Copy (un)reads from the current group to the component groups." ! (let ((groups (mapcar (lambda (g) (list g)) nnvirtual-component-groups)) ! (articles (gnus-list-of-unread-articles ! (nnvirtual-current-group))) ! m) ! (while articles ! (setq m (assq (pop articles) nnvirtual-mapping)) ! (nconc (assoc (nth 1 m) groups) (list (nth 2 m)))) ! (while groups ! (gnus-update-read-articles (caar groups) (cdr (pop groups)))))) ! ! (defun nnvirtual-current-group () ! "Return the prefixed name of the current nnvirtual group." ! (concat "nnvirtual:" nnvirtual-current-group)) ! ! (defsubst nnvirtual-marks (article marks) ! "Return a list of mark types for ARTICLE." ! (let (out) ! (while marks ! (when (memq article (cdar marks)) ! (push (caar marks) out)) ! (setq marks (cdr marks))) ! out)) ! ! (defun nnvirtual-create-mapping () ! "Create an article mapping for the current group." ! (let* ((div nil) ! m marks list article unreads marks active ! (map (sort ! (apply ! 'nconc ! (mapcar ! (lambda (g) ! (when (and (setq active (gnus-activate-group g)) ! (> (cdr active) (car active))) ! (setq unreads (gnus-list-of-unread-articles g) ! marks (gnus-uncompress-marks ! (gnus-info-marks (gnus-get-info g)))) ! (when gnus-use-cache ! (push (cons 'cache (gnus-cache-articles-in-group g)) ! marks)) ! (setq div (/ (float (car active)) ! (if (zerop (cdr active)) ! 1 (cdr active)))) ! (mapcar (lambda (n) ! (list (* div (- n (car active))) ! g n (and (memq n unreads) t) ! (inline (nnvirtual-marks n marks)))) ! (gnus-uncompress-range active)))) ! nnvirtual-component-groups)) ! (lambda (m1 m2) ! (< (car m1) (car m2))))) ! (i 0)) ! (setq nnvirtual-mapping map) ! ;; Set the virtual article numbers. ! (while (setq m (pop map)) ! (setcar m (setq article (incf i)))))) (provide 'nnvirtual) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/noutline.el emacs-19.32/lisp/noutline.el *** emacs-19.31/lisp/noutline.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/noutline.el Wed Jun 26 14:03:29 1996 *************** in the file it applies to.") *** 133,137 **** "Non-nil if using Outline mode as a minor mode of some other mode.") (make-variable-buffer-local 'outline-minor-mode) - (put 'outline-minor-mode 'permanent-local t) (or (assq 'outline-minor-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist --- 133,136 ---- *************** See the command `outline-mode' for more *** 252,255 **** --- 251,259 ---- (if outline-minor-mode (progn + (make-local-hook 'change-major-mode-hook) + ;; Turn off this mode if we change major modes. + (add-hook 'change-major-mode-hook + '(lambda () (outline-minor-mode -1)) + nil t) (make-local-variable 'line-move-ignore-invisible) (setq line-move-ignore-invisible t) *************** Only visible heading lines are considere *** 309,319 **** (or (outline-on-heading-p) (let (found) ! (while (not found) ! (setq found ! (and (re-search-backward (concat "^\\(" outline-regexp "\\)") ! nil t) ! (outline-visible)))) ! found) ! (error "before first heading"))) (defun outline-on-heading-p () --- 313,324 ---- (or (outline-on-heading-p) (let (found) ! (save-excursion ! (while (not found) ! (or (re-search-backward (concat "^\\(" outline-regexp "\\)") ! nil t) ! (error "before first heading")) ! (setq found (and (outline-visible) (point))))) ! (goto-char found) ! found))) (defun outline-on-heading-p () *************** With argument, move up ARG levels." *** 581,585 **** (outline-back-to-heading) (if (eq (funcall outline-level) 1) ! (error "")) (while (and (> (funcall outline-level) 1) (> arg 0) --- 586,590 ---- (outline-back-to-heading) (if (eq (funcall outline-level) 1) ! (error "Already at top level of the outline")) (while (and (> (funcall outline-level) 1) (> arg 0) *************** Stop at the first and last subheadings o *** 604,608 **** (progn (setq arg 0) ! (error "")))))) (defun outline-get-next-sibling () --- 609,613 ---- (progn (setq arg 0) ! (error "No following same-level heading")))))) (defun outline-get-next-sibling () *************** Stop at the first and last subheadings o *** 631,635 **** (progn (setq arg 0) ! (error "")))))) (defun outline-get-last-sibling () --- 636,640 ---- (progn (setq arg 0) ! (error "No previous same-level heading")))))) (defun outline-get-last-sibling () diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/page-ext.el emacs-19.32/lisp/page-ext.el *** emacs-19.31/lisp/page-ext.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/page-ext.el Sat Jul 20 13:32:59 1996 *************** *** 120,126 **** ;; FSF ;; Free Software Foundation ! ;; 675 Massachusetts Avenue ! ;; Cambridge, MA 02139 USA ! ;; (617) 876-3296 ;; gnu@prep.ai.mit.edu ;; --- 120,126 ---- ;; FSF ;; Free Software Foundation ! ;; 59 Temple Place - Suite 330 ! ;; Boston, MA 02111-1307 USA. ! ;; (617) 542-5942 ;; gnu@prep.ai.mit.edu ;; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/paths.el emacs-19.32/lisp/paths.el *** emacs-19.31/lisp/paths.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/paths.el Wed Jun 19 18:14:04 1996 *************** *** 45,52 **** (setq start (nconc start (list configdir))) start) ! "List of directories to search for Info documentation files. ! They are searched in the order they are given in this list. Therefore, the directory of Info files that come with Emacs ! normally should come last (so that local files override standard ones).") (defvar news-path --- 45,57 ---- (setq start (nconc start (list configdir))) start) ! "Default list of directories to search for Info documentation files. ! They are searched in the order they are given in the list. Therefore, the directory of Info files that come with Emacs ! normally should come last (so that local files override standard ones). ! ! Once Info is started, the list of directories to search ! comes from the variable `Info-directory-list'. ! This variable `Info-default-directory-list' is used as the default ! for initializing `Info-directory-list' when Info is started.") (defvar news-path diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/pp.el emacs-19.32/lisp/pp.el *** emacs-19.31/lisp/pp.el Fri Jan 19 06:24:34 1996 --- emacs-19.32/lisp/pp.el Tue Jun 18 11:46:55 1996 *************** that `read' can handle, whenever this is *** 42,47 **** ;; (message "%06d" (- (point-max) (point))) (cond ! ((looking-at "\\s\(") ! (while (looking-at "\\s(") (forward-char 1))) ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)") --- 42,47 ---- ;; (message "%06d" (- (point-max) (point))) (cond ! ((looking-at "\\s(\\|#\\s(") ! (while (looking-at "\\s(\\|#\\s(") (forward-char 1))) ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/profile.el emacs-19.32/lisp/profile.el *** emacs-19.31/lisp/profile.el Fri Mar 8 12:44:02 1996 --- emacs-19.32/lisp/profile.el Fri Jun 28 03:31:06 1996 *************** *** 84,88 **** (defvar profile-timer-process nil "Process running the timer.") (defvar profile-time-list nil ! "List of accumulative time for each profiled function.") (defvar profile-init-list nil "List of entry time for each function. \n\ --- 84,88 ---- (defvar profile-timer-process nil "Process running the timer.") (defvar profile-time-list nil ! "List of cumulative calls and time for each profiled function.") (defvar profile-init-list nil "List of entry time for each function. \n\ *************** Both how many times invoked and real tim *** 100,104 **** "Profile all the functions listed in `profile-functions-list'.\n\ With argument FLIST, use the list FLIST instead." ! (interactive "*P") (if (null flist) (setq flist profile-functions-list)) (mapcar 'profile-a-function flist)) --- 100,104 ---- "Profile all the functions listed in `profile-functions-list'.\n\ With argument FLIST, use the list FLIST instead." ! (interactive "P") (if (null flist) (setq flist profile-functions-list)) (mapcar 'profile-a-function flist)) *************** With argument FLIST, use the list FLIST *** 116,132 **** (defun profile-print (entry) "Print one ENTRY (from `profile-time-list')." ! (let ((time (cdr entry)) str (offset 5)) ! (insert (format "%s" (car entry)) space) ! (move-to-column ref-column) ! (setq str (int-to-string (car time))) ! (insert str) ! (if (>= (length str) offset) nil ! (move-to-column ref-column) ! (insert (substring spaces 0 (- offset (length str)))) ! (forward-char (length str))) ! (setq str (int-to-string (cdr time))) ! (insert "." (substring "000000" 0 (- 6 (length str))) str "\n"))) ! ! (defconst spaces " ") (defun profile-results () --- 116,134 ---- (defun profile-print (entry) "Print one ENTRY (from `profile-time-list')." ! (let* ((calls (car (cdr entry))) ! (timec (cdr (cdr entry))) ! (time (+ (car timec) (/ (cdr timec) (float profile-million)))) ! (avgtime 0.0)) ! (insert (format (concat "%-" ! (int-to-string profile-max-fun-name) ! "s%8d%11d.%06d") ! (car entry) calls (car timec) (cdr timec)) ! (if (zerop calls) ! "\n" ! (format "%12d.%06d\n" ! (truncate (setq avgtime (/ time calls))) ! (truncate (* (- avgtime (ftruncate avgtime)) ! profile-million)))) ! ))) (defun profile-results () *************** With argument FLIST, use the list FLIST *** 134,147 **** \(The buffer name comes from `profile-buffer'.)" (interactive) ! (let* ((ref-column (+ 8 profile-max-fun-name)) ! (space (substring spaces 0 ref-column))) ! (switch-to-buffer profile-buffer) ! (erase-buffer) ! (insert "Function" space) ! (move-to-column ref-column) ! (insert "Time (Seconds.Useconds)\n" "========" space ) ! (move-to-column ref-column) ! (insert "=======================\n") ! (mapcar 'profile-print profile-time-list))) (defun profile-reset-timer () --- 136,146 ---- \(The buffer name comes from `profile-buffer'.)" (interactive) ! (switch-to-buffer profile-buffer) ! (erase-buffer) ! (insert "Function" (make-string (- profile-max-fun-name 6) ? )) ! (insert " Calls Total time (sec) Avg time per call\n") ! (insert (make-string profile-max-fun-name ?=) " ") ! (insert "====== ================ =================\n") ! (mapcar 'profile-print profile-time-list)) (defun profile-reset-timer () *************** With argument FLIST, use the list FLIST *** 198,207 **** (let ((init-time (profile-find-function fun profile-init-list)) (accum (profile-find-function fun profile-time-list)) ! sec usec) (if (or (null init-time) (null accum)) (error "Function %s missing from list" fun)) (setcar init-time (1- (car init-time))) ; pop one level in recursion (if (not (zerop (car init-time))) ! nil ; in some recursion level, do not update accum. time (setq init-time (cdr init-time)) (setq sec (- (car profile-time) (car init-time)) --- 197,210 ---- (let ((init-time (profile-find-function fun profile-init-list)) (accum (profile-find-function fun profile-time-list)) ! calls time sec usec) (if (or (null init-time) (null accum)) (error "Function %s missing from list" fun)) + (setq calls (car accum)) + (setq time (cdr accum)) (setcar init-time (1- (car init-time))) ; pop one level in recursion (if (not (zerop (car init-time))) ! nil ; in some recursion level, ! ; do not update cumulated time ! (setcar accum (1+ calls)) (setq init-time (cdr init-time)) (setq sec (- (car profile-time) (car init-time)) *************** With argument FLIST, use the list FLIST *** 212,220 **** (setq usec (+ usec profile-million)) (setq sec (1- sec))) ! (setcar accum (+ sec (car accum))) ! (setcdr accum (+ usec (cdr accum))) ! (if (< (cdr accum) profile-million) nil ! (setcar accum (1+ (car accum))) ! (setcdr accum (- (cdr accum) profile-million))) ))) --- 215,223 ---- (setq usec (+ usec profile-million)) (setq sec (1- sec))) ! (setcar time (+ sec (car time))) ! (setcdr time (+ usec (cdr time))) ! (if (< (cdr time) profile-million) nil ! (setcar time (1+ (car time))) ! (setcdr time (- (cdr time) profile-million))) ))) *************** With argument FLIST, use the list FLIST *** 244,248 **** (error "To profile: %s must be a user-defined function" fun)) (setq profile-time-list ; add a new entry ! (cons (cons fun (cons 0 0)) profile-time-list)) (setq profile-init-list ; add a new entry (cons (cons fun (cons 0 (cons 0 0))) profile-init-list)) --- 247,251 ---- (error "To profile: %s must be a user-defined function" fun)) (setq profile-time-list ; add a new entry ! (cons (cons fun (cons 0 (cons 0 0))) profile-time-list)) (setq profile-init-list ; add a new entry (cons (cons fun (cons 0 (cons 0 0))) profile-init-list)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/ps-print.el emacs-19.32/lisp/ps-print.el *** emacs-19.31/lisp/ps-print.el Wed May 1 19:50:29 1996 --- emacs-19.32/lisp/ps-print.el Mon Jul 22 12:33:09 1996 *************** *** 4,8 **** ;; Author: Jim Thompson ! ;; Maintainer: FSF ;; Keywords: print, PostScript --- 4,8 ---- ;; Author: Jim Thompson ! ;; Maintainer: duthen@cegelec-red.fr (Jacques Duthen Prestataire) ;; Keywords: print, PostScript *************** EndDSCPage\n")) *** 1945,1949 **** (save-excursion (goto-char (point-min)) ! (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$") (buffer-substring (match-beginning 1) (match-end 1)) "Subject ???"))) --- 1945,1949 ---- (save-excursion (goto-char (point-min)) ! (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t) (buffer-substring (match-beginning 1) (match-end 1)) "Subject ???"))) *************** EndDSCPage\n")) *** 1955,1959 **** (save-excursion (goto-char (point-min)) ! (if (re-search-forward "^From:[ \t]+\\(.*\\)$") (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) (cond --- 1955,1959 ---- (save-excursion (goto-char (point-min)) ! (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t) (let ((fromstring (buffer-substring (match-beginning 1) (match-end 1)))) (cond *************** EndDSCPage\n")) *** 2028,2032 **** (save-excursion (goto-char (point-min)) ! (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)") (buffer-substring (match-beginning 1) (match-end 1)) "File ???"))) --- 2028,2032 ---- (save-excursion (goto-char (point-min)) ! (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t) (buffer-substring (match-beginning 1) (match-end 1)) "File ???"))) *************** EndDSCPage\n")) *** 2037,2041 **** (save-excursion (goto-char (point-min)) ! (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)") (buffer-substring (match-beginning 1) (match-end 1)) "Node ???"))) --- 2037,2041 ---- (save-excursion (goto-char (point-min)) ! (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t) (buffer-substring (match-beginning 1) (match-end 1)) "Node ???"))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/replace.el emacs-19.32/lisp/replace.el *** emacs-19.31/lisp/replace.el Wed Apr 17 13:30:14 1996 --- emacs-19.32/lisp/replace.el Tue Jun 4 11:30:36 1996 *************** It serves as a menu to find any of the o *** 449,457 **** (setq occur-pos-list (nreverse occur-pos-list)) (goto-char (point-min)) ! (if (= (length occur-pos-list) 1) ! (insert "1 line") ! (insert (format "%d lines" (length occur-pos-list)))) ! (if (interactive-p) ! (message "%d matching lines." (length occur-pos-list))))))))) ;; It would be nice to use \\[...], but there is no reasonable way --- 449,459 ---- (setq occur-pos-list (nreverse occur-pos-list)) (goto-char (point-min)) ! (let ((message-string ! (if (= (length occur-pos-list) 1) ! "1 line" ! (format "%d lines" (length occur-pos-list))))) ! (insert message-string) ! (if (interactive-p) ! (message "%s matched" message-string))))))))) ;; It would be nice to use \\[...], but there is no reasonable way diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/reporter.el emacs-19.32/lisp/reporter.el *** emacs-19.31/lisp/reporter.el Mon Jan 29 17:56:54 1996 --- emacs-19.32/lisp/reporter.el Tue Jul 2 21:28:53 1996 *************** *** 1,13 **** ;;; reporter.el --- customizable bug reporting of lisp programs ! ;; Copyright (C) 1993 1994 Barry A. Warsaw ! ;; Copyright (C) 1993 1994 Free Software Foundation, Inc. ! ;; Author: 1993 Barry A. Warsaw ! ;; Maintainer: bwarsaw@cnri.reston.va.us ;; Created: 19-Apr-1993 ! ;; Version: 2.21 ! ;; Last Modified: 1994/11/29 16:13:50 ! ;; Keywords: bug reports lisp ;; This file is part of GNU Emacs. --- 1,11 ---- ;;; reporter.el --- customizable bug reporting of lisp programs ! ;; Copyright (C) 1993 1994 1995 1996 Free Software Foundation, Inc. ! ;; Author: 1993-1996 Barry A. Warsaw ;; Created: 19-Apr-1993 ! ;; Version: 3.3 ! ;; Last Modified: 1996/07/02 00:39:09 ! ;; Keywords: maint mail tools ;; This file is part of GNU Emacs. *************** *** 30,43 **** ;;; Commentary: ! ;; Introduction ! ;; ============ ! ;; This program is for lisp package authors and can be used to ease ! ;; reporting of bugs. When invoked, reporter-submit-bug-report will ! ;; set up a mail buffer with the appropriate bug report address, ! ;; including a lisp expression the maintainer of the package can eval ! ;; to completely reproduce the environment in which the bug was ! ;; observed (e.g. by using eval-last-sexp). This package proved ! ;; especially useful during my development of cc-mode.el, which is ! ;; highly dependent on its configuration variables. ;; ;; Do a "C-h f reporter-submit-bug-report" for more information. --- 28,54 ---- ;;; Commentary: ! ;; End User Interface ! ;; ================== ! ;; The variable `mail-user-agent' contains a symbol indicating which ! ;; Emacs mail package end users would like to use to compose outgoing ! ;; mail. See that variable for details. ! ! ;; Mail Package Interface ! ;; ====================== ! ;; Mail package authors can configure reporter to support their ! ;; package by calling the function `define-mail-user-agent' See that ! ;; function for details. ! ! ;; Lisp Package Authors ! ;; ==================== ! ;; Reporter was written primarily for Emacs Lisp package authors so ! ;; that their users can easily report bugs. When invoked, ! ;; reporter-submit-bug-report will set up an outgoing mail buffer with ! ;; the appropriate bug report address, including a lisp expression the ! ;; maintainer of the package can eval to completely reproduce the ! ;; environment in which the bug was observed (e.g. by using ! ;; eval-last-sexp). This package proved especially useful during my ! ;; development of cc-mode, which is highly dependent on its ! ;; configuration variables. ;; ;; Do a "C-h f reporter-submit-bug-report" for more information. *************** *** 49,53 **** ;; "Submit via mail a bug report on mypkg" ;; (interactive) - ;; (require 'reporter) ;; (reporter-submit-bug-report ;; mypkg-maintainer-address --- 60,63 ---- *************** *** 60,93 **** ;; Mailing List ;; ============ ! ;; I've set up a mailing list to report bugs or suggest enhancements, ! ;; etc. This list's intended audience is elisp package authors who are ! ;; using reporter and want to stay current with releases. Here are the ! ;; relevant addresses: ;; ! ;; Administrivia: reporter-request@anthem.nlm.nih.gov ! ;; Submissions: reporter@anthem.nlm.nih.gov ;; Packages that currently use reporter are: cc-mode, supercite, elp, ! ;; tcl, ediff, crypt, vm, edebug, archie, and efs. If you know of ! ;; others, please email me! ! ! ;; LCD Archive Entry: ! ;; reporter|Barry A. Warsaw|bwarsaw@cnri.reston.va.us| ! ;; Customizable bug reporting of lisp programs.| ! ;; 1994/11/29 16:13:50|2.21|~/misc/reporter.el.Z| ;;; Code: ! ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! ;; user defined variables ! (defvar reporter-mailer '(vm-mail reporter-mail) ! "*Mail package to use to generate bug report buffer. ! This can either be a function symbol or a list of function symbols. ! If a list, it tries to use each specified mailer in order until an ! existing one is found. ! MH-E users may want to use `mh-smail'.") (defvar reporter-prompt-for-summary-p nil --- 70,114 ---- ;; Mailing List ;; ============ ! ;; I've set up a Majordomo mailing list to report bugs or suggest ! ;; enhancements, etc. This list's intended audience is elisp package ! ;; authors who are using reporter and want to stay current with ! ;; releases. Here are the relevant addresses: ;; ! ;; Administrivia: reporter-request@python.org ! ;; Submissions: reporter@python.org ;; Packages that currently use reporter are: cc-mode, supercite, elp, ! ;; tcl, ediff, crypt++ (crypt), dired-x, rmailgen, mode-line, vm, ! ;; mh-e, edebug, archie, viper, w3-mode, framepop, hl319, hilit19, ! ;; pgp, eos, hm--html, efs. ! ;; ! ;; If you know of others, please email me! ;;; Code: ! ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! ;; End user interface ! ! ;;;###autoload ! (defvar mail-user-agent 'sendmail-user-agent ! "*Your preference for a mail composition package. ! Various Emacs Lisp packages (e.g. reporter) require you to compose an ! outgoing email message. As there are several such packages available ! for Emacs, you can indicate your preference by setting this variable. ! ! Valid values currently are: ! ! 'sendmail-user-agent -- use Emacs built-in Mail package ! 'vm-user-agent -- use Kyle Jones' VM package ! 'mh-e-user-agent -- use the Emacs interface to the MH mail system ! Additional valid symbols may be available; check with the author of ! your package for details.") ! ! ! ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv ! ;; Package author interface variables (defvar reporter-prompt-for-summary-p nil *************** MH-E users may want to use `mh-smail'.") *** 95,102 **** When non-nil, `reporter-submit-bug-report' prompts the user for a brief summary of the problem, and puts this summary on the Subject: ! line. Default behavior is to not prompt (i.e. nil). If you want reporter to ! prompt, you should `let' bind this variable to t before calling `reporter-submit-bug-report'. Note that this variable is not buffer-local so you should never just `setq' it.") --- 116,124 ---- When non-nil, `reporter-submit-bug-report' prompts the user for a brief summary of the problem, and puts this summary on the Subject: ! line. If this variable is a string, that string is used as the prompt ! string. Default behavior is to not prompt (i.e. nil). If you want reporter to ! prompt, you should `let' bind this variable before calling `reporter-submit-bug-report'. Note that this variable is not buffer-local so you should never just `setq' it.") *************** Note that this variable is not buffer-lo *** 115,121 **** bind it.") ! ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! ;; end of user defined variables (defvar reporter-eval-buffer nil "Buffer to retrieve variable's value from. --- 137,144 ---- bind it.") ! ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ! ;; End of editable variables + (defvar reporter-eval-buffer nil "Buffer to retrieve variable's value from. *************** variables. Current buffer will always b *** 124,128 **** composed.") ! (defconst reporter-version "2.21" "Reporter version number.") --- 147,151 ---- composed.") ! (defconst reporter-version "3.2" "Reporter version number.") *************** composed.") *** 131,135 **** --- 154,160 ---- (make-variable-buffer-local 'reporter-initial-text) + + ;; status feedback to the user (defvar reporter-status-message nil) (defvar reporter-status-count nil) *************** composed.") *** 144,147 **** --- 169,173 ---- + ;; dumping/pretty printing of values (defun reporter-beautify-list (maxwidth compact-p) ;; pretty print a list *************** composed.") *** 218,222 **** (end-of-line) (insert (symbol-name varsym) " "))) ! (error (error "")))) (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks) --- 244,249 ---- (end-of-line) (insert (symbol-name varsym) " "))) ! (error ! (error "")))) (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks) *************** composed.") *** 303,314 **** (buffer-substring (match-beginning 0) (match-end 0)))) ! ;; Serves as an interface to `mail', ! ;; but when the user says "no" to discarding an unset message, ! ;; it gives an error. (defun reporter-mail (&rest args) - (interactive "P") (or (apply 'mail args) (error "Bug report aborted"))) ;;;###autoload (defun reporter-submit-bug-report --- 330,362 ---- (buffer-substring (match-beginning 0) (match-end 0)))) ! ! ;; Serves as an interface to `mail' (sendmail.el), but when the user ! ;; answers "no" to discarding an unsent message, it gives an error. (defun reporter-mail (&rest args) (or (apply 'mail args) (error "Bug report aborted"))) + (defun reporter-compose-outgoing () + ;; compose the outgoing mail buffer, and return the selected + ;; paradigm, with the current-buffer tacked onto the beginning of + ;; the list. + (let* ((agent mail-user-agent) + (compose (get mail-user-agent 'composefunc))) + ;; Sanity check. If this fails then we'll try to use the SENDMAIL + ;; protocol, otherwise we must signal an error. + (if (not (and compose (fboundp compose))) + (progn + (setq agent 'sendmail-user-agent + compose (get agent 'composefunc)) + (if (not (and compose (fboundp compose))) + (error "Could not find a valid `mail-user-agent'.") + (ding) + (message "`%s' is an invalid `mail-user-agent'; using `sendmail-user-agent'." + mail-user-agent) + ))) + (funcall compose) + agent)) + + ;;;###autoload (defun reporter-submit-bug-report *************** composed.") *** 326,330 **** ;; reporter-prompt-for-summary-p is non-nil. ! ;; The mailer used is described in the variable `reporter-mailer'. (let ((reporter-eval-buffer (current-buffer)) final-resting-place --- 374,378 ---- ;; reporter-prompt-for-summary-p is non-nil. ! ;; The mailer used is described in by the variable `mail-user-agent'. (let ((reporter-eval-buffer (current-buffer)) final-resting-place *************** composed.") *** 333,361 **** (reporter-status-count 0) (problem (and reporter-prompt-for-summary-p ! (read-string "(Very) brief summary of problem: "))) ! (mailbuf ! (progn ! (call-interactively ! (if (nlistp reporter-mailer) ! reporter-mailer ! (let ((mlist reporter-mailer) ! (mailer nil)) ! (while mlist ! (if (commandp (car mlist)) ! (setq mailer (car mlist) ! mlist nil) ! (setq mlist (cdr mlist)))) ! (if (not mailer) ! (error ! "Variable `%s' does not contain a command for mailing" ! "reporter-mailer")) ! mailer))) ! (current-buffer)))) (require 'sendmail) ! (pop-to-buffer reporter-eval-buffer) ! (pop-to-buffer mailbuf) (goto-char (point-min)) ;; different mailers use different separators, some may not even ! ;; use m-h-s, but sendmail.el stuff must have m-h-s bound. (let ((mail-header-separator (reporter-calculate-separator))) (mail-position-on-field "to") --- 381,402 ---- (reporter-status-count 0) (problem (and reporter-prompt-for-summary-p ! (read-string (if (stringp reporter-prompt-for-summary-p) ! reporter-prompt-for-summary-p ! "(Very) brief summary of problem: ")))) ! (agent (reporter-compose-outgoing)) ! (mailbuf (current-buffer)) ! hookvar) ! ;; do the work (require 'sendmail) ! ;; If mailbuf did not get made visible before, make it visible now. ! (let (same-window-buffer-names same-window-regexps) ! (pop-to-buffer mailbuf) ! ;; Just in case the original buffer is not visible now, bring it ! ;; back somewhere ! (display-buffer reporter-eval-buffer)) (goto-char (point-min)) ;; different mailers use different separators, some may not even ! ;; use mail-header-separator, but sendmail.el stuff must have this ! ;; variable bound. (let ((mail-header-separator (reporter-calculate-separator))) (mail-position-on-field "to") *************** composed.") *** 380,406 **** ;; save initial text and set up the `no-empty-submission' hook. ! ;; This only works for mailers that support mail-send-hook, ! ;; e.g. sendmail.el ! (if (fboundp 'add-hook) (progn ! (save-excursion ! (goto-char (point-max)) ! (skip-chars-backward " \t\n") ! (setq reporter-initial-text ! (buffer-substring after-sep-pos (point)))) ! (make-variable-buffer-local 'mail-send-hook) ! (add-hook 'mail-send-hook 'reporter-bug-hook))) ! ! ;; minibuf message ! ;; C-c C-c can't be generalized because they don't always run ! ;; mail-send-and-exit. E.g. vm-mail-send-and-exit. I don't want ! ;; to hard code these. ! (let* ((sendkey "C-c C-c") ! (killkey-whereis (where-is-internal 'kill-buffer nil t)) ! (killkey (if killkey-whereis ! (key-description killkey-whereis) ! "M-x kill-buffer"))) ! (message "Please type in your report. Hit %s to send, %s to abort." ! sendkey killkey)) )) --- 421,450 ---- ;; save initial text and set up the `no-empty-submission' hook. ! ;; This only works for mailers that support a pre-send hook, and ! ;; for which the paradigm has a non-nil value for the `hookvar' ! ;; key in its agent (i.e. sendmail.el's mail-send-hook). ! (save-excursion ! (goto-char (point-max)) ! (skip-chars-backward " \t\n") ! (setq reporter-initial-text (buffer-substring after-sep-pos (point)))) ! (if (setq hookvar (get agent 'hookvar)) (progn ! (make-variable-buffer-local hookvar) ! (add-hook hookvar 'reporter-bug-hook))) ! ! ;; compose the minibuf message and display this. ! (let* ((sendkey-whereis (where-is-internal ! (get agent 'sendfunc) nil t)) ! (abortkey-whereis (where-is-internal ! (get agent 'abortfunc) nil t)) ! (sendkey (if sendkey-whereis ! (key-description sendkey-whereis) ! "C-c C-c")) ; TBD: BOGUS hardcode ! (abortkey (if abortkey-whereis ! (key-description abortkey-whereis) ! "M-x kill-buffer")) ; TBD: BOGUS hardcode ! ) ! (message "Please enter your report. Type %s to send, %s to abort." ! sendkey abortkey)) )) *************** composed.") *** 420,428 **** (string= (buffer-substring after-sep-pos (point)) reporter-initial-text)) ! (error "Empty bug report cannot be sent")) ))) ! (provide 'reporter) ;;; reporter.el ends here --- 464,513 ---- (string= (buffer-substring after-sep-pos (point)) reporter-initial-text)) ! (error "Empty bug report cannot be sent.")) ))) ! ;; paradigm definitions ! (defun define-mail-user-agent (symbol composefunc sendfunc ! &optional abortfunc hookvar) ! "Define a symbol appropriate for `mail-user-agent'. ! ! SYMBOL can be any meaningful lisp symbol. It need not have a function ! or variable definition, as it is only used for its property list. ! The property names are equivalent to the formal argument described ! below (but in lower case). Additional properties can be placed on the ! symbol. ! ! COMPOSEFUNC is program callable function that composes an outgoing ! mail message buffer. This function should set up the basics of the ! buffer without requiring user interaction. It should populate the ! standard mail headers, leaving the `to:' and `subject:' headers blank. ! ! SENDFUNC is the command a user would type to send the message. ! ! Optional ABORTFUNC is the command a user would type to abort the ! message. For mail packages that don't have a separate abort function, ! this can be `kill-buffer' (the equivalent of omitting this argument). ! ! Optional HOOKVAR is a hook variable that gets run before the message ! is actually sent. Reporter will install `reporter-bug-hook' onto this ! hook so that empty bug reports can be suppressed by raising an error. ! If not supplied, `mail-send-hook' will be used." ! (put symbol 'composefunc composefunc) ! (put symbol 'sendfunc sendfunc) ! (put symbol 'abortfunc (or abortfunc 'kill-buffer)) ! (put symbol 'hookvar (or hookvar 'mail-send-hook))) ! ! (define-mail-user-agent 'sendmail-user-agent ! 'reporter-mail 'mail-send-and-exit) ! ! (define-mail-user-agent 'vm-user-agent ! 'vm-mail 'vm-mail-send-and-exit) ! ! (define-mail-user-agent 'mh-e-user-agent ! 'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft ! 'mh-before-send-letter-hook) + + (provide 'reporter) ;;; reporter.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/rlogin.el emacs-19.32/lisp/rlogin.el *** emacs-19.31/lisp/rlogin.el Tue May 7 20:52:30 1996 --- emacs-19.32/lisp/rlogin.el Sun Jun 23 00:31:17 1996 *************** *** 24,28 **** ;; Boston, MA 02111-1307, USA. ! ;; $Id: rlogin.el,v 1.32 1996/05/08 00:52:30 friedman Exp $ ;;; Commentary: --- 24,28 ---- ;; Boston, MA 02111-1307, USA. ! ;; $Id: rlogin.el,v 1.35 1996/06/23 04:31:17 friedman Exp $ ;;; Commentary: *************** this variable is set from that.") *** 110,114 **** ;;;###autoload (defun rlogin (input-args &optional buffer) ! "Open a network login connection to HOST via the `rlogin' program. Input is sent line-at-a-time to the remote connection. --- 110,117 ---- ;;;###autoload (defun rlogin (input-args &optional buffer) ! "Open a network login connection via `rlogin' with args INPUT-ARGS. ! INPUT-ARGS should start with a host name; it may also contain ! other arguments for `rlogin'. ! Input is sent line-at-a-time to the remote connection. *************** If a prefix argument is given and the bu *** 118,123 **** a new buffer with a different connection will be made. ! When called from a program, if the optional second argument is a string or ! buffer, it names the buffer to use. The variable `rlogin-program' contains the name of the actual program to --- 121,126 ---- a new buffer with a different connection will be made. ! When called from a program, if the optional second argument BUFFER is ! a string or buffer, it specifies the buffer to use. The variable `rlogin-program' contains the name of the actual program to *************** variable." *** 185,188 **** --- 188,196 ---- ;; functions in that list are passed arguments. add-hook serves well ;; enough for modifying it. + ;; comint-output-filter-functions should already have a + ;; permanent-local property, at least in emacs 19.27 or later. + (if (fboundp 'make-local-hook) + (make-local-hook 'comint-output-filter-functions) + (make-local-variable 'comint-output-filter-functions)) (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter) *************** variable." *** 194,208 **** (setq rlogin-remote-user user) ! (cond ! ((eq rlogin-directory-tracking-mode t) ! ;; Do this here, rather than calling the tracking mode function, to ! ;; avoid a gratuitous resync check; the default should be the ! ;; user's home directory, be it local or remote. ! (setq comint-file-name-prefix ! (concat "/" rlogin-remote-user "@" rlogin-host ":")) ! (cd-absolute comint-file-name-prefix)) ! ((null rlogin-directory-tracking-mode)) ! (t ! (cd-absolute (concat comint-file-name-prefix "~/")))))))) (defun rlogin-mode () --- 202,217 ---- (setq rlogin-remote-user user) ! (condition-case () ! (cond ((eq rlogin-directory-tracking-mode t) ! ;; Do this here, rather than calling the tracking mode ! ;; function, to avoid a gratuitous resync check; the default ! ;; should be the user's home directory, be it local or remote. ! (setq comint-file-name-prefix ! (concat "/" rlogin-remote-user "@" rlogin-host ":")) ! (cd-absolute comint-file-name-prefix)) ! ((null rlogin-directory-tracking-mode)) ! (t ! (cd-absolute (concat comint-file-name-prefix "~/")))) ! (error nil)))))) (defun rlogin-mode () diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/rmail.el emacs-19.32/lisp/rmail.el *** emacs-19.31/lisp/rmail.el Fri Apr 26 15:44:39 1996 --- emacs-19.32/lisp/rmail.el Sun Jul 21 15:14:49 1996 *************** Called with region narrowed to the messa *** 222,237 **** "From " ! ;; Username, perhaps with a quoted section that can contain spaces. ! "\\(" ! "[^ \n]*" ! "\\(\\|\".*\"[^ \n]*\\)" ! "\\|<[^<>\n]+>" ! "\\) ?" ;; The time the message was sent. ! "\\([^ \n]*\\) *" ; day of the week ! "\\([^ \n]*\\) *" ; month ! "\\([0-9]*\\) *" ; day of month ! "\\([0-9:]*\\) *" ; time of day ;; Perhaps a time zone, specified by an abbreviation, or by a --- 222,246 ---- "From " ! ;; Many things can happen to an RFC 822 mailbox before it is put into ! ;; a `From' line. The leading phrase can be stripped, e.g. ! ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g. ! ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF ! ;; can be removed, e.g. ! ;; From: joe@y.z (Joe K ! ;; User) ! ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and ! ;; From: Joe User ! ;; ! ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'. ! ;; We want to match the results of any of these manglings. ! ;; The following regexp rejects names whose first characters are ! ;; obviously bogus, but after that anything goes. ! "\\([^\0-\r \^?].*\\)? " ;; The time the message was sent. ! "\\([^\0-\r \^?]+\\) +" ; day of the week ! "\\([^\0-\r \^?]+\\) +" ; month ! "\\([0-3]?[0-9]\\) +" ; day of month ! "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day ;; Perhaps a time zone, specified by an abbreviation, or by a *************** Called with region narrowed to the messa *** 240,244 **** ;; The year. ! " [0-9][0-9]\\([0-9]*\\) *" ;; On some systems the time zone can appear after the year, too. --- 249,253 ---- ;; The year. ! " \\([0-9][0-9]+\\) *" ;; On some systems the time zone can appear after the year, too. *************** Instead, these commands are available: *** 657,660 **** --- 666,670 ---- (setq font-lock-defaults '(rmail-font-lock-keywords t nil nil nil + (font-lock-maximum-size . nil) (font-lock-fontify-buffer-function . rmail-fontify-buffer-function) (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function) *************** It returns t if it got any new messages. *** 882,885 **** --- 892,896 ---- (list (if current-prefix-arg (read-file-name "Get new mail from file: ")))) + (run-hooks 'rmail-before-get-new-mail-hook) ;; If the disk file has been changed from under us, ;; revert to it before we get new mail. *************** It returns t if it got any new messages. *** 900,904 **** (buffer-read-only nil) ;; Don't make undo records for what we do in getting mail. ! (buffer-undo-list t)) (goto-char (point-max)) (skip-chars-backward " \t\n") ; just in case of brain damage --- 911,916 ---- (buffer-read-only nil) ;; Don't make undo records for what we do in getting mail. ! (buffer-undo-list t) ! success) (goto-char (point-max)) (skip-chars-backward " \t\n") ; just in case of brain damage *************** It returns t if it got any new messages. *** 915,920 **** ;; Scan the new text and convert each message to babyl format. (goto-char (point-min)) ! (save-excursion ! (setq new-messages (rmail-convert-to-babyl-format))) (or (zerop new-messages) (let (success) --- 927,946 ---- ;; Scan the new text and convert each message to babyl format. (goto-char (point-min)) ! (unwind-protect ! (save-excursion ! (setq new-messages (rmail-convert-to-babyl-format) ! success t)) ! ;; If we could not convert the file's inboxes, ! ;; rename the files we tried to read ! ;; so we won't over and over again. ! (if (and (not file-name) (not success)) ! (let ((files delete-files) ! (count 0)) ! (while files ! (while (file-exists-p (format "RMAILOSE.%d" count)) ! (setq count (1+ count))) ! (rename-file (car files) ! (format "RMAILOSE.%d" count)) ! (setq files (cdr files)))))) (or (zerop new-messages) (let (success) *************** Optional DEFAULT is password to start wi *** 1258,1262 **** "" (concat ! "Date: \\3, \\5 \\4 \\9 \\6 " ;; The timezone could be matched by group 7 or group 10. --- 1284,1288 ---- "" (concat ! "Date: \\2, \\4 \\3 \\9 \\5 " ;; The timezone could be matched by group 7 or group 10. *************** With prefix argument N, do this N times. *** 1889,1901 **** If N is negative, go backwards instead." (interactive "p") ! (let* ((subject (mail-fetch-field "Subject")) ! (search-regexp (concat "^Subject: *\\(Re: *\\)?" ! (regexp-quote subject) ! "\n")) ! (forward (> n 0)) ! (i rmail-current-message) ! found) (if (string-match "Re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) (save-excursion (save-restriction --- 1915,1927 ---- If N is negative, go backwards instead." (interactive "p") ! (let ((subject (mail-fetch-field "Subject")) ! (forward (> n 0)) ! (i rmail-current-message) ! search-regexp found) (if (string-match "Re:[ \t]*" subject) (setq subject (substring subject (match-end 0)))) + (setq search-regexp (concat "^Subject: *\\(Re: *\\)?" + (regexp-quote subject) + "\n")) (save-excursion (save-restriction *************** original message into it." *** 2121,2124 **** --- 2147,2153 ---- (rmail-start-mail t)) + (put 'rmail-send-actions-rmail-buffer 'permanent-local t) + (put 'rmail-send-actions-rmail-msg-number 'permanent-local t) + (defun rmail-reply (just-sender) "Reply to the current message. *************** specifying headers which should not be c *** 2440,2446 **** (buffer-substring (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) ! (re-search-forward mail-unsent-separator) ! (search-forward codestring) ! (or (search-forward "\n\n" nil t) (error "Cannot find end of Mime data in failed message")) (setq bounce-start (point)) --- 2469,2476 ---- (buffer-substring (progn (beginning-of-line) (point)) (progn (end-of-line) (point))))) ! (or (re-search-forward mail-unsent-separator nil t) ! (error "Cannot find beginning of header in failed message")) ! (or (and (search-forward codestring nil t) ! (search-forward "\n\n" nil t)) (error "Cannot find end of Mime data in failed message")) (setq bounce-start (point)) *************** SUBJECT is a string of regexps separated *** 2717,2721 **** t) ! (autoload 'rmail-summary-by-sender "rmailsum" "Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas." --- 2747,2751 ---- t) ! (autoload 'rmail-summary-by-senders "rmailsum" "Display a summary of all messages with the given SENDERS. SENDERS is a string of names separated by commas." diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/rmailsum.el emacs-19.32/lisp/rmailsum.el *** emacs-19.31/lisp/rmailsum.el Thu Apr 4 12:00:11 1996 --- emacs-19.32/lisp/rmailsum.el Fri Jul 12 20:56:22 1996 *************** nil for FUNCTION means all messages." *** 208,212 **** (rmail-summary-mode) (make-local-variable 'minor-mode-alist) ! (setq minor-mode-alist (list '(t (concat ": " description)))) (setq rmail-buffer rbuf rmail-summary-redo redo-form --- 208,212 ---- (rmail-summary-mode) (make-local-variable 'minor-mode-alist) ! (setq minor-mode-alist (list (list t (concat ": " description)))) (setq rmail-buffer rbuf rmail-summary-redo redo-form *************** nil for FUNCTION means all messages." *** 335,338 **** --- 335,347 ---- (buffer-substring (match-beginning 2) (match-end 2)))) + ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)" + (save-excursion (end-of-line) (point)) t) + (format "%2s%2s%2s" + (buffer-substring + (match-beginning 2) (match-end 2)) + (buffer-substring + (match-beginning 3) (match-end 3)) + (buffer-substring + (match-beginning 4) (match-end 4)))) (t "??????")))) " " *************** nil for FUNCTION means all messages." *** 357,361 **** (regexp-quote (user-login-name)) "\\($\\|@\\)\\|" ! (regexp-quote user-mail-address) "\\>\\)") from) --- 366,377 ---- (regexp-quote (user-login-name)) "\\($\\|@\\)\\|" ! (regexp-quote ! ;; Don't lose if run from init file ! ;; where user-mail-address is not ! ;; set yet. ! (or user-mail-address ! (concat (user-login-name) "@" ! (or mail-host-address ! (system-name))))) "\\>\\)") from) *************** messages, or backward if NUMBER is negat *** 454,460 **** With prefix argument N moves forward N messages with these labels." (interactive "p\nsMove to next msg with labels: ") ! (save-excursion ! (set-buffer rmail-buffer) ! (rmail-next-labeled-message n labels))) (defun rmail-summary-previous-labeled-message (n labels) --- 470,479 ---- With prefix argument N moves forward N messages with these labels." (interactive "p\nsMove to next msg with labels: ") ! (let (msg) ! (save-excursion ! (set-buffer rmail-buffer) ! (rmail-next-labeled-message n labels) ! (setq msg rmail-current-message)) ! (rmail-summary-goto-msg msg))) (defun rmail-summary-previous-labeled-message (n labels) *************** With prefix argument N moves forward N m *** 462,468 **** With prefix argument N moves backward N messages with these labels." (interactive "p\nsMove to previous msg with labels: ") ! (save-excursion ! (set-buffer rmail-buffer) ! (rmail-previous-labeled-message n labels))) (defun rmail-summary-next-same-subject (n) --- 481,490 ---- With prefix argument N moves backward N messages with these labels." (interactive "p\nsMove to previous msg with labels: ") ! (let (msg) ! (save-excursion ! (set-buffer rmail-buffer) ! (rmail-previous-labeled-message n labels) ! (setq msg rmail-current-message)) ! (rmail-summary-goto-msg msg))) (defun rmail-summary-next-same-subject (n) *************** Commands for sorting the summary: *** 721,724 **** --- 743,747 ---- (suppress-keymap rmail-summary-mode-map) (define-key rmail-summary-mode-map "a" 'rmail-summary-add-label) + (define-key rmail-summary-mode-map "b" 'rmail-summary-bury) (define-key rmail-summary-mode-map "c" 'rmail-summary-continue) (define-key rmail-summary-mode-map "d" 'rmail-summary-delete-forward) *************** Commands for sorting the summary: *** 814,817 **** --- 837,843 ---- (cons "Summary" (make-sparse-keymap "Summary"))) + (define-key rmail-summary-mode-map [menu-bar summary senders] + '("By Senders..." . rmail-summary-by-senders)) + (define-key rmail-summary-mode-map [menu-bar summary labels] '("By Labels..." . rmail-summary-by-labels)) *************** advance to the previous message." *** 1041,1044 **** --- 1067,1081 ---- (beginning-of-buffer) (pop-to-buffer rmail-summary-buffer)) + + (defun rmail-summary-bury () + "Bury the Rmail buffer and the Rmail summary buffer." + (interactive) + (let ((buffer-to-bury (current-buffer))) + (let (window) + (while (setq window (get-buffer-window rmail-buffer)) + (set-window-buffer window (other-buffer rmail-buffer))) + (bury-buffer rmail-buffer)) + (switch-to-buffer (other-buffer buffer-to-bury)) + (bury-buffer buffer-to-bury))) (defun rmail-summary-quit () diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/scheme.el emacs-19.32/lisp/scheme.el *** emacs-19.31/lisp/scheme.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/scheme.el Thu Jul 4 00:44:58 1996 *************** *** 105,109 **** (setq comment-start ";") (make-local-variable 'comment-start-skip) ! (setq comment-start-skip ";+[ \t]*") (make-local-variable 'comment-column) (setq comment-column 40) --- 105,111 ---- (setq comment-start ";") (make-local-variable 'comment-start-skip) ! ;; Look within the line for a ; following an even number of backslashes ! ;; after either a non-backslash or the line beginning. ! (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*") (make-local-variable 'comment-column) (setq comment-column 40) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/score-mode.el emacs-19.32/lisp/score-mode.el *** emacs-19.31/lisp/score-mode.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/score-mode.el Sun Jun 30 14:11:01 1996 *************** *** 0 **** --- 1,110 ---- + ;;; score-mode.el --- mode for editing Gnus score files + ;; Copyright (C) 1996 Free Software Foundation, Inc. + + ;; Author: Lars Magne Ingebrigtsen + ;; Keywords: news, mail + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;;; Code: + + (require 'easymenu) + (require 'timezone) + (eval-when-compile (require 'cl)) + + (defvar gnus-score-mode-hook nil + "*Hook run in score mode buffers.") + + (defvar gnus-score-menu-hook nil + "*Hook run after creating the score mode menu.") + + (defvar gnus-score-edit-exit-function nil + "Function run on exit from the score buffer.") + + (defvar gnus-score-mode-map nil) + (unless gnus-score-mode-map + (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) + (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) + (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) + (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) + + ;;;###autoload + (defun gnus-score-mode () + "Mode for editing Gnus score files. + This mode is an extended emacs-lisp mode. + + \\{gnus-score-mode-map}" + (interactive) + (kill-all-local-variables) + (use-local-map gnus-score-mode-map) + (when menu-bar-mode + (gnus-score-make-menu-bar)) + (set-syntax-table emacs-lisp-mode-syntax-table) + (setq major-mode 'gnus-score-mode) + (setq mode-name "Score") + (lisp-mode-variables nil) + (make-local-variable 'gnus-score-edit-exit-function) + (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) + + (defun gnus-score-make-menu-bar () + (unless (boundp 'gnus-score-menu) + (easy-menu-define + gnus-score-menu gnus-score-mode-map "" + '("Score" + ["Exit" gnus-score-edit-exit t] + ["Insert date" gnus-score-edit-insert-date t] + ["Format" gnus-score-pretty-print t])) + (run-hooks 'gnus-score-menu-hook))) + + (defun gnus-score-edit-insert-date () + "Insert date in numerical format." + (interactive) + (princ (gnus-score-day-number (current-time)) (current-buffer))) + + (defun gnus-score-pretty-print () + "Format the current score file." + (interactive) + (goto-char (point-min)) + (let ((form (read (current-buffer)))) + (erase-buffer) + (pp form (current-buffer))) + (goto-char (point-min))) + + (defun gnus-score-edit-exit () + "Stop editing the score file." + (interactive) + (unless (file-exists-p (file-name-directory (buffer-file-name))) + (make-directory (file-name-directory (buffer-file-name)) t)) + (save-buffer) + (bury-buffer (current-buffer)) + (let ((buf (current-buffer))) + (when gnus-score-edit-exit-function + (funcall gnus-score-edit-exit-function)) + (when (eq buf (current-buffer)) + (switch-to-buffer (other-buffer (current-buffer)))))) + + (defun gnus-score-day-number (time) + (let ((dat (decode-time time))) + (timezone-absolute-from-gregorian + (nth 4 dat) (nth 3 dat) (nth 5 dat)))) + + (provide 'score-mode) + + ;;; score-mode.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/sendmail.el emacs-19.32/lisp/sendmail.el *** emacs-19.31/lisp/sendmail.el Sat May 4 23:54:00 1996 --- emacs-19.32/lisp/sendmail.el Fri Jun 28 04:24:27 1996 *************** If t, it means to insert the contents of *** 165,168 **** --- 165,170 ---- (defvar mail-send-actions nil "A list of actions to be performed upon successful sending of a message.") + (put 'mail-reply-buffer 'permanent-local t) + (put 'mail-send-actions 'permanent-local t) (defvar mail-default-headers nil *************** C-c C-v mail-sent-via (add a Sent-via f *** 316,320 **** (kill-all-local-variables) (make-local-variable 'mail-reply-buffer) - (setq mail-reply-buffer nil) (make-local-variable 'mail-send-actions) (set-syntax-table mail-mode-syntax-table) --- 318,321 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/sgml-mode.el emacs-19.32/lisp/sgml-mode.el *** emacs-19.31/lisp/sgml-mode.el Thu Feb 8 12:22:18 1996 --- emacs-19.32/lisp/sgml-mode.el Sat Jun 15 19:15:11 1996 *************** This takes effect when first loading the *** 762,776 **** (let ((map (nconc (make-sparse-keymap) sgml-mode-map)) (menu-map (make-sparse-keymap "HTML"))) ! (define-key map "\C-c6" 'html-headline) ! (define-key map "\C-c5" 'html-headline) ! (define-key map "\C-c4" 'html-headline) ! (define-key map "\C-c3" 'html-headline) ! (define-key map "\C-c2" 'html-headline) ! (define-key map "\C-c1" 'html-headline) (define-key map "\C-c\r" 'html-paragraph) (define-key map "\C-c\n" 'html-line) (define-key map "\C-c\C-c-" 'html-horizontal-rule) ! (define-key map "\C-c\C-co" 'html-list) ! (define-key map "\C-c\C-cu" 'html-list) (define-key map "\C-c\C-cr" 'html-radio-buttons) (define-key map "\C-c\C-cc" 'html-checkboxes) --- 762,776 ---- (let ((map (nconc (make-sparse-keymap) sgml-mode-map)) (menu-map (make-sparse-keymap "HTML"))) ! (define-key map "\C-c6" 'html-headline-6) ! (define-key map "\C-c5" 'html-headline-5) ! (define-key map "\C-c4" 'html-headline-4) ! (define-key map "\C-c3" 'html-headline-3) ! (define-key map "\C-c2" 'html-headline-2) ! (define-key map "\C-c1" 'html-headline-1) (define-key map "\C-c\r" 'html-paragraph) (define-key map "\C-c\n" 'html-line) (define-key map "\C-c\C-c-" 'html-horizontal-rule) ! (define-key map "\C-c\C-co" 'html-ordered-list) ! (define-key map "\C-c\C-cu" 'html-unordered-list) (define-key map "\C-c\C-cr" 'html-radio-buttons) (define-key map "\C-c\C-cc" 'html-checkboxes) *************** This takes effect when first loading the *** 782,787 **** (progn (define-key map "\C-c-" 'html-horizontal-rule) ! (define-key map "\C-co" 'html-list) ! (define-key map "\C-cu" 'html-list) (define-key map "\C-cr" 'html-radio-buttons) (define-key map "\C-cc" 'html-checkboxes) --- 782,787 ---- (progn (define-key map "\C-c-" 'html-horizontal-rule) ! (define-key map "\C-co" 'html-ordered-list) ! (define-key map "\C-cu" 'html-unordered-list) (define-key map "\C-cr" 'html-radio-buttons) (define-key map "\C-cc" 'html-checkboxes) *************** This takes effect when first loading the *** 798,812 **** '("View Buffer Contents" . browse-url-of-buffer)) (define-key menu-map [nil] '("--")) ! ;;(define-key menu-map "6" '("Heading 6" . html-headline)) ! ;;(define-key menu-map "5" '("Heading 5" . html-headline)) ! ;;(define-key menu-map "4" '("Heading 4" . html-headline)) ! (define-key menu-map "3" '("Heading 3" . html-headline)) ! (define-key menu-map "2" '("Heading 2" . html-headline)) ! (define-key menu-map "1" '("Heading 1" . html-headline)) (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons)) (define-key menu-map "c" '("Checkboxes" . html-checkboxes)) (define-key menu-map "l" '("List Item" . html-list-item)) ! (define-key menu-map "u" '("Unordered List" . html-list)) ! (define-key menu-map "o" '("Ordered List" . html-list)) (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule)) (define-key menu-map "\n" '("Line Break" . html-line)) --- 798,812 ---- '("View Buffer Contents" . browse-url-of-buffer)) (define-key menu-map [nil] '("--")) ! ;;(define-key menu-map "6" '("Heading 6" . html-headline-6)) ! ;;(define-key menu-map "5" '("Heading 5" . html-headline-5)) ! ;;(define-key menu-map "4" '("Heading 4" . html-headline-4)) ! (define-key menu-map "3" '("Heading 3" . html-headline-3)) ! (define-key menu-map "2" '("Heading 2" . html-headline-2)) ! (define-key menu-map "1" '("Heading 1" . html-headline-1)) (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons)) (define-key menu-map "c" '("Checkboxes" . html-checkboxes)) (define-key menu-map "l" '("List Item" . html-list-item)) ! (define-key menu-map "u" '("Unordered List" . html-unordered-list)) ! (define-key menu-map "o" '("Ordered List" . html-ordered-list)) (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule)) (define-key menu-map "\n" '("Line Break" . html-line)) *************** do: *** 1149,1156 **** "") ! (define-skeleton html-headline ! "HTML headline tags." ! last-command-char ! " _ ") (define-skeleton html-horizontal-rule --- 1149,1181 ---- "") ! (define-skeleton html-headline-1 ! "HTML level 1 headline tags." ! nil ! "

" _ "

") ! ! (define-skeleton html-headline-2 ! "HTML level 2 headline tags." ! nil ! "

" _ "

") ! ! (define-skeleton html-headline-3 ! "HTML level 3 headline tags." ! nil ! "

" _ "

") ! ! (define-skeleton html-headline-4 ! "HTML level 4 headline tags." ! nil ! "

" _ "

") ! ! (define-skeleton html-headline-5 ! "HTML level 5 headline tags." ! nil ! "
" _ "
") ! ! (define-skeleton html-headline-6 ! "HTML level 6 headline tags." ! nil ! "
" _ "
") (define-skeleton html-horizontal-rule *************** do: *** 1169,1178 **** "
" \n) ! (define-skeleton html-list ! "HTML unordered/ordered list tags." ! last-command-char ! ?< str "l>" \n "
  • " _ \n ! "") (define-skeleton html-list-item --- 1194,1210 ---- "
    " \n) ! (define-skeleton html-ordered-list ! "HTML ordered list tags." ! nil ! ?< "ol>" \n ! "
  • " _ \n ! "") ! ! (define-skeleton html-unordered-list ! "HTML unordered list tags." ! nil ! ?< "ul>" \n "
  • " _ \n ! "") (define-skeleton html-list-item diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/sh-script.el emacs-19.32/lisp/sh-script.el *** emacs-19.31/lisp/sh-script.el Mon Apr 15 17:15:47 1996 --- emacs-19.32/lisp/sh-script.el Mon Jul 15 16:15:46 1996 *************** with your script for an edit-interpret-d *** 663,670 **** ;; on the shell thus determined (goto-char (point-min)) ! (sh-set-shell ! (if (looking-at "#![\t ]*\\([^\t\n ]+\\)") ! (match-string 1) ! sh-shell-file))) (run-hooks 'sh-mode-hook)) ;;;###autoload --- 663,669 ---- ;; on the shell thus determined (goto-char (point-min)) ! (and (zerop (buffer-size)) ! (not buffer-read-only) ! (sh-set-shell sh-shell-file))) (run-hooks 'sh-mode-hook)) ;;;###autoload diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/shadow.el emacs-19.32/lisp/shadow.el *** emacs-19.31/lisp/shadow.el Wed Jan 24 19:36:49 1996 --- emacs-19.32/lisp/shadow.el Tue Jul 23 09:56:11 1996 *************** See the documentation for `list-load-pat *** 89,93 **** (and (car path) (not (string= (car path) ".")) ! (message "Ignoring redundant directory '%s'." (car path)))) (setq true-names (append true-names (list dir))) --- 89,93 ---- (and (car path) (not (string= (car path) ".")) ! (message "Ignoring redundant directory %s" (car path)))) (setq true-names (append true-names (list dir))) *************** See the documentation for `list-load-pat *** 97,101 **** (and curr-files (not noninteractive) ! (message "Checking %d files in '%s' ..." (length curr-files) dir)) (setq files-seen-this-dir nil) --- 97,101 ---- (and curr-files (not noninteractive) ! (message "Checking %d files in %s..." (length curr-files) dir)) (setq files-seen-this-dir nil) *************** See the documentation for `list-load-pat *** 136,145 **** (defun list-load-path-shadows () ! "Display a list of Emacs Lisp files that create shadows. This function lists potential load-path problems. Directories in the `load-path' variable are searched, in order, for Emacs Lisp ! files. When a previously encountered file name is re-located, a ! message is displayed indicating that the later file is \"shadowed\" by the earlier. --- 136,145 ---- (defun list-load-path-shadows () ! "Display a list of Emacs Lisp files that shadow other files. This function lists potential load-path problems. Directories in the `load-path' variable are searched, in order, for Emacs Lisp ! files. When a previously encountered file name is found again, a ! message is displayed indicating that the later file is \"hidden\" by the earlier. *************** buffer called `*Shadows*'. Shadowings a *** 177,200 **** (let* ((shadows (find-emacs-lisp-shadows)) (n (/ (length shadows) 2)) ! (msg (format "%s Emacs Lisp load-path shadowing%s found." (if (zerop n) "No" (concat "\n" (number-to-string n))) (if (= n 1) " was" "s were")))) ! (if (interactive-p) ! (save-excursion ! ;; We are interactive. ! ;; Create the *Shadows* buffer and display shadowings there. ! (let ((output-buffer (get-buffer-create "*Shadows*"))) ! (display-buffer output-buffer) ! (set-buffer output-buffer) ! (erase-buffer) ! (while shadows ! (insert (format "%s shadows %s\n" (car shadows) (car (cdr shadows)))) ! (setq shadows (cdr (cdr shadows)))) ! (insert msg "\n"))) ! ;; We are non-interactive, print shadows via message. ! (while shadows ! (message "%s shadows %s" (car shadows) (car (cdr shadows))) ! (setq shadows (cdr (cdr shadows)))) ! (message "%s" msg)))) (provide 'shadow) --- 177,201 ---- (let* ((shadows (find-emacs-lisp-shadows)) (n (/ (length shadows) 2)) ! (msg (format "%s Emacs Lisp load-path shadowing%s found" (if (zerop n) "No" (concat "\n" (number-to-string n))) (if (= n 1) " was" "s were")))) ! (if (interactive-p) ! (save-excursion ! ;; We are interactive. ! ;; Create the *Shadows* buffer and display shadowings there. ! (let ((output-buffer (get-buffer-create "*Shadows*"))) ! (display-buffer output-buffer) ! (set-buffer output-buffer) ! (erase-buffer) ! (while shadows ! (insert (format "%s hides %s\n" (car shadows) ! (car (cdr shadows)))) ! (setq shadows (cdr (cdr shadows)))) ! (insert msg "\n"))) ! ;; We are non-interactive, print shadows via message. ! (while shadows ! (message "%s hides %s" (car shadows) (car (cdr shadows))) ! (setq shadows (cdr (cdr shadows)))) ! (message "%s" msg)))) (provide 'shadow) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/shell.el emacs-19.32/lisp/shell.el *** emacs-19.31/lisp/shell.el Sat Feb 3 08:37:58 1996 --- emacs-19.32/lisp/shell.el Thu Aug 1 18:29:06 1996 *************** This is a fine thing to set in your `.em *** 131,144 **** "List of characters to recognise as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the ! shell buffer. The default is (?\\| ?& ?< ?> ?\\( ?\\) ?\\;). This is a fine thing to set in your `.emacs' file.") (defvar shell-file-name-quote-list ! (append shell-delimiter-argument-list '(?\ ?\* ?\! ?\" ?\' ?\`)) "List of characters to quote when in a file name. This variable is used to initialize `comint-file-name-quote-list' in the ! shell buffer. The default is (?\ ?\* ?\! ?\" ?\' ?\`) plus characters ! in `shell-delimiter-argument-list'. This is a fine thing to set in your `.emacs' file.") --- 131,155 ---- "List of characters to recognise as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the ! shell buffer. The value may depend on the operating system or shell. ! ! This is a fine thing to set in your `.emacs' file.") ! ! (defvar shell-file-name-chars ! (if (memq system-type '(ms-dos windows-nt)) ! "~/A-Za-z0-9_^$!#%&{}@`'.()-" ! "~/A-Za-z0-9+@:_.$#%,={}-") ! "String of characters valid in a file name. ! This variable is used to initialize `comint-file-name-chars' in the ! shell buffer. The value may depend on the operating system or shell. This is a fine thing to set in your `.emacs' file.") (defvar shell-file-name-quote-list ! (if (memq system-type '(ms-dos windows-nt)) ! nil ! (append shell-delimiter-argument-list '(?\ ?\* ?\! ?\" ?\' ?\`))) "List of characters to quote when in a file name. This variable is used to initialize `comint-file-name-quote-list' in the ! shell buffer. The value may depend on the operating system or shell. This is a fine thing to set in your `.emacs' file.") *************** This mirrors the optional behavior of tc *** 187,190 **** --- 198,208 ---- "*Regexp to match subshell commands equivalent to cd.") + (defvar shell-chdrive-regexp + (if (memq system-type '(ms-dos windows-nt)) + ; NetWare allows the five chars between upper and lower alphabetics. + "[]a-zA-Z^_`\\[\\\\]:" + nil) + "*If non-nil, is regexp used to track drive changes.") + (defvar explicit-shell-file-name nil "*If non-nil, is file name to use for explicitly requested inferior shell.") *************** Customization: Entry to this mode runs t *** 288,295 **** on `comint-output-filter-functions' are run. ! Variables `shell-cd-regexp', `shell-pushd-regexp' and `shell-popd-regexp' ! are used to match their respective commands, while `shell-pushd-tohome', ! `shell-pushd-dextract' and `shell-pushd-dunique' control the behavior of the ! relevant command. Variables `comint-completion-autolist', `comint-completion-addsuffix', --- 306,313 ---- on `comint-output-filter-functions' are run. ! Variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp' ! and `shell-popd-regexp' are used to match their respective commands, ! while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' ! control the behavior of the relevant command. Variables `comint-completion-autolist', `comint-completion-addsuffix', *************** buffer." *** 315,318 **** --- 333,337 ---- (setq comint-completion-fignore shell-completion-fignore) (setq comint-delimiter-argument-list shell-delimiter-argument-list) + (setq comint-file-name-chars shell-file-name-chars) (setq comint-file-name-quote-list shell-file-name-quote-list) (setq comint-dynamic-complete-functions shell-dynamic-complete-functions) *************** You may toggle this tracking on and off *** 442,448 **** If emacs gets confused, you can resync with the shell with M-x dirs. ! See variables `shell-cd-regexp', `shell-pushd-regexp', and `shell-popd-regexp', ! while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' ! control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'." --- 461,467 ---- If emacs gets confused, you can resync with the shell with M-x dirs. ! See variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp', ! and `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract', ! and `shell-pushd-dunique' control the behavior of the relevant command. Environment variables are expanded, see function `substitute-in-file-name'." *************** Environment variables are expanded, see *** 460,472 **** "\\)\\($\\|[ \t]\\)") cmd) ! (shell-process-popd (substitute-in-file-name arg1))) ((string-match (concat "\\`\\(" shell-pushd-regexp "\\)\\($\\|[ \t]\\)") cmd) ! (shell-process-pushd (substitute-in-file-name arg1))) ((string-match (concat "\\`\\(" shell-cd-regexp "\\)\\($\\|[ \t]\\)") cmd) ! (shell-process-cd (substitute-in-file-name arg1)))) (setq start (progn (string-match "[; \t]*" str end) ; skip again (match-end 0))))) --- 479,496 ---- "\\)\\($\\|[ \t]\\)") cmd) ! (shell-process-popd (comint-substitute-in-file-name arg1))) ((string-match (concat "\\`\\(" shell-pushd-regexp "\\)\\($\\|[ \t]\\)") cmd) ! (shell-process-pushd (comint-substitute-in-file-name arg1))) ((string-match (concat "\\`\\(" shell-cd-regexp "\\)\\($\\|[ \t]\\)") cmd) ! (shell-process-cd (comint-substitute-in-file-name arg1))) ! ((and shell-chdrive-regexp ! (string-match (concat "\\`\\(" shell-chdrive-regexp ! "\\)\\($\\|[ \t]\\)") ! cmd)) ! (shell-process-cd (comint-substitute-in-file-name cmd)))) (setq start (progn (string-match "[; \t]*" str end) ; skip again (match-end 0))))) *************** See `shell-dynamic-complete-filename'. *** 739,743 **** (defun shell-match-partial-variable () ! "Return the variable at point, or nil if non is found." (save-excursion (let ((limit (point))) --- 763,767 ---- (defun shell-match-partial-variable () ! "Return the shell variable at point, or nil if none is found." (save-excursion (let ((limit (point))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/simple.el emacs-19.32/lisp/simple.el *** emacs-19.31/lisp/simple.el Tue May 21 10:28:39 1996 --- emacs-19.32/lisp/simple.el Thu Jul 4 14:45:35 1996 *************** In Auto Fill mode, if no numeric arg, br *** 40,43 **** --- 40,51 ---- (let ((flag (and (not (bobp)) (bolp) + ;; Make sure the newline before point isn't intangible. + (not (get-char-property (1- (point)) 'intangible)) + ;; Make sure the newline before point isn't read-only. + (not (get-char-property (1- (point)) 'read-only)) + ;; Make sure the newline before point isn't invisible. + (not (get-char-property (1- (point)) 'invisible)) + ;; Make sure the newline before point has the same + ;; properties as the char before it (if any). (< (or (previous-property-change (point)) -2) (- (point) 2)))) *************** In either case, the output is inserted a *** 927,931 **** (progn (end-of-line) (point)))))) (t ! (set-window-start (display-buffer buffer) 1)))))))) (defconst universal-argument-map --- 935,942 ---- (progn (end-of-line) (point)))))) (t ! (save-excursion ! (set-buffer buffer) ! (goto-char (point-min))) ! (display-buffer buffer)))))))) (defconst universal-argument-map *************** In Transient Mark mode, this does not ac *** 1558,1562 **** nil) (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))) ! (or nomsg executing-macro (> (minibuffer-depth) 0) (message "Mark set")) (if (or activate (not transient-mark-mode)) --- 1569,1573 ---- nil) (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil)))) ! (or nomsg executing-kbd-macro (> (minibuffer-depth) 0) (message "Mark set")) (if (or activate (not transient-mark-mode)) *************** automatically breaks the line at a previ *** 2450,2457 **** (defun set-fill-column (arg) ! "Set `fill-column' to current column, or to argument if given. ! The variable `fill-column' has a separate value for each buffer." (interactive "P") ! (setq fill-column (if (integerp arg) arg (current-column))) (message "fill-column set to %d" fill-column)) --- 2461,2474 ---- (defun set-fill-column (arg) ! "Set `fill-column' to specified argument. ! Just \\[universal-argument] as argument means to use the current column." (interactive "P") ! (cond ((integerp arg) ! (setq fill-column arg)) ! ((consp arg) ! (setq fill-column (current-column))) ! ;; Disallow missing argument; it's probably a typo for C-x C-f. ! (t ! (error "set-fill-column requires an explicit argument"))) (message "fill-column set to %d" fill-column)) *************** With prefix argument N, move N items (ne *** 2922,2925 **** --- 2939,2945 ---- ;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text ;; to keep. If it is nil, use choose-completion-delete-max-match instead. + + ;; If BUFFER is the minibuffer, exit the minibuffer + ;; unless it is reading a file name and CHOICE is a directory. (defun choose-completion-string (choice &optional buffer base-size) (let ((buffer (or buffer completion-reference-buffer))) *************** With prefix argument N, move N items (ne *** 2945,2949 **** (and (equal buffer (window-buffer (minibuffer-window))) minibuffer-completion-table ! (exit-minibuffer))))) (defun completion-list-mode () --- 2965,2974 ---- (and (equal buffer (window-buffer (minibuffer-window))) minibuffer-completion-table ! ;; If this is reading a file name, and the file name chosen ! ;; is a directory, don't exit the minibuffer. ! (if (and (eq minibuffer-completion-table 'read-file-name-internal) ! (file-directory-p (buffer-string))) ! (select-window (active-minibuffer-window)) ! (exit-minibuffer)))))) (defun completion-list-mode () diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/skeleton.el emacs-19.32/lisp/skeleton.el *** emacs-19.31/lisp/skeleton.el Fri Mar 1 10:37:16 1996 --- emacs-19.32/lisp/skeleton.el Tue Jun 25 14:51:49 1996 *************** *** 1,5 **** ;;; skeleton.el --- Lisp language extension for writing statement skeletons ! ;; Copyright (C) 1993, 1994, 1995 by Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 --- 1,5 ---- ;;; skeleton.el --- Lisp language extension for writing statement skeletons ! ;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc. ;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389 *************** Typical examples might be `upcase' or `c *** 50,53 **** --- 50,63 ---- + (defvar skeleton-autowrap t + "Controls wrapping behaviour of functions created with `define-skeleton'. + When the region is visible (due to `transient-mark-mode' or marking a region + with the mouse) and this is non-`nil' and the function was called without an + explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible + region. + + We will probably delete this variable in a future Emacs version + unless we get a substantial number of complaints about the auto-wrap + feature.") (defvar skeleton-end-hook *************** The variables `v1' and `v2' are still se *** 61,65 **** ;;;###autoload (defvar skeleton-filter 'identity ! "Function for transforming a skeleton-proxy's aliases' variable value.") (defvar skeleton-untabify t --- 71,75 ---- ;;;###autoload (defvar skeleton-filter 'identity ! "Function for transforming a skeleton proxy's aliases' variable value.") (defvar skeleton-untabify t *************** skeleton elements.") *** 84,88 **** ! (defvar skeleton-abbrev-cleanup nil) --- 94,99 ---- ! (defvar skeleton-abbrev-cleanup nil ! "Variable used to delete the character that led to abbrev expansion.") *************** INTERACTOR and ELEMENT ... are as define *** 105,112 **** (set command skeleton)) `(progn ! (defvar ,command ',skeleton ,documentation) ! (defalias ',command 'skeleton-proxy))) ;; This command isn't meant to be called, only it's aliases with meaningful --- 116,173 ---- (set command skeleton)) `(progn ! (defun ,command (&optional str arg) ! ,(concat documentation ! (if (string-match "\n\\>" documentation) ! "" "\n") ! "\n" ! "This is a skeleton command (see `skeleton-insert'). ! Normally the skeleton text is inserted at point, with nothing \"inside\". ! If there is a highlighted region, the skeleton text is wrapped ! around the region text. ! ! A prefix argument ARG says to wrap the skeleton around the next ARG words. ! A prefix argument of zero says to wrap around zero words---that is, nothing. ! This is a way of overiding the use of a highlighted region.") ! (interactive "*P\nP") ! (skeleton-proxy-new ',skeleton str arg)))) + ;;;###autoload + (defun skeleton-proxy-new (skeleton &optional str arg) + "Insert skeleton defined by variable of same name (see `skeleton-insert'). + Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). + If no ARG was given, but the region is visible, ARG defaults to -1 depending + on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. + This command can also be an abbrev expansion (3rd and 4th columns in + \\[edit-abbrevs] buffer: \"\" command-name). + When called as a function, optional first argument STR may also be a string + which will be the value of `str' whereas the skeleton's interactor is then + ignored." + (interactive "*P\nP") + (setq skeleton (funcall skeleton-filter skeleton)) + (if (not skeleton) + (if (memq this-command '(self-insert-command + skeleton-pair-insert-maybe + expand-abbrev)) + (setq buffer-undo-list (primitive-undo 1 buffer-undo-list))) + (skeleton-insert skeleton + (if (setq skeleton-abbrev-cleanup + (or (eq this-command 'self-insert-command) + (eq this-command + 'skeleton-pair-insert-maybe))) + () + ;; Pretend C-x a e passed its prefix arg to us + (if (or arg current-prefix-arg) + (prefix-numeric-value (or arg + current-prefix-arg)) + (and skeleton-autowrap + (or (eq last-command 'mouse-drag-region) + (and transient-mark-mode mark-active)) + -1))) + (if (stringp str) + str)) + (and skeleton-abbrev-cleanup + (setq skeleton-abbrev-cleanup (point)) + (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t)))) ;; This command isn't meant to be called, only it's aliases with meaningful *************** INTERACTOR and ELEMENT ... are as define *** 116,119 **** --- 177,182 ---- "Insert skeleton defined by variable of same name (see `skeleton-insert'). Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). + If no ARG was given, but the region is visible, ARG defaults to -1 depending + on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. This command can also be an abbrev expansion (3rd and 4th columns in \\[edit-abbrevs] buffer: \"\" command-name). *************** ignored." *** 124,128 **** (interactive "*P\nP") (let ((function (nth 1 (backtrace-frame 1)))) ! (if (eq function 'nth) ; uncompiled lisp function (setq function (nth 1 (backtrace-frame 5))) (if (eq function 'byte-code) ; tracing byte-compiled function --- 187,191 ---- (interactive "*P\nP") (let ((function (nth 1 (backtrace-frame 1)))) ! (if (eq function 'nth) ; uncompiled Lisp function (setq function (nth 1 (backtrace-frame 5))) (if (eq function 'byte-code) ; tracing byte-compiled function *************** ignored." *** 142,152 **** (if (or arg current-prefix-arg) (prefix-numeric-value (or arg ! current-prefix-arg)))) (if (stringp str) str)) ! (if skeleton-abbrev-cleanup ! (setq deferred-action-list t ! deferred-action-function 'skeleton-abbrev-cleanup ! skeleton-abbrev-cleanup (point)))))) --- 205,218 ---- (if (or arg current-prefix-arg) (prefix-numeric-value (or arg ! current-prefix-arg)) ! (and skeleton-autowrap ! (or (eq last-command 'mouse-drag-region) ! (and transient-mark-mode mark-active)) ! -1))) (if (stringp str) str)) ! (and skeleton-abbrev-cleanup ! (setq skeleton-abbrev-cleanup (point)) ! (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t))))) *************** ignored." *** 156,162 **** (progn (delete-region skeleton-abbrev-cleanup (point)) ! (setq deferred-action-list () ! deferred-action-function nil ! skeleton-abbrev-cleanup nil)))) --- 222,227 ---- (progn (delete-region skeleton-abbrev-cleanup (point)) ! (setq skeleton-abbrev-cleanup) ! (remove-hook 'post-command-hook 'skeleton-abbrev-cleanup t)))) *************** formatted with `skeleton-subprompt'. Su *** 201,206 **** strings with the subskeleton being repeated once for each string. ! Quoted lisp-expressions are evaluated evaluated for their side-effect. ! Other lisp-expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this implies an endless loop. Modes can define other symbols by locally setting them --- 266,271 ---- strings with the subskeleton being repeated once for each string. ! Quoted Lisp expressions are evaluated evaluated for their side-effect. ! Other Lisp expressions are evaluated and the value treated as above. Note that expressions may not return `t' since this implies an endless loop. Modes can define other symbols by locally setting them *************** available: *** 212,216 **** help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str ! v1, v2 local variables for memorising anything you want When done with skeleton, but before going back to `_'-point call --- 277,281 ---- help help-form during interaction with the user or `nil' input initial input (string or cons with index) while reading str ! v1, v2 local variables for memorizing anything you want When done with skeleton, but before going back to `_'-point call *************** automatically, and you are prompted to f *** 382,412 **** ;; Maybe belongs into simple.el or elsewhere ! ! (define-skeleton local-variables-section ! "Insert a local variables section. Use current comment syntax if any." ! () ! '(save-excursion ! (if (re-search-forward page-delimiter nil t) ! (error "Not on last page."))) ! comment-start "Local Variables:" comment-end \n ! comment-start "mode: " ! (completing-read "Mode: " obarray ! (lambda (symbol) ! (if (commandp symbol) ! (string-match "-mode$" (symbol-name symbol)))) ! t) ! & -5 | '(kill-line 0) & -1 | comment-end \n ! ( (completing-read (format "Variable, %s: " skeleton-subprompt) ! obarray ! (lambda (symbol) ! (or (eq symbol 'eval) ! (user-variable-p symbol))) ! t) ! comment-start str ": " ! (read-from-minibuffer "Expression: " nil read-expression-map nil ! 'read-expression-history) | _ ! comment-end \n) ! resume: ! comment-start "End:" comment-end) ;; Variables and command for automatically inserting pairs like () or "". --- 447,476 ---- ;; Maybe belongs into simple.el or elsewhere ! ;; ;###autoload ! ;;; (define-skeleton local-variables-section ! ;; "Insert a local variables section. Use current comment syntax if any." ! ;; (completing-read "Mode: " obarray ! ;; (lambda (symbol) ! ;; (if (commandp symbol) ! ;; (string-match "-mode$" (symbol-name symbol)))) ! ;; t) ! ;; '(save-excursion ! ;; (if (re-search-forward page-delimiter nil t) ! ;; (error "Not on last page."))) ! ;; comment-start "Local Variables:" comment-end \n ! ;; comment-start "mode: " str ! ;; & -5 | '(kill-line 0) & -1 | comment-end \n ! ;; ( (completing-read (format "Variable, %s: " skeleton-subprompt) ! ;; obarray ! ;; (lambda (symbol) ! ;; (or (eq symbol 'eval) ! ;; (user-variable-p symbol))) ! ;; t) ! ;; comment-start str ": " ! ;; (read-from-minibuffer "Expression: " nil read-expression-map nil ! ;; 'read-expression-history) | _ ! ;; comment-end \n) ! ;; resume: ! ;; comment-start "End:" comment-end \n) ;; Variables and command for automatically inserting pairs like () or "". *************** Elements might be (?` ?` _ \"''\"), (?\\ *** 439,444 **** "Insert the character you type ARG times. ! With no ARG, if `skeleton-pair' is non-nil, and if ! `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. --- 503,509 ---- "Insert the character you type ARG times. ! With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region ! is visible the pair is wrapped around it depending on `skeleton-autowrap'. ! Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a word, and if `skeleton-pair-filter' returns nil, pairing is performed. *************** the defaults are used. These are (), [] *** 447,517 **** symmetrical ones, and the same character twice for the others." (interactive "*P") ! (if (or arg ! overwrite-mode ! (not skeleton-pair) ! (if (not skeleton-pair-on-word) (looking-at "\\w")) ! (funcall skeleton-pair-filter)) ! (self-insert-command (prefix-numeric-value arg)) ! (self-insert-command 1) ! (if skeleton-abbrev-cleanup ! () ! ;; (preceding-char) is stripped of any Meta-stuff in last-command-char ! (if (setq arg (assq (preceding-char) skeleton-pair-alist)) ! ;; typed char is inserted (car is no real interactor) ! (let (skeleton-end-hook) ! (skeleton-insert arg)) ! (save-excursion ! (insert (or (cdr (assq (preceding-char) ! '((?( . ?)) ! (?[ . ?]) ! (?{ . ?}) ! (?< . ?>) ! (?` . ?')))) ! last-command-char))))))) ! ;;; ;; A more serious example can be found in sh-script.el ! ;;; ;; The quote before (defun prevents this from being byte-compiled. ! ;;;(defun mirror-mode () ! ;;; "This major mode is an amusing little example of paired insertion. ! ;;;All printable characters do a paired self insert, while the other commands ! ;;;work normally." ! ;;; (interactive) ! ;;; (kill-all-local-variables) ! ;;; (make-local-variable 'pair) ! ;;; (make-local-variable 'pair-on-word) ! ;;; (make-local-variable 'pair-filter) ! ;;; (make-local-variable 'pair-alist) ! ;;; (setq major-mode 'mirror-mode ! ;;; mode-name "Mirror" ! ;;; pair-on-word t ! ;;; ;; in the middle column insert one or none if odd window-width ! ;;; pair-filter (lambda () ! ;;; (if (>= (current-column) ! ;;; (/ (window-width) 2)) ! ;;; ;; insert both on next line ! ;;; (next-line 1) ! ;;; ;; insert one or both? ! ;;; (= (* 2 (1+ (current-column))) ! ;;; (window-width)))) ! ;;; ;; mirror these the other way round as well ! ;;; pair-alist '((?) _ ?() ! ;;; (?] _ ?[) ! ;;; (?} _ ?{) ! ;;; (?> _ ?<) ! ;;; (?/ _ ?\\) ! ;;; (?\\ _ ?/) ! ;;; (?` ?` _ "''") ! ;;; (?' ?' _ "``")) ! ;;; ;; in this mode we exceptionally ignore the user, else it's no fun ! ;;; pair t) ! ;;; (let ((map (make-keymap)) ! ;;; (i ? )) ! ;;; (use-local-map map) ! ;;; (setq map (car (cdr map))) ! ;;; (while (< i ?\^?) ! ;;; (aset map i 'skeleton-pair-insert-maybe) ! ;;; (setq i (1+ i)))) ! ;;; (run-hooks 'mirror-mode-hook)) (provide 'skeleton) --- 512,581 ---- symmetrical ones, and the same character twice for the others." (interactive "*P") ! (let ((mark (and skeleton-autowrap ! (or (eq last-command 'mouse-drag-region) ! (and transient-mark-mode mark-active)))) ! (skeleton-end-hook)) ! (if (or arg ! (not skeleton-pair) ! (and (not mark) ! (or overwrite-mode ! (if (not skeleton-pair-on-word) (looking-at "\\w")) ! (funcall skeleton-pair-filter)))) ! (self-insert-command (prefix-numeric-value arg)) ! (setq last-command-char (logand last-command-char 255)) ! (or skeleton-abbrev-cleanup ! (skeleton-insert ! (cons nil (or (assq last-command-char skeleton-pair-alist) ! (assq last-command-char '((?( _ ?)) ! (?[ _ ?]) ! (?{ _ ?}) ! (?< _ ?>) ! (?` _ ?'))) ! `(,last-command-char _ ,last-command-char))) ! (if mark -1)))))) ! ;; A more serious example can be found in sh-script.el ! ;;; (defun mirror-mode () ! ;; "This major mode is an amusing little example of paired insertion. ! ;;All printable characters do a paired self insert, while the other commands ! ;;work normally." ! ;; (interactive) ! ;; (kill-all-local-variables) ! ;; (make-local-variable 'skeleton-pair) ! ;; (make-local-variable 'skeleton-pair-on-word) ! ;; (make-local-variable 'skeleton-pair-filter) ! ;; (make-local-variable 'skeleton-pair-alist) ! ;; (setq major-mode 'mirror-mode ! ;; mode-name "Mirror" ! ;; skeleton-pair-on-word t ! ;; ;; in the middle column insert one or none if odd window-width ! ;; skeleton-pair-filter (lambda () ! ;; (if (>= (current-column) ! ;; (/ (window-width) 2)) ! ;; ;; insert both on next line ! ;; (next-line 1) ! ;; ;; insert one or both? ! ;; (= (* 2 (1+ (current-column))) ! ;; (window-width)))) ! ;; ;; mirror these the other way round as well ! ;; skeleton-pair-alist '((?) _ ?() ! ;; (?] _ ?[) ! ;; (?} _ ?{) ! ;; (?> _ ?<) ! ;; (?/ _ ?\\) ! ;; (?\\ _ ?/) ! ;; (?` ?` _ "''") ! ;; (?' ?' _ "``")) ! ;; ;; in this mode we exceptionally ignore the user, else it's no fun ! ;; skeleton-pair t) ! ;; (let ((map (make-vector 256 'skeleton-pair-insert-maybe)) ! ;; (i 0)) ! ;; (use-local-map `(keymap ,map)) ! ;; (while (< i ? ) ! ;; (aset map i nil) ! ;; (aset map (+ i 128) nil) ! ;; (setq i (1+ i)))) ! ;; (run-hooks 'mirror-mode-hook)) (provide 'skeleton) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/smtpmail.el emacs-19.32/lisp/smtpmail.el *** emacs-19.31/lisp/smtpmail.el Wed Dec 31 19:00:00 1969 --- emacs-19.32/lisp/smtpmail.el Mon Jul 15 15:59:32 1996 *************** *** 0 **** --- 1,525 ---- + ;; Simple SMTP protocol (RFC 821) for sending mail + + ;; Copyright (C) 1995, 1996 Free Software Foundation, Inc. + + ;; Author: Tomoji Kagatani + ;; Maintainer: Brian D. Carlstrom + ;; Keywords: mail + + ;; This file is part of GNU Emacs. + + ;; GNU Emacs is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2, or (at your option) + ;; any later version. + + ;; GNU Emacs is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + + ;; You should have received a copy of the GNU General Public License + ;; along with GNU Emacs; see the file COPYING. If not, write to the + ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, + ;; Boston, MA 02111-1307, USA. + + ;;; Commentary: + + ;; Send Mail to smtp host from smtpmail temp buffer. + + ;; Please add these lines in your .emacs(_emacs). + ;; + ;;(setq send-mail-function 'smtpmail-send-it) + ;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST") + ;;(setq smtpmail-smtp-service "smtp") + ;;(setq smtpmail-local-domain "YOUR DOMAIN NAME") + ;;(setq smtpmail-debug-info t) + ;;(load-library "smtpmail") + ;;(setq smtpmail-code-conv-from nil) + ;;(setq user-full-name "YOUR NAME HERE") + + ;;; Code: + + (require 'sendmail) + + ;;; + (defvar smtpmail-default-smtp-server nil + "*Specify default SMTP server.") + + (defvar smtpmail-smtp-server + (or (getenv "SMTPSERVER") smtpmail-default-smtp-server) + "*The name of the host running SMTP server.") + + (defvar smtpmail-smtp-service 25 + "*SMTP service port number. smtp or 25 .") + + (defvar smtpmail-local-domain nil + "*Local domain name without a host name. + If the function (system-name) returns the full internet address, + don't define this value.") + + (defvar smtpmail-debug-info nil + "*smtpmail debug info printout. messages and process buffer.") + + (defvar smtpmail-code-conv-from nil ;; *junet* + "*smtpmail code convert from this code to *internal*..for tiny-mime..") + + ;;; + ;;; + ;;; + + (defun smtpmail-send-it () + (require 'mail-utils) + (let ((errbuf (if mail-interactive + (generate-new-buffer " smtpmail errors") + 0)) + (tembuf (generate-new-buffer " smtpmail temp")) + (case-fold-search nil) + resend-to-addresses + delimline + (mailbuf (current-buffer))) + (unwind-protect + (save-excursion + (set-buffer tembuf) + (erase-buffer) + (insert-buffer-substring mailbuf) + (goto-char (point-max)) + ;; require one newline at the end. + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Change header-delimiter to be what sendmail expects. + (goto-char (point-min)) + (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n")) + (replace-match "\n") + (backward-char 1) + (setq delimline (point-marker)) + ;; (sendmail-synch-aliases) + (if mail-aliases + (expand-mail-aliases (point-min) delimline)) + (goto-char (point-min)) + ;; ignore any blank lines in the header + (while (and (re-search-forward "\n\n\n*" delimline t) + (< (point) delimline)) + (replace-match "\n")) + (let ((case-fold-search t)) + (goto-char (point-min)) + (goto-char (point-min)) + (while (re-search-forward "^Resent-to:" delimline t) + (setq resend-to-addresses + (save-restriction + (narrow-to-region (point) + (save-excursion + (end-of-line) + (point))) + (append (mail-parse-comma-list) + resend-to-addresses)))) + ;;; Apparently this causes a duplicate Sender. + ;;; ;; If the From is different than current user, insert Sender. + ;;; (goto-char (point-min)) + ;;; (and (re-search-forward "^From:" delimline t) + ;;; (progn + ;;; (require 'mail-utils) + ;;; (not (string-equal + ;;; (mail-strip-quoted-names + ;;; (save-restriction + ;;; (narrow-to-region (point-min) delimline) + ;;; (mail-fetch-field "From"))) + ;;; (user-login-name)))) + ;;; (progn + ;;; (forward-line 1) + ;;; (insert "Sender: " (user-login-name) "\n"))) + ;; Don't send out a blank subject line + (goto-char (point-min)) + (if (re-search-forward "^Subject:[ \t]*\n" delimline t) + (replace-match "")) + ;; Put the "From:" field in unless for some odd reason + ;; they put one in themselves. + (goto-char (point-min)) + (if (not (re-search-forward "^From:" delimline t)) + (let* ((login user-mail-address) + (fullname (user-full-name))) + (cond ((eq mail-from-style 'angles) + (insert "From: " fullname) + (let ((fullname-start (+ (point-min) 6)) + (fullname-end (point-marker))) + (goto-char fullname-start) + ;; Look for a character that cannot appear unquoted + ;; according to RFC 822. + (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" + fullname-end 1) + (progn + ;; Quote fullname, escaping specials. + (goto-char fullname-start) + (insert "\"") + (while (re-search-forward "[\"\\]" + fullname-end 1) + (replace-match "\\\\\\&" t)) + (insert "\"")))) + (insert " <" login ">\n")) + ((eq mail-from-style 'parens) + (insert "From: " login " (") + (let ((fullname-start (point))) + (insert fullname) + (let ((fullname-end (point-marker))) + (goto-char fullname-start) + ;; RFC 822 says \ and nonmatching parentheses + ;; must be escaped in comments. + ;; Escape every instance of ()\ ... + (while (re-search-forward "[()\\]" fullname-end 1) + (replace-match "\\\\\\&" t)) + ;; ... then undo escaping of matching parentheses, + ;; including matching nested parentheses. + (goto-char fullname-start) + (while (re-search-forward + "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" + fullname-end 1) + (replace-match "\\1(\\3)" t) + (goto-char fullname-start)))) + (insert ")\n")) + ((null mail-from-style) + (insert "From: " login "\n"))))) + ;; Insert an extra newline if we need it to work around + ;; Sun's bug that swallows newlines. + (goto-char (1+ delimline)) + (if (eval mail-mailer-swallows-blank-line) + (newline)) + ;; Find and handle any FCC fields. + (goto-char (point-min)) + (if (re-search-forward "^FCC:" delimline t) + (mail-do-fcc delimline)) + (if mail-interactive + (save-excursion + (set-buffer errbuf) + (erase-buffer)))) + ;; + ;; + ;; + (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*")) + (setq smtpmail-recipient-address-list + (or resend-to-addresses + (smtpmail-deduce-address-list tembuf (point-min) delimline))) + (kill-buffer smtpmail-address-buffer) + + (smtpmail-do-bcc delimline) + + (if (not (null smtpmail-recipient-address-list)) + (if (not (smtpmail-via-smtp smtpmail-recipient-address-list tembuf)) + (error "Sending failed; SMTP protocol error")) + (error "Sending failed; no recipients")) + ) + (kill-buffer tembuf) + (if (bufferp errbuf) + (kill-buffer errbuf))))) + + + ;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer) + + (defun smtpmail-fqdn () + (if smtpmail-local-domain + (concat (system-name) "." smtpmail-local-domain) + (system-name))) + + (defun smtpmail-via-smtp (recipient smtpmail-text-buffer) + (let ((process nil) + (host smtpmail-smtp-server) + (port smtpmail-smtp-service) + response-code + greeting + process-buffer) + (unwind-protect + (catch 'done + ;; get or create the trace buffer + (setq process-buffer + (get-buffer-create (format "*trace of SMTP session to %s*" host))) + + ;; clear the trace buffer of old output + (save-excursion + (set-buffer process-buffer) + (erase-buffer)) + + ;; open the connection to the server + (setq process (open-network-stream "SMTP" process-buffer host port)) + (and (null process) (throw 'done nil)) + + ;; set the send-filter + (set-process-filter process 'smtpmail-process-filter) + + (save-excursion + (set-buffer process-buffer) + (make-local-variable 'smtpmail-read-point) + (setq smtpmail-read-point (point-min)) + + + (if (or (null (car (setq greeting (smtpmail-read-response process)))) + (not (integerp (car greeting))) + (>= (car greeting) 400)) + (throw 'done nil) + ) + + ;; HELO + (smtpmail-send-command process (format "HELO %s" (smtpmail-fqdn))) + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + + ;; MAIL FROM: + ; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn))) + (smtpmail-send-command process (format "MAIL FROM: <%s>" user-mail-address)) + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + + ;; RCPT TO: + (let ((n 0)) + (while (not (null (nth n recipient))) + (smtpmail-send-command process (format "RCPT TO: <%s>" (nth n recipient))) + (setq n (1+ n)) + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + )) + + ;; DATA + (smtpmail-send-command process "DATA") + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + + ;; Mail contents + (smtpmail-send-data process smtpmail-text-buffer) + + ;;DATA end "." + (smtpmail-send-command process ".") + + (if (or (null (car (setq response-code (smtpmail-read-response process)))) + (not (integerp (car response-code))) + (>= (car response-code) 400)) + (throw 'done nil) + ) + + ;;QUIT + ; (smtpmail-send-command process "QUIT") + ; (and (null (car (smtpmail-read-response process))) + ; (throw 'done nil)) + t )) + (if process + (save-excursion + (set-buffer (process-buffer process)) + (smtpmail-send-command process "QUIT") + (smtpmail-read-response process) + + ; (if (or (null (car (setq response-code (smtpmail-read-response process)))) + ; (not (integerp (car response-code))) + ; (>= (car response-code) 400)) + ; (throw 'done nil) + ; ) + (delete-process process)))))) + + + (defun smtpmail-process-filter (process output) + (save-excursion + (set-buffer (process-buffer process)) + (goto-char (point-max)) + (insert output))) + + (defun smtpmail-read-response (process) + (let ((case-fold-search nil) + (response-string nil) + (response-continue t) + (return-value '(nil "")) + match-end) + + ; (setq response-string nil) + ; (setq response-continue t) + ; (setq return-value '(nil "")) + + (while response-continue + (goto-char smtpmail-read-point) + (while (not (search-forward "\r\n" nil t)) + (accept-process-output process) + (goto-char smtpmail-read-point)) + + (setq match-end (point)) + (if (null response-string) + (setq response-string + (buffer-substring smtpmail-read-point (- match-end 2)))) + + (goto-char smtpmail-read-point) + (if (looking-at "[0-9]+ ") + (progn (setq response-continue nil) + ; (setq return-value response-string) + + (if smtpmail-debug-info + (message response-string)) + + (setq smtpmail-read-point match-end) + (setq return-value + (cons (string-to-int + (buffer-substring (match-beginning 0) (match-end 0))) + response-string))) + + (if (looking-at "[0-9]+-") + (progn (setq smtpmail-read-point match-end) + (setq response-continue t)) + (progn + (setq smtpmail-read-point match-end) + (setq response-continue nil) + (setq return-value + (cons nil response-string)) + ) + ))) + (setq smtpmail-read-point match-end) + return-value)) + + + (defun smtpmail-send-command (process command) + (goto-char (point-max)) + (if (= (aref command 0) ?P) + (insert "PASS \r\n") + (insert command "\r\n")) + (setq smtpmail-read-point (point)) + (process-send-string process command) + (process-send-string process "\r\n")) + + (defun smtpmail-send-data-1 (process data) + (goto-char (point-max)) + + (if (not (null smtpmail-code-conv-from)) + (setq data (code-convert-string data smtpmail-code-conv-from *internal*))) + + (if smtpmail-debug-info + (insert data "\r\n")) + + (setq smtpmail-read-point (point)) + ;; Escape "." at start of a line + (if (eq (string-to-char data) ?.) + (process-send-string process ".")) + (process-send-string process data) + (process-send-string process "\r\n") + ) + + (defun smtpmail-send-data (process buffer) + (let + ((data-continue t) + (sending-data nil) + this-line + this-line-end) + + (save-excursion + (set-buffer buffer) + (goto-char (point-min))) + + (while data-continue + (save-excursion + (set-buffer buffer) + (beginning-of-line) + (setq this-line (point)) + (end-of-line) + (setq this-line-end (point)) + (setq sending-data nil) + (setq sending-data (buffer-substring this-line this-line-end)) + (if (/= (forward-line 1) 0) + (setq data-continue nil))) + + (smtpmail-send-data-1 process sending-data) + ) + ) + ) + + + (defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end) + "Get address list suitable for smtp RCPT TO:
    ." + (require 'mail-utils) ;; pick up mail-strip-quoted-names + (let + ((case-fold-search t) + (simple-address-list "") + this-line + this-line-end + addr-regexp) + + (unwind-protect + (save-excursion + ;; + (set-buffer smtpmail-address-buffer) (erase-buffer) + (insert-buffer-substring smtpmail-text-buffer header-start header-end) + (goto-char (point-min)) + ;; RESENT-* fields should stop processing of regular fields. + (save-excursion + (if (re-search-forward "^RESENT-TO:" header-end t) + (setq addr-regexp "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)") + (setq addr-regexp "^\\(TO:\\|CC:\\|BCC:\\)"))) + + (while (re-search-forward addr-regexp header-end t) + (replace-match "") + (setq this-line (match-beginning 0)) + (forward-line 1) + ;; get any continuation lines + (while (and (looking-at "^[ \t]+") (< (point) header-end)) + (forward-line 1)) + (setq this-line-end (point-marker)) + (setq simple-address-list + (concat simple-address-list " " + (mail-strip-quoted-names (buffer-substring this-line this-line-end)))) + ) + (erase-buffer) + (insert-string " ") + (insert-string simple-address-list) + (insert-string "\n") + (subst-char-in-region (point-min) (point-max) 10 ? t);; newline --> blank + (subst-char-in-region (point-min) (point-max) ?, ? t);; comma --> blank + (subst-char-in-region (point-min) (point-max) 9 ? t);; tab --> blank + + (goto-char (point-min)) + ;; tidyness in case hook is not robust when it looks at this + (while (re-search-forward "[ \t]+" header-end t) (replace-match " ")) + + (goto-char (point-min)) + (let (recipient-address-list) + (while (re-search-forward " \\([^ ]+\\) " (point-max) t) + (backward-char 1) + (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1)) + recipient-address-list)) + ) + (setq smtpmail-recipient-address-list recipient-address-list)) + + ) + ) + ) + ) + + + (defun smtpmail-do-bcc (header-end) + "Delete BCC: and their continuation lines from the header area. + There may be multiple BCC: lines, and each may have arbitrarily + many continuation lines." + (let ((case-fold-search t)) + (save-excursion (goto-char (point-min)) + ;; iterate over all BCC: lines + (while (re-search-forward "^BCC:" header-end t) + (delete-region (match-beginning 0) (progn (forward-line 1) (point))) + ;; get rid of any continuation lines + (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) + (replace-match "")) + ) + ) ;; save-excursion + ) ;; let + ) + + + + (provide 'smtpmail) + + ;; smtpmail.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/startup.el emacs-19.32/lisp/startup.el *** emacs-19.31/lisp/startup.el Thu Apr 11 01:22:42 1996 --- emacs-19.32/lisp/startup.el Thu Jul 11 20:06:11 1996 *************** This is normally copied from `default-di *** 164,169 **** ("-d" 1 x-handle-display) ("-display" 1 x-handle-display) ! ("-name" 1 x-handle-name-rn-switch) ! ("-rn" 1 x-handle-name-rn-switch) ("-title" 1 x-handle-switch title) ("-T" 1 x-handle-switch title) --- 164,168 ---- ("-d" 1 x-handle-display) ("-display" 1 x-handle-display) ! ("-name" 1 x-handle-name-switch) ("-title" 1 x-handle-switch title) ("-T" 1 x-handle-switch title) *************** This is normally copied from `default-di *** 192,196 **** ("--border-width" 1 x-handle-numeric-switch border-width) ("--display" 1 x-handle-display) ! ("--name" 1 x-handle-name-rn-switch) ("--title" 1 x-handle-switch title) ("--reverse-video" 0 x-handle-switch reverse t) --- 191,195 ---- ("--border-width" 1 x-handle-numeric-switch border-width) ("--display" 1 x-handle-display) ! ("--name" 1 x-handle-name-switch) ("--title" 1 x-handle-switch title) ("--reverse-video" 0 x-handle-switch reverse t) *************** from being initialized.") *** 306,310 **** ;; This function is called from the subdirs.el file. (defun normal-top-level-add-to-load-path (dirs) ! (let ((tail (member default-directory load-path))) (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))) --- 305,309 ---- ;; This function is called from the subdirs.el file. (defun normal-top-level-add-to-load-path (dirs) ! (let ((tail (member (directory-file-name default-directory) load-path))) (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail))))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/subr.el emacs-19.32/lisp/subr.el *** emacs-19.31/lisp/subr.el Wed Feb 28 04:21:50 1996 --- emacs-19.32/lisp/subr.el Thu Jul 4 00:45:52 1996 *************** Please convert your programs to use the *** 430,433 **** --- 430,435 ---- baud-rate) + (defalias 'focus-frame 'ignore) + (defalias 'unfocus-frame 'ignore) ;;;; Alternate names for functions - these are not being phased out. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/tar-mode.el emacs-19.32/lisp/tar-mode.el *** emacs-19.31/lisp/tar-mode.el Wed Mar 6 02:49:00 1996 --- emacs-19.32/lisp/tar-mode.el Sat Jul 6 21:20:30 1996 *************** is visible (and the real data of the buf *** 495,501 **** --- 495,503 ---- (define-key tar-mode-map "n" 'tar-next-line) (define-key tar-mode-map "\^N" 'tar-next-line) + (define-key tar-mode-map [down] 'tar-next-line) (define-key tar-mode-map "o" 'tar-extract-other-window) (define-key tar-mode-map "p" 'tar-previous-line) (define-key tar-mode-map "\^P" 'tar-previous-line) + (define-key tar-mode-map [up] 'tar-previous-line) (define-key tar-mode-map "r" 'tar-rename-entry) (define-key tar-mode-map "u" 'tar-unflag) *************** appear on disk when you save the tar-fil *** 631,639 **** ;; Revert the buffer and recompute the dired-like listing. (defun tar-mode-revert (&optional no-autosave no-confirm) ! (setq tar-header-offset nil) ! (let ((revert-buffer-function nil)) ! (revert-buffer t no-confirm) ! (widen)) ! (tar-mode)) --- 633,649 ---- ;; Revert the buffer and recompute the dired-like listing. (defun tar-mode-revert (&optional no-autosave no-confirm) ! (let ((revert-buffer-function nil) ! (old-offset tar-header-offset) ! success) ! (setq tar-header-offset nil) ! (unwind-protect ! (and (revert-buffer t no-confirm) ! (progn (widen) ! (setq success t) ! (tar-mode))) ! ;; If the revert was canceled, ! ;; put back the old value of tar-header-offset. ! (or success ! (setq tar-header-offset old-offset))))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/tcl-mode.el emacs-19.32/lisp/tcl-mode.el *** emacs-19.31/lisp/tcl-mode.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/tcl-mode.el Tue Jul 2 12:15:52 1996 *************** Should be a list of strings.") *** 151,155 **** (defvar tcl-imenu-generic-expression ! '("^[ \t]*proc[ \t]+\\(\\(\\s_\\|\\sw\\)+\\)" 1) "Imenu generic expression for tcl-mode. See `imenu-generic-expression'.") --- 151,155 ---- (defvar tcl-imenu-generic-expression ! '((nil "^[ \t]*proc[ \t]+\\(\\(\\s_\\|\\sw\\)+\\)" 1)) "Imenu generic expression for tcl-mode. See `imenu-generic-expression'.") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/term/pc-win.el emacs-19.32/lisp/term/pc-win.el *** emacs-19.31/lisp/term/pc-win.el Sat Mar 2 01:37:32 1996 --- emacs-19.32/lisp/term/pc-win.el Mon Jun 10 17:18:50 1996 *************** *** 27,58 **** (load "term/internal" nil t) ! ;; Color translation -- doesn't really need to be fast (defvar msdos-color-aliases ! '(("purple" . "magenta") ! ("firebrick" . "red") ; ? ! ("pink" . "lightred") ! ("royalblue" . "blue") ! ("cadetblue" . "blue") ! ("forestgreen" . "green") ! ("darkolivegreen" . "green") ! ("darkgoldenrod" . "brown") ! ("goldenrod" . "yellow") ! ("grey40" . "darkgray") ! ("dark gray" . "darkgray") ! ("light gray" . "lightgray") ! ("rosybrown" . "brown") ! ("blue" . "lightblue") ;; from here: for Enriched Text ! ("darkslategray" . "darkgray") ! ("orange" . "brown") ! ("light blue" . "lightblue") ;; from here: for cpp-highlight ! ("light cyan" . "lightcyan") ! ("light yellow" . "yellow") ! ("light pink" . "lightred") ! ("pale green" . "lightgreen") ! ("beige" . "brown") ! ("medium purple" . "magenta") ! ("turquoise" . "lightgreen") ! ("violet" . "magenta")) "List of alternate names for colors.") --- 27,173 ---- (load "term/internal" nil t) ! ;; Color translation -- doesn't really need to be fast. ! ;; Colors listed here do not include the "light-", ! ;; "medium-" and "dark-" prefixes that are accounted for ! ;; by `msdos-color-translate', which see below). (defvar msdos-color-aliases ! '(("snow" . "white") ! ("ghost white" . "white") ! ("ghostwhite" . "white") ! ("white smoke" . "white") ! ("whitesmoke" . "white") ! ("gainsboro" . "white") ! ("floral white" . "white") ! ("floralwhite" . "white") ! ("old lace" . "white") ! ("oldlace" . "white") ! ("linen" . "white") ! ("antique white" . "white") ! ("antiquewhite" . "white") ! ("papaya whip" . "white") ! ("papayawhip" . "white") ! ("blanched almond" . "white") ! ("blanchedalmond" . "white") ! ("bisque" . "white") ! ("peach puff" . "lightred") ! ("peachpuff" . "lightred") ! ("navajo white" . "lightred") ! ("navajowhite" . "lightred") ! ("moccasin" . "lightred") ! ("cornsilk" . "white") ! ("ivory" . "white") ! ("lemon chiffon" . "yellow") ! ("lemonchiffon" . "yellow") ! ("seashell" . "white") ! ("honeydew" . "white") ! ("mint cream" . "white") ! ("mintcream" . "white") ! ("azure" . "lightcyan") ! ("alice blue" . "lightcyan") ! ("aliceblue" . "lightcyan") ! ("lavender" . "lightcyan") ! ("lavender blush" . "lightcyan") ! ("lavenderblush" . "lightcyan") ! ("misty rose" . "lightred") ! ("mistyrose" . "lightred") ! ("aquamarine" . "blue") ! ("cadet blue" . "blue") ! ("cadetblue" . "blue") ! ("cornflower blue" . "lightblue") ! ("cornflowerblue" . "lightblue") ! ("midnight blue" . "blue") ! ("midnightblue" . "blue") ! ("navy blue" . "cyan") ! ("navyblue" . "cyan") ! ("navy" . "cyan") ! ("sky blue" . "lightblue") ! ("skyblue" . "lightblue") ! ("dodger blue" . "blue") ! ("dodgerblue" . "blue") ! ("powder blue" . "lightblue") ! ("powderblue" . "lightblue") ! ("slate blue" . "cyan") ! ("slateblue" . "cyan") ! ("steel blue" . "blue") ! ("steelblue" . "blue") ! ("coral" . "lightred") ! ("firebrick" . "red") ! ("gold" . "yellow") ! ("goldenrod" . "yellow") ! ("pale goldenrod" . "yellow") ! ("palegoldenrod" . "yellow") ! ("olive green" . "lightgreen") ! ("olivegreen" . "lightgreen") ! ("olive drab" . "green") ! ("olivedrab" . "green") ! ("forest green" . "green") ! ("forestgreen" . "green") ! ("lime green" . "lightgreen") ! ("limegreen" . "lightgreen") ! ("sea green" . "lightcyan") ! ("seagreen" . "lightcyan") ! ("spring green" . "green") ! ("springgreen" . "green") ! ("pale green" . "lightgreen") ! ("palegreen" . "lightgreen") ! ("lawn green" . "lightgreen") ! ("lawngreen" . "lightgreen") ! ("chartreuse" . "yellow") ! ("yellow green" . "lightgreen") ! ("yellowgreen" . "lightgreen") ! ("green yellow" . "lightgreen") ! ("greenyellow" . "lightgreen") ! ("slate grey" . "lightgray") ! ("slategrey" . "lightgray") ! ("slate gray" . "lightgray") ! ("slategray" . "lightgray") ! ("dim grey" . "darkgray") ! ("dimgrey" . "darkgray") ! ("dim gray" . "darkgray") ! ("dimgray" . "darkgray") ! ("light grey" . "lightgray") ! ("lightgrey" . "lightgray") ! ("light gray" . "lightgray") ! ("gray" . "darkgray") ! ("grey" . "darkgray") ! ("gray80" . "darkgray") ! ("gray50" . "black") ! ("gray90" . "darkgray") ! ("khaki" . "green") ! ("maroon" . "red") ! ("orange" . "brown") ! ("orchid" . "brown") ! ("saddle brown" . "red") ! ("saddlebrown" . "red") ! ("sienna" . "red") ! ("peru" . "red") ! ("pink" . "lightred") ! ("plum" . "magenta") ! ("indian red" . "red") ! ("indianred" . "red") ! ("violet red" . "magenta") ! ("violetred" . "magenta") ! ("orange red" . "red") ! ("orangered" . "red") ! ("salmon" . "lightred") ! ("sienna" . "lightred") ! ("tan" . "lightred") ! ("thistle" . "magenta") ! ("turquoise" . "lightgreen") ! ("pale turquoise" . "cyan") ! ("paleturquoise" . "cyan") ! ("violet" . "magenta") ! ("blue violet" . "lightmagenta") ! ("blueviolet" . "lightmagenta") ! ("wheat" . "white") ! ("green yellow" . "yellow") ! ("greenyellow" . "yellow") ! ("purple" . "magenta") ! ("royalblue" . "blue") ! ("grey40" . "darkgray") ! ("rosybrown" . "brown") ! ("rosy brown" . "brown") ! ("beige" . "brown")) "List of alternate names for colors.") *************** *** 68,108 **** (msdos-color-translate try)) (and (> len 5) ! (string= "light" (substring name 0 4)) (setq try (msdos-color-translate (substring name 5))) (logior try 8)) (and (> len 6) ! (string= "light " (substring name 0 5)) (setq try (msdos-color-translate (substring name 6))) (logior try 8)) (and (> len 4) ! (string= "dark" (substring name 0 3)) (msdos-color-translate (substring name 4))) (and (> len 5) ! (string= "dark " (substring name 0 4)) (msdos-color-translate (substring name 5)))))) ;; --------------------------------------------------------------------------- ;; We want to delay setting frame parameters until the faces are setup (defvar default-frame-alist nil) (defun msdos-face-setup () ! (modify-frame-parameters (selected-frame) default-frame-alist) ! (set-face-foreground 'bold "yellow") ! (set-face-foreground 'italic "red") ! (set-face-foreground 'bold-italic "lightred") ! (set-face-foreground 'underline "white") ! (set-face-background 'region "green") (make-face 'msdos-menu-active-face) (make-face 'msdos-menu-passive-face) (make-face 'msdos-menu-select-face) ! (set-face-foreground 'msdos-menu-active-face "white") ! (set-face-foreground 'msdos-menu-passive-face "lightgray") ! (set-face-background 'msdos-menu-active-face "blue") ! (set-face-background 'msdos-menu-passive-face "blue") ! (set-face-background 'msdos-menu-select-face "red")) ;; We have only one font, so... (add-hook 'before-init-hook 'msdos-face-setup) ;; --------------------------------------------------------------------------- ;; More or less useful imitations of certain X-functions. A lot of the --- 183,239 ---- (msdos-color-translate try)) (and (> len 5) ! (string= "light" (substring name 0 5)) (setq try (msdos-color-translate (substring name 5))) (logior try 8)) (and (> len 6) ! (string= "light " (substring name 0 6)) (setq try (msdos-color-translate (substring name 6))) (logior try 8)) + (and (> len 6) + (string= "medium" (substring name 0 6)) + (msdos-color-translate (substring name 6))) + (and (> len 7) + (string= "medium " (substring name 0 7)) + (msdos-color-translate (substring name 7))) (and (> len 4) ! (string= "dark" (substring name 0 4)) (msdos-color-translate (substring name 4))) (and (> len 5) ! (string= "dark " (substring name 0 5)) (msdos-color-translate (substring name 5)))))) ;; --------------------------------------------------------------------------- ;; We want to delay setting frame parameters until the faces are setup (defvar default-frame-alist nil) + (modify-frame-parameters terminal-frame default-frame-alist) (defun msdos-face-setup () ! (modify-frame-parameters terminal-frame default-frame-alist) ! (set-face-foreground 'bold "yellow" terminal-frame) ! (set-face-foreground 'italic "red" terminal-frame) ! (set-face-foreground 'bold-italic "lightred" terminal-frame) ! (set-face-foreground 'underline "white" terminal-frame) ! (set-face-background 'region "green" terminal-frame) (make-face 'msdos-menu-active-face) (make-face 'msdos-menu-passive-face) (make-face 'msdos-menu-select-face) ! (set-face-foreground 'msdos-menu-active-face "white" terminal-frame) ! (set-face-foreground 'msdos-menu-passive-face "lightgray" terminal-frame) ! (set-face-background 'msdos-menu-active-face "blue" terminal-frame) ! (set-face-background 'msdos-menu-passive-face "blue" terminal-frame) ! (set-face-background 'msdos-menu-select-face "red" terminal-frame)) ;; We have only one font, so... (add-hook 'before-init-hook 'msdos-face-setup) + + ;; We create frames as if we were a terminal, but with a twist. + (defun make-msdos-frame (&optional parameters) + (let ((parms + (append initial-frame-alist default-frame-alist parameters nil))) + (make-terminal-frame parms))) + + (setq frame-creation-function 'make-msdos-frame) + ;; --------------------------------------------------------------------------- ;; More or less useful imitations of certain X-functions. A lot of the *************** *** 113,118 **** ;; From src/xfns.c (defun x-display-color-p (&optional display) 't) - (fset 'focus-frame 'ignore) - (fset 'unfocus-frame 'ignore) (defun x-list-fonts (pattern &optional face frame) (list "default")) (defun x-color-defined-p (color) (numberp (msdos-color-translate color))) --- 244,247 ---- *************** The value may be different for frames on *** 172,189 **** (fset 'set-cursor-color 'ignore) ; Hardware determined by char under. (fset 'set-border-color 'ignore) ; Not useful. - (fset 'auto-raise-mode 'ignore) - (fset 'auto-lower-mode 'ignore) - (defun set-background-color (color-name) - "Set the background color of the selected frame to COLOR. - When called interactively, prompt for the name of the color to use." - (interactive "sColor: ") - (modify-frame-parameters (selected-frame) - (list (cons 'background-color color-name)))) - (defun set-foreground-color (color-name) - "Set the foreground color of the selected frame to COLOR. - When called interactively, prompt for the name of the color to use." - (interactive "sColor: ") - (modify-frame-parameters (selected-frame) - (list (cons 'foreground-color color-name)))) ;; --------------------------------------------------------------------------- ;; Handle the X-like command line parameters "-fg" and "-bg" --- 301,304 ---- *************** When called interactively, prompt for th *** 210,216 **** (setq command-line-args (msdos-handle-args command-line-args)) ;; --------------------------------------------------------------------------- - (require 'faces) - (if (msdos-mouse-p) - (progn - (require 'menu-bar) - (menu-bar-mode t))) --- 325,326 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/term/x-win.el emacs-19.32/lisp/term/x-win.el *** emacs-19.31/lisp/term/x-win.el Sun Apr 21 20:48:52 1996 --- emacs-19.32/lisp/term/x-win.el Wed Jul 31 12:58:24 1996 *************** *** 133,147 **** x-invocation-args (cdr x-invocation-args)))) ! ;; Handle the -name and -rn options. Set the variable x-resource-name ! ;; to the option's operand; if the switch was `-name', set the name of ;; the initial frame, too. ! (defun x-handle-name-rn-switch (switch) (or (consp x-invocation-args) (error "%s: missing argument to `%s' option" (invocation-name) switch)) (setq x-resource-name (car x-invocation-args) x-invocation-args (cdr x-invocation-args)) ! (if (string= switch "-name") ! (setq initial-frame-alist (cons (cons 'name x-resource-name) ! initial-frame-alist)))) (defvar x-display-name nil --- 133,146 ---- x-invocation-args (cdr x-invocation-args)))) ! ;; Handle the -name option. Set the variable x-resource-name ! ;; to the option's operand; set the name of ;; the initial frame, too. ! (defun x-handle-name-switch (switch) (or (consp x-invocation-args) (error "%s: missing argument to `%s' option" (invocation-name) switch)) (setq x-resource-name (car x-invocation-args) x-invocation-args (cdr x-invocation-args)) ! (setq initial-frame-alist (cons (cons 'name x-resource-name) ! initial-frame-alist))) (defvar x-display-name nil *************** This is in addition to the primary selec *** 702,708 **** (setq-default mode-line-buffer-identification '("Emacs: %12b")) ! ;; Motif normally handles f10 itself, so don't try to handle it a second time. ! (if (featurep 'motif) ! (global-set-key [f10] 'ignore)) ;;; x-win.el ends here --- 701,710 ---- (setq-default mode-line-buffer-identification '("Emacs: %12b")) ! ;;; Motif direct handling of f10 wasn't working right, ! ;;; So temporarily we've turned it off in lwlib-Xm.c ! ;;; and turned the Emacs f10 back on. ! ;;; ;; Motif normally handles f10 itself, so don't try to handle it a second time. ! ;;; (if (featurep 'motif) ! ;;; (global-set-key [f10] 'ignore)) ;;; x-win.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/term.el emacs-19.32/lisp/term.el *** emacs-19.31/lisp/term.el Fri May 17 17:14:54 1996 --- emacs-19.32/lisp/term.el Sun Jun 23 11:47:46 1996 *************** Entry to this mode runs the hooks on ter *** 524,529 **** (define-key newmap [terminal-line-mode] '("Line mode" . term-line-mode)) ! (define-key newmap [menu-bar terminal] ! (setq term-terminal-menu (cons "Terminal" newmap))) ;; completion: (line mode only) --- 524,528 ---- (define-key newmap [terminal-line-mode] '("Line mode" . term-line-mode)) ! (setq term-terminal-menu (cons "Terminal" newmap)) ;; completion: (line mode only) *************** buffer. The hook term-exec-hook is run a *** 885,889 **** (format "LINES=%d" term-height) (format "COLUMNS=%d" term-width)) ! process-environment))) (apply 'start-process name buffer "/bin/sh" "-c" --- 884,889 ---- (format "LINES=%d" term-height) (format "COLUMNS=%d" term-width)) ! process-environment)) ! (process-connection-type t)) (apply 'start-process name buffer "/bin/sh" "-c" diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/tex-mode.el emacs-19.32/lisp/tex-mode.el *** emacs-19.31/lisp/tex-mode.el Wed May 15 11:15:07 1996 --- emacs-19.32/lisp/tex-mode.el Thu Jul 11 19:53:41 1996 *************** Entering SliTeX mode runs the hook `text *** 557,560 **** --- 557,563 ---- (make-local-variable 'compare-windows-whitespace) (setq compare-windows-whitespace 'tex-categorize-whitespace) + (make-local-variable 'skeleton-further-elements) + (setq skeleton-further-elements + '((indent-line-function 'indent-relative-maybe))) (make-local-variable 'facemenu-add-face-function) (make-local-variable 'facemenu-end-add-face) *************** for the invalidity you want to see." *** 650,658 **** (goto-char (point-max)) (while (and (not (input-pending-p)) (not (bobp))) ! (let ((end (point))) ;; Scan the previous paragraph for invalidities. ! (search-backward "\n\n" nil 'move) (or (tex-validate-region (point) end) ! (let* ((end (save-excursion (forward-line 1) (point))) start tem) (beginning-of-line) --- 653,667 ---- (goto-char (point-max)) (while (and (not (input-pending-p)) (not (bobp))) ! (let ((end (point)) ! prev-end) ;; Scan the previous paragraph for invalidities. ! (if (search-backward "\n\n" nil t) ! (progn ! (setq prev-end (point)) ! (forward-char 2)) ! (goto-char (setq prev-end (point-min)))) (or (tex-validate-region (point) end) ! (let* ((oend end) ! (end (save-excursion (forward-line 1) (point))) start tem) (beginning-of-line) *************** for the invalidity you want to see." *** 677,681 **** (insert-buffer-substring buffer start end) (forward-char (- start end)) ! (insert (format "%3d: " linenum)))))))) (save-excursion (set-buffer standard-output) --- 686,691 ---- (insert-buffer-substring buffer start end) (forward-char (- start end)) ! (insert (format "%3d: " linenum))))) ! (goto-char prev-end)))) (save-excursion (set-buffer standard-output) *************** area if a mismatch is found." *** 699,702 **** --- 709,713 ---- (forward-sexp 1))) (error + (skip-syntax-forward " .>") (setq failure-point (point))))) (if failure-point *************** A prefix arg inhibits the checking." *** 729,751 **** ;;; Like tex-insert-braces, but for LaTeX. ! (defun tex-latex-block (name) ! "Creates a matching pair of lines `\\begin{NAME}' and `\\end{NAME}' at point. Puts point on a blank line between them." ! (interactive ! (prog2 ! (barf-if-buffer-read-only) ! (list ! (completing-read "LaTeX block name: " ! (mapcar 'list ! (append standard-latex-block-names ! latex-block-names)))))) ! (let ((col (current-column))) ! (insert (format "\\begin{%s}\n" name)) ! (indent-to col) ! (save-excursion ! (insert ?\n) ! (indent-to col) ! (insert-string (format "\\end{%s}" name)) ! (if (eobp) (insert ?\n))))) (defun tex-last-unended-begin () --- 740,757 ---- ;;; Like tex-insert-braces, but for LaTeX. ! (define-skeleton tex-latex-block ! "Create a matching pair of lines \\begin[OPT]{NAME} and \\end{NAME} at point. Puts point on a blank line between them." ! (completing-read "LaTeX block name: " ! (mapcar 'list ! (append standard-latex-block-names ! latex-block-names))) ! "\\begin[" ! (skeleton-read "[options]: ") & ?\] | -1 ! ?\{ ! str ! ?\} \n ! _ \n ! "\\end{" str ?\}) (defun tex-last-unended-begin () diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/texinfmt.el emacs-19.32/lisp/texinfmt.el *** emacs-19.31/lisp/texinfmt.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/texinfmt.el Mon Jul 15 16:24:34 1996 *************** lower types.") *** 892,900 **** (insert "Info file: " texinfo-format-filename ", -*-Text-*-\n" - ;; Date string removed so that regression testing is easier. - ;; "produced on " - ;; (substring (current-time-string) 8 10) " " - ;; (substring (current-time-string) 4 7) " " - ;; (substring (current-time-string) -4) " " "produced by `texinfo-format-buffer'\n" "from file" --- 892,895 ---- *************** Used by @refill indenting command to avo *** 1569,1576 **** (defun texinfo-format-today () (texinfo-parse-arg-discard) ! (insert (format "%s %s %s" ! (substring (current-time-string) 8 10) ! (substring (current-time-string) 4 7) ! (substring (current-time-string) -4)))) --- 1564,1568 ---- (defun texinfo-format-today () (texinfo-parse-arg-discard) ! (insert (format-time-string "%e %b %Y"))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/texnfo-upd.el emacs-19.32/lisp/texnfo-upd.el *** emacs-19.31/lisp/texnfo-upd.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/texnfo-upd.el Sun Jun 9 09:41:38 1996 *************** and leave point on the line before the ` *** 965,973 **** (goto-char end-of-menu) ;; handle multi-line description ! (if (not (re-search-backward "^\* " nil t)) (error "No entries in menu.")) (point)))) (while (< (point) last-entry) ! (if (re-search-forward "^\* " end-of-menu t) (progn (setq this-menu-list --- 965,973 ---- (goto-char end-of-menu) ;; handle multi-line description ! (if (not (re-search-backward "^\\* " nil t)) (error "No entries in menu.")) (point)))) (while (< (point) last-entry) ! (if (re-search-forward "^\\* " end-of-menu t) (progn (setq this-menu-list *************** and leave point on the line before the ` *** 977,981 **** ;; copy multi-line descriptions (save-excursion ! (re-search-forward "\\(^\* \\|^@e\\)" nil t) (- (point) 3))) this-menu-list))))) --- 977,981 ---- ;; copy multi-line descriptions (save-excursion ! (re-search-forward "\\(^\\* \\|^@e\\)" nil t) (- (point) 3))) this-menu-list))))) *************** The first and second arguments bound the *** 1363,1367 **** beginning and end, respectively, of the enclosing higher level section. The third argument is a string specifying the general kind ! of section such as \"chapter\ or \"section\". When looking for the `Next' pointer, the section found will be at the same hierarchical level in the Texinfo file; when looking for the `Previous' pointer, --- 1363,1367 ---- beginning and end, respectively, of the enclosing higher level section. The third argument is a string specifying the general kind ! of section such as \"chapter\" or \"section\". When looking for the `Next' pointer, the section found will be at the same hierarchical level in the Texinfo file; when looking for the `Previous' pointer, *************** Return type of pointer (either 'normal o *** 1560,1564 **** The first argument is a string specifying the general kind of section ! such as \"chapter\ or \"section\". The section found will be at the same hierarchical level in the Texinfo file, or, in the case of the up pointer, some level higher. The second argument (one of 'next, --- 1560,1564 ---- The first argument is a string specifying the general kind of section ! such as \"chapter\" or \"section\". The section found will be at the same hierarchical level in the Texinfo file, or, in the case of the up pointer, some level higher. The second argument (one of 'next, diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/time.el emacs-19.32/lisp/time.el *** emacs-19.31/lisp/time.el Sat Mar 2 01:03:48 1996 --- emacs-19.32/lisp/time.el Sun Jul 21 15:46:59 1996 *************** After each update, `display-time-hook' i *** 72,76 **** (and display-time-timer (cancel-timer display-time-timer)) (setq display-time-timer ! (run-at-time nil display-time-interval 'display-time-event-handler)) ;; When you get new mail, clear "Mail" from the mode line. (add-hook 'rmail-after-get-new-mail-hook 'display-time-event-handler)) --- 72,80 ---- (and display-time-timer (cancel-timer display-time-timer)) (setq display-time-timer ! ;; Start timer at the beginning of the next minute. ! (run-at-time (apply 'encode-time 60 (cdr (decode-time))) ! display-time-interval 'display-time-event-handler)) ! ;; Make the time appear right away. ! (display-time-update) ;; When you get new mail, clear "Mail" from the mode line. (add-hook 'rmail-after-get-new-mail-hook 'display-time-event-handler)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/timezone.el emacs-19.32/lisp/timezone.el *** emacs-19.31/lisp/timezone.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/timezone.el Sun Jul 7 20:07:41 1996 *************** *** 1,5 **** ;;; timezone.el --- time zone package for GNU Emacs ! ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. ;; Author: Masanobu Umeda --- 1,5 ---- ;;; timezone.el --- time zone package for GNU Emacs ! ;; Copyright (C) 1990, 1991, 1992, 1993, 1996 Free Software Foundation, Inc. ;; Author: Masanobu Umeda *************** Understands the following styles: *** 131,136 **** (5) 22-AUG-1993 10:59:12.82 (6) Thu, 11 Apr 16:17:12 91 [MET] ! (7) Mon, 6 Jul 16:47:20 T 1992 [MET]" ! ;; Get rid of any text properties. (and (stringp date) (or (text-properties-at 0 date) --- 131,137 ---- (5) 22-AUG-1993 10:59:12.82 (6) Thu, 11 Apr 16:17:12 91 [MET] ! (7) Mon, 6 Jul 16:47:20 T 1992 [MET] ! (8) 1996-06-24 21:13:12 [GMT]" ! ;; Get rid of any text properties. (and (stringp date) (or (text-properties-at 0 date) *************** Understands the following styles: *** 176,179 **** --- 177,188 ---- ;; Styles: (5) without timezone. (setq year 3 month 2 day 1 time 4 zone nil)) + ((string-match + "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) + ;; Styles: (8) with timezone. + (setq year 1 month 2 day 3 time 4 zone 5)) + ((string-match + "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)" date) + ;; Styles: (8) without timezone. + (setq year 1 month 2 day 3 time 4 zone nil)) ) (if year *************** Understands the following styles: *** 184,194 **** (if (< (length year) 4) (setq year (concat "19" (substring year -2 nil)))) ! (let ((string (substring date ! (match-beginning month) ! (+ (match-beginning month) 3)))) ! (setq month ! (int-to-string ! (cdr (assoc (upcase string) timezone-months-assoc))))) ! (setq day (substring date (match-beginning day) (match-end day))) --- 193,207 ---- (if (< (length year) 4) (setq year (concat "19" (substring year -2 nil)))) ! (setq month ! (if (= (aref date (+ (match-beginning month) 2)) ?-) ! ;; Handle numeric months, spanning exactly two digits. ! (substring date ! (match-beginning month) ! (+ (match-beginning month) 2)) ! (let ((string (substring date ! (match-beginning month) ! (+ (match-beginning month) 3)))) ! (int-to-string ! (cdr (assoc (upcase string) timezone-months-assoc)))))) (setq day (substring date (match-beginning day) (match-end day))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/tmm.el emacs-19.32/lisp/tmm.el *** emacs-19.31/lisp/tmm.el Thu Mar 28 13:14:08 1996 --- emacs-19.32/lisp/tmm.el Fri Jun 28 03:19:36 1996 *************** the item in the minibuffer, and press RE *** 106,110 **** marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. " ! "What insert on top of completion buffer.") ;;;###autoload --- 106,112 ---- marked letters to pick up your choice. Type C-g or ESC ESC ESC to cancel. " ! "String to insert at top of completion buffer. ! If this is nil, delete even the usual help text ! and show just the alternatives.") ;;;###autoload *************** Stores a list of all the shortcuts in th *** 278,282 **** (set-buffer "*Completions*") (goto-char 1) ! (insert tmm-completion-prompt) ) (save-excursion --- 280,288 ---- (set-buffer "*Completions*") (goto-char 1) ! (if tmm-completion-prompt ! (insert tmm-completion-prompt) ! ;; Delete even the usual help info that all completion buffers have. ! (goto-char 1) ! (delete-region 1 (search-forward "Possible completions are:\n"))) ) (save-excursion diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/type-break.el emacs-19.32/lisp/type-break.el *** emacs-19.31/lisp/type-break.el Mon Jan 29 16:54:31 1996 --- emacs-19.32/lisp/type-break.el Sat Jul 20 13:38:19 1996 *************** *** 23,28 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 23,29 ---- ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/undigest.el emacs-19.32/lisp/undigest.el *** emacs-19.31/lisp/undigest.el Mon Mar 4 15:26:43 1996 --- emacs-19.32/lisp/undigest.el Thu Jun 13 13:35:11 1996 *************** This puts the forwarded message into a s *** 138,173 **** following the containing message." (interactive) ! (narrow-to-region (rmail-msgbeg rmail-current-message) ! (rmail-msgend rmail-current-message)) ! (goto-char (point-min)) ! (let (beg end (buffer-read-only nil) msg-string who-forwarded-it) ! (setq who-forwarded-it (mail-fetch-field "From")) ! (if (re-search-forward "^----" nil t) ! nil ! (error "No forwarded message")) ! (forward-line 1) ! (setq beg (point)) ! (if (re-search-forward "^----" nil t) ! (setq end (match-beginning 0)) ! (error "No terminator for forwarded message")) ! (widen) ! (setq msg-string (buffer-substring beg end)) ! (goto-char (rmail-msgend rmail-current-message)) ! (narrow-to-region (point) (point)) ! (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n") ! (narrow-to-region (point) (point)) ! (insert "Forwarded-by: " who-forwarded-it "\n") ! (insert msg-string) ! (goto-char (point-min)) ! (while (not (eobp)) ! (if (looking-at "- ") ! (delete-region (point) (+ 2 (point)))) ! (forward-line 1)) ! (let ((n rmail-current-message)) ! (rmail-forget-messages) ! (rmail-show-message n) ! (if (rmail-summary-exists) ! (rmail-select-summary ! (rmail-update-summary)))))) ;;; undigest.el ends here --- 138,182 ---- following the containing message." (interactive) ! ;; Don't use save-excursion because we don't want to restore point ! ;; in the case where we do not switch buffers. ! (let ((obuf (current-buffer))) ! (unwind-protect ! (progn ! ;; If we are in a summary buffer, switch to the Rmail buffer. ! (if (local-variable-p 'rmail-buffer) ! (set-buffer rmail-buffer)) ! (narrow-to-region (rmail-msgbeg rmail-current-message) ! (rmail-msgend rmail-current-message)) ! (goto-char (point-min)) ! (let (beg end (buffer-read-only nil) msg-string who-forwarded-it) ! (setq who-forwarded-it (mail-fetch-field "From")) ! (if (re-search-forward "^----" nil t) ! nil ! (error "No forwarded message")) ! (forward-line 1) ! (setq beg (point)) ! (if (re-search-forward "^----" nil t) ! (setq end (match-beginning 0)) ! (error "No terminator for forwarded message")) ! (widen) ! (setq msg-string (buffer-substring beg end)) ! (goto-char (rmail-msgend rmail-current-message)) ! (narrow-to-region (point) (point)) ! (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n") ! (narrow-to-region (point) (point)) ! (insert "Forwarded-by: " who-forwarded-it "\n") ! (insert msg-string) ! (goto-char (point-min)) ! (while (not (eobp)) ! (if (looking-at "- ") ! (delete-region (point) (+ 2 (point)))) ! (forward-line 1)) ! (let ((n rmail-current-message)) ! (rmail-forget-messages) ! (rmail-show-message n) ! (if (rmail-summary-exists) ! (rmail-select-summary ! (rmail-update-summary)))))) ! (set-buffer obuf)))) ;;; undigest.el ends here diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/userlock.el emacs-19.32/lisp/userlock.el *** emacs-19.31/lisp/userlock.el Sun Jan 14 02:34:30 1996 --- emacs-19.32/lisp/userlock.el Sat Jun 29 16:03:56 1996 *************** The buffer in question is current when t *** 99,103 **** (let (answer) (while (null answer) ! (message "%s changed on disk; really edit the buffer? (y, n or C-h) " (file-name-nondirectory fn)) (let ((tem (downcase (let ((cursor-in-echo-area t)) --- 99,103 ---- (let (answer) (while (null answer) ! (message "%s changed on disk; really edit the buffer? (y, n, r or C-h) " (file-name-nondirectory fn)) (let ((tem (downcase (let ((cursor-in-echo-area t)) *************** The buffer in question is current when t *** 109,120 **** (?\C-g . yield) (?y . proceed) (?? . help)))))) (cond ((null answer) (beep) ! (message "Please type y or n; or ? for help") (sit-for 3)) ((eq answer 'help) (ask-user-about-supersession-help) (setq answer nil)) ((eq answer 'yield) (signal 'file-supersession --- 109,126 ---- (?\C-g . yield) (?y . proceed) + (?r . revert) (?? . help)))))) (cond ((null answer) (beep) ! (message "Please type y, n or r; or ? for help") (sit-for 3)) ((eq answer 'help) (ask-user-about-supersession-help) (setq answer nil)) + ((eq answer 'revert) + (revert-buffer nil (not (buffer-modified-p))) + ; ask confirmation iff buffer modified + (signal 'file-supersession + (list "File reverted" fn))) ((eq answer 'yield) (signal 'file-supersession *************** since you last read it in or saved it wi *** 131,134 **** --- 137,142 ---- If you say `y' to go ahead and modify this buffer, you risk ruining the work of whoever rewrote the file. + If you say `r' to revert, the contents of the buffer are refreshed + from the file on disk. If you say `n', the change you started to make will be aborted. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/vc-hooks.el emacs-19.32/lisp/vc-hooks.el *** emacs-19.31/lisp/vc-hooks.el Thu May 9 15:45:40 1996 --- emacs-19.32/lisp/vc-hooks.el Sun Jun 23 11:39:35 1996 *************** control system name." *** 879,889 **** (concat " " (or label (symbol-name vc-type)) (and vc-display-status (vc-status file))))) (and vc-type (equal file (buffer-file-name)) (vc-locking-user file) - ;; If the file is locked by some other user, make - ;; the buffer read-only. Like this, even root - ;; cannot modify a file without locking it first. (not (string= (user-login-name) (vc-locking-user file))) (setq buffer-read-only t)) (force-mode-line-update) --- 879,899 ---- (concat " " (or label (symbol-name vc-type)) (and vc-display-status (vc-status file))))) + ;; If the file is locked by some other user, make + ;; the buffer read-only. Like this, even root + ;; cannot modify a file that someone else has locked. (and vc-type (equal file (buffer-file-name)) (vc-locking-user file) (not (string= (user-login-name) (vc-locking-user file))) + (setq buffer-read-only t)) + ;; If the user is root, and the file is not owner-writable, + ;; then pretend that we can't write it + ;; even though we can (because root can write anything). + ;; This way, even root cannot modify a file that isn't locked. + (and vc-type + (equal file (buffer-file-name)) + (not buffer-read-only) + (zerop (user-real-uid)) + (zerop (logand (file-modes (buffer-file-name)) 128)) (setq buffer-read-only t)) (force-mode-line-update) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/vc.el emacs-19.32/lisp/vc.el *** emacs-19.31/lisp/vc.el Sat May 11 14:17:13 1996 --- emacs-19.32/lisp/vc.el Fri Jul 26 17:21:31 1996 *************** to an optional list of FLAGS." *** 421,425 **** path-separator (mapconcat 'identity vc-path path-separator)) ! process-environment))) (setq status (apply 'call-process command nil t nil squeezed))) (goto-char (point-max)) --- 421,426 ---- path-separator (mapconcat 'identity vc-path path-separator)) ! process-environment)) ! (win32-quote-process-args t)) (setq status (apply 'call-process command nil t nil squeezed))) (goto-char (point-max)) *************** A prefix argument means do not revert th *** 1619,1624 **** (cond ((not (vc-registered (buffer-file-name))) ! (vc-registration-error (buffer-file-name)) ! (eq (vc-backend (buffer-file-name)) 'CVS) (error "Unchecking files under CVS is dangerous and not supported in VC")) ((vc-locking-user (buffer-file-name)) --- 1620,1625 ---- (cond ((not (vc-registered (buffer-file-name))) ! (vc-registration-error (buffer-file-name))) ! ((eq (vc-backend (buffer-file-name)) 'CVS) (error "Unchecking files under CVS is dangerous and not supported in VC")) ((vc-locking-user (buffer-file-name)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/version.el emacs-19.32/lisp/version.el *** emacs-19.31/lisp/version.el Sat May 25 15:26:52 1996 --- emacs-19.32/lisp/version.el Thu Aug 1 01:09:09 1996 *************** *** 25,29 **** ;;; Code: ! (defconst emacs-version "19.31" "\ Version numbers of this version of Emacs.") --- 25,29 ---- ;;; Code: ! (defconst emacs-version "19.32" "\ Version numbers of this version of Emacs.") diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/view.el emacs-19.32/lisp/view.el *** emacs-19.31/lisp/view.el Sun Feb 4 16:11:42 1996 --- emacs-19.32/lisp/view.el Sat Jul 20 02:14:07 1996 *************** *** 38,42 **** (defvar view-mode-auto-exit nil ! "Non-nil means scrolling past the end of buffer exits View mode.") (make-variable-buffer-local 'view-mode-auto-exit) --- 38,45 ---- (defvar view-mode-auto-exit nil ! "Non-nil means scrolling past the end of buffer exits View mode. ! Some commands, such as \\[view-file], set this to t locally; ! the only way to override that is to set it to nil using `view-mode-hook'.") ! (make-variable-buffer-local 'view-mode-auto-exit) *************** This command runs the normal hook `view- *** 185,192 **** (defun view-mode (&optional arg) "Toggle View mode. ! If you use this function to turn on View mode, ! \"exiting\" View mode does nothing except turn View mode off. ! The other way to turn View mode on is by calling ! `view-mode-enter'. Letters do not insert themselves. Instead these commands are provided. --- 188,198 ---- (defun view-mode (&optional arg) "Toggle View mode. ! With a prefix argument, turn View mode on if the argument is >= zero ! and off if it is not. ! ! If you use this function to turn on View mode, then subsequently ! \"exiting\" View mode does nothing except turn View mode off. The ! other way to turn View mode on is by calling `view-mode-enter'; ! that is what Lisp programs usually use. Letters do not insert themselves. Instead these commands are provided. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/viper-ex.el emacs-19.32/lisp/viper-ex.el *** emacs-19.31/lisp/viper-ex.el Thu Mar 28 19:39:57 1996 --- emacs-19.32/lisp/viper-ex.el Fri Jun 21 22:22:28 1996 *************** *** 103,112 **** (defvar ex-g-pat nil) ! ;; `sh' doesn't seem to expand wildcards, like `*' ! (defconst ex-find-file-shell "csh" ! "Shell in which to interpret wildcards. Must be csh, tcsh, or similar. ! Bourne shell doesn't seem to work here.") ! (defvar ex-find-file-shell-options "-f" ! "*Options to pass to `ex-find-file-shell'.") ;; Remembers the previous Ex tag. --- 103,144 ---- (defvar ex-g-pat nil) ! ! (defvar ex-unix-type-shell ! (let ((case-fold-search t)) ! (and (stringp shell-file-name) ! (string-match ! (concat ! "\\(" ! "csh$\\|csh.exe$" ! "\\|" ! "ksh$\\|ksh.exe$" ! "\\|" ! "^sh$\\|sh.exe$" ! "\\|" ! "[^a-z]sh$\\|[^a-z]sh.exe$" ! "\\|" ! "bash$\\|bash.exe$" ! "\\)") ! shell-file-name))) ! "Is the user using a unix-type shell?") ! ! (defvar ex-unix-type-shell-options ! (let ((case-fold-search t)) ! (if ex-unix-type-shell ! (cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name) ! "-f") ; csh: do it fast ! ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name) ! "-noprofile") ; bash: ignore .profile ! ))) ! "Options to pass to the Unix-style shell. ! Don't put `-c' here, as it is added automatically.") ! ! (defvar ex-nontrivial-find-file-function ! (cond (ex-unix-type-shell 'vip-ex-nontrivial-find-file-unix) ! ((eq system-type 'emx) 'vip-ex-nontrivial-find-file-ms) ; OS/2 ! (vip-ms-style-os-p 'vip-ex-nontrivial-find-file-ms) ; a Microsoft OS ! (vip-vms-os-p 'vip-ex-nontrivial-find-file-unix) ; VMS ! (t 'vip-ex-nontrivial-find-file-unix) ; presumably UNIX ! )) ;; Remembers the previous Ex tag. *************** reversed.") *** 883,888 **** (while cont (setq vip-keep-reading-filename nil ! val (read-file-name (concat prompt str) nil default-directory) ! str (concat str (if (equal val "") "" " ") val (if (equal val "") "" " "))) --- 915,922 ---- (while cont (setq vip-keep-reading-filename nil ! val (read-file-name (concat prompt str) nil default-directory)) ! (if (string-match " " val) ! (setq val (concat "\\\"" val "\\\""))) ! (setq str (concat str (if (equal val "") "" " ") val (if (equal val "") "" " "))) *************** reversed.") *** 1148,1187 **** (ex-fixup-history vip-last-ex-prompt ex-file)) ! ;; splits the string FILESPEC into substrings separated by newlines `\012' ! ;; each line assumed to be a file name. find-file's each file thus obtained. (defun ex-find-file (filespec) ! (let (f filebuf tmp-buf status) ! (if (string-match "[^a-zA-Z0-9_.-/]" filespec) ! (progn ! (save-excursion ! (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name))) ! (erase-buffer) ! (setq status ! (call-process ex-find-file-shell nil t nil ! ex-find-file-shell-options ! "-c" ! (format "echo %s | tr ' ' '\\012'" filespec))) ! (goto-char (point-min)) ! ;; Issue an error, if no match. ! (if (> status 0) ! (save-excursion ! (skip-chars-forward " \t\n\j") ! (if (looking-at "echo:") ! (vip-forward-word 1)) ! (error "%S%s" ! filespec ! (buffer-substring (point) (vip-line-pos 'end))) ! )) ! (reverse-region (point-min) (point-max)) ! (goto-char (point-min)) ! (while (not (eobp)) ! (setq f (buffer-substring (point) (vip-line-pos 'end))) ! (setq filebuf (find-file f)) ! (set-buffer tmp-buf) ; otherwise it'll be in f. ! (forward-to-indentation 1)) ! )) ! (setq filebuf (find-file-noselect (setq f filespec)))) ! (switch-to-buffer filebuf) )) ;; Ex global command --- 1182,1194 ---- (ex-fixup-history vip-last-ex-prompt ex-file)) ! ;; Splits the string FILESPEC into substrings separated by newlines. ! ;; Each line is assumed to be a file name. find-file's each file thus obtained. (defun ex-find-file (filespec) ! (let ((nonstandard-filename-chars "[^a-zA-Z0-9_.-/,\\]")) ! (if (string-match nonstandard-filename-chars filespec) ! (funcall ex-nontrivial-find-file-function filespec) ! (find-file filespec)) )) + ;; Ex global command diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/viper-macs.el emacs-19.32/lisp/viper-macs.el *** emacs-19.31/lisp/viper-macs.el Thu Mar 28 19:40:09 1996 --- emacs-19.32/lisp/viper-macs.el Fri Jun 21 21:14:44 1996 *************** there." *** 845,849 **** (defun vip-char-array-p (array) ! (eval (cons 'and (mapcar 'numberp array)))) (defun vip-macro-to-events (macro-body) --- 845,849 ---- (defun vip-char-array-p (array) ! (eval (cons 'and (mapcar 'vip-characterp array)))) (defun vip-macro-to-events (macro-body) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/viper-mous.el emacs-19.32/lisp/viper-mous.el *** emacs-19.31/lisp/viper-mous.el Thu Mar 28 19:40:14 1996 --- emacs-19.32/lisp/viper-mous.el Fri Jun 21 21:16:01 1996 *************** On single or double click, returns the w *** 193,198 **** (click-pos (vip-mouse-click-posn click)) (click-buf (vip-mouse-click-window-buffer click))) ! (or (numberp count) (setq count 1)) ! (or (numberp click-count) (setq click-count 1)) (save-excursion --- 193,198 ---- (click-pos (vip-mouse-click-posn click)) (click-buf (vip-mouse-click-window-buffer click))) ! (or (natnump count) (setq count 1)) ! (or (natnump click-count) (setq click-count 1)) (save-excursion *************** See `vip-surrounding-word' for the defin *** 221,227 **** ;; turn arg into a number ! (cond ((numberp arg) nil) ;; prefix arg is a list when one hits C-u then command ! ((and (listp arg) (numberp (car arg))) (setq arg (car arg))) (t (setq arg 1))) --- 221,227 ---- ;; turn arg into a number ! (cond ((integerp arg) nil) ;; prefix arg is a list when one hits C-u then command ! ((and (listp arg) (integerp (car arg))) (setq arg (car arg))) (t (setq arg 1))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/viper-util.el emacs-19.32/lisp/viper-util.el *** emacs-19.31/lisp/viper-util.el Thu Mar 28 19:40:21 1996 --- emacs-19.32/lisp/viper-util.el Sun Jul 21 15:29:06 1996 *************** *** 58,61 **** --- 58,66 ---- (and (vip-device-type) (not (memq (vip-device-type) '(tty stream))))) + (defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95)) + "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.") + (defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms)) + "Tells if Emacs is running under VMS.") + (defvar vip-force-faces nil "If t, Viper will think that it is running on a display that supports faces. *************** that Viper doesn't know about.") *** 185,188 **** --- 190,197 ---- ))) + (fset 'vip-characterp + (symbol-function + (if vip-xemacs-p 'characterp 'integerp))) + (defsubst vip-color-display-p () (if vip-emacs-p *************** that Viper doesn't know about.") *** 191,195 **** (defsubst vip-get-cursor-color () ! (cdr (assoc 'cursor-color (frame-parameters)))) ;; OS/2 --- 200,207 ---- (defsubst vip-get-cursor-color () ! (if vip-emacs-p ! (cdr (assoc 'cursor-color (frame-parameters))) ! (color-instance-name (frame-property (selected-frame) 'cursor-color)))) ! ;; OS/2 *************** that Viper doesn't know about.") *** 396,399 **** --- 408,548 ---- (nconc lis1 lis2))) + + + ;;; Support for :e and file globbing + + (defun vip-ex-nontrivial-find-file-unix (filespec) + "Glob the file spec and visit all files matching the spec. + This function is designed to work under Unix. It may also work under VMS. + + Users who prefer other types of shells should write their own version of this + function and set the variable `ex-nontrivial-find-file-function' + appropriately." + (let ((gshell + (cond (ex-unix-type-shell shell-file-name) + ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS + (t "sh"))) ; probably Unix anyway + (gshell-options + ;; using cond in anticipation of further additions + (cond (ex-unix-type-shell-options) + )) + (command (cond (vip-ms-style-os-p (format "\"ls -1 %s\"" filespec)) + (t (format "ls -1 %s" filespec)))) + file-list) + (save-excursion + (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name))) + (erase-buffer) + (setq status + (if gshell-options + (call-process gshell nil t nil + gshell-options + "-c" + command) + (call-process gshell nil t nil + "-c" + command))) + (goto-char (point-min)) + ;; Issue an error, if no match. + (if (> status 0) + (save-excursion + (skip-chars-forward " \t\n\j") + (if (looking-at "ls:") + (vip-forward-Word 1)) + (error "%s: %s" + (if (stringp gshell) + gshell + "shell") + (buffer-substring (point) (vip-line-pos 'end))) + )) + (goto-char (point-min)) + (setq file-list (vip-get-filenames-from-buffer 'one-per-line))) + + (mapcar 'find-file file-list) + )) + + (defun vip-ex-nontrivial-find-file-ms (filespec) + "Glob the file spec and visit all files matching the spec. + This function is designed to work under MS type systems, such as NT, W95, and + DOS. It may also work under OS/2. + + The users of Unix-type shells should be able to use + `vip-ex-nontrivial-find-file-unix', making it into the value of the variable + `ex-nontrivial-find-file-function'. If this doesn't work, the user may have + to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'." + (save-excursion + (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name))) + (erase-buffer) + (insert filespec) + (goto-char (point-min)) + (mapcar 'find-file + (vip-glob-ms-windows-files (vip-get-filenames-from-buffer))) + )) + + + ;; Interpret the stuff in the buffer as a list of file names + ;; return a list of file names listed in the buffer beginning at point + ;; If optional arg is supplied, assume each filename is listed on a separate + ;; line + (defun vip-get-filenames-from-buffer (&optional one-per-line) + (let ((skip-chars (if one-per-line "\t\n" " \t\n")) + result fname delim) + (skip-chars-forward skip-chars) + (while (not (eobp)) + (if (cond ((looking-at "\"") + (setq delim ?\") + (re-search-forward "[^\"]+" nil t)) ; noerror + ((looking-at "'") + (setq delim ?') + (re-search-forward "[^']+" nil t)) ; noerror + (t + (re-search-forward + (concat "[^" skip-chars "]+") nil t))) ;noerror + (setq fname + (buffer-substring (match-beginning 0) (match-end 0)))) + (if delim + (forward-char 1)) + (skip-chars-forward " \t\n") + (setq result (cons fname result))) + result)) + + ;; convert MS-DOS wildcards to regexp + (defun vip-wildcard-to-regexp (wcard) + (save-excursion + (set-buffer (setq tmp-buf (get-buffer-create vip-ex-tmp-buf-name))) + (erase-buffer) + (insert wcard) + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward "^*?.\\\\") + (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1)) + ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1)) + ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1)) + ((eq (char-after (point)) ??) (delete-char 1)(insert "."))) + ) + (buffer-string) + )) + + + ;; glob windows files + ;; LIST is expected to be in reverse order + (defun vip-glob-ms-windows-files (list) + (let ((tmp list) + (case-fold-search t) + tmp2) + (while tmp + (setq tmp2 (cons (directory-files + ;; the directory part + (or (file-name-directory (car tmp)) + "") + t ; return full names + ;; the regexp part: globs the file names + (concat "^" + (vip-wildcard-to-regexp + (file-name-nondirectory (car tmp))) + "$")) + tmp2)) + (setq tmp (cdr tmp))) + (reverse (apply 'append tmp2)))) + *************** that Viper doesn't know about.") *** 794,806 **** ;; This function lets function-key-map convert key sequences into logical ;; keys. This does a better job than vip-read-event when it comes to kbd ! ;; macros, since it enables certain macros to be shared between X and TTY ! ;; modes. (defun vip-read-key () (let ((overriding-local-map vip-overriding-map) key) (use-global-map vip-overriding-map) (setq key (elt (read-key-sequence nil) 0)) (use-global-map global-map) ! key)) --- 943,957 ---- ;; This function lets function-key-map convert key sequences into logical ;; keys. This does a better job than vip-read-event when it comes to kbd ! ;; macros, since it enables certain macros to be shared between X and TTY modes ! ;; by correctly mapping key sequences for Left/Right/... (one an ascii ! ;; terminal) into logical keys left, right, etc. (defun vip-read-key () (let ((overriding-local-map vip-overriding-map) + (inhibit-quit t) key) (use-global-map vip-overriding-map) (setq key (elt (read-key-sequence nil) 0)) (use-global-map global-map) ! key)) *************** that Viper doesn't know about.") *** 826,830 **** ;; \S-a isn't considered the same as A (it behaves as ;; plain `a' instead). So we take care of this here ! (cond ((and (numberp event) (<= ?A event) (<= event ?Z)) (setq mod nil event event)) --- 977,981 ---- ;; \S-a isn't considered the same as A (it behaves as ;; plain `a' instead). So we take care of this here ! (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z)) (setq mod nil event event)) *************** that Viper doesn't know about.") *** 832,841 **** ;; represent M-char *if* this appears inside a string. ;; So, we convert them manually to (meta char). ! ((and (numberp event) (< ?\C-? event) (<= event 255)) (setq mod '(meta) event (- event ?\C-? 1))) (t (event-basic-type event))) ))) ! (if (numberp basis) (setq basis (if (= basis ?\C-?) --- 983,992 ---- ;; represent M-char *if* this appears inside a string. ;; So, we convert them manually to (meta char). ! ((and (vip-characterp event) (< ?\C-? event) (<= event 255)) (setq mod '(meta) event (- event ?\C-? 1))) (t (event-basic-type event))) ))) ! (if (vip-characterp basis) (setq basis (if (= basis ?\C-?) *************** that Viper doesn't know about.") *** 885,898 **** ;; representing a vector of converted events. If the input was a Viper macro, ;; will return a string that represents this macro as a vector. ! (defun vip-array-to-string (event-seq &optional representation) ! (let (temp) (cond ((stringp event-seq) event-seq) ((vip-event-vector-p event-seq) (setq temp (mapcar 'vip-event-key event-seq)) ! (if (vip-char-symbol-sequence-p temp) ! (mapconcat 'symbol-name temp "") ! (prin1-to-string (vconcat temp)))) ((vip-char-symbol-sequence-p event-seq) (mapconcat 'symbol-name event-seq "")) (t (prin1-to-string event-seq))))) --- 1036,1056 ---- ;; representing a vector of converted events. If the input was a Viper macro, ;; will return a string that represents this macro as a vector. ! (defun vip-array-to-string (event-seq) ! (let (temp temp2) (cond ((stringp event-seq) event-seq) ((vip-event-vector-p event-seq) (setq temp (mapcar 'vip-event-key event-seq)) ! (cond ((vip-char-symbol-sequence-p temp) ! (mapconcat 'symbol-name temp "")) ! ((and (vip-char-array-p ! (setq temp2 (mapcar 'vip-key-to-character temp)))) ! (mapconcat 'char-to-string temp2 "")) ! (t (prin1-to-string (vconcat temp))))) ((vip-char-symbol-sequence-p event-seq) (mapconcat 'symbol-name event-seq "")) + ((and (vectorp event-seq) + (vip-char-array-p + (setq temp (mapcar 'vip-key-to-character event-seq)))) + (mapconcat 'char-to-string temp "")) (t (prin1-to-string event-seq))))) *************** that Viper doesn't know about.") *** 920,923 **** --- 1078,1096 ---- char)) + ;; key is supposed to be in viper's representation, e.g., (control l), a + ;; character, etc. + (defun vip-key-to-character (key) + (cond ((eq key 'space) ?\ ) + ((eq key 'delete) ?\C-?) + ((eq key 'backspace) ?\C-h) + ((and (symbolp key) + (= 1 (length (symbol-name key)))) + (string-to-char (symbol-name key))) + ((and (listp key) + (eq (car key) 'control) + (symbol-name (nth 1 key)) + (= 1 (length (symbol-name (nth 1 key))))) + (read (format "?\\C-%s" (symbol-name (nth 1 key))))) + (t key))) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/viper.el emacs-19.32/lisp/viper.el *** emacs-19.31/lisp/viper.el Thu Mar 28 19:40:39 1996 --- emacs-19.32/lisp/viper.el Sun Jul 21 15:29:14 1996 *************** *** 9,13 **** ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ! (defconst viper-version "2.86 of March 14, 1996" "The current version of Viper") --- 9,13 ---- ;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. ! (defconst viper-version "2.90 of June 19, 1996" "The current version of Viper") *************** *** 25,30 **** ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. ;;; Commentary: --- 25,31 ---- ;; You should have received a copy of the GNU General Public License ! ;; along with GNU Emacs; see the file COPYING. If not, write to the ! ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ! ;; Boston, MA 02111-1307, USA. ;;; Commentary: *************** *** 89,93 **** ;; one global, several definitions for various major modes, and ;; definitions for specific buffers. ! ;; Bffer-specific definitions override mode-specific ;; definitions, which, in turn, override global definitions. ;; --- 90,94 ---- ;; one global, several definitions for various major modes, and ;; definitions for specific buffers. ! ;; Buffer-specific definitions override mode-specific ;; definitions, which, in turn, override global definitions. ;; *************** *** 101,106 **** ;;; Acknowledgements: ;; ----------------- ! ;; Bug reports and ideas contributed by the following users ! ;; have helped improve Viper and the various versions of VIP. ;; See the on-line manual for a complete list of contributors. ;; --- 102,107 ---- ;;; Acknowledgements: ;; ----------------- ! ;; Bug reports and ideas contributed by many users have helped ! ;; improve Viper and the various versions of VIP. ;; See the on-line manual for a complete list of contributors. ;; *************** *** 156,161 **** ;; and so many of the goodies of Emacs are not available. ;; ! ;; An skilled user, should set vip-expert-level to at least 3. This will ! ;; enable ;; C-c and many Emacs facilities will become available. ;; In this case, vip-vi-diehard-minor-mode is inactive. ;; --- 157,162 ---- ;; and so many of the goodies of Emacs are not available. ;; ! ;; A skilled user should set vip-expert-level to at least 3. This will ! ;; enable `C-c' and many Emacs facilities will become available. ;; In this case, vip-vi-diehard-minor-mode is inactive. ;; *************** These buffers can be cycled through via *** 821,826 **** "t means, arrange that vi-state will be a default.") ! (defvar vip-custom-file-name (cond ((memq system-type '(vax-vms axp-vms)) ! "sys$login:.vip") ((memq system-type '(emx ms-dos)) "/_vip") --- 822,826 ---- "t means, arrange that vi-state will be a default.") ! (defvar vip-custom-file-name (cond (vip-vms-os-p "sys$login:.vip") ((memq system-type '(emx ms-dos)) "/_vip") *************** These buffers can be cycled through via *** 832,835 **** --- 832,836 ---- This variable must be set _before_ loading Viper.") + (defvar vip-spell-function 'ispell-region "Spell function used by #s command to spell.") *************** XEmacs 19. It supports virtually all of *** 1258,1274 **** and improving upon much of it. ! 1. Viper supports Vi at several levels. Level 1 is the closest to ! Vi, level 5 provides the most flexibility to depart from many Vi ! conventions. You will be asked to specify your user level in a following screen. ! If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will ! behave as in VI, to smooth transition to Viper for the beginners. ! However, to use Emacs productively, you are advised to reach user ! level 3 or higher. If your user level is 2 or higher, ^X and ^C will invoke Emacs ! functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and ^G will be the usual Emacs's keyboard-quit (something like ^C in VI). --- 1259,1273 ---- and improving upon much of it. ! 1. Viper supports Vi at several levels. Level 1 is the closest to Vi, ! level 5 provides the most flexibility to depart from many Vi conventions. You will be asked to specify your user level in a following screen. ! If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will behave ! as in VI, to smooth transition to Viper for the beginners. However, to ! use Emacs productively, you are advised to reach user level 3 or higher. If your user level is 2 or higher, ^X and ^C will invoke Emacs ! functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and ^G will be the usual Emacs's keyboard-quit (something like ^C in VI). *************** and improving upon much of it. *** 1281,1287 **** 6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'. On a window system, the best way is to use the Meta-key. ! 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly, ! if something funny happens. This would abort the current editing ! command. You can get more information on Viper by: --- 1280,1285 ---- 6. Emacs Meta functions are invoked by typing `_' or `\\ ESC'. On a window system, the best way is to use the Meta-key. ! 7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,if ! something funny happens. This would abort the current editing command. You can get more information on Viper by: *************** This startup message appears whenever yo *** 1299,1304 **** "Viper startup message inhibited" vip-custom-file-name t)) ! (kill-buffer (current-buffer)))) ! (message " ") (vip-set-expert-level 'dont-change-unless))) (vip-change-state-to-vi)))) --- 1297,1305 ---- "Viper startup message inhibited" vip-custom-file-name t)) ! ;;(kill-buffer (current-buffer)) ! (message ! "The last message is in buffer `Viper Startup Message'") ! (sit-for 4) ! )) (vip-set-expert-level 'dont-change-unless))) (vip-change-state-to-vi)))) *************** behaves as in Emacs, any number of multi *** 1792,1797 **** (let (value) ;; read while number ! (while (and (numberp event) (>= event ?0) (<= event ?9)) ! (setq value (+ (* (if (numberp value) value 0) 10) (- event ?0))) (setq event (vip-read-event-convert-to-char))) --- 1793,1798 ---- (let (value) ;; read while number ! (while (and (vip-characterp event) (>= event ?0) (<= event ?9)) ! (setq value (+ (* (if (vip-characterp value) value 0) 10) (- event ?0))) (setq event (vip-read-event-convert-to-char))) *************** behaves as in Emacs, any number of multi *** 1902,1910 **** (cond ((null arg) nil) ((consp arg) (car arg)) ! ((numberp arg) arg) (t (error vip-InvalidCommandArgument))) (cond ((null arg) nil) ((consp arg) (cdr arg)) ! ((numberp arg) nil) (t (error vip-InvalidCommandArgument)))) (quit (setq vip-use-register nil) --- 1903,1911 ---- (cond ((null arg) nil) ((consp arg) (car arg)) ! ((integerp arg) arg) (t (error vip-InvalidCommandArgument))) (cond ((null arg) nil) ((consp arg) (cdr arg)) ! ((integerp arg) nil) (t (error vip-InvalidCommandArgument)))) (quit (setq vip-use-register nil) *************** controlled by the sign of prefix numeric *** 3560,3564 **** (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively --- 3561,3566 ---- (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg)) ! (cmd-representation (nth 5 vip-d-com))) (if (> val 0) ;; this means that the function was called interactively *************** controlled by the sign of prefix numeric *** 3567,3572 **** vip-f-offset nil) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp (nth 5 vip-d-com)) ! (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) --- 3569,3574 ---- vip-f-offset nil) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp cmd-representation) ! (vip-seq-last-elt cmd-representation) vip-F-char) vip-f-char vip-F-char) *************** controlled by the sign of prefix numeric *** 3585,3589 **** (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively --- 3587,3592 ---- (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg)) ! (cmd-representation (nth 5 vip-d-com))) (if (> val 0) ;; this means that the function was called interactively *************** controlled by the sign of prefix numeric *** 3592,3597 **** vip-f-offset t) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp (nth 5 vip-d-com)) ! (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) --- 3595,3600 ---- vip-f-offset t) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp cmd-representation) ! (vip-seq-last-elt cmd-representation) vip-F-char) vip-f-char vip-F-char) *************** controlled by the sign of prefix numeric *** 3610,3614 **** (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively --- 3613,3618 ---- (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg)) ! (cmd-representation (nth 5 vip-d-com))) (if (> val 0) ;; this means that the function was called interactively *************** controlled by the sign of prefix numeric *** 3617,3622 **** vip-f-offset nil) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp (nth 5 vip-d-com)) ! (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) --- 3621,3626 ---- vip-f-offset nil) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp cmd-representation) ! (vip-seq-last-elt cmd-representation) vip-F-char) vip-f-char vip-F-char) *************** controlled by the sign of prefix numeric *** 3635,3639 **** (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg))) (if (> val 0) ;; this means that the function was called interactively --- 3639,3644 ---- (interactive "P") (let ((val (vip-p-val arg)) ! (com (vip-getcom arg)) ! (cmd-representation (nth 5 vip-d-com))) (if (> val 0) ;; this means that the function was called interactively *************** controlled by the sign of prefix numeric *** 3642,3647 **** vip-f-offset t) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp (nth 5 vip-d-com)) ! (vip-seq-last-elt (nth 5 vip-d-com)) vip-F-char) vip-f-char vip-F-char) --- 3647,3652 ---- vip-f-offset t) ;; vip-repeat --- set vip-F-char from command-keys ! (setq vip-F-char (if (stringp cmd-representation) ! (vip-seq-last-elt cmd-representation) vip-F-char) vip-f-char vip-F-char) *************** controlled by the sign of prefix numeric *** 3777,3782 **** "Go to the matching parenthesis." (interactive "P") ! (let ((com (vip-getcom arg))) ! (if (numberp arg) (if (or (> arg 99) (< arg 1)) (error "Prefix must be between 1 and 99") --- 3782,3788 ---- "Go to the matching parenthesis." (interactive "P") ! (let ((com (vip-getcom arg)) ! anchor-point) ! (if (integerp arg) (if (or (> arg 99) (< arg 1)) (error "Prefix must be between 1 and 99") *************** controlled by the sign of prefix numeric *** 3786,3797 **** (/ (* (point-max) arg) 100))) (back-to-indentation)) ! (let (lim) (if (and (eolp) (not (bolp))) (forward-char -1)) (save-excursion (end-of-line) ! (setq lim (point))) ! (if (re-search-forward "[][(){}]" lim t) ! (backward-char) ! (error "No matching character on line"))) (cond ((looking-at "[\(\[{]") (if com (vip-move-marker-locally 'vip-com-point (point))) --- 3792,3809 ---- (/ (* (point-max) arg) 100))) (back-to-indentation)) ! (let (beg-lim end-lim) (if (and (eolp) (not (bolp))) (forward-char -1)) + (if (not (looking-at "[][(){}]")) + (setq anchor-point (point))) (save-excursion + (beginning-of-line) + (setq beg-lim (point)) (end-of-line) ! (setq end-lim (point))) ! (cond ((re-search-forward "[][(){}]" end-lim t) ! (backward-char) ) ! ((re-search-backward "[][(){}]" beg-lim t)) ! (t ! (error "No matching character on line")))) (cond ((looking-at "[\(\[{]") (if com (vip-move-marker-locally 'vip-com-point (point))) *************** controlled by the sign of prefix numeric *** 3800,3803 **** --- 3812,3822 ---- (vip-execute-com 'vip-paren-match nil com) (backward-char))) + (anchor-point + (if com + (progn + (vip-move-marker-locally 'vip-com-point anchor-point) + (forward-char 1) + (vip-execute-com 'vip-paren-match nil com) + ))) ((looking-at "[])}]") (forward-char) *************** cursor move past the beginning of line." *** 4532,4536 **** (kill-region (vip-replace-start) (vip-replace-end)) ! (vip-restore-cursor-color) (vip-change-state-to-insert)) (error ;; make sure that the overlay doesn't stay. --- 4551,4555 ---- (kill-region (vip-replace-start) (vip-replace-end)) ! (vip-hide-replace-overlay) (vip-change-state-to-insert)) (error ;; make sure that the overlay doesn't stay. *************** sensitive for VI-style look-and-feel." *** 4917,4921 **** (interactive) ! (if (not (numberp vip-expert-level)) (setq vip-expert-level 0)) (save-window-excursion --- 4936,4940 ---- (interactive) ! (if (not (natnump vip-expert-level)) (setq vip-expert-level 0)) (save-window-excursion *************** Mail anyway (y or n)? ") *** 5311,5315 **** unread-command-events (append ! (cond ((numberp arg) (list (character-to-event arg))) ((eventp arg) (list arg)) ((stringp arg) (mapcar 'character-to-event arg)) --- 5330,5334 ---- unread-command-events (append ! (cond ((vip-characterp arg) (list (character-to-event arg))) ((eventp arg) (list arg)) ((stringp arg) (mapcar 'character-to-event arg)) *************** Mail anyway (y or n)? ") *** 5324,5328 **** (mapcar (function (lambda (elt) ! (cond ((numberp elt) (character-to-event elt)) ((eventp elt) elt) (t (error --- 5343,5347 ---- (mapcar (function (lambda (elt) ! (cond ((vip-characterp elt) (character-to-event elt)) ((eventp elt) elt) (t (error *************** Mail anyway (y or n)? ") *** 5378,5417 **** (vip-change-state-to-vi)) ! (defvar makefile-mode-hook nil) (add-hook 'makefile-mode-hook 'viper-mode) ! (defvar help-mode-hook nil) (add-hook 'help-mode-hook 'viper-mode) ! (defvar awk-mode-hook nil) (add-hook 'awk-mode-hook 'viper-mode) ! (defvar html-mode-hook nil) (add-hook 'html-mode-hook 'viper-mode) ! (defvar html-helper-mode-hook nil) (add-hook 'html-helper-mode-hook 'viper-mode) ! (defvar emacs-lisp-mode-hook nil) (add-hook 'emacs-lisp-mode-hook 'viper-mode) ! (defvar lisp-mode-hook nil) (add-hook 'lisp-mode-hook 'viper-mode) ! (defvar bibtex-mode-hook nil) (add-hook 'bibtex-mode-hook 'viper-mode) ! (defvar cc-mode-hook nil) (add-hook 'cc-mode-hook 'viper-mode) ! (defvar c-mode-hook nil) (add-hook 'c-mode-hook 'viper-mode) ! (defvar c++-mode-hook nil) (add-hook 'c++-mode-hook 'viper-mode) ! (defvar lisp-interaction-mode-hook nil) (add-hook 'lisp-interaction-mode-hook 'viper-mode) ! (defvar text-mode-hook nil) (add-hook 'text-mode-hook 'viper-mode) --- 5397,5439 ---- (vip-change-state-to-vi)) ! (defvar makefile-mode-hook) (add-hook 'makefile-mode-hook 'viper-mode) ! (defvar help-mode-hook) (add-hook 'help-mode-hook 'viper-mode) ! (defvar awk-mode-hook) (add-hook 'awk-mode-hook 'viper-mode) ! (defvar html-mode-hook) (add-hook 'html-mode-hook 'viper-mode) ! (defvar html-helper-mode-hook) (add-hook 'html-helper-mode-hook 'viper-mode) ! (defvar emacs-lisp-mode-hook) (add-hook 'emacs-lisp-mode-hook 'viper-mode) ! (defvar lisp-mode-hook) (add-hook 'lisp-mode-hook 'viper-mode) ! (defvar bibtex-mode-hook) (add-hook 'bibtex-mode-hook 'viper-mode) ! (defvar cc-mode-hook) (add-hook 'cc-mode-hook 'viper-mode) ! (defvar c-mode-hook) (add-hook 'c-mode-hook 'viper-mode) ! (defvar c++-mode-hook) (add-hook 'c++-mode-hook 'viper-mode) ! (defvar lisp-interaction-mode-hook) (add-hook 'lisp-interaction-mode-hook 'viper-mode) + + (defvar fortran-mode-hook) + (add-hook 'fortran-mode-hook 'vip-mode) ! (defvar text-mode-hook) (add-hook 'text-mode-hook 'viper-mode) *************** Mail anyway (y or n)? ") *** 5422,5426 **** (add-hook 'tcl-mode-hook 'viper-mode) ! (defvar emerge-startup-hook nil) (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs) ;; Run vip-change-state-to-vi after quitting emerge. --- 5444,5448 ---- (add-hook 'tcl-mode-hook 'viper-mode) ! (defvar emerge-startup-hook) (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs) ;; Run vip-change-state-to-vi after quitting emerge. *************** Mail anyway (y or n)? ") *** 5456,5467 **** ;; Emacs shell, ange-ftp, and comint-based modes ! (defvar comint-mode-hook nil) (add-hook 'comint-mode-hook 'vip-change-state-to-insert) (add-hook 'comint-mode-hook 'vip-comint-mode-hook) ;; Shell scripts ! (defvar sh-mode-hook nil) (add-hook 'sh-mode-hook 'viper-mode) ! (defvar ksh-mode-hook nil) (add-hook 'ksh-mode-hook 'viper-mode) --- 5478,5489 ---- ;; Emacs shell, ange-ftp, and comint-based modes ! (defvar comint-mode-hook) (add-hook 'comint-mode-hook 'vip-change-state-to-insert) (add-hook 'comint-mode-hook 'vip-comint-mode-hook) ;; Shell scripts ! (defvar sh-mode-hook) (add-hook 'sh-mode-hook 'viper-mode) ! (defvar ksh-mode-hook) (add-hook 'ksh-mode-hook 'viper-mode) *************** Mail anyway (y or n)? ") *** 5472,5491 **** (if vip-emacs-p (progn ! (defvar view-mode-hook nil ! "View hook. Run after view mode.") (add-hook 'view-mode-hook 'vip-change-state-to-emacs)) (defadvice view-minor-mode (after vip-view-ad activate) "Switch to Emacs state in View mode." (vip-change-state-to-emacs)) ! (defvar view-hook nil ! "View hook. Run after view mode.") (add-hook 'view-hook 'vip-change-state-to-emacs)) ;; For VM users. ;; Put summary and other VM buffers in Emacs state. ! (defvar vm-mode-hooks nil ! "This hook is run after vm is started.") ! (defvar vm-summary-mode-hooks nil ! "This hook is run after vm switches to summary mode.") (add-hook 'vm-mode-hooks 'vip-change-state-to-emacs) (add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs) --- 5494,5509 ---- (if vip-emacs-p (progn ! (defvar view-mode-hook) (add-hook 'view-mode-hook 'vip-change-state-to-emacs)) (defadvice view-minor-mode (after vip-view-ad activate) "Switch to Emacs state in View mode." (vip-change-state-to-emacs)) ! (defvar view-hook) (add-hook 'view-hook 'vip-change-state-to-emacs)) ;; For VM users. ;; Put summary and other VM buffers in Emacs state. ! (defvar vm-mode-hooks) ! (defvar vm-summary-mode-hooks) (add-hook 'vm-mode-hooks 'vip-change-state-to-emacs) (add-hook 'vm-summary-mode-hooks 'vip-change-state-to-emacs) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/winnt.el emacs-19.32/lisp/winnt.el *** emacs-19.31/lisp/winnt.el Sat May 18 16:09:04 1996 --- emacs-19.32/lisp/winnt.el Tue Jul 23 12:16:40 1996 *************** *** 64,67 **** --- 64,71 ---- (setq shell-command-switch "/c") + ;; For appending suffixes to directories and files in shell completions. + (add-hook 'shell-mode-hook + '(lambda () (setq comint-completion-addsuffix '("\\" . " ")))) + ;; Use ";" instead of ":" as a path separator (from files.el). (setq path-separator ";") *************** *** 89,94 **** ("\\.tp[ulpw]$" . t) ; Borland Pascal stuff - ("[:/]tags$" . t) - ; Emacs TAGS file ) "*Alist for distinguishing text files from binary files. --- 93,96 ---- *************** against the file name, and TYPE is nil f *** 147,154 **** ;; Really should provide this capability at the drive letter granularity. (defun using-unix-filesystems (flag) ! "Read and write all files assuming that they are on a drive attached ! to a remote Unix file system. No CR/LF translation is done on any files ! in this case. This behavior is activated when FLAG is t and deactived ! when FLAG is any other value." (if flag (progn --- 149,155 ---- ;; Really should provide this capability at the drive letter granularity. (defun using-unix-filesystems (flag) ! "Read and write files without CR/LF translation, if FLAG is non-nil. ! This is in effect assuming the files are on a remote Unix file system. ! If FLAG is nil, resume using CR/LF translation as usual." (if flag (progn *************** when FLAG is any other value." *** 159,163 **** (remove-hook 'after-save-hook 'revert-from-unix-hook)))) ! ;;; Avoid creating auto-save file names containing illegal characters ;;; (primarily "*", eg. for the *mail* buffer). (fset 'original-make-auto-save-file-name --- 160,164 ---- (remove-hook 'after-save-hook 'revert-from-unix-hook)))) ! ;;; Avoid creating auto-save file names containing invalid characters ;;; (primarily "*", eg. for the *mail* buffer). (fset 'original-make-auto-save-file-name *************** See also `auto-save-file-name-p'." *** 178,183 **** ;;; Fix interface to (X-specific) mouse.el ! (defalias 'x-set-selection 'ignore) ! (fset 'x-get-selection '(lambda (&rest rest) "")) (fmakunbound 'font-menu-add-default) (global-unset-key [C-down-mouse-1]) --- 179,190 ---- ;;; Fix interface to (X-specific) mouse.el ! (defun x-set-selection (type data) ! (or type (setq type 'PRIMARY)) ! (put 'x-selections type data)) ! ! (defun x-get-selection (&optional type data-type) ! (or type (setq type 'PRIMARY)) ! (get 'x-selections type)) ! (fmakunbound 'font-menu-add-default) (global-unset-key [C-down-mouse-1]) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lisp/xt-mouse.el emacs-19.32/lisp/xt-mouse.el *** emacs-19.31/lisp/xt-mouse.el Mon Mar 4 16:22:25 1996 --- emacs-19.32/lisp/xt-mouse.el Tue Jun 4 17:51:35 1996 *************** *** 125,128 **** --- 125,132 ---- (move-to-window-line (cdr where)) (move-to-column (+ (car where) (current-column) + (if (string-match "\\` \\*Minibuf" + (buffer-name)) + (- (minibuffer-prompt-width)) + 0) (max 0 (1- (window-hscroll))))) (point)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lwlib/ChangeLog emacs-19.32/lwlib/ChangeLog *** emacs-19.31/lwlib/ChangeLog Sat May 25 15:31:38 1996 --- emacs-19.32/lwlib/ChangeLog Wed Jul 31 15:10:20 1996 *************** *** 1,2 **** --- 1,40 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + Wed Jul 31 12:48:46 1996 Marcus Daniels + + * lwlib-Xm.c (make_menubar): Turn off menu accelerator. + + Wed Jul 24 07:26:26 1996 Marcus Daniels + + * lwlib.c (merge_widget_value) [USE_MOTIF]: Pass along the change + flag from merged_contents. + + Sat Jul 13 14:50:46 1996 Karl Heuer + + * lwlib-Xm.c (xm_update_menu): Fix loop termination test. + + Sun Jul 7 18:54:35 1996 Karl Heuer + + * lwlib-Xm.h, lwlib-Xm.c, lwlib.h, lwlib.c: Undo previous change. + + Wed Jul 3 01:09:22 1996 Marcus Daniels + + * lwlib-Xm.h: Declare lw_motif_menu_related_event_p. + + * lwlib-Xm.c (lw_motif_menu_related_event_p): A predicate to + identify keyboard events intended only for menus. + + * lwlib.h: Declare lw_toolkit_related_event_p. + + * lwlib.c (lw_toolkit_related_event_p): A predicate to identify + toolkit-specific events. + + Fri Jun 7 13:14:02 1996 Marcus Daniels + + * lwlib-Xm.c (make_menu_in_widget): Set mapping delay + for cascade buttons to zero. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lwlib/lwlib-Xm.c emacs-19.32/lwlib/lwlib-Xm.c *** emacs-19.31/lwlib/lwlib-Xm.c Sun Mar 31 19:14:11 1996 --- emacs-19.32/lwlib/lwlib-Xm.c Wed Jul 31 12:49:52 1996 *************** make_menu_in_widget (instance, widget, v *** 441,445 **** menu = XmCreatePulldownMenu (widget, cur->name, NULL, 0); make_menu_in_widget (instance, menu, cur->contents, 0); ! XtSetArg (al [ac], XmNsubMenuId, menu); ac++; button = XmCreateCascadeButtonGadget (widget, cur->name, al, ac); --- 441,448 ---- menu = XmCreatePulldownMenu (widget, cur->name, NULL, 0); make_menu_in_widget (instance, menu, cur->contents, 0); ! XtSetArg (al [ac], XmNsubMenuId, menu); ac++; ! /* non-zero values don't work reliably in ! conjunction with Emacs' event loop */ ! XtSetArg (al [ac], XmNmappingDelay, 0); ac++; button = XmCreateCascadeButtonGadget (widget, cur->name, al, ac); *************** xm_update_menu (instance, widget, val, d *** 551,555 **** if (children) { ! for (i = 0, cur = val->contents; i < num_children; i++, cur = cur->next) { --- 554,560 ---- if (children) { ! for (i = 0, cur = val->contents; ! (i < num_children ! && cur); /* how else to ditch unwanted children ?? - mgd */ i++, cur = cur->next) { *************** xm_create_dialog (instance) *** 1263,1271 **** } static Widget make_menubar (instance) widget_instance* instance; { ! return XmCreateMenuBar (instance->parent, instance->info->name, NULL, 0); } --- 1268,1284 ---- } + /* Create a menu bar. We turn off the f10 key + because we have not yet managed to make it work right in Motif. */ + static Widget make_menubar (instance) widget_instance* instance; { ! Arg al[1]; ! int ac; ! ! ac = 0; ! XtSetArg(al[0], XmNmenuAccelerator, 0); ! return XmCreateMenuBar (instance->parent, instance->info->name, al, 1); } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lwlib/lwlib.c emacs-19.32/lwlib/lwlib.c *** emacs-19.31/lwlib/lwlib.c Sun Mar 24 07:18:36 1996 --- emacs-19.32/lwlib/lwlib.c Sat Jul 27 12:19:48 1996 *************** merge_widget_value (val1, val2, level) *** 527,530 **** --- 527,533 ---- 0, 0); change = max (change, INVISIBLE_CHANGE); + #ifdef USE_MOTIF + change = max (merged_contents->change, change); + #endif } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/lwlib/xlwmenu.c emacs-19.32/lwlib/xlwmenu.c *** emacs-19.31/lwlib/xlwmenu.c Fri Mar 1 14:39:57 1996 --- emacs-19.32/lwlib/xlwmenu.c Sat Jul 20 14:10:08 1996 *************** GNU General Public License for more deta *** 15,20 **** You should have received a copy of the GNU General Public License ! Alongalong with GNU Emacs; see the file COPYING. If not, write to ! the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Created by devin@lucid.com */ --- 15,21 ---- 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. */ /* Created by devin@lucid.com */ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/make-dist emacs-19.32/make-dist *** emacs-19.31/make-dist Fri May 3 17:46:43 1996 --- emacs-19.32/make-dist Sat Jul 20 13:58:03 1996 *************** *** 22,27 **** # # 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, 675 Mass Ave, Cambridge, MA 02139, USA. progname="$0" --- 22,28 ---- # # 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. progname="$0" *************** fi *** 127,130 **** --- 128,138 ---- rm -f /tmp/el /tmp/elc + ### Check for .el files that would overflow the 14-char limit if compiled. + long=`find lisp -name '[a-zA-Z0-9]??????????*.el' -print` + if [ "$long" != "" ]; then + echo "The following .el file names are too long:" + echo "$long" + fi + ### Make sure configure is newer than configure.in. if [ "x`ls -t configure configure.in | head -1`" != "xconfigure" ]; then *************** if [ "x`ls -t configure configure.in | h *** 133,139 **** autoconf || { x=$?; echo Autoconf FAILED! >&2; exit $x; } fi - - ### Update getdate.c. - (cd lib-src; make -f Makefile getdate.c YACC="bison -y") echo "Updating Info files" --- 141,144 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/ChangeLog emacs-19.32/man/ChangeLog *** emacs-19.31/man/ChangeLog Sat May 25 15:31:49 1996 --- emacs-19.32/man/ChangeLog Wed Jul 31 15:10:55 1996 *************** *** 1,2 **** --- 1,26 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + Thu Jun 27 18:23:13 1996 Lars Magne Ingebrigtsen + + * Makefile.in: Add rules for the Message manual. + + Wed Jun 26 14:36:26 1996 Lars Magne Ingebrigtsen + + * gnus.texi: New version. + + * message.texi: New manual. + + Thu Jun 20 17:17:14 1996 Richard Stallman + + * Makefile.in (All info targets): cd $(srcdir) to do the work. + + Wed Jun 19 17:27:01 1996 Richard Stallman + + * Makefile.in (All info targets): Specify $(srcdir) in input files. + Specify -I option. + (All dvi targets): Set the TEXINPUTS variable. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/Makefile.in emacs-19.32/man/Makefile.in *** emacs-19.31/man/Makefile.in Sat Feb 17 23:54:37 1996 --- emacs-19.32/man/Makefile.in Thu Jun 27 18:27:19 1996 *************** MAKEINFO = makeinfo *** 15,21 **** INFO_TARGETS = ../info/emacs ../info/ccmode ../info/cl ../info/dired-x \ ../info/ediff ../info/forms ../info/gnus ../info/info \ ! ../info/mh-e ../info/sc ../info/vip ../info/viper DVI_TARGETS = emacs.dvi cc-mode.dvi cl.dvi dired-x.dvi ediff.dvi forms.dvi \ ! gnus.dvi mh-e.dvi sc.dvi vip.dvi viper.dvi INFOSOURCES = info.texi info-stnd.texi --- 15,22 ---- INFO_TARGETS = ../info/emacs ../info/ccmode ../info/cl ../info/dired-x \ ../info/ediff ../info/forms ../info/gnus ../info/info \ ! ../info/mh-e ../info/sc ../info/vip ../info/viper \ ! ../info/message DVI_TARGETS = emacs.dvi cc-mode.dvi cl.dvi dired-x.dvi ediff.dvi forms.dvi \ ! gnus.dvi mh-e.dvi sc.dvi vip.dvi viper.dvi message.dvi INFOSOURCES = info.texi info-stnd.texi *************** info: $(INFO_TARGETS) *** 70,129 **** dvi: $(DVI_TARGETS) ../info/info: ${INFOSOURCES} ! $(MAKEINFO) --no-split info.texi info.dvi: ${INFOSOURCES} ! $(TEXI2DVI) ${srcdir}/info.texi ../info/emacs: ${EMACSSOURCES} ! $(MAKEINFO) emacs.texi emacs.dvi: ${EMACSSOURCES} ! $(TEXI2DVI) ${srcdir}/emacs.texi ../info/ccmode: cc-mode.texi ! $(MAKEINFO) cc-mode.texi cc-mode.dvi: cc-mode.texi ! $(TEXI2DVI) ${srcdir}/cc-mode.texi ../info/cl: cl.texi ! $(MAKEINFO) cl.texi cl.dvi: cl.texi ! $(TEXI2DVI) ${srcdir}/cl.texi ../info/dired-x: dired-x.texi ! $(MAKEINFO) dired-x.texi dired-x.dvi: dired-x.texi ! $(TEXI2DVI) ${srcdir}/dired-x.texi ../info/ediff: ediff.texi ! $(MAKEINFO) ediff.texi ediff.dvi: ediff.texi ! $(TEXI2DVI) ${srcdir}/ediff.texi ../info/forms: forms.texi ! $(MAKEINFO) forms.texi forms.dvi: forms.texi ! $(TEXI2DVI) ${srcdir}/forms.texi ../info/mh-e: mh-e.texi ! $(MAKEINFO) mh-e.texi mh-e.dvi: mh-e.texi ! $(TEXI2DVI) ${srcdir}/mh-e.texi ../info/sc: sc.texi ! $(MAKEINFO) sc.texi sc.dvi: sc.texi ! $(TEXI2DVI) ${srcdir}/sc.texi ../info/vip: vip.texi ! $(MAKEINFO) vip.texi vip.dvi: vip.texi ! $(TEXI2DVI) ${srcdir}/vip.texi ../info/gnus: gnus.texi ! $(MAKEINFO) gnus.texi gnus.dvi: gnus.texi ! $(TEXI2DVI) ${srcdir}/gnus.texi ../etc/GNU: gnu1.texi gnu.texi --- 71,140 ---- dvi: $(DVI_TARGETS) + # Note that all the Info targets build the Info files + # in srcdir. There is no provision for Info files + # to exist in the build directory. + # In a distribution of Emacs, the Info files should be up to date. + ../info/info: ${INFOSOURCES} ! cd $(srcdir); $(MAKEINFO) --no-split info.texi info.dvi: ${INFOSOURCES} ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/info.texi ../info/emacs: ${EMACSSOURCES} ! cd $(srcdir); $(MAKEINFO) emacs.texi emacs.dvi: ${EMACSSOURCES} ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/emacs.texi ../info/ccmode: cc-mode.texi ! cd $(srcdir); $(MAKEINFO) cc-mode.texi cc-mode.dvi: cc-mode.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/cc-mode.texi ../info/cl: cl.texi ! cd $(srcdir); $(MAKEINFO) cl.texi cl.dvi: cl.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/cl.texi ../info/dired-x: dired-x.texi ! cd $(srcdir); $(MAKEINFO) dired-x.texi dired-x.dvi: dired-x.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/dired-x.texi ../info/ediff: ediff.texi ! cd $(srcdir); $(MAKEINFO) ediff.texi ediff.dvi: ediff.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/ediff.texi ../info/forms: forms.texi ! cd $(srcdir); $(MAKEINFO) forms.texi forms.dvi: forms.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/forms.texi ../info/mh-e: mh-e.texi ! cd $(srcdir); $(MAKEINFO) mh-e.texi mh-e.dvi: mh-e.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/mh-e.texi ../info/sc: sc.texi ! cd $(srcdir); $(MAKEINFO) sc.texi sc.dvi: sc.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/sc.texi ../info/vip: vip.texi ! cd $(srcdir); $(MAKEINFO) vip.texi vip.dvi: vip.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/vip.texi ../info/gnus: gnus.texi ! cd $(srcdir); $(MAKEINFO) gnus.texi gnus.dvi: gnus.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/gnus.texi ! ! ../info/message: message.texi ! cd $(srcdir); $(MAKEINFO) message.texi ! message.dvi: message.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/message.texi ../etc/GNU: gnu1.texi gnu.texi *************** gnus.dvi: gnus.texi *** 131,137 **** ../info/viper: viper.texi viper-cmd.texi ! $(MAKEINFO) viper.texi viper.dvi: viper.texi viper-cmd.texi ! $(TEXI2DVI) ${srcdir}/viper.texi mostlyclean: --- 142,148 ---- ../info/viper: viper.texi viper-cmd.texi ! cd $(srcdir); $(MAKEINFO) viper.texi viper.dvi: viper.texi viper-cmd.texi ! TEXINPUTS="$(srcdir) $(TEXINPUTS)"; $(TEXI2DVI) ${srcdir}/viper.texi mostlyclean: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/abbrevs.texi emacs-19.32/man/abbrevs.texi *** emacs-19.31/man/abbrevs.texi Thu Dec 21 01:12:44 1995 --- emacs-19.32/man/abbrevs.texi Fri May 31 12:01:43 1996 *************** it has a definition as an ordinary abbre *** 368,374 **** @vindex dabbrev-case-fold-search Normally, dynamic abbrev expansion ignores case when searching for ! expansions. That is, the expansion need not agree in case with the ! word you are expanding. If you set @code{dabbrev-case-fold-search} ! to @code{nil}, then the word and the expansion must match in case. @vindex dabbrev-case-replace --- 368,383 ---- @vindex dabbrev-case-fold-search Normally, dynamic abbrev expansion ignores case when searching for ! expansions. That is, the expansion need not agree in case with the word ! you are expanding. If you set @code{dabbrev-case-fold-search} to ! @code{nil}, then the word and the expansion must match in case. ! ! The value of @code{dabbrev-case-fold-search} may be any expression. ! Dynamic abbrev expansion evaluates that expression, and ignores case ! while searching if its value is not @code{nil}. The default value of ! @code{dabbrev-case-fold-search} is @code{case-fold-search}, so normally ! the value of @code{case-fold-search} controls the decision. The reason ! why dynamic abbrev expansion normally ignores case when searching for ! expansions is that normally the value of @code{case-fold-search} is ! @code{t}. @vindex dabbrev-case-replace diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/ack.texi emacs-19.32/man/ack.texi *** emacs-19.31/man/ack.texi Thu Mar 7 17:19:53 1996 --- emacs-19.32/man/ack.texi Thu Jul 11 19:52:18 1996 *************** *** 1,4 **** @c This is part of the Emacs manual. ! @c Copyright (C) 1994, 1995 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Acknowledgments, Screen, Concept Index, Top --- 1,4 ---- @c This is part of the Emacs manual. ! @c Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. @node Acknowledgments, Screen, Concept Index, Top *************** portions. *** 13,18 **** @item Per Abrahamsen wrote @file{double.el}, for typing accented characters ! not normally available from the keyboard, and @file{cpp.el}, which hides ! or highlights parts of C programs according to preprocessor conditionals. @item --- 13,19 ---- @item Per Abrahamsen wrote @file{double.el}, for typing accented characters ! not normally available from the keyboard, @file{xt-mouse.el}, which ! handles mouse commands through Xterm, and @file{cpp.el}, which hides or ! highlights parts of C programs according to preprocessor conditionals. @item *************** flow control. *** 141,144 **** --- 142,148 ---- @item + Kevin Gallo added multiple-frame support for Windows NT. + + @item Howard Gayle wrote: @itemize @bullet *************** expansion package. *** 229,235 **** @item ! Lars Ingebrigtsen wrote @file{gnus-uu.el}, an extension to the GNUS ! newsreader to extract, view, and save articles using various encoding ! and packaging formats. @item --- 233,240 ---- @item ! Lars Ingebrigtsen did a major redesign of the GNUS newsreader. ! ! @item ! Andrew Innes contributed extensively to the Windows NT support. @item *************** hiding selected code within C @code{#ifd *** 332,337 **** @item ! Simon Marshall wrote @file{fast-lock.el}, which caches the face ! data computed by Font-Lock mode. @item --- 337,348 ---- @item ! Simon Marshall wrote: ! @itemize @bullet ! @item ! @file{fast-lock.el}, which caches the face data computed by Font Lock mode, and ! @item ! @file{lazy-lock.el}, which makes Font Lock mode fontification become ! demand-driven and/or defer-driven. ! @end itemize @item *************** editing FORTRAN code. *** 456,463 **** @item - Mukesh Prasad wrote @file{vmsproc.el}, support for asynchronous - processes under VMS. - - @item Ashwin Ram wrote @file{refer.el}, commands to look up references in bibliography files by keyword. --- 467,470 ---- *************** and motion commands, and *** 676,679 **** --- 683,688 ---- @end itemize + He also helped port Emacs to MS-DOS. + @item Joseph Brian Wells wrote: *************** merging two versions of a file. *** 706,709 **** --- 715,721 ---- Tom Wurgler wrote @file{emacs-lock.el}, which makes it harder to exit with valuable buffers unsaved. + + @item + Eli Zaretskii made many standard Emacs features work on MS-DOS. @item diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/calendar.texi emacs-19.32/man/calendar.texi *** emacs-19.31/man/calendar.texi Tue May 21 11:44:36 1996 --- emacs-19.32/man/calendar.texi Thu Jul 25 05:57:04 1996 *************** *** 2,6 **** @c Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. ! @node Calendar/Diary, GNUS, Dired, Top @chapter The Calendar and the Diary @cindex calendar --- 2,6 ---- @c Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 Free Software Foundation, Inc. @c See file emacs.texi for copying conditions. ! @node Calendar/Diary, Gnus, Dired, Top @chapter The Calendar and the Diary @cindex calendar *************** argument which specifies how many days, *** 364,368 **** (starting always with the selected one). ! If the variable @code{cal-text-holidays} is non-@code{nil} (the default), then the printed calendars show the holidays in @code{calendar-holidays}. If the variable @code{cal-tex-diary} is --- 364,368 ---- (starting always with the selected one). ! If the variable @code{cal-tex-holidays} is non-@code{nil} (the default), then the printed calendars show the holidays in @code{calendar-holidays}. If the variable @code{cal-tex-diary} is diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/custom.texi emacs-19.32/man/custom.texi *** emacs-19.31/man/custom.texi Fri May 17 17:22:35 1996 --- emacs-19.32/man/custom.texi Sat Jun 29 16:58:08 1996 *************** Insert in the buffer a keyboard macro's *** 624,627 **** --- 624,629 ---- @item C-x C-k Edit a previously defined keyboard macro (@code{edit-kbd-macro}). + @item M-x apply-macro-to-region-lines + Run the last keyboard macro on each complete line in the region. @end table *************** and enters a specialized major mode for *** 716,719 **** --- 718,727 ---- once in that buffer to display details of how to edit the macro. When you are finished editing, type @kbd{C-c C-c}. + + @findex apply-macro-to-region-lines + The command @kbd{M-x apply-macro-to-region-lines} repeats the last + defined keyboard macro on each complete line within the current region. + It does this line by line, by moving point to the beginning of the line + and then executing the macro. @node Save Kbd Macro diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/ediff.texi emacs-19.32/man/ediff.texi *** emacs-19.31/man/ediff.texi Fri Feb 16 01:39:12 1996 --- emacs-19.32/man/ediff.texi Fri Jun 21 23:00:04 1996 *************** paragraph not being relevant to the prin *** 38,44 **** @title Ediff User's Manual @sp 4 ! @subtitle Ediff version 2.50 @sp 1 ! @subtitle November 1995 @sp 5 @author Michael Kifer --- 38,44 ---- @title Ediff User's Manual @sp 4 ! @subtitle Ediff version 2.59 @sp 1 ! @subtitle March 1996 @sp 5 @author Michael Kifer *************** paragraph not being relevant to the prin *** 47,51 **** @vskip 0pt plus 1filll @noindent ! Copyright @copyright{} 1995 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of --- 47,51 ---- @vskip 0pt plus 1filll @noindent ! Copyright @copyright{} 1995, 1996 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of *************** patches selectively (i.e., you can copy *** 101,106 **** you don't like). ! Unfortunately, Ediff still doesn't understand multi-file patches---this ! requires further work (volunteers needed!). Ediff is aware of version control, which lets you compare --- 101,109 ---- you don't like). ! Ediff even understands multi-file patches and can apply them interactively! ! (Ediff can recognize multi-file patches only if they are in the context or ! GNU unified format. All other patches are treated as 1-file patches. Ediff ! is [hopefully] using the same algorithm as patch to determine which ! files need to be patched.) Ediff is aware of version control, which lets you compare *************** Compare regions line-by-line. *** 198,207 **** @findex ediff-patch-file @findex epatch ! Patch file, then compare. At present, Ediff doesn't understand multi-file ! patches. @item ediff-patch-buffer @itemx epatch-buffer @findex ediff-patch-buffer ! Patch buffer, then compare. @item ediff-merge-files --- 201,210 ---- @findex ediff-patch-file @findex epatch ! Patch a file, then compare. ! @item ediff-patch-buffer @itemx epatch-buffer @findex ediff-patch-buffer ! Patch auffer, then compare. @item ediff-merge-files *************** restores the 4th difference region in bu *** 342,349 **** --- 345,372 ---- saved as a result of copying from, say, buffer B to A). + Some commands take negative prefix arguments as well. + For instance, typing @kbd{-} and then @kbd{j} will take Ediff to the last + difference. Typing @kbd{-2} then @kbd{j} takes Ediff to to the penultimate + difference region, etc. + Without the prefix argument, all commands operate on the current selected difference region. You can select any difference region as the current one using other Ediff commands. + For some commands, the value of the prefix argument is immaterial. However, + if supplied, the prefix argument modifies the command. For instance, + normally the commands @kbd{ga}/@kbd{gb}/@kbd{gc} + (@code{ediff-jump-to-difference-at-point}) causes Ediff to jump to the + difference region that is closest to the point in a specified buffer (the + buffer, A, B, or C, is specified by the last character of the command, + i.e., for @code{gb}, the specified buffer is B). + However, with a prefix argument, Ediff would position all these + buffers around the area indicated by the current point in the specified + buffer: if the point is inside a difference region, then the buffers will + be positioned at this difference region. If the point is not in any + difference region, then it is in an area where all buffers agree with each + other. In this case, all buffers will be positioned so that they would + display this area. + The total number of differences and the current difference number are always displayed in the mode line of the control window. *************** packages all use this method). *** 565,572 **** Regular files are treated by the @code{patch} utility in the usual manner, ! i.e., the ! original is renamed into @file{source-name_orig} and the result of the patch ! is placed into the file source-name. (Ediff uses @file{_orig} instead of ! the usual @file{.orig} to placate systems like VMS.) @node Customization, Credits, Remote and Compressed Files, Top --- 588,594 ---- Regular files are treated by the @code{patch} utility in the usual manner, ! i.e., the original is renamed into @file{source-name.orig} and the result ! of the patch is placed into the file source-name. (Ediff @file{_orig} ! on systems like VMS, DOS, etc.) @node Customization, Credits, Remote and Compressed Files, Top *************** X-windows, you can use this name to set *** 785,790 **** use. Usually this is preferable to changing @code{ediff-control-frame-parameters} directly. For instance, you can ! specify in @file{~/.Xdefaults} where the control frame is to be sitting on ! the screen using the resource @samp{Ediff*geometry}. In general, any X resource pertaining the control frame can be reached --- 807,812 ---- use. Usually this is preferable to changing @code{ediff-control-frame-parameters} directly. For instance, you can ! specify in @file{~/.Xdefaults} the color of the control frame ! using the resource @samp{Ediff*background}. In general, any X resource pertaining the control frame can be reached *************** and @code{ediff-previous-difference}, i. *** 922,926 **** @kbd{n}/@key{SPC} and @kbd{p}/@key{DEL}. @kbd{#f} and @kbd{#h} do not change the position of the point in the buffers. And you can still jump ! directly (using @kbd{j} or @kbd{ga}/@kbd{gb}/@kbd{gc}) to any numbered difference. --- 944,948 ---- @kbd{n}/@key{SPC} and @kbd{p}/@key{DEL}. @kbd{#f} and @kbd{#h} do not change the position of the point in the buffers. And you can still jump ! directly (using @kbd{j}) to any numbered difference. *************** fine difference regions): *** 1219,1223 **** @vindex ediff-diff-program @vindex ediff-diff3-program ! These three variables specify the programs to run to produce differences and do patching. --- 1241,1245 ---- @vindex ediff-diff-program @vindex ediff-diff3-program ! These variables specify the programs to use to produce differences and do patching. *************** and do patching. *** 1228,1233 **** @vindex ediff-diff-options @vindex ediff-diff3-options ! These three variables ! specify which options to pass to the above utilities. In @code{ediff-diff-options}, it may be useful to specify options --- 1250,1254 ---- @vindex ediff-diff-options @vindex ediff-diff3-options ! These variables specify the options to pass to the above utilities. In @code{ediff-diff-options}, it may be useful to specify options *************** eliminate this nuisance by keeping a cop *** 1260,1263 **** --- 1281,1288 ---- desired format in a buffer that can be displayed via the command @kbd{D}. + @item ediff-patch-default-directory + @vindex ediff-patch-default-directory + Specifies the default directory to look for patches. + @end table *************** Harald Boegeholz (hwb@@machnix.mathemati *** 1680,1684 **** Bradley A. Bosch (brad@@lachman.com), Michael D. Carney (carney@@ltx-tr.com), ! Jin S. Choi (jin@@atype.com), Eric Eide (eeide@@asylum.cs.utah.edu), Kevin Esler (esler@@ch.hp.com), Robert Estes (estes@@ece.ucdavis.edu), Xavier Fornari (xavier@@europe.cma.fr), --- 1705,1711 ---- Bradley A. Bosch (brad@@lachman.com), Michael D. Carney (carney@@ltx-tr.com), ! Jin S. Choi (jin@@atype.com), ! Albert Dvornik (bert@@mit.edu), ! Eric Eide (eeide@@asylum.cs.utah.edu), Kevin Esler (esler@@ch.hp.com), Robert Estes (estes@@ece.ucdavis.edu), Xavier Fornari (xavier@@europe.cma.fr), diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/emacs.texi emacs-19.32/man/emacs.texi *** emacs-19.31/man/emacs.texi Thu May 23 15:32:26 1996 --- emacs-19.32/man/emacs.texi Thu Jul 11 19:52:53 1996 *************** *** 3,8 **** @ifinfo @c The edition number appears in several places in this file ! This corresponds to the eleventh edition of the @cite{GNU Emacs Manual}, ! for Emacs version 19.31. @c Please REMEMBER to update edition number in *three* places in this file. --- 3,8 ---- @ifinfo @c The edition number appears in several places in this file ! This corresponds to the twelfth edition of the @cite{GNU Emacs Manual}, ! for Emacs version 19.32. @c Please REMEMBER to update edition number in *three* places in this file. *************** original English. *** 64,68 **** @center @titlefont{GNU Emacs Manual} @sp 4 ! @center Eleventh Edition, Updated for Emacs Version 19.31 @sp 5 @center Richard Stallman --- 64,68 ---- @center @titlefont{GNU Emacs Manual} @sp 4 ! @center Twelfth Edition, Updated for Emacs Version 19.32 @sp 5 @center Richard Stallman *************** original English. *** 71,77 **** Copyright @copyright{} 1985, 1986, 1987, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. @sp 2 ! Eleventh Edition @* ! Updated for Emacs Version 19.31, @* ! November 1995 ISBN 1-882114-83-3 --- 71,77 ---- Copyright @copyright{} 1985, 1986, 1987, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. @sp 2 ! Twelfth Edition @* ! Updated for Emacs Version 19.32, @* ! June 1996 ISBN 1-882114-83-3 *************** Emacs is the extensible, customizable, s *** 111,115 **** display editor. This Info file describes how to edit with Emacs and some of how to customize it, but not how to extend it. It ! corresponds to GNU Emacs version 19.31. @end ifinfo --- 111,115 ---- display editor. This Info file describes how to edit with Emacs and some of how to customize it, but not how to extend it. It ! corresponds to GNU Emacs version 19.32. @end ifinfo *************** Advanced Features *** 204,208 **** * Dired:: You can ``edit'' a directory to manage files in it. * Calendar/Diary:: The calendar and diary facilities. ! * GNUS:: How to read netnews with Emacs. * Shell:: Executing shell commands from Emacs. * Emacs Server:: Using Emacs as an editing server for @code{mail}, etc. --- 204,208 ---- * Dired:: You can ``edit'' a directory to manage files in it. * Calendar/Diary:: The calendar and diary facilities. ! * Gnus:: How to read netnews with Emacs. * Shell:: Executing shell commands from Emacs. * Emacs Server:: Using Emacs as an editing server for @code{mail}, etc. *************** Frames and X Windows *** 414,418 **** --- 414,427 ---- * Faces:: How to change the display style using faces. * Modifying Faces:: How to change what a particular face looks like. + * Font Lock:: Minor mode for syntactic highlighting using faces. + * Support Modes:: Font Lock support modes make Font Lock faster. * Misc X:: Iconifying and deleting frames. Region highlighting. + * Non-Window Terminals:: Multiple frames on terminals that only show one. + + Font Lock Support Modes + + * Fast Lock Mode:: Saving font information in files. + * Lazy Lock Mode:: Fontifying only text that is actually displayed. + * Fast or Lazy:: Which support mode is best for you? Major Modes *************** Editing Programs *** 464,468 **** command. Tags remembers which file it is in. * Emerge:: A convenient way of merging two versions of a program. ! * C Mode:: Special commands of C mode (and C++ mode). * Fortran:: Fortran mode and its special features. * Asm Mode:: Asm mode and its special features. --- 473,477 ---- command. Tags remembers which file it is in. * Emerge:: A convenient way of merging two versions of a program. ! * C Mode:: Special commands of C, C++, Objective-C and Java modes. * Fortran:: Fortran mode and its special features. * Asm Mode:: Asm mode and its special features. *************** Tags Tables *** 482,486 **** * Find Tag:: Commands to find the definition of a specific tag. * Tags Search:: Using a tags table for searching and replacing. - * Tags Stepping:: Visiting files in a tags table, one by one. * List Tags:: Listing and finding tags defined in a file. --- 491,494 ---- *************** The Diary *** 621,629 **** * Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc. ! @sc{GNUS} ! * Buffers of GNUS:: The Newsgroups, Summary and Article buffers. ! * GNUS Startup:: What you should know about starting GNUS. ! * Summary of GNUS:: A short description of the basic GNUS commands. Running Shell Commands from Emacs --- 629,637 ---- * Special Diary Entries:: Anniversaries, blocks of dates, cyclic entries, etc. ! @sc{Gnus} ! * Buffers of Gnus:: The group, summary and article buffers. ! * Gnus Startup:: What you should know about starting Gnus. ! * Summary of Gnus:: A short description of the basic Gnus commands. Running Shell Commands from Emacs *************** MS-DOS and Windows NT/95 *** 745,749 **** * Printing and MS-DOS:: * Subprocesses on MS-DOS:: ! * Windows 95 Subprocesses:: @end menu --- 753,758 ---- * Printing and MS-DOS:: * Subprocesses on MS-DOS:: ! * Windows Subprocesses:: ! * System Menu on Windows:: @end menu *************** Clarkson, Doug Cutting, Michael DeCorte, *** 874,902 **** Scott Draves, Viktor Dukhovni, Rolf Ebert, Torbj@"orn Einarsson, Hans Henrik Eriksen, Michael Ernst, Ata Etemadi, Fred Fish, Karl Fogel, Noah ! Friedman, Keith Gabryelski, Kevin Gallagher, Howard Gayle, Stephen ! Gildea, David Gillespie, Boris Goldowsky, Michael Gschwind, Henry ! Guillaume, Doug Gwyn, Chris Hanson, K. Shane Hartman, Markus Heritsch, ! Karl Heuer, Manabu Higashida, Anders Holst, Lars Ingebrigtsen, Michael ! K. Johnson, Kyle Jones, Brewster Kahle, David Kaufman, Henry Kautz, ! Howard Kaye, Michael Kifer, Richard King, Larry K. Kolodney, Robert ! Krawitz, Sebastian Kremer, Geoff Kuenning, David K@aa gedal, Daniel ! LaLiberte, Aaron Larson, James R. Larus, Lars Lindberg, Neil M. Mager, ! Ken Manheimer, Bill Mann, Brian Marick, Simon Marshall, Bengt ! Martensson, Charlie Martin, Thomas May, Roland McGrath, David Megginson, ! Richard Mlynarik, Keith Moore, Thomas Neumann, Mike Newton, Jurgen ! Nickelsen, Jeff Norden, Jeff Peck, Damon Anton Permezel, Tom Perrine, ! Daniel Pfeiffer, Fred Pierresteguy, Christian Plaunt, Francesco ! A. Potorti, Michael D. Prange, Mukesh Prasad, Ashwin Ram, Eric ! S. Raymond, Paul Reilly, Edward M. Reingold, Rob Riepel, Roland B. Roberts, John Robinson, William Rosenblatt, Guillermo J. Rozas, Wolfgang Rupprecht, James B. Salem, Masahiko Sato, William Schelter, Gregor Schmid, Michael Schmidt, Ronald S. Schnell, Philippe Schnoebelen, ! Randal Schwartz, Mark Shapiro, Olin Shivers, Espen Skoglund, Rick ! Sladkey, Lynn Slater, Chris Smith, David Smith, William Sommerfeld, Ake ! Stenhoff, Jonathan Stigelman, Steve Strassman, Spencer Thomas, Jim ! Thompson, Masanobu Umeda, Geoffrey Voelker, Johan Vromans, Barry Warsaw, ! Morten Welinder, Joseph Brian Wells, Ed Wilkinson, Mike Williams, Steven ! A. Wood, Dale R. Worley, Felix S. T. Wu, Tom Wurgler, Jamie Zawinski, ! and Neal Ziring. @end iftex --- 883,911 ---- Scott Draves, Viktor Dukhovni, Rolf Ebert, Torbj@"orn Einarsson, Hans Henrik Eriksen, Michael Ernst, Ata Etemadi, Fred Fish, Karl Fogel, Noah ! Friedman, Keith Gabryelski, Kevin Gallagher, Kevin Gallo, Howard Gayle, ! Stephen Gildea, David Gillespie, Boris Goldowsky, Michael Gschwind, ! Henry Guillaume, Doug Gwyn, Chris Hanson, K. Shane Hartman, Markus ! Heritsch, Karl Heuer, Manabu Higashida, Anders Holst, Lars Ingebrigtsen, ! Andrew Innes, Michael K. Johnson, Kyle Jones, Brewster Kahle, David ! Kaufman, Henry Kautz, Howard Kaye, Michael Kifer, Richard King, Larry ! K. Kolodney, Robert Krawitz, Sebastian Kremer, Geoff Kuenning, David ! K@aa gedal, Daniel LaLiberte, Aaron Larson, James R. Larus, Lars ! Lindberg, Neil M. Mager, Ken Manheimer, Bill Mann, Brian Marick, Simon ! Marshall, Bengt Martensson, Charlie Martin, Thomas May, Roland McGrath, ! David Megginson, Richard Mlynarik, Keith Moore, Erik Naggum, Thomas ! Neumann, Mike Newton, Jurgen Nickelsen, Jeff Norden, Jeff Peck, Damon ! Anton Permezel, Tom Perrine, Daniel Pfeiffer, Fred Pierresteguy, ! Christian Plaunt, Francesco A. Potorti, Michael D. Prange, Ashwin Ram, ! Eric S. Raymond, Paul Reilly, Edward M. Reingold, Rob Riepel, Roland B. Roberts, John Robinson, William Rosenblatt, Guillermo J. Rozas, Wolfgang Rupprecht, James B. Salem, Masahiko Sato, William Schelter, Gregor Schmid, Michael Schmidt, Ronald S. Schnell, Philippe Schnoebelen, ! Stephen Schoef, Randal Schwartz, Mark Shapiro, Olin Shivers, Espen ! Skoglund, Rick Sladkey, Lynn Slater, Chris Smith, David Smith, William ! Sommerfeld, Ake Stenhoff, Jonathan Stigelman, Steve Strassman, Spencer ! Thomas, Jim Thompson, Masanobu Umeda, Geoffrey Voelker, Johan Vromans, ! Barry Warsaw, Morten Welinder, Joseph Brian Wells, Ed Wilkinson, Mike ! Williams, Steven A. Wood, Dale R. Worley, Felix S. T. Wu, Tom Wurgler, ! Eli Zaretskii, Jamie Zawinski, and Neal Ziring. @end iftex diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/files.texi emacs-19.32/man/files.texi *** emacs-19.31/man/files.texi Wed May 15 10:50:35 1996 --- emacs-19.32/man/files.texi Wed Jun 26 15:30:12 1996 *************** then discover a trivial error in it; you *** 1137,1140 **** --- 1137,1150 ---- check-in, fix the error, and check the file in again. + When @kbd{C-x v c} does not revert the buffer, it unexpands all + version control headers in the buffer instead (@pxref{Version Headers}). + This is because the buffer no longer corresponds to any existing + version. If you check it in again, the checkin process will expand the + headers properly for the new version number. + + However, it is impossible to unexpand the RCS @samp{$Log$} header + automatically. If you use that header feature, you have to unexpand it + by hand---by deleting the entry for the version that you just canceled. + Be careful when invoking @kbd{C-x v c}, as it is easy to throw away a lot of work with it. To help you be careful, this command always diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/frames.texi emacs-19.32/man/frames.texi *** emacs-19.31/man/frames.texi Wed May 15 10:44:05 1996 --- emacs-19.32/man/frames.texi Mon Jul 8 12:25:59 1996 *************** frame. *** 39,43 **** --- 39,46 ---- * Faces:: How to change the display style using faces. * Modifying Faces:: How to change what a particular face looks like. + * Font Lock:: Minor mode for syntactic highlighting using faces. + * Support Modes:: Font Lock support modes make Font Lock faster. * Misc X:: Iconifying and deleting frames. Region highlighting. + * Non-Window Terminals:: Multiple frames on terminals that only show one. @end menu *************** that kills the region already selected. *** 113,120 **** @item Double-Mouse-1 ! This key sets the region around the word which you click on. ! If you click on a character with ``symbol'' syntax (such as ! underscore, in C mode), it sets the region around the symbol ! surrounding that character. @item Double-Drag-Mouse-1 --- 116,129 ---- @item Double-Mouse-1 ! This key sets the region around the word which you click on. If you ! click on a character with ``symbol'' syntax (such as underscore, in C ! mode), it sets the region around the symbol surrounding that character. ! ! If you click on a character with open-parenthesis or close-parenthesis ! syntax, it sets the region around the parenthetical grouping (sexp) ! which that character starts or ends. If you click on a character with ! string-delimiter syntax (such as a singlequote or doublequote in C), it ! sets the region around the string constant (using heuristics to figure ! out whether that character is the beginning or the end of it). @item Double-Drag-Mouse-1 *************** for more information about Transient Mar *** 656,754 **** deactivation of the mark. ! @cindex Font-Lock mode ! One easy way to use faces is to turn on Font-Lock mode. This minor ! mode, which is always local to a particular buffer, arranges to choose ! faces according to the syntax of the text you are editing. It can ! recognize comments and strings in most languages; in several languages, ! it can also recognize and properly highlight various other important ! constructs---for example, names of functions being defined. ! ! @kindex C-M-g ! @findex font-lock-fontify-block ! In Font-Lock mode, when you edit the text, the highlighting updates ! automatically in the line that you changed. Most changes don't affect ! the highlighting of subsequent lines, but occasionally they do. To ! rehighlight a range of lines, use the command @kbd{C-M-g} ! (@code{font-lock-fontify-block}). ! ! @vindex font-lock-mark-block-function ! In certain major modes, @kbd{C-M-g} refontifies the entire current ! function. (The variable @code{font-lock-mark-block-function} controls ! how to find the current function.) In other major modes, @kbd{C-M-g} ! refontifies 16 lines above and below point. ! ! With a prefix argument @var{n}, @kbd{C-M-g} refontifies @var{n} lines ! above and below point, regardless of the mode. ! ! @findex font-lock-mode ! @findex turn-on-font-lock ! Font-Lock mode is a minor mode. The command @kbd{M-x font-lock-mode} ! turns the mode on or off. The function @code{turn-on-font-lock} ! unconditionally enables Font-Lock mode. This is useful in mode-hook ! functions. For example, to enable Font-Lock mode whenever you edit a C ! file, you can do this: ! ! @example ! (add-hook 'c-mode-hook 'turn-on-font-lock) ! @end example ! ! @findex global-font-lock-mode ! To turn on Font-Lock mode automatically in all modes which support it, ! use the function @code{global-font-lock-mode}, like this: ! ! @example ! (global-font-lock-mode t) ! @end example ! ! @vindex font-lock-display-type ! To get the full benefit of Font-Lock mode, you need to choose a ! default font which has bold, italic, and bold-italic variants; or else ! you need to have a color or grayscale screen. The variable ! @code{font-lock-display-type} specifies whether Font-Lock mode should ! use font styles, colors, or shades of gray to distinguish the various ! kinds of text. Emacs chooses the default value according to the ! characteristics of your display. ! ! @vindex font-lock-maximum-decoration ! The variable @code{font-lock-maximum-decoration} specifies the ! preferred level of fontification for modes that provide multiple levels. ! The normal default is 1; larger numbers request more fontification, and ! some modes support levels as high as 3. These variables can also ! specify different numbers for particular major modes; for example, to ! use level 3 for C/C++ modes, and the default level otherwise, use this: ! ! @example ! (setq font-lock-maximum-decoration ! '((c-mode . 3) (c++-mode . 3))) ! @end example ! ! @vindex font-lock-maximum-size ! Fontification can be too slow for large buffers, so you can suppress ! it. The variable `font-lock-maximum-size' specifies a buffer size, ! beyond which buffer fontification is suppressed. ! ! @cindex Fast Lock mode ! To make Font Lock mode practical for large buffers, you can use Fast ! Lock mode to avoid repetitive buffer fontification. Fast Lock mode ! saves the font information for a file in a separate cache file; each ! time you visit the file, it rereads the font information from the cache ! file instead of refontifying the text from scratch. ! ! @findex fast-lock-mode ! @findex turn-on-fast-lock ! The command @kbd{M-x fast-lock-mode} turns Fast Lock mode on or off, ! according to the argument (with no argument, it toggles). The function ! @code{turn-on-fast-lock} unconditionally enables Fast Lock mode. Here ! is how you can arrange to enable Fast Lock mode whenever you use Font ! Lock mode: ! ! @example ! (add-hook 'font-lock-mode-hook 'turn-on-fast-lock) ! @end example ! ! @vindex fast-lock-minimum-size ! It is not worth while writing a cache file for small buffers. ! Therefore, the variable @code{fast-lock-minimum-size} specifies a ! minimum buffer size for caching font information. You can print out the buffer with the highlighting that appears --- 665,676 ---- deactivation of the mark. ! @cindex Font Lock mode ! One easy way to use faces is to turn on Font Lock mode. This minor ! mode, which is always local to a particular buffer, arranges to ! choose faces according to the syntax of the text you are editing. It ! can recognize comments and strings in most languages; in several ! languages, it can also recognize and properly highlight various other ! important constructs. @xref{Font Lock}, for more information about ! Font Lock mode and syntactic highlighting. You can print out the buffer with the highlighting that appears *************** attribute. Type @samp{none} if you want *** 839,842 **** --- 761,996 ---- faces. @xref{Resources X}. + @node Font Lock + @section Font Lock mode + @cindex Font Lock mode + + Font Lock mode is a minor mode, always local to a particular + buffer, which highlights (or ``fontifies'') using various faces + according to the syntax of the text you are editing. It can + recognize comments and strings in most languages; in several + languages, it can also recognize and properly highlight various other + important constructs---for example, names of functions being defined + or reserved keywords. + + @findex font-lock-mode + @findex turn-on-font-lock + The command @kbd{M-x font-lock-mode} turns the mode on or off. The + function @code{turn-on-font-lock} unconditionally enables Font Lock + mode. This is useful in mode-hook functions. For example, to enable + Font Lock mode whenever you edit a C file, you can do this: + + @example + (add-hook 'c-mode-hook 'turn-on-font-lock) + @end example + + @findex global-font-lock-mode + To turn on Font Lock mode automatically in all modes which support it, + use the function @code{global-font-lock-mode}, like this: + + @example + (global-font-lock-mode t) + @end example + + @kindex C-M-g + @findex font-lock-fontify-block + In Font Lock mode, when you edit the text, the highlighting updates + automatically in the line that you changed. Most changes don't affect + the highlighting of subsequent lines, but occasionally they do. To + rehighlight a range of lines, use the command @kbd{C-M-g} + (@code{font-lock-fontify-block}). + + @vindex font-lock-mark-block-function + In certain major modes, @kbd{C-M-g} refontifies the entire current + function. (The variable @code{font-lock-mark-block-function} controls + how to find the current function.) In other major modes, @kbd{C-M-g} + refontifies 16 lines above and below point. + + With a prefix argument @var{n}, @kbd{C-M-g} refontifies @var{n} lines + above and below point, regardless of the mode. + + @vindex font-lock-display-type + To get the full benefit of Font Lock mode, you need to choose a + default font which has bold, italic, and bold-italic variants; or else + you need to have a color or grayscale screen. The variable + @code{font-lock-display-type} specifies whether Font Lock mode should + use font styles, colors, or shades of gray to distinguish the various + kinds of text. Emacs chooses the default value according to the + characteristics of your display. + + @vindex font-lock-maximum-decoration + The variable @code{font-lock-maximum-decoration} specifies the + preferred level of fontification for modes that provide multiple levels. + The normal default is 1; larger numbers request more fontification, and + some modes support levels as high as 3. These variables can also + specify different numbers for particular major modes; for example, to + use level 3 for C/C++ modes, and the default level otherwise, use this: + + @example + (setq font-lock-maximum-decoration + '((c-mode . 3) (c++-mode . 3))) + @end example + + @vindex font-lock-maximum-size + Fontification can be too slow for large buffers, so you can suppress + it. The variable @code{font-lock-maximum-size} specifies a buffer size, + beyond which buffer fontification is suppressed. + + @node Support Modes + @section Font Lock Support Modes + + Font Lock support modes make Font Lock mode faster for large buffers. + There are two support modes: Fast Lock mode and Lazy Lock mode. They + use two different methods of speeding up Font Lock mode. + + @menu + * Fast Lock Mode:: Saving font information in files. + * Lazy Lock Mode:: Fontifying only text that is actually displayed. + * Fast or Lazy:: Which support mode is best for you? + @end menu + + @node Fast Lock Mode + @subsection Fast Lock Mode + + @cindex Fast Lock mode + To make Font Lock mode faster for buffers visiting large files, you + can use Fast Lock mode. Fast Lock mode saves the font information for + each file in a separate cache file; each time you visit the file, it + rereads the font information from the cache file instead of refontifying + the text from scratch. + + @findex fast-lock-mode + The command @kbd{M-x fast-lock-mode} turns Fast Lock mode on or off, + according to the argument (with no argument, it toggles). You can also + arrange to enable Fast Lock mode whenever you use Font Lock mode, like + this: + + @example + (setq font-lock-support-mode 'fast-lock-mode) + @end example + + @vindex fast-lock-minimum-size + It is not worth writing a cache file for small buffers. Therefore, + the variable @code{fast-lock-minimum-size} specifies a minimum file size + for caching font information. + + @vindex fast-lock-cache-directories + The variable @code{fast-lock-cache-directories} specifies where to put + the cache files. Its value is a list of directories to try; @code{"."} + means the same directory as the file being edited. The default value is + @code{("." "~/.emacs-flc")}, which means to use the same directory if + possible, and otherwise the directory @file{~/.emacs-flc}. + + @vindex fast-lock-save-others + The variable @code{fast-lock-save-others} specifies whether Fast Lock + mode should save cache files for files that you do not own. A + non-@code{nil} value means yes (and that is the default). + + @node Lazy Lock Mode + @subsection Lazy Lock Mode + @cindex Lazy Lock mode + + To make Font Lock mode faster for large buffers, you can use Lazy Lock + mode to reduce the amount of text that is fontified. In Lazy Lock mode, + buffer fontification is demand-driven; it happens to portions of the + buffer that are about to be displayed. And fontification of your + changes is deferred; it happens only when Emacs has been idle for a + certain short period of time. + + @findex lazy-lock-mode + The command @kbd{M-x lazy-lock-mode} turns Lazy Lock mode on or off, + according to the argument (with no argument, it toggles). You can also + arrange to enable Lazy Lock mode whenever you use Font Lock mode, like + this: + + @example + (setq font-lock-support-mode 'lazy-lock-mode) + @end example + + @vindex lazy-lock-minimum-size + It is not worth avoiding buffer fontification for small buffers. + Therefore, the variable @code{lazy-lock-minimum-size} specifies a + minimum buffer size for demand-driven buffer fontification. Buffers + smaller than that are fontified all at once, as in plain Font Lock mode. + + @vindex lazy-lock-defer-time + When you alter the buffer, Lazy Lock mode defers fontification of the + text you changed. The variable @code{lazy-lock-defer-time} specifies + how many seconds Emacs must be idle before it starts fontifying your + changes. If the value is @code{nil}, then changes are fontified + immediately, as in plain Font Lock mode. + + @vindex lazy-lock-defer-driven + Lazy Lock mode normally fontifies newly visible portions of the buffer + before they are first displayed. However, if the value of + @code{lazy-lock-defer-driven} is non-@code{nil}, newly visible text is + fontified only when Emacs is idle for @code{lazy-lock-defer-time} + seconds. + + @cindex stealth fontification + When Emacs is idle for a long time, Lazy Lock fontifies additional + portions of the buffer, not yet displayed, in case you will display them + later. This is called @dfn{stealth fontification}. + + @vindex lazy-lock-stealth-time + @vindex lazy-lock-stealth-lines + @vindex lazy-lock-stealth-verbose + The variable @code{lazy-lock-stealth-time} specifies how many seconds + Emacs has to be idle before stealth fontification starts. A value of + @code{nil} means no stealth fontification. The variables + @code{lazy-lock-stealth-lines} and @code{lazy-lock-stealth-verbose} + specify the granularity and verbosity of stealth fontification. + + @node Fast or Lazy + @subsection Fast Lock or Lazy Lock? + + Here is a simple guide to help you choose one of the Font Lock support + modes. + + @itemize @bullet + @item + Fast Lock mode only intervenes during file visiting and buffer + killing (and related events); therefore buffer editing and window + scrolling are no faster or slower than plain Font Lock mode. + + @item + Fast Lock mode is slower at reading a cache file than Lazy Lock + mode is at fontifying a window; therefore Fast Lock mode is slower at + visiting a file than Lazy Lock mode. + + @item + Lazy Lock mode intervenes during window scrolling to fontify text that + scrolls onto the screen; therefore, scrolling is slower than in plain + Font Lock mode. + + @item + Lazy Lock mode doesn't fontify during buffer editing (it defers + fontification of changes); therefore, editing is faster than in plain + Font Lock mode. + + @item + Fast Lock mode can be fooled by a file that is kept under version + control software; therefore buffer fontification may occur even when + a cache file exists for the file. + + @item + Fast Lock mode only works with a buffer visiting a file; Lazy Lock + mode works with any buffer. + + @item + Fast Lock mode generates cache files; Lazy Lock mode does not. + @end itemize + + @vindex font-lock-support-mode + The variable @code{font-lock-support-mode} specifies which of these + support modes to use; for example, to specify that Fast Lock mode is + used for C/C++ modes, and Lazy Lock mode otherwise, set the variable + like this: + + @example + (setq font-lock-support-mode + '((c-mode . fast-lock-mode) (c++-mode . fast-lock-mode) + (t . lazy-lock-mode))) + @end example + @node Misc X @section Miscellaneous X Window Features *************** To delete the selected frame, type @kbd{ *** 861,864 **** --- 1015,1025 ---- This is not allowed if there is only one frame. + @item C-x 5 o + @kindex C-x 5 o + @findex other-frame + Select another frame, raise it, and warp the mouse to it so that it + stays selected. If you repeat this command, it cycles through all the + frames on your terminal. + @item M-x transient-mark-mode Under X Windows, when Transient Mark mode is enabled, Emacs highlights *************** using Transient Mark mode. To toggle th *** 867,868 **** --- 1028,1049 ---- command @kbd{M-x transient-mark-mode}. @xref{Mark}. @end table + + @node Non-Window Terminals + @section Non-Window Terminals + @cindex non-window terminals + @cindex single-frame terminals + + If your terminal does not have a window system that Emacs supports, + then it can display only one Emacs frame at a time. However, you can + still create multiple Emacs frames, and switch between them. Switching + frames on these terminals is much like switching between different + window configurations. + + Use @kbd{C-x 5 2} to create a new frame and switch to it; use @kbd{C-x + 5 o} to cycle through the existing frames; use @kbd{C-x 5 0} to delete + the current frame. + + Each frame has a number to distinguish it. The selected frame's + number appears in the mode line after @samp{Emacs}, except when frame 1 + is selected. + diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/gnus-faq.texi emacs-19.32/man/gnus-faq.texi *** emacs-19.31/man/gnus-faq.texi Wed Dec 31 19:00:00 1969 --- emacs-19.32/man/gnus-faq.texi Wed Jun 26 14:39:43 1996 *************** *** 0 **** --- 1,659 ---- + \input texinfo + @c -*-texinfo-*- + @c Copyright (C) 1995 Free Software Foundation, Inc. + @setfilename gnus-faq.info + + @node Frequently Asked Questions + @section Frequently Asked Questions + + This is the Gnus Frequently Asked Questions list. + If you have a Web browser, the official hypertext version is at + @file{http://www.miranova.com/~steve/gnus-faq.html>}, and has + probably been updated since you got this manual. + + @menu + * Installation FAQ:: Installation of Gnus. + * Customization FAQ:: Customizing Gnus. + * Reading News FAQ:: News Reading Questions. + * Reading Mail FAQ:: Mail Reading Questions. + @end menu + + + @node Installation FAQ + @subsection Installation + + @itemize @bullet + @item + Q1.1 What is the latest version of Gnus? + + The latest (and greatest) version is 5.0.10. You might also run + across something called @emph{September Gnus}. September Gnus + is the alpha version of the next major release of Gnus. It is currently + not stable enough to run unless you are prepared to debug lisp. + + @item + Q1.2 Where do I get Gnus? + + Any of the following locations: + + @itemize @minus + @item + @file{ftp://ftp.ifi.uio.no/pub/emacs/gnus/gnus.tar.gz} + + @item + @file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/} + + @item + @file{gopher://gopher.pilgrim.umass.edu/11/pub/misc/ding/} + + @item + @file{ftp://aphrodite.nectar.cs.cmu.edu/pub/ding-gnus/} + + @item + @file{ftp://ftp.solace.mh.se:/pub/gnu/elisp/} + + @end itemize + + @item + Q1.3 Which version of Emacs do I need? + + At least GNU Emacs 19.28, or XEmacs 19.12 is recommended. GNU Emacs + 19.25 has been reported to work under certain circumstances, but it + doesn't @emph{officially} work on it. 19.27 has also been reported to + work. Gnus has been reported to work under OS/2 as well as Unix. + + + @item + Q1.4 Where is timezone.el? + + Upgrade to XEmacs 19.13. In earlier versions of XEmacs this file was + placed with Gnus 4.1.3, but that has been corrected. + + + @item + Q1.5 When I run Gnus on XEmacs 19.13 I get weird error messages. + + You're running an old version of Gnus. Upgrade to at least version + 5.0.4. + + + @item + Q1.6 How do I unsubscribe from the Mailing List? + + Send an e-mail message to @file{ding-request@@ifi.uio.no} with the magic word + @emph{unsubscribe} somewhere in it, and you will be removed. + + If you are reading the digest version of the list, send an e-mail message + to @* + @file{ding-rn-digests-d-request@@moe.shore.net} + with @emph{unsubscribe} as the subject and you will be removed. + + + @item + Q1.7 How do I run Gnus on both Emacs and XEmacs? + + The basic answer is to byte-compile under XEmacs, and then you can + run under either Emacsen. There is, however, a potential version + problem with easymenu.el with Gnu Emacs prior to 19.29. + + Per Abrahamsen writes :@* + The internal easymenu.el interface changed between 19.28 and 19.29 in + order to make it possible to create byte compiled files that can be + shared between Gnu Emacs and XEmacs. The change is upward + compatible, but not downward compatible. + This gives the following compatibility table: + + @example + Compiled with: | Can be used with: + ----------------+-------------------------------------- + 19.28 | 19.28 19.29 + 19.29 | 19.29 XEmacs + XEmacs | 19.29 XEmacs + @end example + + If you have Gnu Emacs 19.28 or earlier, or XEmacs 19.12 or earlier, get + a recent version of auc-menu.el from + @file{ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auc-menu.el}, and install it + under the name easymenu.el somewhere early in your load path. + + + @item + Q1.8 What resources are available? + + There is the newsgroup Gnu.emacs.gnus. Discussion of Gnus 5.x is now + taking place there. There is also a mailing list, send mail to + @file{ding-request@@ifi.uio.no} with the magic word @emph{subscribe} + somewhere in it. + + @emph{NOTE:} the traffic on this list is heavy so you may not want to be + on it (unless you use Gnus as your mailer reader, that is). The mailing + list is mainly for developers and testers. + + Gnus has a home World Wide Web page at@* + @file{http://www.ifi.uio.no/~larsi/ding.html}. + + Gnus has a write up in the X Windows Applications FAQ at@* + @file{http://www.ee.ryerson.ca:8080/~elf/xapps/Q-III.html}. + + The Gnus manual is also available on the World Wide Web. The canonical + source is in Norway at@* + @file{http://www.ifi.uio.no/~larsi/ding-manual/gnus_toc.html}. + + There are three mirrors in the United States: + @enumerate + @item + @file{http://www.miranova.com/gnus-man/} + + @item + @file{http://www.pilgrim.umass.edu/pub/misc/ding/manual/gnus_toc.html} + + @item + @file{http://www.rtd.com/~woo/gnus/} + + @end enumerate + + PostScript copies of the Gnus Reference card are available from@* + @file{ftp://ftp.cs.ualberta.ca/pub/oolog/gnus/}. They are mirrored at@* + @file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/refcard/} in the + United States. And@* + @file{ftp://marvin.fkphy.uni-duesseldorf.de/pub/gnus/} + in Germany. + + An online version of the Gnus FAQ is available at@* + @file{http://www.miranova.com/~steve/gnus-faq.html}. Off-line formats + are also available:@* + ASCII: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq}@* + PostScript: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq.ps}. + + + @item + Q1.9 Gnus hangs on connecting to NNTP server + + I am running XEmacs on SunOS and Gnus prints a message about Connecting + to NNTP server and then just hangs. + + Ben Wing writes :@* + I wonder if you're hitting the infamous @emph{libresolv} problem. + The basic problem is that under SunOS you can compile either + with DNS or NIS name lookup libraries but not both. Try + substituting the IP address and see if that works; if so, you + need to download the sources and recompile. + + + @item + Q1.10 Mailcrypt 3.4 doesn't work + + This problem is verified to still exist in Gnus 5.0.9 and MailCrypt 3.4. + The answer comes from Peter Arius + . + + I found out that mailcrypt uses + @code{gnus-eval-in-buffer-window}, which is a macro. + It seems as if you have + compiled mailcrypt with plain old GNUS in load path, and the XEmacs byte + compiler has inserted that macro definition into + @file{mc-toplev.elc}. + The solution is to recompile @file{mc-toplev.el} with Gnus 5 in + load-path, and it works fine. + + Steve Baur adds :@* + The problem also manifests itself if neither GNUS 4 nor Gnus 5 is in the + load-path. + + + @item + Q1.11 What other packages work with Gnus? + + @itemize @minus + @item + Mailcrypt. + + Mailcrypt is an Emacs interface to PGP. It works, it installs + without hassle, and integrates very easily. Mailcrypt can be + obtained from@* + @file{ftp://cag.lcs.mit.edu/pub/patl/mailcrypt-3.4.tar.gz}. + + @item + Tiny Mime. + + Tiny Mime is an Emacs MUA interface to MIME. Installation is + a two-step process unlike most other packages, so you should + be prepared to move the byte-compiled code somewhere. There + are currently two versions of this package available. It can + be obtained from@* + @file{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/}. + Be sure to apply the supplied patch. It works with Gnus through + version 5.0.9. In order for all dependencies to work correctly + the load sequence is as follows: + @lisp + (load "tm-setup") + (load "gnus") + (load "mime-compose") + @end lisp + + @emph{NOTE:} Loading the package disables citation highlighting by + default. To get the old behavior back, use the @kbd{M-t} command. + + @end itemize + + @end itemize + + + @node Customization FAQ + @subsection Customization + + @itemize @bullet + @item + Q2.1 Custom Edit does not work under XEmacs + + The custom package has not been ported to XEmacs. + + + @item + Q2.2 How do I quote messages? + + I see lots of messages with quoted material in them. I am wondering + how to have Gnus do it for me. + + This is Gnus, so there are a number of ways of doing this. You can use + the built-in commands to do this. There are the @kbd{F} and @kbd{R} + keys from the summary buffer which automatically include the article + being responded to. These commands are also selectable as @i{Followup + and Yank} and @i{Reply and Yank} in the Post menu. + + @kbd{C-c C-y} grabs the previous message and prefixes each line with + @code{ail-indentation-spaces} spaces or @code{mail-yank-prefix} if that is + non-nil, unless you have set your own @code{mail-citation-hook}, which will + be called to to do the job. + + You might also consider the Supercite package, which allows for pretty + arbitrarily complex quoting styles. Some people love it, some people + hate it. + + + @item + Q2.3 How can I keep my nnvirtual:* groups sorted? + + How can I most efficiently arrange matters so as to keep my nnvirtual:* + (etc) groups at the top of my group selection buffer, whilst keeping + everything sorted in alphabetical order. + + If you don't subscribe often to new groups then the easiest way is to + first sort the groups and then manually kill and yank the virtuals + wherever you want them. + + + @item + Q2.4 Any good suggestions on stuff for an all.SCORE file? + + Here is a collection of suggestions from the Gnus mailing list. + + @enumerate + @item + From ``Dave Disser'' @* + I like blasting anything without lowercase letters. Weeds out most of + the make $$ fast, as well as the lame titles like ``IBM'' and ``HP-UX'' + with no further description. + @lisp + (("Subject" + ("^\\(Re: \\)?[^a-z]*$" -200 nil R))) + @end lisp + + @item + From ``Peter Arius'' @* + The most vital entries in my (still young) all.SCORE: + @lisp + (("xref" + ("alt.fan.oj-simpson" -1000 nil s)) + ("subject" + ("\\<\\(make\\|fast\\|big\\)\\s-*\\(money\\|cash\\|bucks?\\)\\>" -1000 nil r) + ("$$$$" -1000 nil s))) + @end lisp + + @item + From ``Per Abrahamsen'' @* + @lisp + (("subject" + ;; CAPS OF THE WORLD, UNITE + ("^..[^a-z]+$" -1 nil R) + ;; $$$ Make Money $$$ (Try work) + ("$" -1 nil s) + ;; I'm important! And I have exclamation marks to prove it! + ("!" -1 nil s))) + @end lisp + + @item + From ``heddy boubaker'' @* + I would like to contribute with mine. + @lisp + ( + (read-only t) + ("subject" + ;; ALL CAPS SUBJECTS + ("^\\([Rr][Ee]: +\\)?[^a-z]+$" -1 nil R) + ;; $$$ Make Money $$$ + ("$$" -10 nil s) + ;; Empty subjects are worthless! + ("^ *\\([(<]none[>)]\\|(no subject\\( given\\)?)\\)? *$" -10 nil r) + ;; Sometimes interesting announces occur! + ("ANN?OU?NC\\(E\\|ING\\)" +10 nil r) + ;; Some people think they're on mailing lists + ("\\(un\\)?sub?scribe" -100 nil r) + ;; Stop Micro$oft NOW!! + ("\\(m\\(icro\\)?[s$]\\(oft\\|lot\\)?-?\\)?wind?\\(ows\\|aube\\|oze\\)?[- ]*\\('?95\\|NT\\|3[.]1\\|32\\)" -1001 nil r) + ;; I've nothing to buy + ("\\(for\\|4\\)[- ]*sale" -100 nil r) + ;; SELF-DISCIPLINED people + ("\\[[^a-z0-9 \t\n][^a-z0-9 \t\n]\\]" +100 nil r) + ) + ("from" + ;; To keep track of posters from my site + (".dgac.fr" +1000 nil s)) + ("followup" + ;; Keep track of answers to my posts + ("boubaker" +1000 nil s)) + ("lines" + ;; Some people have really nothing to say!! + (1 -10 nil <=)) + (mark -100) + (expunge -1000) + ) + @end lisp + + @item + From ``Christopher Jones'' @* + The sample @file{all.SCORE} files from Per and boubaker could be + augmented with: + @lisp + (("subject" + ;; No junk mail please! + ("please ignore" -500 nil s) + ("test" -500 nil e)) + ) + @end lisp + + @item + From ``Brian Edmonds'' @* + Augment any of the above with a fast method of scoring down + excessively cross posted articles. + @lisp + ("xref" + ;; the more cross posting, the exponentially worse the article + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+" -1 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -2 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -4 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -8 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -16 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -32 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -64 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -128 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -256 nil r) + ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -512 nil r)) + @end lisp + + @end enumerate + + + @item + Q2.5 What do I use to yank-through when replying? + + You should probably reply and followup with @kbd{R} and @kbd{F}, instead + of @kbd{r} and @kbd{f}, which solves your problem. But you could try + something like: + + @example + (defconst mail-yank-ignored-headers + "^.*:" + "Delete these headers from old message when it's inserted in a reply.") + @end example + + + @item + Q2.6 I don't like the default WWW browser + + Now when choosing an URL Gnus starts up a W3 buffer, I would like it + to always use Netscape (I don't browse in text-mode ;-). + + @enumerate + @item + Activate `Customize...' from the `Help' menu. + + @item + Scroll down to the `WWW Browser' field. + + @item + Click `mouse-2' on `WWW Browser'. + + @item + Select `Netscape' from the pop up menu. + + @item + Press `C-c C-c' + + @end enumerate + + If you are using XEmacs then to specify Netscape do + @lisp + (setq gnus-button-url 'gnus-netscape-open-url) + @end lisp + + + @item + Q2.7 What, if any, relation is between ``ask-server'' and ``(setq + gnus-read-active-file 'some)''? + + In order for Gnus to show you the complete list of newsgroups, it will + either have to either store the list locally, or ask the server to + transmit the list. You enable the first with + + @lisp + (setq gnus-save-killed-list t) + @end lisp + + and the second with + + @lisp + (setq gnus-read-active-file t) + @end lisp + + If both are disabled, Gnus will not know what newsgroups exists. There + is no option to get the list by casting a spell. + + + @item + Q2.8 Moving between groups is slow. + + Per Abrahamsen writes:@* + + Do you call @code{define-key} or something like that in one of the + summary mode hooks? This would force Emacs to recalculate the keyboard + shortcuts. Removing the call should speed up @kbd{M-x gnus-summary-mode + RET} by a couple of orders of magnitude. You can use + + @lisp + (define-key gnus-summary-mode-map KEY COMMAND) + @end lisp + + in your @file{.gnus} instead. + + @end itemize + + + @node Reading News FAQ + @subsection Reading News + + @itemize @bullet + @item + Q3.1 How do I convert my kill files to score files? + + A kill-to-score translator was written by Ethan Bradford + . It is available from@* + @file{http://baugi.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}. + + + @item + Q3.2 My news server has a lot of groups, and killing groups is painfully + slow. + + Don't do that then. The best way to get rid of groups that should be + dead is to edit your newsrc directly. This problem will be addressed + in the near future. + + + @item + Q3.3 How do I use an NNTP server with authentication? + + Put the following into your .gnus: + @lisp + (add-hook 'nntp-server-opened-hook 'nntp-send-authinfo) + @end lisp + + + @item + Q3.4 Not reading the first article. + + How do I avoid reading the first article when a group is selected? + + @enumerate + @item + Use @kbd{RET} to select the group instead of @kbd{SPC}. + + @item + @code{(setq gnus-auto-select first nil)} + + @item + Luis Fernandes writes:@* + This is what I use...customize as necessary... + + @lisp + ;;; Don't auto-select first article if reading sources, or archives or + ;;; jobs postings, etc. and just display the summary buffer + (add-hook 'gnus-select-group-hook + (function + (lambda () + (cond ((string-match "sources" gnus-newsgroup-name) + (setq gnus-auto-select-first nil)) + ((string-match "jobs" gnus-newsgroup-name) + (setq gnus-auto-select-first nil)) + ((string-match "comp\\.archives" gnus-newsgroup-name) + (setq gnus-auto-select-first nil)) + ((string-match "reviews" gnus-newsgroup-name) + (setq gnus-auto-select-first nil)) + ((string-match "announce" gnus-newsgroup-name) + (setq gnus-auto-select-first nil)) + ((string-match "binaries" gnus-newsgroup-name) + (setq gnus-auto-select-first nil)) + (t + (setq gnus-auto-select-first t)))))) + @end lisp + + @item + Per Abrahamsen writes:@* + Another possibility is to create an @file{all.binaries.all.SCORE} file + like this: + + @lisp + ((local + (gnus-auto-select-first nil))) + @end lisp + + and insert + @lisp + (setq gnus-auto-select-first t) + @end lisp + + in your @file{.gnus}. + + @end enumerate + + @item + Q3.5 Why aren't BBDB known posters marked in the summary buffer? + + Brian Edmonds writes:@* + Due to changes in Gnus 5.0, @file{bbdb-gnus.el} no longer marks known + posters in the summary buffer. An updated version, @file{gnus-bbdb.el} + is available at the locations listed below. This package also supports + autofiling of incoming mail to folders specified in the BBDB. Extensive + instructions are included as comments in the file. + + Send mail to @file{majordomo@@edmonds.home.cs.ubc.ca} with the following + line in the body of the message: @emph{get misc gnus-bbdb.el}. + + Or get it from the World Wide Web:@* + @file{http://www.cs.ubc.ca/spider/edmonds/gnus-bbdb.el}. + + @end itemize + + + @node Reading Mail FAQ + @subsection Reading Mail + + @itemize @bullet + @item + Q4.1 What does the message ``Buffer has changed on disk'' mean in a mail + group? + + Your filter program should not deliver mail directly to your folders, + instead it should put the mail into spool files. Gnus will then move + the mail safely from the spool files into the folders. This will + eliminate the problem. Look it up in the manual, in the section + entitled ``Mail & Procmail''. + + + @item + Q4.2 How do you make articles un-expirable? + + I am using nnml to read news and have used + @code{gnus-auto-expirable-newsgroups} to automagically expire articles + in some groups (Gnus being one of them). Sometimes there are + interesting articles in these groups that I want to keep. Is there any + way of explicitly marking an article as un-expirable - that is mark it + as read but not expirable? + + Use @kbd{u}, @kbd{!}, @kbd{d} or @kbd{M-u} in the summary buffer. You + just remove the @kbd{E} mark by setting some other mark. It's not + necessary to tick the articles. + + + @item + Q4.3 How do I delete bogus nnml: groups? + + My problem is that I have various mail (nnml) groups generated while + experimenting with Gnus. How do I remove them now? Setting the level to + 9 does not help. Also @code{gnus-group-check-bogus-groups} does not + recognize them. + + Removing mail groups is tricky at the moment. (It's on the to-do list, + though.) You basically have to kill the groups in Gnus, shut down Gnus, + edit the active file to exclude these groups, and probably remove the + nnml directories that contained these groups as well. Then start Gnus + back up again. + + + @item + Q4.4 What happened to my new mail groups? + + I got new mail, but I have + never seen the groups they should have been placed in. + + They are probably there, but as zombies. Press @kbd{A z} to list + zombie groups, and then subscribe to the groups you want with @kbd{u}. + This is all documented quite nicely in the user's manual. + + + @item + Q4.5 Not scoring mail groups + + How do you @emph{totally} turn off scoring in mail groups? + + Use an nnbabyl:all.SCORE (or nnmh, or nnml, or whatever) file containing: + + @example + ((adapt ignore) + (local (gnus-use-scoring nil)) + (exclude-files "all.SCORE")) + @end example + + @end itemize + + diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/gnus.texi emacs-19.32/man/gnus.texi *** emacs-19.31/man/gnus.texi Fri Feb 9 22:36:19 1996 --- emacs-19.32/man/gnus.texi Wed Jun 26 17:49:29 1996 *************** *** 1,6 **** \input texinfo @c -*-texinfo-*- ! @comment %**start of header (This is for running Texinfo on a region.) @setfilename ../info/gnus ! @settitle Gnus 5.1 Manual @synindex fn cp @synindex vr cp --- 1,6 ---- \input texinfo @c -*-texinfo-*- ! @setfilename ../info/gnus ! @settitle Gnus 5.3 Manual @synindex fn cp @synindex vr cp *************** *** 10,19 **** @end iftex @setchapternewpage odd - @c @smallbook - @comment %**end of header (This is for running Texinfo on a region.) - @tex - \overfullrule=0pt - %\global\baselineskip 30pt % For printing in double spaces - @end tex @ifinfo --- 10,13 ---- *************** *** 21,25 **** This file documents Gnus, the GNU Emacs newsreader. ! Copyright (C) 1995 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of --- 15,19 ---- This file documents Gnus, the GNU Emacs newsreader. ! Copyright (C) 1995,96 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of *************** into another language, under the above c *** 43,47 **** @end ifinfo ! @iftex @titlepage --- 37,41 ---- @end ifinfo ! @tex @titlepage *************** into another language, under the above c *** 50,55 **** @author by Lars Magne Ingebrigtsen @page @vskip 0pt plus 1filll ! Copyright @copyright{} 1995 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of --- 44,50 ---- @author by Lars Magne Ingebrigtsen @page + @vskip 0pt plus 1filll ! Copyright @copyright{} 1995,96 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of *************** Permission is granted to copy and distri *** 65,975 **** into another language, under the above conditions for modified versions. - Cover art by Etienne Suvasa. @end titlepage @page ! @end iftex @node Top @top The Gnus Newsreader You can read news (and mail) from within Emacs by using Gnus. The news ! can be gotten by any nefarious means you can think of - @sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. ! @menu ! * History:: How Gnus got where it is today. ! * Terminology:: We use really difficult, like, words here. ! * Starting Up:: Finding news can be a pain. ! * The Group Buffer:: Selecting, subscribing and killing groups. ! * The Summary Buffer:: Reading, saving and posting articles. ! * The Article Buffer:: Displaying and handling articles. ! * The Server Buffer:: Making and editing virtual servers. ! * Various:: General purpose settings. ! * Customization:: Tailoring Gnus to your needs. ! * Troubleshooting:: What you might try if things do not work. ! * The End:: Farewell and goodbye. ! * Appendix:: Technical stuff for technical people. ! * Index:: Variable, function and concept index. ! * Key Index:: Key Index. ! @end menu ! @node History ! @chapter History ! @cindex history ! @sc{gnus} was written by Masanobu UMEDA. When autumn crept up in '94, ! Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus. ! The recommended pronunciation of the name this program is "ding ! guh-noose", with "ding" being half-sung in a loud, high-pitched voice, ! and "guh-noose" being grumbled and a disaffected fashion. Any ! irritation and/or damage this name may cause you is not the ! responsibility of the author, even though you might like to strangle him ! for the stupid idea. ! If you want to investigate the person responsible for this outrage, you ! can point your (feh!) web browser to ! @file{http://www.ifi.uio.no/~larsi/}. This is also the primary ! distribution point for the new and spiffy versions of Gnus, also know as ! The Site That Destroys Newsrcs And Drives People Mad. ! During the first extended alpha period of development, the new Gnus was ! called "(ding) Gnus". @dfn{(ding)}, is, of course, short for @dfn{ding ! is not Gnus}, which is a total and utter lie, but who cares? (Besides, ! the "Gnus" in this abbreviation should probably be pronounced "news" as ! UMEDA intended, which makes it a more appropriate name, don't you ! think?) ! ! In any case, after spending all that energy with coming up with a new ! and spiffy name, we decided that the name was @emph{too} spiffy, so we ! renamed it back again to "Gnus". But in mixed case. "Gnus" vs. ! @sc{gnus}. New vs. old. - Incidentally, the next Gnus generation will be called "September Gnus", - and won't be released until February. Confused? You will be. @menu ! * Why?:: What's the point of Gnus? ! * Compatibility:: Just how compatible is Gnus with @sc{gnus}? ! * Conformity:: Gnus tries to conform to all standards. ! * Contributors:: Oodles of people. ! * New Features:: Pointers to some of the new stuff in Gnus. ! * Newest Features:: Features so new that they haven't been written yet. ! * Censorship:: This manual has been censored. @end menu - @node Why? - @section Why? ! What's the point of Gnus? ! I want to provide a "rad", "happening", "way cool" and "hep" newsreader, ! that lets you do anything you can think of. That was my original ! motivation, but while working on Gnus, it has become clear to me that ! this generation of newsreaders really belong in the stone age. ! Newsreaders haven't developed much since the infancy of the net. If the ! volume continues to rise with the current rate of increase, all current ! newsreaders will be pretty much useless. How do you deal with ! newsgroups that have hundreds (or thousands) of new articles each day? ! Gnus offer no real solutions to these questions, but I would very much ! like to see Gnus being used as a testing ground for new methods of ! reading and fetching news. Expanding on Umeda-san's wise decision to ! separate the newsreader from the backends, Gnus now offers a simple ! interface for anybody who wants to write new backends for fetching mail ! and news from different sources. I have added hooks for customizations ! everywhere I can imagine useful. By doing so, I'm inviting every one of ! you to explore and invent new ways of reading news. ! May Gnus never be complete. @kbd{C-u 100 M-x hail-emacs}. ! @node Compatibility ! @section Compatibility - @cindex compatibility - Gnus was designed to be fully compatible with @sc{gnus}. Almost all key - bindings have been kept. More key bindings have been added, of course, - but only in one or two obscure cases have old bindings been changed. ! Our motto is: ! @quotation ! @cartouche ! @center In a cloud bones of steel. ! @end cartouche ! @end quotation ! All commands have kept their names. Some internal functions have changed ! their names. ! The @code{gnus-uu} package has changed drastically. @xref{Decoding ! Articles}. ! One major compatibility question if the presence of several summary ! buffers. All variables that are relevant while reading a group are ! buffer-local to the summary buffer they belong in. Although most ! important variables have their values copied into their global ! counterparts whenever a command is executed in the summary buffer, this ! change might lead to incorrect values being used unless you are careful. ! All code that relies on knowledge of @sc{gnus} internals will probably ! fail. To take two examples: Sorting @code{gnus-newsrc-assoc} (or ! changing it in any way, as a matter of fact) is strictly verboten. Gnus ! maintains a hash table that points to the entries in this assoc (which ! speeds up many functions), and changing the assoc directly will lead to ! peculiar results. ! @cindex hilit19 ! @cindex highlighting ! Old hilit19 code does not work at all. In fact, you should probably ! remove all hilit code from all Gnus hooks ! (@code{gnus-group-prepare-hook}, @code{gnus-summary-prepare-hook} and ! @code{gnus-summary-article-hook}). (Well, at the very least the first ! two.) Gnus provides various integrated functions for highlighting. ! These are faster and more accurate. To make life easier for everybody, ! Gnus will by default remove all hilit calls from all hilit hooks. ! Uncleanliness! Away! ! Packages like @code{expire-kill} will no longer work. As a matter of ! fact, you should probably remove all old @sc{gnus} packages (and other ! code) when you start using Gnus. More likely than not, Gnus already ! does what you have written code to make @sc{gnus} do. (Snicker.) ! Even though old methods of doing things are still supported, only the ! new methods are documented in this manual. If you detect a new method of ! doing something while reading this manual, that does not mean you have ! to stop doing it the old way. ! Gnus understands all @sc{gnus} startup files. ! @kindex M-x gnus-bug ! Overall, a casual user who hasn't written much code that depends on ! @sc{gnus} internals should suffer no problems. If problems occur, ! please let me know (@kbd{M-x gnus-bug}). ! Problems specific to GNU XEmacs can be reported to popineau@@ese-metz.fr ! (Fabrice Popineau). I will just forward any such questions to him, ! anyway, so you might have to wait longer if you mail XEmacs questions to ! me. ! @node Conformity ! @section Conformity ! No rebels without a clue here, ma'am. We conform to all standards known ! to man. Except, of course, where we disagree with the standards and/or ! conventions. - @table @strong ! @item RFC 822 ! There are no known breaches to this standard. ! @item RFC 1036 ! There are no known breaches to this standard, either. ! @item Usenet Seal of Approval ! Gnus hasn't been formally through the Seal process, but I have read ! through the Seal text, and I think that Gnus would pass. ! @item Son-of-RFC 1036 ! We do have some breaches to this one. ! @table @emph ! @item MIME ! Gnus does no MIME handling, and this standard-to-be seems to think that ! MIME is the bees' knees, so we have major breakage here. ! @item X-Newsreader ! This is considered to be a "vanity header", while I consider it to be ! consumer information. After seeing so many badly formatted articles ! coming from @code{tin} and @code{Netscape} I know not to use either of ! those for posting articles. I would not have known that if it wasn't ! for the @code{X-Newsreader} header. ! @item References ! Gnus does line breaking on this header. I infer from RFC1036 that being ! conservative in what you output is not creating 5000-character lines, so ! it seems like a good idea to me. However, this standard-to-be says that ! whitespace in the @code{References} header is to be preserved, so... It ! doesn't matter one way or the other to Gnus, so if somebody tells me ! what The Way is, I'll change it. Or not. ! @end table ! @end table - If you ever see Gnus act noncompliantly to the texts mentioned above, - don't hesitate to drop a note to Gnus Towers and let us know. ! @node Contributors ! @section Contributors ! @cindex contributors ! The new Gnus version couldn't have been done without the help of all the ! people on the (ding) mailing list. Every day for months I have gotten ! tens of nice bug reports from them, filling me with joy, every single ! one of them. Smooches. The people on the list have been tried beyond ! endurance, what with my "oh, that's a neat idea , yup, I'll ! release it right away no wait, that doesn't work at all , yup, I'll ship that one off right away no, wait, that ! absolutely does not work" policy for releases. Microsoft - bah. I'm ! @emph{much} worse. - I would like to take this opportunity to thank the Academy for... oops, - wrong show. ! @itemize @bullet ! @item ! Of course, GNUS was written by Masanobu UMEDA. ! @item ! Many excellent functions, especially dealing with scoring and ! highlighting (as well as the soon-to-come @sc{soup} support) was written ! by Per Abrahamsen. ! @item ! Innumerable bug fixes were written by Sudish Joseph. ! @item ! The refcard was written by Vladimir Alexiev. ! @item ! I stole some pieces from the XGnus distribution by Felix Lee and JWZ. ! @item ! nnfolder has been much enhanced by Scott Byer. ! @item ! The orphan scoring was written by Peter Mutsaers. ! @item ! GNU XEmacs support has been added by Fabrice Popineau. ! @item ! Various bits and pieces, especially dealing with .newsrc files, was ! suggested and added by Hallvard B Furuseth. ! @item ! Brian Edmonds has written @code{gnus-bbdb}, as well as other bits and ! pieces. ! @item ! Ricardo Nassif did the proof-reading. ! @item ! Kevin Davidson came up with the name @dfn{ding}, so blame him. ! @item ! Stainless Steel Rat, Ulrik Dickow, Jack Vinson, Daniel Quinlan, Ilja ! Weis, Frank D. Cringle, Geoffrey T. Dairiki and Andrew Eskilsson have ! all contributed code and suggestions. ! @end itemize ! @node New Features ! @section New Features ! @cindex new features ! @itemize @bullet ! @item ! The look of all buffers can be changed by setting format-like variables ! (@pxref{Group Buffer Format} and @pxref{Summary Buffer Format}). ! ! @item ! Local spool and several @sc{nntp} servers can be used at once ! (@pxref{Foreign Groups}). ! @item ! You can combine groups into virtual groups (@pxref{nnvirtual}). ! @item ! You can read a number of different mail formats (@pxref{Reading Mail}). ! All the mail backends implement a convenient mail expiry scheme ! (@code{Expiring Old Mail Articles}). ! @item ! Gnus can use various strategies for gathering threads that have lost ! their roots (thereby gathering loose sub-threads in one thread) or it ! can go back and retrieve enough headers to build a complete thread ! (@pxref{Customizing Threading}). ! @item ! Killed groups can be displayed in the group buffer, and you can read ! them as well. ! @item ! Gnus can do partial group updates - you do not have to retrieve the ! entire active file just to check for new articles in a few groups ! (@pxref{The Active File}). ! @item ! Gnus implements a sliding scale of subscribedness to groups ! (@pxref{Group Levels}). ! @item ! You can score articles according to any number of criteria (@pxref{Score ! Files}). You can even get Gnus to score articles for you ! (@pxref{Adaptive Scoring}). ! @item ! Gnus maintains a dribble buffer that is auto-saved the normal Emacs ! manner, so it should be difficult to lose much data on what you have ! read if your machine should go down (@pxref{Auto Save}). ! @item ! Gnus now has its own startup file to avoid cluttering up the ! @file{.emacs} file. ! ! @item ! You can set the process mark on both groups and articles and perform ! operations on all the marked items (@pxref{Process/Prefix}). ! @item ! You can grep through a subset of groups and create a group from the ! results (@pxref{nnkiboze}). ! @item ! You can list subsets of groups according to, well, anything ! (@pxref{Listing Groups}). ! @item ! You can browse foreign servers and subscribe to groups from those ! servers (@pxref{Browse Foreign Server}). ! @item ! Gnus can fetch articles asynchronously on a second connection to the ! server (@pxref{Asynchronous Fetching}). ! @item ! You can cache articles locally (@pxref{Article Caching}). ! @item ! The uudecode functions have been expanded and generalized ! (@pxref{Decoding Articles}). ! @item ! You can still post uuencoded articles, which was a little-known feature ! of @sc{gnus} past (@pxref{Uuencoding & Posting}). - @item - Fetching parents (and other articles) now actually works without - glitches (@pxref{Finding the Parent}). ! @item ! Gnus can fetch FAQs to and descriptions of groups (@pxref{Group ! Information}). ! @item ! Digests (and other files) can be used as the basis for groups ! (@pxref{nndoc}). ! @item ! Articles can be highlighted and customized (@pxref{Customizing ! Articles}). ! @item ! All Gnus buffers can be customized in a difficult fashion ! (@pxref{Windows Configuration}). ! @item ! You can click on buttons instead of using the keyboard ! (@pxref{Buttons}). ! @end itemize ! This is, of course, just a @emph{short} overview of the @emph{most} ! important new features. No, really. There are tons more. Yes, we have ! feeping creaturism in full effect, but nothing too gratuitous, I would ! hope. - @node Newest Features - @section Newest Features - @cindex todo ! Also known as the @dfn{todo list}. Sure to be implemented before the ! next millennium. ! Be afraid. Be very afraid. ! @itemize @bullet ! @item ! Native @sc{mime} support is something that should be done. I was hoping ! I could steal code from @code{Mew}, the @sc{mime} mail reader for Emacs, ! but I'm not quite sure what the status of that project is. Gnus might ! support @sc{mime} quite soon, and it might not. ! @item ! @code{trn}-like trees. ! @item ! @code{nn}-like pick-and-read summary interface. ! @item ! NoCeM support. ! @item ! Frame configuration. ! @item ! Re-sending bounced mail and rejected articles. ! @item ! Floating point group levels and group bubbling. ! @item ! @file{/etc/nntpserver} usage. ! @item ! Automatic re-scan of incoming mail. ! @item ! Buttonize more stuff in the article buffer. ! @item ! A better and simpler method for specifying mail composing methods. ! @item ! Marks for saved, forwarded, etc articles. ! @item ! Speed up caching and adaptive scoring. ! @item ! Gather thread by filling in missing Message-IDs. ! @item ! Slave Gnusii to enable several Gnusii to run at once. ! @item ! PGP support. ! @item ! Allow posting through mail-to-news gateways. ! @item ! Allow renaming mail groups in a simple fashion. ! @item ! Speed up massive group massacres. ! @item ! @code{jka-compr} isn't fully supported. ! @item ! Create better digests. ! @item ! Do better word-wrap on cited text. ! @item ! Better X-Face support with X-Face databases and stuff. ! @item ! Support SELF-DISCIPLINE pins. ! @item ! Really do unbinhexing. ! @item ! Fetching by Message-ID should work in mail groups. ! @item ! Listing of all active groups. ! @item ! XEmacs toolbar. ! @item ! Do the X-Receipt-To thing. ! @item ! Hierarchal group buffers. ! @item ! Don't kill summary buffers upon exit from the groups. ! @item ! Allow adaptation on secondary marks. ! @end itemize ! And much, much, much more. There is more to come than has already been ! implemented. (But that's always true, isn't it?) - You can probably sneak a look at the actual up-to-the-second todo list - by snooping @code{}. ! @node Censorship ! @section Censorship ! @cindex censorship ! ! This version of the Gnus manual (as well as Gnus itself) has been ! censored in accord with the Communications Decency Act. This law was ! described by its proponents as a ban on pornography---which was a ! deception, since it prohibits far more than that. This manual did not ! contain pornography, but part of it was prohibited nonetheless. ! ! For information on US government censorship of the Internet, and ! what you can do to bring back freedom of the press, see the web ! site @samp{http://www.vtw.org/}. ! @node Terminology ! @chapter Terminology ! @cindex terminology ! @table @dfn ! @item news ! @cindex news ! This is what you are supposed to use this thing for - reading news. ! News is generally fetched from a nearby @sc{nntp} server, and is ! generally publicly available to everybody. If you post news, the entire ! world is likely to read just what you have written, and they'll all ! snigger mischievously. Behind your back. ! @item mail ! @cindex mail ! Everything that's delivered to you personally is mail. Some news/mail ! readers (like Gnus) blur the distinction between mail and news, but ! there is a difference. Mail is private. News is public. Mailing is ! not posting, and replying is not following up. ! @item reply ! Send a mail to the person who has written what you are reading. ! @item follow up ! Post an article to the current newsgroup responding to the article you ! are reading. ! @item backend ! Gnus gets fed articles from a number of backends, both news and mail ! backends. Gnus does not handle the underlying media, so to speak - this ! is all done by the backends. ! @item native ! Gnus will always use one method (and backend) as the @dfn{native}, or ! default, way of getting news. ! @item foreign ! You can also have any number of foreign groups at the same time. These ! are groups that use different backends for getting news. ! @item head ! @cindex head ! The top part of an article, where administration information (etc.) is ! put. ! @item body ! @cindex body ! The rest of an article. Everything that is not in the head is in the ! body. ! @item header ! @cindex header ! A line from the head of an article. ! @item headers ! @cindex headers ! A collection of such lines, or a collection of heads. Or even a ! collection of @sc{nov} lines. ! @item @sc{nov} ! @cindex nov ! When Gnus enters a group, it asks the backend for the headers for all ! the unread articles in the group. Most servers support the News OverView ! format, which is much smaller and much faster to read than the normal ! HEAD format. ! @item level ! @cindex levels ! Each group is subscribed at some @dfn{level} or other (1-9). The ones ! that have a lower level are "more" subscribed than the groups with a ! higher level. In fact, groups on levels 1-5 are considered ! @dfn{subscribed}; 6-7 are @dfn{unsubscribed}; 8 are @dfn{zombies}; and 9 ! are @dfn{killed}. Commands for listing groups and scanning for new ! articles will all use the numeric prefix as @dfn{working level}. ! @item killed groups ! @cindex killed groups ! No information on killed groups is stored or updated, which makes killed ! groups much easier to handle than subscribed groups. ! @item zombie groups ! @cindex zombie groups ! Just like killed groups, only slightly less dead. ! @item active file ! @cindex active file ! The news server has to keep track of what articles it carries, and what ! groups exist. All this information in stored in the active file, which ! is rather large, as you might surmise. ! @item bogus groups ! @cindex bogus groups ! A group that exists in the @file{.newsrc} file, but isn't known to the ! server (i. e., it isn't in the active file), is a @emph{bogus group}. ! This means that the group probably doesn't exist (any more). ! @end table ! @node Starting Up ! @chapter Starting Gnus ! @cindex starting up ! @kindex M-x gnus ! If your system administrator has set things up properly, starting Gnus ! and reading news is extremely easy - you just type @kbd{M-x gnus}. ! If things do not go smoothly at startup, you have to twiddle some ! variables. ! ! @menu ! * Finding the News:: Choosing a method for getting news. ! * The First Time:: What does Gnus do the first time you start it? ! * The Server is Down:: How can I read my mail then? ! * New Groups:: What is Gnus supposed to do with new groups? ! * Startup Files:: Those pesky startup files - @file{.newsrc}. ! * Auto Save:: Recovering from a crash. ! * The Active File:: Reading the active file over a slow line Takes Time. ! * Startup Variables:: Other variables you might change. ! @end menu ! ! @node Finding the News ! @section Finding the News ! ! @vindex gnus-select-method ! The @code{gnus-select-method} variable controls how Gnus finds news. ! This variable should be a list where the first element says @dfn{how} ! and the second element says @dfn{where}. This method is is your native ! method. All groups that are not fetched with this method are foreign ! groups. ! ! For instance, if you want to get your daily dosage of news from the ! @samp{news.somewhere.edu} @sc{nntp} server, you'd say: ! ! @lisp ! (setq gnus-select-method '(nntp "news.somewhere.edu")) ! @end lisp ! ! If you want to read directly from the local spool, say: ! ! @lisp ! (setq gnus-select-method '(nnspool "")) ! @end lisp ! ! If you can use a local spool, you probably should, as it will almost ! certainly be much faster. ! ! If this variable is not set, Gnus will take a look at the ! @code{NNTPSERVER} environment variable. If that isn't set either, it ! will try to use the machine that is running Emacs as an @sc{nntp} ! server. ! ! @vindex gnus-nntp-server ! If @code{gnus-nntp-server} is set, this variable will override ! @code{gnus-select-method}. You should therefore set ! @code{gnus-nntp-server} to @code{nil}, which is what it is by default. ! ! @vindex gnus-secondary-servers ! You can also make Gnus prompt you interactively for the name of an ! @sc{nntp} server. If you give a non-numerical prefix to @code{gnus} ! (i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers ! in the @code{gnus-secondary-servers} list (if any). You can also just ! type in the name of any server you feel like visiting. ! ! However, if you use one @sc{nntp} server regularly, and are just ! interested in a couple of groups from a different server, you would be ! better served by using the @code{gnus-group-browse-foreign-server} ! command from the group buffer. It will let you have a look at what ! groups are available, and you can subscribe to any of the groups you ! want to. This also makes @file{.newsrc} maintenance much tidier. ! @xref{Foreign Groups}. ! ! @vindex gnus-secondary-select-methods ! A slightly different approach to foreign groups is to set the ! @code{gnus-secondary-select-methods} variable. The select methods ! listed in this variable are in many ways just as native as the ! @code{gnus-select-method} server. They will also be queried for active ! files during startup (if that's required), and new newsgroups that ! appear on these servers will be subscribed (or not) just as native ! groups are. ! ! For instance, if you use the @code{nnmbox} backend to read you mail, you ! would typically set this variable to ! ! @lisp ! (setq gnus-secondary-select-methods '((nnmbox ""))) ! @end lisp ! ! @node The First Time ! @section The First Time ! @cindex first time usage ! ! If no startup files exist, Gnus will try to determine what groups should ! be subscribed by default. ! ! @vindex gnus-default-subscribed-newsgroups ! If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus ! will subscribe you to just those groups in that list, leaving the rest ! killed. Your system administrator should have set this variable to ! something useful. ! ! Since she hasn't, Gnus will just subscribe you to a few randomly picked ! groups (i.e., @samp{*.newusers}). (@dfn{Random} is here defined as ! "whatever Lars thinks you should read".) ! ! You'll also be subscribed to the Gnus documentation group, which should ! help you with most common problems. ! ! If @code{gnus-default-subscribed-newsgroups} is @code{t}, Gnus will just ! use the normal functions for handling new groups, and not do anything ! special. ! ! @node The Server is Down ! @section The Server is Down ! @cindex server errors ! ! If the default server is down, Gnus will understandably have some ! problems starting. However, if you have some mail groups in addition to ! the news groups, you may want to start Gnus anyway. ! ! Gnus, being the trusting sort of program, will ask whether to proceed ! without a native select method if that server can't be contacted. This ! will happen whether the server doesn't actually exist (i.e., you have ! given the wrong address) or the server has just momentarily taken ill ! for some reason or other. ! ! If Gnus says "nntp server on can't be opened. Continue?", ! you do not want to continue unless you have some foreign groups that you ! want to read. Even if you don't, Gnus will let you continue, but you'll ! find it difficult to actually do anything in the group buffer. But, ! hey, that's your problem. Blllrph! ! ! @node New Groups ! @section New Groups ! @cindex new groups ! ! @vindex gnus-subscribe-newsgroup-method ! What Gnus does when it encounters a new group is determined by the ! @code{gnus-subscribe-newsgroup-method} variable. ! ! This variable should contain a function. Some handy pre-fab values ! are: ! ! @table @code ! @item gnus-subscribe-randomly ! @vindex gnus-subscribe-randomly ! Subscribe all new groups randomly. ! @item gnus-subscribe-alphabetically ! @vindex gnus-subscribe-alphabetically ! Subscribe all new groups alphabetically. ! @item gnus-subscribe-hierarchically ! @vindex gnus-subscribe-hierarchically ! Subscribe all new groups hierarchically. ! @item gnus-subscribe-interactively ! @vindex gnus-subscribe-interactively ! Subscribe new groups interactively. This means that Gnus will ask ! you about @strong{all} new groups. ! @item gnus-subscribe-zombies ! @vindex gnus-subscribe-zombies ! Make all new groups zombies. You can browse the zombies later and ! either kill them all off properly, or subscribe to them. This is the ! default. ! @end table ! ! @vindex gnus-subscribe-hierarchical-interactive ! A closely related variable is ! @code{gnus-subscribe-hierarchical-interactive}. (That's quite a ! mouthful.) If this variable is non-@code{nil}, Gnus will ask you in a ! hierarchical fashion whether to subscribe to new groups or not. Gnus ! will ask you for each sub-hierarchy whether you want to descend the ! hierarchy or not. ! ! One common way to control which new newsgroups should be subscribed or ! ignored is to put an @dfn{options} line at the start of the ! @file{.newsrc} file. Here's an example: ! ! @example ! options -n !alt.all !rec.all sci.all ! @end example ! ! @vindex gnus-subscribe-options-newsgroup-method ! This line obviously belongs to a serious-minded intellectual scientific ! person (or she may just be plain old boring), because it says that all ! groups that have names beginning with @samp{alt} and @samp{rec} should ! be ignored, and all groups with names beginning with @samp{sci} should ! be subscribed. Gnus will not use the normal subscription method for ! subscribing these groups. ! @code{gnus-subscribe-options-newsgroup-method} is used instead. This ! variable defaults to @code{gnus-subscribe-alphabetically}. ! ! @vindex gnus-options-not-subscribe ! @vindex gnus-options-subscribe ! If you don't want to mess with your @file{.newsrc} file, you can just ! set the two variables @code{gnus-options-subscribe} and ! @code{gnus-options-not-subscribe}. These two variables do exactly the ! same as the @file{.newsrc} options -n trick. Both are regexps, and if ! the the new group matches the first, it will be unconditionally ! subscribed, and if it matches the latter, it will be ignored. ! ! @vindex gnus-check-new-newsgroups ! If you are satisfied that you really never want to see any new groups, ! you could set @code{gnus-check-new-newsgroups} to @code{nil}. This will ! also save you some time at startup. Even if this variable is ! @code{nil}, you can always subscribe to the new groups just by pressing ! @kbd{U} in the group buffer (@pxref{Group Maintenance}). ! ! Gnus normally determines whether a group is new or not by comparing the ! list of groups from the active file(s) with the lists of subscribed and ! dead groups. This isn't a particularly fast method. If ! @code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the ! server for new groups since the last time. This is both faster & ! cheaper. This also means that you can get rid of the list of killed ! groups altogether, so you may set @code{gnus-save-killed-list} to ! @code{nil}, which will save time both at startup, at exit, and all over. ! Saves disk space, too. Why isn't this the default, then? ! Unfortunately, not all servers support this function. ! ! This variable can also be a list of select methods. If so, Gnus will ! issue an @code{ask-server} command to each of the select methods, and ! subscribe them (or not) using the normal methods. This might be handy ! if you are monitoring a few servers for new groups. A side effect is ! that startup will take much longer, so you can meditate while waiting. ! Use the mantra "dingnusdingnusdingnus" to achieve permanent happiness. ! ! @node Startup Files ! @section Startup Files ! @cindex startup files ! @cindex .newsrc ! ! Now, you all know about the @file{.newsrc} file. All subscription ! information is traditionally stored in this file. ! ! Things got a bit more complicated with @sc{gnus}. In addition to ! keeping the @file{.newsrc} file updated, it also used a file called ! @file{.newsrc.el} for storing all the information that didn't fit into ! the @file{.newsrc} file. (Actually, it duplicated everything in the ! @file{.newsrc} file.) @sc{gnus} would read whichever one of these files ! that were the most recently saved, which enabled people to swap between ! @sc{gnus} and other newsreaders. ! ! That was kinda silly, so Gnus went one better: In addition to the ! @file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called ! @file{.newsrc.eld}. It will read whichever of these files that are most ! recent, but it will never write a @file{.newsrc.el} file. ! ! @vindex gnus-save-newsrc-file ! You can also turn off writing the @file{.newsrc} file by setting ! @code{gnus-save-newsrc-file} to @code{nil}, which means you can delete ! the file and save some space, as well as making exit from Gnus faster. ! However, this will make it impossible to use other newsreaders than ! Gnus. But hey, who would want to, right? ! ! @vindex gnus-save-killed-list ! If @code{gnus-save-killed-list} is @code{nil}, Gnus will not save the ! list of killed groups to the startup file. This will save both time ! (when starting and quitting) and space (on disk). It will also means ! that Gnus has no record of what groups are new or old, so the automatic ! new groups subscription methods become meaningless. You should always ! set @code{gnus-check-new-newsgroups} to @code{nil} or @code{ask-server} ! if you set this variable to @code{nil} (@pxref{New Groups}). ! ! @vindex gnus-startup-file ! The @code{gnus-startup-file} variable says where the startup files are. ! The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup ! file being whatever that one is with a @samp{.eld} appended. ! ! @vindex gnus-save-newsrc-hook ! @code{gnus-save-newsrc-hook} is called before saving the @file{.newsrc} ! file. ! ! @node Auto Save ! @section Auto Save ! @cindex dribble file ! @cindex auto-save ! ! Whenever you do something that changes the Gnus data (reading articles, ! catching up, killing/subscribing groups), the change is added to a ! special @dfn{dribble buffer}. This buffer is auto-saved the normal ! Emacs way. If your Emacs should crash before you have saved the ! @file{.newsrc} files, all changes you have made can be recovered from ! this file. ! ! If Gnus detects this file at startup, it will ask the user whether to ! read it. The auto save file is deleted whenever the real startup file is ! saved. ! ! @vindex gnus-use-dribble-file ! If @code{gnus-use-dribble-file} is @code{nil}, Gnus won't create and ! maintain a dribble buffer. ! ! @node The Active File ! @section The Active File ! @cindex active file ! @cindex ignored groups ! ! When Gnus starts, or indeed whenever it tries to determine whether new ! articles have arrived, it reads the active file. This is a very large ! file that lists all the active groups and articles on the @sc{nntp} ! server. ! ! @vindex gnus-ignored-newsgroups ! Before examining the active file, Gnus deletes all lines that match the ! regexp @code{gnus-ignored-newsgroups}. This is done primarily to reject ! any groups with bogus names, but you can use this variable to make Gnus ! ignore hierarchies you aren't ever interested in. This variable is ! @code{nil} by default, and will slow down active file handling somewhat ! if you set it to anything else. ! ! @vindex gnus-read-active-file ! The active file can be rather Huge, so if you have a slow network, you ! can set @code{gnus-read-active-file} to @code{nil} to prevent Gnus from ! reading the active file. ! ! Gnus will try to make do by just getting information on the groups ! that you actually subscribe to. ! ! Note that if you subscribe to lots and lots of groups, setting this ! variable to @code{nil} will probably make Gnus slower, not faster. At ! present, having this variable @code{nil} will slow Gnus down ! considerably, unless you read news over a 2400 baud modem. This variable can also have the value @code{some}. Gnus will then attempt to read active info only on the subscribed groups. On some servers this is quite fast (on sparkling, brand new INN servers that ! support the @samp{LIST ACTIVE group} command), on others this is not ! fast at all. In any case, @code{some} should be faster than @code{nil}, ! and is certainly faster than @code{t} over slow lines. ! If this variable is @code{nil}, Gnus will as for group info in total lock-step, which isn't very fast. If it is @code{some} and you use an ! NNTP server, Gnus will pump out commands as fast as it can, and read all ! the replies in one swoop. This will normally result in better performance, but if the server does not support the aforementioned ! @samp{LIST ACTIVE group} command, this isn't very nice to the server. - In any case, if you use @code{some} or @code{nil}, you should kill all - groups that you aren't interested in. @node Startup Variables --- 60,587 ---- into another language, under the above conditions for modified versions. @end titlepage @page ! @end tex ! @node Top @top The Gnus Newsreader + @ifinfo + You can read news (and mail) from within Emacs by using Gnus. The news ! can be gotten by any nefarious means you can think of---@sc{nntp}, local spool or your mbox file. All at the same time, if you want to push your luck. ! @end ifinfo ! @iftex ! Gnus is the advanced, self-documenting, customizable, extensible ! unreal-time newsreader for GNU Emacs. ! Oops. That sounds oddly familiar, so let's start over again to avoid ! being accused of plagiarism: ! Gnus is a message-reading laboratory. It will let you look at just ! about anything as if it were a newsgroup. You can read mail with it, ! you can browse directories with it, you can @code{ftp} with it---you can ! even read news with it! ! ! Gnus tries to empower people who read news the same way Emacs empowers ! people who edit text. Gnus sets no limits to what the user should be ! allowed to do. Users are encouraged to extend Gnus to make it behave ! like they want it to behave. A program should not control people; ! people should be empowered to do what they want by using (or abusing) ! the program. ! @end iftex @menu ! * Starting Up:: Finding news can be a pain. ! * The Group Buffer:: Selecting, subscribing and killing groups. ! * The Summary Buffer:: Reading, saving and posting articles. ! * The Article Buffer:: Displaying and handling articles. ! * Composing Messages:: Information on sending mail and news. ! * Select Methods:: Gnus reads all messages from various select methods. ! * Scoring:: Assigning values to articles. ! * Various:: General purpose settings. ! * The End:: Farewell and goodbye. ! * Appendices:: Terminology, Emacs intro, FAQ, History, Internals. ! * Index:: Variable, function and concept index. ! * Key Index:: Key Index. @end menu ! @node Starting Up ! @chapter Starting Gnus ! @cindex starting up ! @kindex M-x gnus ! @findex gnus ! If your system administrator has set things up properly, starting Gnus ! and reading news is extremely easy---you just type @kbd{M-x gnus} in ! your Emacs. ! @findex gnus-other-frame ! @kindex M-x gnus-other-frame ! If you want to start Gnus in a different frame, you can use the command ! @kbd{M-x gnus-other-frame} instead. ! If things do not go smoothly at startup, you have to twiddle some ! variables. ! @menu ! * Finding the News:: Choosing a method for getting news. ! * The First Time:: What does Gnus do the first time you start it? ! * The Server is Down:: How can I read my mail then? ! * Slave Gnusii:: You can have more than one Gnus active at a time. ! * Fetching a Group:: Starting Gnus just to read a group. ! * New Groups:: What is Gnus supposed to do with new groups? ! * Startup Files:: Those pesky startup files---@file{.newsrc}. ! * Auto Save:: Recovering from a crash. ! * The Active File:: Reading the active file over a slow line Takes Time. ! * Startup Variables:: Other variables you might change. ! @end menu ! @node Finding the News ! @section Finding the News ! @vindex gnus-select-method ! @c @head ! The @code{gnus-select-method} variable says where Gnus should look for ! news. This variable should be a list where the first element says ! @dfn{how} and the second element says @dfn{where}. This method is your ! native method. All groups that are not fetched with this method are ! foreign groups. ! For instance, if the @samp{news.somewhere.edu} @sc{nntp} server is where ! you want to get your daily dosage of news from, you'd say: ! @lisp ! (setq gnus-select-method '(nntp "news.somewhere.edu")) ! @end lisp ! If you want to read directly from the local spool, say: ! @lisp ! (setq gnus-select-method '(nnspool "")) ! @end lisp ! If you can use a local spool, you probably should, as it will almost ! certainly be much faster. ! @vindex gnus-nntpserver-file ! @cindex NNTPSERVER ! @cindex @sc{nntp} server ! If this variable is not set, Gnus will take a look at the ! @code{NNTPSERVER} environment variable. If that variable isn't set, ! Gnus will see whether @code{gnus-nntpserver-file} ! (@file{/etc/nntpserver} by default) has any opinions on the matter. If ! that fails as well, Gnus will will try to use the machine that is ! running Emacs as an @sc{nntp} server. That's a long-shot, though. ! @vindex gnus-nntp-server ! If @code{gnus-nntp-server} is set, this variable will override ! @code{gnus-select-method}. You should therefore set ! @code{gnus-nntp-server} to @code{nil}, which is what it is by default. ! @vindex gnus-secondary-servers ! You can also make Gnus prompt you interactively for the name of an ! @sc{nntp} server. If you give a non-numerical prefix to @code{gnus} ! (i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers ! in the @code{gnus-secondary-servers} list (if any). You can also just ! type in the name of any server you feel like visiting. ! @findex gnus-group-browse-foreign-server ! @kindex B (Group) ! However, if you use one @sc{nntp} server regularly and are just ! interested in a couple of groups from a different server, you would be ! better served by using the @kbd{B} command in the group buffer. It will ! let you have a look at what groups are available, and you can subscribe ! to any of the groups you want to. This also makes @file{.newsrc} ! maintenance much tidier. @xref{Foreign Groups}. + @vindex gnus-secondary-select-methods + @c @head + A slightly different approach to foreign groups is to set the + @code{gnus-secondary-select-methods} variable. The select methods + listed in this variable are in many ways just as native as the + @code{gnus-select-method} server. They will also be queried for active + files during startup (if that's required), and new newsgroups that + appear on these servers will be subscribed (or not) just as native + groups are. ! For instance, if you use the @code{nnmbox} backend to read your mail, you ! would typically set this variable to ! @lisp ! (setq gnus-secondary-select-methods '((nnmbox ""))) ! @end lisp ! @node The First Time ! @section The First Time ! @cindex first time usage ! If no startup files exist, Gnus will try to determine what groups should ! be subscribed by default. ! @vindex gnus-default-subscribed-newsgroups ! If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus ! will subscribe you to just those groups in that list, leaving the rest ! killed. Your system administrator should have set this variable to ! something useful. ! Since she hasn't, Gnus will just subscribe you to a few arbitrarily ! picked groups (i.e., @samp{*.newusers}). (@dfn{Arbitrary} is here ! defined as @dfn{whatever Lars thinks you should read}.) ! You'll also be subscribed to the Gnus documentation group, which should ! help you with most common problems. ! If @code{gnus-default-subscribed-newsgroups} is @code{t}, Gnus will just ! use the normal functions for handling new groups, and not do anything ! special. + @node The Server is Down + @section The Server is Down + @cindex server errors ! If the default server is down, Gnus will understandably have some ! problems starting. However, if you have some mail groups in addition to ! the news groups, you may want to start Gnus anyway. ! Gnus, being the trusting sort of program, will ask whether to proceed ! without a native select method if that server can't be contacted. This ! will happen whether the server doesn't actually exist (i.e., you have ! given the wrong address) or the server has just momentarily taken ill ! for some reason or other. If you decide to continue and have no foreign ! groups, you'll find it difficult to actually do anything in the group ! buffer. But, hey, that's your problem. Blllrph! ! ! @findex gnus-no-server ! @c @head ! If you know that the server is definitely down, or you just want to read ! your mail without bothering with the server at all, you can use the ! @code{gnus-no-server} command to start Gnus. That might come in handy ! if you're in a hurry as well. ! ! ! @node Slave Gnusii ! @section Slave Gnusiï ! @cindex slave ! ! You might want to run more than one Emacs with more than one Gnus at the ! same time. If you are using different @file{.newsrc} files (eg., if you ! are using the two different Gnusiï to read from two different servers), ! that is no problem whatsoever. You just do it. ! ! The problem appears when you want to run two Gnusiï that use the same ! @code{.newsrc} file. ! ! To work around that problem some, we here at the Think-Tank at the Gnus ! Towers have come up with a new concept: @dfn{Masters} and ! @dfn{servants}. (We have applied for a patent on this concept, and have ! taken out a copyright on those words. If you wish to use those words in ! conjunction with each other, you have to send $1 per usage instance to ! me. Usage of the patent (@dfn{Master/Slave Relationships In Computer ! Applications}) will be much more expensive, of course.) ! ! Anyways, you start one Gnus up the normal way with @kbd{M-x gnus} (or ! however you do it). Each subsequent slave Gnusiï should be started with ! @kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc} ! files, but instead save @dfn{slave files} that contains information only ! on what groups have been read in the slave session. When a master Gnus ! starts, it will read (and delete) these slave files, incorporating all ! information from them. (The slave files will be read in the sequence ! they were created, so the latest changes will have precedence.) ! ! Information from the slave files has, of course, precedence over the ! information in the normal (i. e., master) @code{.newsrc} file. ! ! ! @node Fetching a Group ! @section Fetching a Group ! ! @findex gnus-fetch-group ! It it sometime convenient to be able to just say ``I want to read this ! group and I don't care whether Gnus has been started or not''. This is ! perhaps more useful for people who write code than for users, but the ! command @code{gnus-fetch-group} provides this functionality in any case. ! It takes the group name as a parameter. ! @node New Groups ! @section New Groups ! @cindex new groups + @vindex gnus-subscribe-newsgroup-method + What Gnus does when it encounters a new group is determined by the + @code{gnus-subscribe-newsgroup-method} variable. ! This variable should contain a function. Some handy pre-fab values ! are: ! @table @code ! @item gnus-subscribe-zombies ! @vindex gnus-subscribe-zombies ! Make all new groups zombies. You can browse the zombies later (with ! @kbd{A z}) and either kill them all off properly, or subscribe to them. ! This is the default. ! @item gnus-subscribe-randomly ! @vindex gnus-subscribe-randomly ! Subscribe all new groups randomly. ! @item gnus-subscribe-alphabetically ! @vindex gnus-subscribe-alphabetically ! Subscribe all new groups alphabetically. ! @item gnus-subscribe-hierarchically ! @vindex gnus-subscribe-hierarchically ! Subscribe all new groups hierarchically. ! @item gnus-subscribe-interactively ! @vindex gnus-subscribe-interactively ! Subscribe new groups interactively. This means that Gnus will ask ! you about @strong{all} new groups. ! @item gnus-subscribe-killed ! @vindex gnus-subscribe-killed ! Kill all new groups. ! @end table ! @vindex gnus-subscribe-hierarchical-interactive ! A closely related variable is ! @code{gnus-subscribe-hierarchical-interactive}. (That's quite a ! mouthful.) If this variable is non-@code{nil}, Gnus will ask you in a ! hierarchical fashion whether to subscribe to new groups or not. Gnus ! will ask you for each sub-hierarchy whether you want to descend the ! hierarchy or not. ! One common mistake is to set the variable a few paragraphs above to ! @code{gnus-subscribe-hierarchical-interactive}. This is an error. This ! will not work. This is ga-ga. So don't do it. ! ! A nice and portable way to control which new newsgroups should be ! subscribed (or ignored) is to put an @dfn{options} line at the start of ! the @file{.newsrc} file. Here's an example: ! @example ! options -n !alt.all !rec.all sci.all ! @end example ! @vindex gnus-subscribe-options-newsgroup-method ! This line obviously belongs to a serious-minded intellectual scientific ! person (or she may just be plain old boring), because it says that all ! groups that have names beginning with @samp{alt} and @samp{rec} should ! be ignored, and all groups with names beginning with @samp{sci} should ! be subscribed. Gnus will not use the normal subscription method for ! subscribing these groups. ! @code{gnus-subscribe-options-newsgroup-method} is used instead. This ! variable defaults to @code{gnus-subscribe-alphabetically}. ! @vindex gnus-options-not-subscribe ! @vindex gnus-options-subscribe ! If you don't want to mess with your @file{.newsrc} file, you can just ! set the two variables @code{gnus-options-subscribe} and ! @code{gnus-options-not-subscribe}. These two variables do exactly the ! same as the @file{.newsrc} @samp{options -n} trick. Both are regexps, ! and if the the new group matches the former, it will be unconditionally ! subscribed, and if it matches the latter, it will be ignored. ! @vindex gnus-auto-subscribed-groups ! Yet another variable that meddles here is ! @code{gnus-auto-subscribed-groups}. It works exactly like ! @code{gnus-options-subscribe}, and is therefore really superfluous, but I ! thought it would be nice to have two of these. This variable is more ! meant for setting some ground rules, while the other variable is used ! more for user fiddling. By default this variable makes all new groups ! that come from mail backends (@code{nnml}, @code{nnbabyl}, ! @code{nnfolder}, @code{nnmbox}, and @code{nnmh}) subscribed. If you ! don't like that, just set this variable to @code{nil}. ! @vindex gnus-check-new-newsgroups ! If you are satisfied that you really never want to see any new groups, ! you could set @code{gnus-check-new-newsgroups} to @code{nil}. This will ! also save you some time at startup. Even if this variable is ! @code{nil}, you can always subscribe to the new groups just by pressing ! @kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable ! is @code{t} by default. ! Gnus normally determines whether a group is new or not by comparing the ! list of groups from the active file(s) with the lists of subscribed and ! dead groups. This isn't a particularly fast method. If ! @code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the ! server for new groups since the last time. This is both faster & ! cheaper. This also means that you can get rid of the list of killed ! groups altogether, so you may set @code{gnus-save-killed-list} to ! @code{nil}, which will save time both at startup, at exit, and all over. ! Saves disk space, too. Why isn't this the default, then? ! Unfortunately, not all servers support this command. ! I bet I know what you're thinking now: How do I find out whether my ! server supports @code{ask-server}? No? Good, because I don't have a ! fail-safe answer. I would suggest just setting this variable to ! @code{ask-server} and see whether any new groups appear within the next ! few days. If any do, then it works. If any don't, then it doesn't ! work. I could write a function to make Gnus guess whether the server ! supports @code{ask-server}, but it would just be a guess. So I won't. ! You could @code{telnet} to the server and say @code{HELP} and see ! whether it lists @samp{NEWGROUPS} among the commands it understands. If ! it does, then it might work. (But there are servers that lists ! @samp{NEWGROUPS} without supporting the function properly.) ! This variable can also be a list of select methods. If so, Gnus will ! issue an @code{ask-server} command to each of the select methods, and ! subscribe them (or not) using the normal methods. This might be handy ! if you are monitoring a few servers for new groups. A side effect is ! that startup will take much longer, so you can meditate while waiting. ! Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss. ! @node Startup Files ! @section Startup Files ! @cindex startup files ! @cindex .newsrc ! Now, you all know about the @file{.newsrc} file. All subscription ! information is traditionally stored in this file. ! Things got a bit more complicated with @sc{gnus}. In addition to ! keeping the @file{.newsrc} file updated, it also used a file called ! @file{.newsrc.el} for storing all the information that didn't fit into ! the @file{.newsrc} file. (Actually, it also duplicated everything in ! the @file{.newsrc} file.) @sc{gnus} would read whichever one of these ! files was the most recently saved, which enabled people to swap between ! @sc{gnus} and other newsreaders. ! That was kinda silly, so Gnus went one better: In addition to the ! @file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called ! @file{.newsrc.eld}. It will read whichever of these files that are most ! recent, but it will never write a @file{.newsrc.el} file. ! @vindex gnus-save-newsrc-file ! You can turn off writing the @file{.newsrc} file by setting ! @code{gnus-save-newsrc-file} to @code{nil}, which means you can delete ! the file and save some space, as well as making exit from Gnus faster. ! However, this will make it impossible to use other newsreaders than ! Gnus. But hey, who would want to, right? ! @vindex gnus-save-killed-list ! If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus ! will not save the list of killed groups to the startup file. This will ! save both time (when starting and quitting) and space (on disk). It ! will also means that Gnus has no record of what groups are new or old, ! so the automatic new groups subscription methods become meaningless. ! You should always set @code{gnus-check-new-newsgroups} to @code{nil} or ! @code{ask-server} if you set this variable to @code{nil} (@pxref{New ! Groups}). ! @vindex gnus-startup-file ! The @code{gnus-startup-file} variable says where the startup files are. ! The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup ! file being whatever that one is with a @samp{.eld} appended. + @vindex gnus-save-newsrc-hook + @vindex gnus-save-quick-newsrc-hook + @vindex gnus-save-standard-newsrc-hook + @code{gnus-save-newsrc-hook} is called before saving any of the newsrc + files, while @code{gnus-save-quick-newsrc-hook} is called just before + saving the @file{.newsrc.eld} file, and + @code{gnus-save-standard-newsrc-hook} is called just before saving the + @file{.newsrc} file. The latter two are commonly used to turn version + control on or off. Version control is off by default when saving the + startup files. ! @node Auto Save ! @section Auto Save ! @cindex dribble file ! @cindex auto-save ! Whenever you do something that changes the Gnus data (reading articles, ! catching up, killing/subscribing groups), the change is added to a ! special @dfn{dribble buffer}. This buffer is auto-saved the normal ! Emacs way. If your Emacs should crash before you have saved the ! @file{.newsrc} files, all changes you have made can be recovered from ! this file. ! If Gnus detects this file at startup, it will ask the user whether to ! read it. The auto save file is deleted whenever the real startup file is ! saved. ! @vindex gnus-use-dribble-file ! If @code{gnus-use-dribble-file} is @code{nil}, Gnus won't create and ! maintain a dribble buffer. The default is @code{t}. ! @vindex gnus-dribble-directory ! Gnus will put the dribble file(s) in @code{gnus-dribble-directory}. If ! this variable is @code{nil}, which it is by default, Gnus will dribble ! into the directory where the @file{.newsrc} file is located. (This is ! normally the user's home directory.) The dribble file will get the same ! file permissions as the @code{.newsrc} file. ! @node The Active File ! @section The Active File ! @cindex active file ! @cindex ignored groups ! When Gnus starts, or indeed whenever it tries to determine whether new ! articles have arrived, it reads the active file. This is a very large ! file that lists all the active groups and articles on the server. ! @vindex gnus-ignored-newsgroups ! Before examining the active file, Gnus deletes all lines that match the ! regexp @code{gnus-ignored-newsgroups}. This is done primarily to reject ! any groups with bogus names, but you can use this variable to make Gnus ! ignore hierarchies you aren't ever interested in. However, this is not ! recommended. In fact, it's highly discouraged. Instead, @pxref{New ! Groups} for an overview of other variables that can be used instead. ! ! @c This variable is ! @c @code{nil} by default, and will slow down active file handling somewhat ! @c if you set it to anything else. ! @vindex gnus-read-active-file ! @c @head ! The active file can be rather Huge, so if you have a slow network, you ! can set @code{gnus-read-active-file} to @code{nil} to prevent Gnus from ! reading the active file. This variable is @code{t} by default. ! Gnus will try to make do by getting information just on the groups that ! you actually subscribe to. ! Note that if you subscribe to lots and lots of groups, setting this ! variable to @code{nil} will probably make Gnus slower, not faster. At ! present, having this variable @code{nil} will slow Gnus down ! considerably, unless you read news over a 2400 baud modem. This variable can also have the value @code{some}. Gnus will then attempt to read active info only on the subscribed groups. On some servers this is quite fast (on sparkling, brand new INN servers that ! support the @code{LIST ACTIVE group} command), on others this isn't fast ! at all. In any case, @code{some} should be faster than @code{nil}, and ! is certainly faster than @code{t} over slow lines. ! If this variable is @code{nil}, Gnus will ask for group info in total lock-step, which isn't very fast. If it is @code{some} and you use an ! @sc{nntp} server, Gnus will pump out commands as fast as it can, and ! read all the replies in one swoop. This will normally result in better performance, but if the server does not support the aforementioned ! @code{LIST ACTIVE group} command, this isn't very nice to the server. ! ! In any case, if you use @code{some} or @code{nil}, you should definitely ! kill all groups that you aren't interested in to speed things up. @node Startup Variables *************** groups that you aren't interested in. *** 977,984 **** @table @code @item gnus-load-hook @vindex gnus-load-hook A hook that is run while Gnus is being loaded. Note that this hook will ! normally be run just once in a single Emacs session, no matter how many times you start Gnus. --- 589,597 ---- @table @code + @item gnus-load-hook @vindex gnus-load-hook A hook that is run while Gnus is being loaded. Note that this hook will ! normally be run just once in each Emacs session, no matter how many times you start Gnus. *************** If non-@code{nil}, Gnus will check for a *** 992,998 **** startup. A @dfn{bogus group} is a group that you have in your @file{.newsrc} file, but doesn't exist on the news server. Checking for ! bogus groups isn't very quick, so to save time and resources, it's best ! to leave this option off, and instead do the checking for bogus groups ! once in a while from the group buffer (@pxref{Group Maintenance}). @item gnus-inhibit-startup-message --- 605,611 ---- startup. A @dfn{bogus group} is a group that you have in your @file{.newsrc} file, but doesn't exist on the news server. Checking for ! bogus groups can take quite a while, so to save time and resources it's ! best to leave this option off, and do the checking for bogus groups once ! in a while from the group buffer instead (@pxref{Group Maintenance}). @item gnus-inhibit-startup-message *************** once in a while from the group buffer (@ *** 1000,1004 **** If non-@code{nil}, the startup message won't be displayed. That way, your boss might not notice that you are reading news instead of doing ! your job. @item gnus-no-groups-message --- 613,617 ---- If non-@code{nil}, the startup message won't be displayed. That way, your boss might not notice that you are reading news instead of doing ! your job as easily. @item gnus-no-groups-message *************** Message displayed by Gnus when no groups *** 1007,1010 **** --- 620,624 ---- @end table + @node The Group Buffer @chapter The Group Buffer *************** long as Gnus is active. *** 1019,1038 **** * Group Maneuvering:: Commands for moving in the group buffer. * Selecting a Group:: Actually reading news. ! * Group Subscribing:: Unsubscribing, killing, subscribing. * Group Levels:: Levels? What are those, then? * Marking Groups:: You can mark groups for later processing. ! * Foreign Groups:: How to create foreign groups. * Group Parameters:: Each group may have different parameters set. * Listing Groups:: Gnus can list various subsets of the groups. * Group Maintenance:: Maintaining a tidy @file{.newsrc} file. ! * Browse Foreign Server:: You can browse a server. See what if has to offer. * Exiting Gnus:: Stop reading news and get some work done. * Misc Group Stuff:: Other stuff that you can to do. @end menu @node Group Buffer Format @section Group Buffer Format @cindex group buffer format The default format of the group buffer is nice and dull, but you can make it as exciting and ugly as you feel like. --- 633,666 ---- * Group Maneuvering:: Commands for moving in the group buffer. * Selecting a Group:: Actually reading news. ! * Subscription Commands:: Unsubscribing, killing, subscribing. * Group Levels:: Levels? What are those, then? + * Group Score:: A mechanism for finding out what groups you like. * Marking Groups:: You can mark groups for later processing. ! * Foreign Groups:: Creating and editing groups. * Group Parameters:: Each group may have different parameters set. * Listing Groups:: Gnus can list various subsets of the groups. + * Sorting Groups:: Re-arrange the group order. * Group Maintenance:: Maintaining a tidy @file{.newsrc} file. ! * Browse Foreign Server:: You can browse a server. See what it has to offer. * Exiting Gnus:: Stop reading news and get some work done. + * Group Topics:: A folding group mode divided into topics. * Misc Group Stuff:: Other stuff that you can to do. @end menu + @node Group Buffer Format @section Group Buffer Format @cindex group buffer format + @menu + * Group Line Specification:: Deciding how the group buffer is to look. + * Group Modeline Specification:: The group buffer modeline. + * Group Highlighting:: Having nice colors in the group buffer. + @end menu + + + @node Group Line Specification + @subsection Group Line Specification + The default format of the group buffer is nice and dull, but you can make it as exciting and ugly as you feel like. *************** You can change that format to whatever y *** 1057,1071 **** lines of a @code{format} specification, which is pretty much the same as a @code{printf} specifications, for those of you who use (feh!) C. ! ! In addition to the normal "padding" specs that @code{format} supports ! (eg. @samp{%7d}), specifications like @samp{%7,12s} are allowed. A spec ! of this type means that the field will be at least 7 characters long, ! and never more that 12 characters long. The default value that produced those lines above is ! @samp{"%M%S%5y: %(%g%)\n"}. There should always be a colon on the line; the cursor always moves to ! the colon after performing an operation. Nothing else is required - not even the group name. All displayed text is just window dressing, and is never examined by Gnus. Gnus stores all real information it needs using --- 685,695 ---- lines of a @code{format} specification, which is pretty much the same as a @code{printf} specifications, for those of you who use (feh!) C. ! @xref{Formatting Variables}. The default value that produced those lines above is ! @samp{%M%S%5y: %(%g%)\n}. There should always be a colon on the line; the cursor always moves to ! the colon after performing an operation. Nothing else is required---not even the group name. All displayed text is just window dressing, and is never examined by Gnus. Gnus stores all real information it needs using *************** Here's a list of all available format ch *** 1079,1119 **** @table @samp @item M Only marked articles. @item S Whether the group is subscribed. @item L Level of subscribedness. @item N Number of unread articles. @item I Number of dormant articles. @item T Number of ticked articles. @item R Number of read articles. @item t Total number of articles. @item y Number of unread, unticked, non-dormant articles. @item i Number of ticked and dormant articles. @item g Full group name. @item G Group name. @item D Newsgroup description. @item o ! Moderated. @item O ! Moderated. @item s Select method. @item n Select from where. @item z A string that looks like @samp{<%s:%n>} if a foreign select method is used. @item u User defined specifier. The next character in the format string should --- 703,771 ---- @table @samp + @item M Only marked articles. + @item S Whether the group is subscribed. + @item L Level of subscribedness. + @item N Number of unread articles. + @item I Number of dormant articles. + @item T Number of ticked articles. + @item R Number of read articles. + @item t Total number of articles. + @item y Number of unread, unticked, non-dormant articles. + @item i Number of ticked and dormant articles. + @item g Full group name. + @item G Group name. + @item D Newsgroup description. + @item o ! @samp{m} if moderated. ! @item O ! @samp{(m)} if moderated. ! @item s Select method. + @item n Select from where. + @item z A string that looks like @samp{<%s:%n>} if a foreign select method is used. + + @item P + Indentation based on the level of the topic (@pxref{Group Topics}). + + @item c + @vindex gnus-group-uncollapsed-levels + Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels} + variable says how many levels to leave at the end of the group name. + The default is @code{1}. + @item u User defined specifier. The next character in the format string should *************** into the buffer just like information fr *** 1126,1133 **** @cindex * ! All the "number-of" specs will be filled with an asterisk (@samp{*}) if ! no info is available - for instance, if it is a non-activated foreign group, or a bogus (or semi-bogus) native group. @vindex gnus-group-mode-line-format The mode line can be changed by setting --- 778,789 ---- @cindex * ! All the ``number-of'' specs will be filled with an asterisk (@samp{*}) ! if no info is available---for instance, if it is a non-activated foreign group, or a bogus (or semi-bogus) native group. + + @node Group Modeline Specification + @subsection Group Modeline Specification + @vindex gnus-group-mode-line-format The mode line can be changed by setting *************** format specifiers: *** 1137,1145 **** @table @samp @item S ! Default news server. @item M ! Default select method. @end table @node Group Maneuvering @section Group Maneuvering --- 793,863 ---- @table @samp @item S ! The native news server. @item M ! The native select method. @end table + + @node Group Highlighting + @subsection Group Highlighting + + @vindex gnus-group-highlight + Highlighting in the group buffer is controlled by the + @code{gnus-group-highlight} variable. This is an alist with elements + that look like @var{(form . face)}. If @var{form} evaluates to + something non-@code{nil}, the @var{face} will be used on the line. + + Here's an example value for this variable that might look nice if the + background is dark: + + @lisp + (setq gnus-group-highlight + `(((> unread 200) . + ,(custom-face-lookup "Red" nil nil t nil nil)) + ((and (< level 3) (zerop unread)) . + ,(custom-face-lookup "SeaGreen" nil nil t nil nil)) + ((< level 3) . + ,(custom-face-lookup "SpringGreen" nil nil t nil nil)) + ((zerop unread) . + ,(custom-face-lookup "SteelBlue" nil nil t nil nil)) + (t . + ,(custom-face-lookup "SkyBlue" nil nil t nil nil)) + )) + @end lisp + + Variables that are dynamically bound when the forms are evaluated + include: + + @table @code + @item group + The group name. + @item unread + The number of unread articles in the group. + @item method + The select method. + @item mailp + Whether the group is a mail group. + @item level + The level of the group. + @item score + The score of the group. + @item ticked + The number of ticked articles in the group. + @item topic + When using the topic minor mode, this variable is bound to the current + topic being inserted. + @end table + + When the forms are @code{eval}ed, point is at the beginning of the line + of the group in question, so you can use many of the normal Gnus + functions for snarfing info on the group. + + @vindex gnus-group-update-hook + @findex gnus-group-highlight-line + @code{gnus-group-update-hook} is called when a group line is changed. + It will not be called when @code{gnus-visual} is @code{nil}. This hook + calls @code{gnus-group-highlight-line} by default. + + @node Group Maneuvering @section Group Maneuvering *************** expected, hopefully. *** 1150,1153 **** --- 868,872 ---- @table @kbd + @item n @kindex n (Group) *************** expected, hopefully. *** 1155,1159 **** --- 874,880 ---- Go to the next group that has unread articles (@code{gnus-group-next-unread-group}). + @item p + @itemx DEL @kindex DEL (Group) *************** Go to the next group that has unread art *** 1162,1173 **** --- 883,897 ---- Go to the previous group group that has unread articles (@code{gnus-group-prev-unread-group}). + @item N @kindex N (Group) @findex gnus-group-next-group Go to the next group (@code{gnus-group-next-group}). + @item P @kindex P (Group) @findex gnus-group-prev-group Go to the previous group (@code{gnus-group-prev-group}). + @item M-p @kindex M-p (Group) *************** Go to the previous group (@code{gnus-gro *** 1175,1178 **** --- 899,903 ---- Go to the next unread group on the same level (or lower) (@code{gnus-group-next-unread-group-same-level}). + @item M-n @kindex M-n (Group) *************** Three commands for jumping to groups: *** 1185,1188 **** --- 910,914 ---- @table @kbd + @item j @kindex j (Group) *************** Jump to a group (and make it visible if *** 1191,1194 **** --- 917,921 ---- (@code{gnus-group-jump-to-group}). Killed groups can be jumped to, just like living groups. + @item , @kindex , (Group) *************** like living groups. *** 1196,1199 **** --- 923,927 ---- Jump to the unread group with the lowest level (@code{gnus-group-best-unread-group}). + @item . @kindex . (Group) *************** Jump to the first group with unread arti *** 1206,1210 **** If @code{gnus-group-goto-unread} is @code{nil}, all the movement commands will move to the next group, not the next unread group. Even ! the commands that say they move to the next unread group. @node Selecting a Group --- 934,940 ---- If @code{gnus-group-goto-unread} is @code{nil}, all the movement commands will move to the next group, not the next unread group. Even ! the commands that say they move to the next unread group. The default ! is @code{t}. ! @node Selecting a Group *************** the commands that say they move to the n *** 1213,1216 **** --- 943,947 ---- @table @kbd + @item SPACE @kindex SPACE (Group) *************** will fetch @var{N} number of articles. *** 1224,1227 **** --- 955,959 ---- the @var{N} newest articles, if @var{N} is negative, fetch the @var{abs(N)} oldest articles. + @item RET @kindex RET (Group) *************** the @var{N} newest articles, if @var{N} *** 1229,1304 **** Select the current group and switch to the summary buffer (@code{gnus-group-select-group}). Takes the same arguments as ! @code{gnus-group-read-group} - the only difference is that this command does not display the first unread article automatically upon group entry. @item c @kindex c (Group) @findex gnus-group-catchup-current Mark all unticked articles in this group as read ! (@code{gnus-group-catchup-current}). @item C @kindex C (Group) @findex gnus-group-catchup-current-all Mark all articles in this group, even the ticked ones, as read ! (@code{gnus-group-catchup-current-all}). @end table @vindex gnus-large-newsgroup The @code{gnus-large-newsgroup} variable says what Gnus should consider ! to be a big group. If the group has more unread articles than this, ! Gnus will query the user before entering the group. The user can then ! specify how many articles should be fetched from the server. If the ! user specifies a negative number (@samp{-n}), the @samp{n} oldest ! articles will be fetched. If it is positive, the @samp{n} articles that ! have arrived most recently will be fetched. @vindex gnus-select-group-hook @vindex gnus-auto-select-first ! If @code{gnus-auto-select-first} is non-@code{nil}, the first unread ! article in the group will be displayed when you enter the group. If you ! want to prevent automatic selection in some group (say, in a binary ! group with Huge articles) you can set this variable to @code{nil} in ! @code{gnus-select-group-hook}, which is called when a group is selected. ! @findex gnus-thread-sort-by-total-score ! @findex gnus-thread-sort-by-date ! @findex gnus-thread-sort-by-score ! @findex gnus-thread-sort-by-subject ! @findex gnus-thread-sort-by-author ! @findex gnus-thread-sort-by-number ! @vindex gnus-thread-sort-functions ! If you are using a threaded summary display, you can sort the threads by ! setting @code{gnus-thread-sort-functions}, which is a list of functions. ! By default, sorting is done on article numbers. Ready-made sorting ! functions include @code{gnus-thread-sort-by-number}, ! @code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, ! @code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, ! @code{gnus-thread-sort-by-total-score}. ! Each function takes two threads and return non-@code{nil} if the first ! thread should be sorted before the other. If you use more than one ! function, the primary sort key should be the last function in the list. ! If you would like to sort by score, then by subject, and finally by ! date, you could do something like: ! @lisp ! (setq gnus-thread-sort-functions ! '(gnus-thread-sort-by-date ! gnus-thread-sort-by-subject ! gnus-thread-sort-by-score)) ! @end lisp - @vindex gnus-thread-score-function - The function in the @code{gnus-thread-score-function} variable (default - @code{+}) is used for calculating the total score of a thread. Useful - functions might be @code{max}, @code{min}, or squared means, or whatever - tickles you fancy. ! @node Group Subscribing ! @section Group Subscribing @cindex subscribing @table @kbd @item S t @itemx u --- 961,1040 ---- Select the current group and switch to the summary buffer (@code{gnus-group-select-group}). Takes the same arguments as ! @code{gnus-group-read-group}---the only difference is that this command does not display the first unread article automatically upon group entry. + + @item M-RET + @kindex M-RET (Group) + @findex gnus-group-quick-select-group + This does the same as the command above, but tries to do it with the + minimum amount off fuzz (@code{gnus-group-quick-select-group}). No + scoring/killing will be performed, there will be no highlights and no + expunging. This might be useful if you're in a real hurry and have to + enter some humongous group. + + @item M-SPACE + @kindex M-RET (Group) + @findex gnus-group-visible-select-group + This is yet one more command that does the same as the one above, but + this one does it without expunging and hiding dormants + (@code{gnus-group-visible-select-group}). + @item c @kindex c (Group) @findex gnus-group-catchup-current + @vindex gnus-group-catchup-group-hook Mark all unticked articles in this group as read ! (@code{gnus-group-catchup-current}). ! @code{gnus-group-catchup-group-hook} is when catching up a group from ! the group buffer. ! @item C @kindex C (Group) @findex gnus-group-catchup-current-all Mark all articles in this group, even the ticked ones, as read ! (@code{gnus-group-catchup-current-all}). @end table @vindex gnus-large-newsgroup The @code{gnus-large-newsgroup} variable says what Gnus should consider ! to be a big group. This is 200 by default. If the group has more ! unread articles than this, Gnus will query the user before entering the ! group. The user can then specify how many articles should be fetched ! from the server. If the user specifies a negative number (@code{-n}), ! the @code{n} oldest articles will be fetched. If it is positive, the ! @code{n} articles that have arrived most recently will be fetched. @vindex gnus-select-group-hook @vindex gnus-auto-select-first ! @code{gnus-auto-select-first} control whether any articles are selected ! automatically when entering a group. ! @table @code ! @item nil ! Don't select any articles when entering the group. Just display the ! full summary buffer. ! @item t ! Select the first unread article when entering the group. ! @item best ! Select the most high-scored article in the group when entering the ! group. ! @end table ! ! If you want to prevent automatic selection in some group (say, in a ! binary group with Huge articles) you can set this variable to @code{nil} ! in @code{gnus-select-group-hook}, which is called when a group is ! selected. ! @node Subscription Commands ! @section Subscription Commands @cindex subscribing @table @kbd + @item S t @itemx u *************** tickles you fancy. *** 1308,1311 **** --- 1044,1048 ---- Toggle subscription to the current group (@code{gnus-group-unsubscribe-current-group}). + @item S s @itemx U *************** Prompt for a group to subscribe, and the *** 1316,1319 **** --- 1053,1057 ---- subscribed already, unsubscribe it instead (@code{gnus-group-unsubscribe-group}). + @item S k @itemx C-k *************** subscribed already, unsubscribe it inste *** 1322,1325 **** --- 1060,1064 ---- @findex gnus-group-kill-group Kill the current group (@code{gnus-group-kill-group}). + @item S y @itemx C-y *************** Kill the current group (@code{gnus-group *** 1328,1331 **** --- 1067,1078 ---- @findex gnus-group-yank-group Yank the last killed group (@code{gnus-group-yank-group}). + + @item C-x C-t + @kindex C-x C-t (Group) + @findex gnus-group-transpose-groups + Transpose two groups (@code{gnus-group-transpose-groups}). This isn't + really a subscription command, but you can use it instead of a + kill-and-yank sequence sometimes. + @item S w @itemx C-w *************** Yank the last killed group (@code{gnus-g *** 1334,1343 **** --- 1081,1106 ---- @findex gnus-group-kill-region Kill all groups in the region (@code{gnus-group-kill-region}). + @item S z @kindex S z (Group) @findex gnus-group-kill-all-zombies Kill all zombie groups (@code{gnus-group-kill-all-zombies}). + + @item S C-k + @kindex S C-k (Group) + @findex gnus-group-kill-level + Kill all groups on a certain level (@code{gnus-group-kill-level}). + These groups can't be yanked back after killing, so this command should + be used with some caution. The only thing where this command comes in + really handy is when you have a @file{.newsrc} with lots of unsubscribed + groups that you want to get rid off. @kbd{S C-k} on level @code{7} will + kill off all unsubscribed groups that do not have message numbers in the + @file{.newsrc} file. + @end table + Also @pxref{Group Levels}. + + @node Group Levels @section Group Levels *************** group is on level 2, it is more subscrib *** 1348,1354 **** can ask Gnus to just list groups on a given level or lower (@pxref{Listing Groups}), or to just check for new articles in groups on ! a given level or lower (@pxref{Misc Group Stuff}). @table @kbd @item S l @kindex S l (Group) --- 1111,1120 ---- can ask Gnus to just list groups on a given level or lower (@pxref{Listing Groups}), or to just check for new articles in groups on ! a given level or lower (@pxref{Scanning New Messages}). ! ! Remember: The higher the level of the group, the less important it is. @table @kbd + @item S l @kindex S l (Group) *************** prompted for a level. *** 1364,1377 **** @vindex gnus-level-subscribed Gnus considers groups on between levels 1 and ! @code{gnus-level-subscribed} (inclusive) to be subscribed, @code{gnus-level-subscribed} (exclusive) and ! @code{gnus-level-unsubscribed} (inclusive) to be unsubscribed, ! @code{gnus-level-zombie} to be zombies (walking dead) and ! @code{gnus-level-killed} to be killed, completely dead. Gnus treats ! subscribed and unsubscribed groups exactly the same, but zombie and ! killed groups have no information on what articles you have read, etc, ! stored. This distinction between dead and living groups isn't done ! because it is nice or clever, it is done purely for reasons of ! efficiency. It is recommended that you keep all your mail groups (if any) on quite --- 1130,1143 ---- @vindex gnus-level-subscribed Gnus considers groups on between levels 1 and ! @code{gnus-level-subscribed} (inclusive) (default 5) to be subscribed, @code{gnus-level-subscribed} (exclusive) and ! @code{gnus-level-unsubscribed} (inclusive) (default 7) to be ! unsubscribed, @code{gnus-level-zombie} to be zombies (walking dead) ! (default 8) and @code{gnus-level-killed} to be killed (default 9), ! completely dead. Gnus treats subscribed and unsubscribed groups exactly ! the same, but zombie and killed groups have no information on what ! articles you have read, etc, stored. This distinction between dead and ! living groups isn't done because it is nice or clever, it is done purely ! for reasons of efficiency. It is recommended that you keep all your mail groups (if any) on quite *************** them at all unless you know exactly what *** 1385,1391 **** @vindex gnus-level-default-subscribed Two closely related variables are @code{gnus-level-default-subscribed} ! and @code{gnus-level-default-unsubscribed}, which are the levels that new ! groups will be put on if they are (un)subscribed. These two variables ! should, of course, be inside the relevant legal ranges. @vindex gnus-keep-same-level --- 1151,1158 ---- @vindex gnus-level-default-subscribed Two closely related variables are @code{gnus-level-default-subscribed} ! (default 3) and @code{gnus-level-default-unsubscribed} (default 6), ! which are the levels that new groups will be put on if they are ! (un)subscribed. These two variables should, of course, be inside the ! relevant legal ranges. @vindex gnus-keep-same-level *************** All groups with a level less than or equ *** 1402,1409 **** by default. @vindex gnus-group-use-permanent-levels If @code{gnus-group-use-permanent-levels} is non-@code{nil}, once you give a level prefix to @kbd{g} or @kbd{l}, all subsequent commands will ! use this level as the "work" level. @node Marking Groups --- 1169,1217 ---- by default. + @vindex gnus-group-list-inactive-groups + If @code{gnus-group-list-inactive-groups} is non-@code{nil}, non-active + groups will be listed along with the unread groups. This variable is + @code{t} by default. If it is @code{nil}, inactive groups won't be + listed. + @vindex gnus-group-use-permanent-levels If @code{gnus-group-use-permanent-levels} is non-@code{nil}, once you give a level prefix to @kbd{g} or @kbd{l}, all subsequent commands will ! use this level as the ``work'' level. ! ! @vindex gnus-activate-level ! Gnus will normally just activate groups that are on level ! @code{gnus-activate-level} or less. If you don't want to activate ! unsubscribed groups, for instance, you might set this variable to ! @code{5}. ! ! ! @node Group Score ! @section Group Score ! @cindex group score ! ! You would normally keep important groups on high levels, but that scheme ! is somewhat restrictive. Don't you wish you could have Gnus sort the ! group buffer according to how often you read groups, perhaps? Within ! reason? ! ! This is what @dfn{group score} is for. You can assign a score to each ! group. You can then sort the group buffer based on this score. ! Alternatively, you can sort on score and then level. (Taken together, ! the level and the score is called the @dfn{rank} of the group. A group ! that is on level 4 and has a score of 1 has a higher rank than a group ! on level 5 that has a score of 300. (The level is the most significant ! part and the score is the least significant part.) ! ! @findex gnus-summary-bubble-group ! If you want groups you read often to get higher scores than groups you ! read seldom you can add the @code{gnus-summary-bubble-group} function to ! the @code{gnus-summary-exit-hook} hook. This will result (after ! sorting) in a bubbling sort of action. If you want to see that in ! action after each summary exit, you can add ! @code{gnus-group-sort-groups-by-rank} or ! @code{gnus-group-sort-groups-by-score} to the same hook, but that will ! slow things down somewhat. ! @node Marking Groups *************** use this level as the "work" level. *** 1411,1415 **** @cindex marking groups ! If you want to perform some action on several groups, and they appear subsequently in the group buffer, you would normally just give a numerical prefix to the command. Most group commands will then do your --- 1219,1223 ---- @cindex marking groups ! If you want to perform some command on several groups, and they appear subsequently in the group buffer, you would normally just give a numerical prefix to the command. Most group commands will then do your *************** bidding on those groups. *** 1417,1475 **** However, if the groups are not in sequential order, you can still ! perform an action on several groups. You simply mark the groups first, ! and then execute the command. @table @kbd @item # @kindex # (Group) ! @item M m @kindex M m (Group) @findex gnus-group-mark-group Set the mark on the current group (@code{gnus-group-mark-group}). @item M-# @kindex M-# (Group) ! @item < u @kindex M u (Group) @findex gnus-group-unmark-group Remove the mark from the current group (@code{gnus-group-unmark-group}). @item M w @kindex M w (Group) @findex gnus-group-mark-region Mark all groups between point and mark (@code{gnus-group-mark-region}). - @end table - - @node Foreign Groups - @section Foreign Groups - @cindex foreign groups - - A @dfn{foreign group} is a group that is not read by the usual (or - default) means. It could be, for instance, a group from a different - @sc{nntp} server, it could be a virtual group, or it could be your own - personal mail group. ! A foreign group (or any group, really) is specified by a @dfn{name} and ! a @dfn{select method}. To take the latter first, a select method is a ! list where the first element says what backend to use (eg. @code{nntp}, ! @code{nnspool}, @code{nnml}) and the second element is the @dfn{server ! name}. There may be additional elements in the select method, where the ! value may have special meaning for the backend in question. ! ! One could say that a select method defines a @dfn{virtual server} - so ! we do just that (@pxref{The Server Buffer}). - The @dfn{name} of the group is the name the backend will recognize the - group as. ! For instance, the group @samp{soc.motss} on the @sc{nntp} server ! @samp{some.where.edu} will have the name @samp{soc.motss} and select ! method @code{(nntp "some.where.edu")}. Gnus will call this group, in ! all circumstances, @samp{nntp+some.where.edu:soc.motss}, even though the ! nntp backend just knows this group as @samp{soc.motss}. ! Here are some commands for making and editing general foreign groups, ! and some commands to ease the creation of some special-purpose groups: @table @kbd @item G m @kindex G m (Group) --- 1225,1288 ---- However, if the groups are not in sequential order, you can still ! perform a command on several groups. You simply mark the groups first ! with the process mark and then execute the command. @table @kbd + @item # @kindex # (Group) ! @itemx M m @kindex M m (Group) @findex gnus-group-mark-group Set the mark on the current group (@code{gnus-group-mark-group}). + @item M-# @kindex M-# (Group) ! @itemx M u @kindex M u (Group) @findex gnus-group-unmark-group Remove the mark from the current group (@code{gnus-group-unmark-group}). + + @item M U + @kindex M U (Group) + @findex gnus-group-unmark-all-groups + Remove the mark from all groups (@code{gnus-group-unmark-all-groups}). + @item M w @kindex M w (Group) @findex gnus-group-mark-region Mark all groups between point and mark (@code{gnus-group-mark-region}). ! @item M b ! @kindex M b (Group) ! @findex gnus-group-mark-buffer ! Mark all groups in the buffer (@code{gnus-group-mark-buffer}). ! ! @item M r ! @kindex M r (Group) ! @findex gnus-group-mark-regexp ! Mark all groups that match some regular expression ! (@code{gnus-group-mark-regexp}). ! @end table ! ! Also @pxref{Process/Prefix}. ! ! @findex gnus-group-universal-argument ! If you want to execute some command on all groups that have been marked ! with the process mark, you can use the @kbd{M-&} ! (@code{gnus-group-universal-argument}) command. It will prompt you for ! the command to be executed. ! @node Foreign Groups ! @section Foreign Groups ! Here are some group mode commands for making and editing general foreign ! groups, as well as commands to ease the creation of a few ! special-purpose groups: @table @kbd + @item G m @kindex G m (Group) *************** and some commands to ease the creation o *** 1477,1481 **** Make a new group (@code{gnus-group-make-group}). Gnus will prompt you for a name, a method and possibly an @dfn{address}. For an easier way ! to subscribe to @sc{nntp} groups, @xref{Browse Foreign Server}. @item G e --- 1290,1302 ---- Make a new group (@code{gnus-group-make-group}). Gnus will prompt you for a name, a method and possibly an @dfn{address}. For an easier way ! to subscribe to @sc{nntp} groups, @pxref{Browse Foreign Server}. ! ! @item G r ! @kindex G r (Group) ! @findex gnus-group-rename-group ! Rename the current group to something else ! (@code{gnus-group-rename-group}). This is legal only on some groups -- ! mail groups mostly. This command might very well be quite slow on some ! backends. @item G e *************** Make the Gnus help group (@code{gnus-gro *** 1515,1519 **** Make a Gnus archive group (@code{gnus-group-make-archive-group}). By default a group pointing to the most recent articles will be created ! (@code{gnus-group-recent-archibe-directory}), but given a prefix, a full group will be created from from @code{gnus-group-archive-directory}. --- 1336,1340 ---- Make a Gnus archive group (@code{gnus-group-make-archive-group}). By default a group pointing to the most recent articles will be created ! (@code{gnus-group-recent-archive-directory}), but given a prefix, a full group will be created from from @code{gnus-group-archive-directory}. *************** group will be created from from @code{gn *** 1522,1532 **** @findex gnus-group-make-kiboze-group Make a kiboze group. You will be prompted for a name, for a regexp to ! match groups to be "included" in the kiboze group, and a series of strings to match on headers (@code{gnus-group-make-kiboze-group}). @item G D @kindex G D (Group) @findex gnus-group-enter-directory ! Read a random directory as if with were a newsgroup with the @code{nneething} backend (@code{gnus-group-enter-directory}). --- 1343,1354 ---- @findex gnus-group-make-kiboze-group Make a kiboze group. You will be prompted for a name, for a regexp to ! match groups to be ``included'' in the kiboze group, and a series of strings to match on headers (@code{gnus-group-make-kiboze-group}). + @xref{Kibozed Groups} @item G D @kindex G D (Group) @findex gnus-group-enter-directory ! Read an arbitrary directory as if with were a newsgroup with the @code{nneething} backend (@code{gnus-group-enter-directory}). *************** Read a random directory as if with were *** 1534,1541 **** @kindex G f (Group) @findex gnus-group-make-doc-group Make a group based on some file or other ! (@code{gnus-group-make-doc-group}). You will be prompted for a file ! name and a file type. Currently supported types are @code{babyl}, ! @code{mbox} and @code{digest}. @item G V --- 1356,1376 ---- @kindex G f (Group) @findex gnus-group-make-doc-group + @cindex ClariNet Briefs Make a group based on some file or other ! (@code{gnus-group-make-doc-group}). If you give a prefix to this ! command, you will be prompted for a file name and a file type. ! Currently supported types are @code{babyl}, @code{mbox}, @code{digest}, ! @code{mmdf}, @code{news}, @code{rnews}, @code{clari-briefs}, and ! @code{forward}. If you run this command without a prefix, Gnus will ! guess at the file type. ! ! @item G DEL ! @kindex G DEL (Group) ! @findex gnus-group-delete-group ! This function will delete the current group ! (@code{gnus-group-delete-group}). If given a prefix, this function will ! actually delete all the articles in the group, and forcibly remove the ! group itself from the face of the Earth. Use a prefix only if you are ! absolutely sure of what you are doing. @item G V *************** Add the current group to an @code{nnvirt *** 1552,1567 **** @end table ! The different methods all have their peculiarities, of course. ! ! @menu ! * nntp:: Reading news from a different @sc{nntp} server. ! * nnspool:: Reading news from the local spool. ! * nnvirtual:: Combining articles from many groups. ! * nnkiboze:: Looking through parts of the newsfeed for articles. ! * nndir:: You can read a directory as if it was a newsgroup. ! * nneething:: Dired? Who needs dired? ! * nndoc:: Single files can be the basis of a group. ! * Reading Mail:: Reading your personal mail with Gnus. ! @end menu @vindex gnus-activate-foreign-newsgroups --- 1387,1392 ---- @end table ! @xref{Select Methods} for more information on the various select ! methods. @vindex gnus-activate-foreign-newsgroups *************** If the @code{gnus-activate-foreign-newsg *** 1569,4043 **** Gnus will check all foreign groups with this level or lower at startup. This might take quite a while, especially if you subscribe to lots of ! groups from different @sc{nntp} servers. It is @code{nil} by default, ! which means that you won't be told whether there are new articles in ! these groups. How many unread articles there are will be determined ! when, or if, you decide to enter them. You can also activate any group ! with @kbd{M-g} to see how many unread articles there are. ! ! @node nntp ! @subsection nntp ! @cindex @sc{nntp} - Subscribing to a foreign group from an @sc{nntp} server is rather easy. - You just specify @code{nntp} as method and the address of the @sc{nntp} - server as the, uhm, address. ! If the @sc{nntp} server is located at a non-standard port, setting the ! third element of the select method to this port number should allow you ! to connect to the right port. You'll have to edit the group info for ! that (@pxref{Foreign Groups}). ! The name of the foreign group can be the same as a native group. In ! fact, you can subscribe to the same group from as many different servers ! you feel like. There will be no name collisions. ! The following variables can be used to create a virtual @code{nntp} ! server: @table @code ! @item nntp-server-opened-hook ! @vindex nntp-server-opened-hook ! @cindex @sc{mode reader} ! @cindex authinfo ! @findex nntp-send-authinfo ! @findex nntp-send-mode-reader ! @code{nntp-server-opened-hook} is run after a connection has been made. ! It can be used to send commands to the @sc{nntp} server after it has ! been contacted. By default is sends the command @samp{MODE READER} to ! the server with the @code{nntp-send-mode-reader} function. Another ! popular function is @code{nntp-send-authinfo}, which will prompt you for ! an @sc{nntp} password and stuff. ! @item nntp-maximum-request ! @vindex nntp-maximum-request ! If the @sc{nntp} server doesn't support @sc{nov} headers, this backend ! will collect headers by sending a series of @code{head} commands. To ! speed things up, the backend sends lots of these commands without ! waiting for reply, and then reads all the replies. This is controlled ! by the @code{nntp-maximum-request} variable, and is 400 by default. If ! your network is buggy, you should set this to 1. ! @item nntp-connection-timeout ! @vindex nntp-connection-timeout ! If you have lots of foreign @code{nntp} groups that you connect to ! regularly, you're sure to have problems with @sc{nntp} servers not ! responding properly, or being too loaded to reply within reasonable ! time. This is can lead to awkward problems, which can be helped ! somewhat by setting @code{nntp-connection-timeout}. This is an integer ! that says how many seconds the @code{nntp} backend should wait for a ! connection before giving up. If it is @code{nil}, which is the default, ! no timeouts are done. ! @item nntp-server-hook ! @vindex nntp-server-hook ! This hook is run as the last step when connecting to an @sc{nntp} ! server. ! @c @findex nntp-open-rlogin ! @c @findex nntp-open-network-stream ! @c @item nntp-open-server-function ! @c @vindex nntp-open-server-function ! @c This function is used to connect to the remote system. Two pre-made ! @c functions are @code{nntp-open-network-stream}, which is the default, and ! @c simply connects to some port or other on the remote system. The other ! @c is @code{nntp-open-rlogin}, which does an rlogin on the remote system, ! @c and then does a telnet to the @sc{nntp} server available there. ! @c ! @c @item nntp-rlogin-parameters ! @c @vindex nntp-rlogin-parameters ! @c If you use @code{nntp-open-rlogin} as the ! @c @code{nntp-open-server-function}, this list will be used as the ! @c parameter list given to @code{rsh}. ! @c ! @c @item nntp-rlogin-user-name ! @c @vindex nntp-rlogin-user-name ! @c User name on the remote system when using the @code{rlogin} connect ! @c function. ! @item nntp-address ! @vindex nntp-address ! The address of the remote system running the @sc{nntp} server. ! @item nntp-port-number ! @vindex nntp-port-number ! Port number to connect to when using the @code{nntp-open-network-stream} ! connect function. ! @item nntp-buggy-select ! @vindex nntp-buggy-select ! Set this to non-@code{nil} if your select routine is buggy. - @item nntp-nov-is-evil - @vindex nntp-nov-is-evil - If the @sc{nntp} server does not support @sc{nov}, you could set this - variable to @code{t}, but @code{nntp} usually checks whether @sc{nov} - can be used automatically. ! @item nntp-xover-commands ! @vindex nntp-xover-commands ! List of strings that are used as commands to fetch @sc{nov} lines from a ! server. The default value of this variable is @code{("XOVER" ! "XOVERVIEW")}. ! @item nntp-nov-gap ! @vindex nntp-nov-gap ! @code{nntp} normally sends just one big request for @sc{nov} lines to ! the server. The server responds with one huge list of lines. However, ! if you have read articles 2-5000 in the group, and only want to read ! article 1 and 5001, that means that @code{nntp} will fetch 4999 @sc{nov} ! lines that you do not want, and will not use. This variable says how ! big a gap between two consecutive articles is allowed to be before the ! @code{XOVER} request is split into several request. Note that if your ! network is fast, setting this variable to a really small number means ! that fetching will probably be slower. If this variable is @code{nil}, ! @code{nntp} will never split requests. ! @item nntp-prepare-server-hook ! @vindex nntp-prepare-server-hook ! A hook run before attempting to connect to an @sc{nntp} server. ! @item nntp-async-number ! @vindex nntp-async-number ! How many articles should be pre-fetched when in asynchronous mode. If ! this variable is @code{t}, @code{nntp} will pre-fetch all the articles ! that it can without bound. If it is @code{nil}, no pre-fetching will be ! made. ! @end table ! @node nnspool ! @subsection nnspool ! @cindex nnspool ! @cindex news spool ! Subscribing to a foreign group from the local spool is extremely easy, ! and might be useful, for instance, to speed up reading groups like ! @samp{alt.binaries.pictures.furniture}. ! Anyways, you just specify @code{nnspool} as the method and @samp{""} (or ! anything else) as the address. ! If you have access to a local spool, you should probably use that as the ! native select method (@pxref{Finding the News}). ! @table @code ! @item nnspool-inews-program ! @vindex nnspool-inews-program ! Program used to post an article. ! @item nnspool-inews-switches ! @vindex nnspool-inews-switches ! Parameters given to the inews program when posting an article. ! @item nnspool-spool-directory ! @vindex nnspool-spool-directory ! Where nnspool looks for the articles. This is normally ! @file{/usr/spool/news/}. ! @item nnspool-nov-directory ! @vindex nnspool-nov-directory ! Where nnspool will look for @sc{nov} files. This is normally ! @file{/usr/spool/news/over.view/}. ! @item nnspool-lib-dir ! @vindex nnspool-lib-dir ! Where the news lib dir is (@file{/usr/lib/news/} by default). ! @item nnspool-active-file ! @vindex nnspool-active-file ! The path of the active file. ! @item nnspool-newsgroups-file ! @vindex nnspool-newsgroups-file ! The path of the group description file. ! @item nnspool-history-file ! @vindex nnspool-history-file ! The path of the news history file. ! @item nnspool-active-times-file ! @vindex nnspool-active-times-file ! The path of the active date file. ! @item nnspool-nov-is-evil ! @vindex nnspool-nov-is-evil ! If non-@code{nil}, @code{nnspool} won't try to use any @sc{nov} files ! that it finds. ! @item nnspool-sift-nov-with-sed ! @vindex nnspool-sift-nov-with-sed ! If non-@code{nil}, which is the default, use @code{sed} to get the ! relevant portion from the overview file. If nil, @code{nnspool} will ! load the entire file into a buffer and process it there. ! @end table ! @node nnvirtual ! @subsection nnvirtual ! @cindex nnvirtual ! @cindex virtual groups - An @dfn{nnvirtual group} is really nothing more than a collection of - other groups. ! For instance, if you are tired of reading many small group, you can ! put them all in one big group, and then grow tired of reading one ! big, unwieldy group. The joys of computing! ! You specify @code{nnvirtual} as the method. The address should be a ! regexp to match component groups. - All marks in the virtual group will stick to the articles in the - component groups. So if you tick an article in a virtual group, the - article will also be ticked in the component group from whence it came. - (And vice versa - marks from the component groups will also be shown in - the virtual group.) ! Here's an example nnvirtual method that collects all Andrea Dworkin ! newsgroups into one, big, happy newsgroup: ! @lisp ! (nnvirtual "^alt\\.fan\\.andrea-dworkin$\\|^rec\\.dworkin.*") ! @end lisp ! The component groups can be native or foreign; everything should work ! smoothly, but if your computer explodes, it was probably my fault. ! Collecting the same group from several servers might actually be a good ! idea if users have set the Distribution header to limit distribution. ! If you would like to read @samp{soc.motss} both from a server in Japan ! and a server in Norway, you could use the following as the group regexp: ! @example ! "^nntp+some.server.jp:soc.motss$\\|^nntp+some.server.no:soc.motss$" ! @end example ! This should work kinda smoothly - all articles from both groups should ! end up in this one, and there should be no duplicates. Threading (and ! the rest) will still work as usual, but there might be problems with the ! sequence of articles. Sorting on date might be an option here ! (@pxref{Selecting a Group}. ! One limitation, however - all groups that are included in a virtual ! group has to be alive (i.e., subscribed or unsubscribed). Killed or ! zombie groups can't be component groups for nnvirtual groups. ! @node nnkiboze ! @subsection nnkiboze ! @cindex nnkiboze ! @cindex kibozing ! @dfn{Kibozing} is defined by OED as "grepping through (parts of) the ! news feed". nnkiboze is a backend that will do this for you. Oh joy! ! Now you can grind any @sc{nntp} server down to a halt with useless ! requests! Oh happiness! ! ! The address field of the nnkiboze method is, as with nnvirtual, a regexp ! to match groups to be "included" in the nnkiboze group. There most ! similarities between nnkiboze and nnvirtual ends. - In addition to this regexp detailing component groups, an nnkiboze group - must have a score file to say what articles that are to be included in - the group (@pxref{Score Files}). ! @kindex M-x nnkiboze-generate-groups ! @findex nnkiboze-generate-groups ! You must run @kbd{M-x nnkiboze-generate-groups} after creating the ! nnkiboze groups you want to have. This command will take time. Lots of ! time. Oodles and oodles of time. Gnus has to fetch the headers from ! all the articles in all the components groups and run them through the ! scoring process to determine if there are any articles in the groups ! that are to be part of the nnkiboze groups. ! Please limit the number of component groups by using restrictive ! regexps. Otherwise your sysadmin may become annoyed with you, and the ! @sc{nntp} site may throw you off and never let you back in again. ! Stranger things have happened. ! nnkiboze component groups do not have to be alive - they can be dead, ! and they can be foreign. No restrictions. ! @vindex nnkiboze-directory ! The generation of an nnkiboze group means writing two files in ! @code{nnkiboze-directory}, which is @file{~/News/} by default. One ! contains the @sc{nov} header lines for all the articles in the group, ! and the other is an additional @file{.newsrc} file to store information ! on what groups that have been searched through to find component ! articles. ! Articles that are marked as read in the nnkiboze group will have their ! @sc{nov} lines removed from the @sc{nov} file. ! @node nndir ! @subsection nndir ! @cindex nndir ! @cindex directory groups - If you have a directory that has lots of articles in separate files in - it, you might treat it as a newsgroup. The files have to have numerical - names, of course. ! This might be an opportune moment to mention @code{ange-ftp}, that most ! wonderful of all wonderful Emacs packages. When I wrote @code{nndir}, I ! didn't think much about it - a backend to read directories. Big deal. ! @code{ange-ftp} changes that picture dramatically. For instance, if you ! enter @file{"/ftp@@sina.tcamc.uh.edu:/pub/emacs/ding-list/"} as the the ! directory name, ange-ftp will actually allow you to read this directory ! over at @samp{sina} as a newsgroup. Distributed news ahoy! ! @code{nndir} will use @sc{nov} files if they are present. ! @code{nndir} is a "read-only" backend - you can't delete or expire ! articles with this method. You can use @code{nnmh} or @code{nnml} for ! whatever you use @code{nndir} for, so you could switch to any of those ! methods if you feel the need to have a non-read-only @code{nndir}. ! @node nneething ! @subsection nneething ! @cindex nneething ! From the @code{nndir} backend (which reads a single spool-like ! directory), it's just a hop and a skip to @code{nneething}, which ! pretends that any random directory is a newsgroup. Strange, but true. ! When @code{nneething} is presented with a directory, it will scan this ! directory and assign article numbers to each file. When you enter such a ! group, @code{nneething} must create "headers" that Gnus can use. After ! all, Gnus is a newsreader, in case you're forgetting. @code{nneething} ! does this in a two-step process. First, it snoops each file in question. ! If the file looks like an article (i.e., the first few lines look like ! headers), it will use this as the head. If this is just some random file ! without a head (eg. a C source file), @code{nneething} will cobble up a ! header out of thin air. It will use file ownership, name and date and do ! whatever it can with these elements. ! All this should happen automatically for you, and you will be presented ! with something that looks very much like a newsgroup. Totally like a ! newsgroup, to be precise. If you select an article, it will be displayed ! in the article buffer, just as usual. ! If you select a line that represents a directory, Gnus will pop you into ! a new summary buffer for this @code{nneething} group. And so on. You can ! traverse the entire disk this way, if you feel like, but remember that ! Gnus is not dired, really, and does not intend to be, either. ! There are two overall modes to this action - ephemeral or solid. When ! doing the ephemeral thing (i.e., @kbd{G D} from the group buffer), Gnus ! will not store information on what files you have read, and what files ! are new, and so on. If you create a solid @code{nneething} group the ! normal way with @kbd{G m}, Gnus will store a mapping table between ! article numbers and file names, and you can treat this group like any ! other groups. When you activate a solid @code{nneething} group, you will ! be told how many unread articles it contains, etc., etc. ! ! Some variables: ! ! @table @code ! @item nneething-map-file-directory ! @vindex nneething-map-file-directory ! All the mapping files for solid @code{nneething} groups will be stored ! in this directory, which defaults to @file{~/.nneething/}. ! @item nneething-exclude-files ! @vindex nneething-exclude-files ! All files that match this regexp will be ignored. Nice to use to exclude ! auto-save files and the like, which is what it does by default. ! @item nneething-map-file ! @vindex nneething-map-file ! Name of the map files. @end table ! @node nndoc ! @subsection nndoc ! @cindex nndoc ! @cindex documentation group ! @cindex help group ! nndoc is a cute little thing that will let you read a single file as a ! newsgroup. Currently supported file types are @code{babyl}, @code{mbox} ! and @code{digest}. ! nndoc will not try to change the file or insert any extra headers into ! it - it will simply, like, let you use the file as the basis for a ! group. And that's it. ! Virtual server variables: ! @table @code ! @item nndoc-article-type ! @vindex nndoc-article-type ! This should be one of @code{mbox}, @code{babyl} or @code{digest}. @end table ! @node Reading Mail ! @subsection Reading Mail ! @cindex reading mail ! @cindex mail ! Reading mail with a newsreader - isn't that just plain WeIrD? But of ! course. ! Gnus will read the mail spool when you activate a mail group. The mail ! file is first copied to your home directory. What happens after that ! depends on what format you want to store your mail in. ! @menu ! * Creating Mail Groups:: How to create mail groups. ! * Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail. ! * Mail & Procmail:: Reading mail groups that procmail create. ! * Expiring Old Mail Articles:: Getting rid of unwanted mail. ! * Not Reading Mail:: Using mail backends for reading other files. ! * nnmbox:: Using the (quite) standard Un*x mbox. ! * nnbabyl:: Emacs programs use the rmail babyl format. ! * nnml:: Store your mail in a private spool? ! * nnmh:: An mhspool-like backend. ! * nnfolder:: Having one file for each group. ! @end menu - @vindex nnmail-read-incoming-hook - The mail backends all call @code{nnmail-read-incoming-hook} after - reading new mail. You can use this hook to notify any mail watch - programs, if you want to. ! @vindex nnmail-spool-file ! @code{nnmail-spool-file} says where to look for new mail. If this ! variable is @code{nil}, the mail backends will never attempt to fetch ! mail by themselves. It is quite likely that Gnus supports POP-mail. ! Set this variable to begin with the string @samp{po:}, and everything ! should go smoothly, even though I have never tested this. ! @vindex nnmail-use-procmail ! If @code{nnmail-use-procmail} is non-@code{nil}, the mail backends will ! look in @code{nnmail-procmail-directory} for incoming mail. All the ! files in that directory that have names ending in ! @code{gnus-procmail-suffix} will be considered incoming mailboxes, and ! will be searched for new mail. ! @vindex nnmail-prepare-incoming-hook ! @code{nnmail-prepare-incoming-hook} is run in a buffer that holds all ! the new incoming mail, and can be used for, well, anything, really. ! @vindex nnmail-tmp-directory ! @code{nnmail-tmp-directory} says where to move the incoming mail to ! while processing it. This is usually done in the same directory that ! the mail backend inhabits (i.e., @file{~/Mail/}), but if this variable is ! non-@code{nil}, it will be used instead. - @vindex nnmail-movemail-program - @code{nnmail-movemail-program} is executed to move mail from the user's - inbox to her home directory. The default is @samp{"movemail"}. ! @vindex nnmail-delete-incoming ! If @code{nnmail-delete-incoming} is non-@code{nil}, the mail backends ! will delete the temporary incoming file after splitting mail into the ! proper groups. This is @code{nil} by default for reasons of security. ! @vindex nnmail-message-id-cache-length ! @vindex nnmail-message-id-cache-file ! @vindex nnmail-delete-duplicates ! @cindex duplicate mails ! If you are a member of a couple of mailing list, you will sometime ! receive two copies of the same mail. This can be quite annoying, so ! @code{nnmail} checks for and discards any duplicates it might find. To ! do this, it keeps a cache of old @code{Message-ID}s - ! @code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by ! default. The approximate maximum number of @code{Message-ID}s stored ! there is controlled by the @code{nnmail-message-id-cache-length} ! variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be ! stored.) If all this sounds scary to you, you can set ! @code{nnmail-delete-duplicates} to @code{nil} (which is what it is by ! default), and @code{nnmail} won't do any duplicate checking. ! Here's a neat feature: If you know that the recipient reads her mail ! with Gnus, and that she has @code{nnmail-delete-duplicates} set to ! @code{t}, you can send her as many insults as you like, just by using a ! @code{Message-ID} of a mail that you know that she's already received. ! Think of all the fun! She'll never see any of it! Whee! ! Gnus gives you all the opportunity you could possibly want for shooting ! yourself in the foot. Let's say you create a group that will contain ! all the mail you get from your boss. And then you accidentally ! unsubscribe from the group. Gnus will still put all the mail from your ! boss in the unsubscribed group, and so, when your boss mails you "Have ! that report ready by Monday or you're fired!", you'll never see it and, ! come Tuesday, you'll still believe that you're gainfully employed while ! you really should be out collecting empty bottles to save up for next ! month's rent money. - @node Creating Mail Groups - @subsubsection Creating Mail Groups - @cindex creating mail groups - - You can make Gnus read your personal, private, secret mail. - - You should first set @code{gnus-secondary-select-methods} to, for - instance, @code{((nnmbox ""))}. When you start up Gnus, Gnus will ask - this backend for what groups it carries (@samp{mail.misc} by default) - and subscribe it the normal way. (Which means you may have to look for - it among the zombie groups, I guess, all depending on your - @code{gnus-subscribe-newsgroup-method} variable.) ! @vindex nnmail-split-methods ! Then you should set the variable @code{nnmail-split-methods} to specify ! how the incoming mail is to be split into groups. ! @lisp ! (setq nnmail-split-methods ! '(("mail.junk" "^From:.*Lars Ingebrigtsen") ! ("mail.crazy" "^Subject:.*die\\|^Organization:.*flabby") ! ("mail.other" ""))) ! @end lisp ! This variable is a list of lists, where the first element of each of ! these lists is the name of the mail group (they do not have to be called ! something beginning with @samp{mail}, by the way), and the second ! element is a regular expression used on the header of each mail to ! determine if it belongs in this mail group. ! The second element can also be a function. In that case, it will be ! called narrowed to the headers with the first element of the rule as the ! argument. It should return a non-@code{nil} value if it thinks that the ! mail belongs in that group. ! The last of these groups should always be a general one, and the regular ! expression should @emph{always} be @samp{""} so that it matches any ! mails that haven't been matched by any of the other regexps. ! If you like to tinker with this yourself, you can set this variable to a ! function of your choice. This function will be called without any ! arguments in a buffer narrowed to the headers of an incoming mail ! message. The function should return a list of groups names that it ! thinks should carry this mail message. ! @vindex nnmail-crosspost ! The mail backends all support cross-posting. If several regexps match, ! the mail will be "cross-posted" to all those groups. ! @code{nnmail-crosspost} says whether to use this mechanism or not. Note ! that no articles are crossposted to the general (@samp{""}) group. ! @node Fancy Mail Splitting ! @subsubsection Fancy Mail Splitting ! @cindex mail splitting ! @cindex fancy mail splitting ! @vindex nnmail-split-fancy ! @findex nnmail-split-fancy ! If the rather simple, standard method for specifying how to split mail ! doesn't allow you to do what you want, you can set ! @code{nnmail-split-methods} to @code{nnmail-split-fancy}. Then you can ! play with the @code{nnmail-split-fancy} variable. ! Let's look at an example value of this variable first: ! @lisp ! ;; Messages from the mailer daemon are not crossposted to any of ! ;; the ordinary groups. Warnings are put in a separate group ! ;; from real errors. ! (| ("from" mail (| ("subject" "warn.*" "mail.warning") ! "mail.misc")) ! ;; Non-error messages are crossposted to all relevant ! ;; groups, but we don't crosspost between the group for the ! ;; (ding) list and the group for other (ding) related mail. ! (& (| (any "ding@@ifi\\.uio\\.no" "ding.list") ! ("subject" "ding" "ding.misc")) ! ;; Other mailing lists... ! (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list") ! (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list") ! ;; People... ! (any "larsi@@ifi\\.uio\\.no" "people.Lars Magne Ingebrigtsen")) ! ;; Unmatched mail goes to the catch all group. ! "misc.misc"))") ! @end lisp ! This variable has the format of a @dfn{split}. A split is a (possibly) ! recursive structure where each split may contain other splits. Here are ! the four possible split syntaxes: ! @table @dfn ! @item GROUP ! If the split is a string, that will be taken as a group name. ! @item (FIELD VALUE SPLIT) ! If the split is a list, and the first element is a string, then that ! means that if header FIELD (a regexp) contains VALUE (also a regexp), ! then store the message as specified by SPLIT. ! @item (| SPLIT...) ! If the split is a list, and the first element is @code{|} (vertical ! bar), then process each SPLIT until one of them matches. A SPLIT is ! said to match if it will cause the mail message to be stored in one or ! more groups. ! @item (& SPLIT...) ! If the split is a list, and the first element is @code{&}, then process ! all SPLITs in the list. ! @end table ! In these splits, FIELD must match a complete field name. VALUE must ! match a complete word according to the fundamental mode syntax table. ! You can use @code{.*} in the regexps to match partial field names or ! words. ! @vindex nnmail-split-abbrev-alist ! FIELD and VALUE can also be lisp symbols, in that case they are expanded ! as specified by the variable @code{nnmail-split-abbrev-alist}. This is ! an alist of cons cells, where the car of the cells contains the key, and ! the cdr contains a string. - @node Mail & Procmail - @subsubsection Mail & Procmail - @cindex procmail ! Many people use @code{procmail} to split incoming mail into groups. If ! you do that, you should set @code{nnmail-spool-file} to @code{procmail} ! to ensure that the mail backends never ever try to fetch mail by ! themselves. ! This also means that you probably don't want to set ! @code{nnmail-split-methods} either, which has some, perhaps, unexpected ! side effects. ! When a mail backend is queried for what groups it carries, it replies ! with the contents of that variable, along with any groups it has figured ! out that it carries by other means. None of the backends (except ! @code{nnmh}) actually go out to the disk and check what groups actually ! exist. (It's not trivial to distinguish between what the user thinks is ! a basis for a newsgroup and what is just a plain old file or directory.) ! This means that you have to tell Gnus (and the backends) what groups ! exist by hand. - Let's take the @code{nnmh} backend as an example. ! The folders are located in @code{nnmh-directory}, say, @file{~/Mail/}. ! There are three folders, @file{foo}, @file{bar} and @file{mail.baz}. ! Go to the group buffer and type @kbd{G m}. When prompted, answer ! @samp{foo} for the name and @samp{nnmh} for the method. Repeat ! twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure ! to include all your mail groups. ! That's it. You are now set to read your mail. An active file for this ! method will be created automatically. ! @vindex nnmail-procmail-suffix ! @vindex nnmail-procmail-directory ! If you use @code{nnfolder} or any other backend that store more than a ! single article in each file, you should never have procmail add mails to ! the file that Gnus sees. Instead, procmail should put all incoming mail ! in @code{nnmail-procmail-directory}. To arrive at the file name to put ! the incoming mail in, append @code{nnmail-procmail-suffix} to the group ! name. The mail backends will read the mail from these files. ! @vindex nnmail-resplit-incoming ! When Gnus reads a file called @file{mail.misc.spool}, this mail will be ! put in the @code{mail.misc}, as one would expect. However, if you want ! Gnus to split the mail the normal way, you could set ! @code{nnmail-resplit-incoming} to @code{t}. ! @vindex nnmail-keep-last-article ! If you use @code{procmail} to split things directory into an 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. ! @node Expiring Old Mail Articles ! @subsubsection Expiring Old Mail Articles ! @cindex article expiry ! Traditional mail readers have a tendency to remove mail articles when ! you mark them as read, in some way. Gnus takes a fundamentally ! different approach to mail reading. ! Gnus basically considers mail just to be news that has been received in ! a rather peculiar manner. It does not think that it has the power to ! actually change the mail, or delete any mail messages. If you enter a ! mail group, and mark articles as "read", or kill them in some other ! fashion, the mail articles will still exist on the system. I repeat: ! Gnus will not delete your old, read mail. Unless you ask it to, of ! course. ! To make Gnus get rid of your unwanted mail, you have to mark the ! articles as @dfn{expirable}. This does not mean that the articles will ! disappear right away, however. In general, a mail article will be ! deleted from your system if, 1) it is marked as expirable, AND 2) it is ! more than one week old. If you do not mark an article as expirable, it ! will remain on your system until hell freezes over. This bears ! repeating one more time, with some spurious capitalizations: IF you do ! NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES. ! @vindex gnus-auto-expirable-newsgroups ! You do not have to mark articles as expirable by hand. Groups that ! match the regular expression @code{gnus-auto-expirable-newsgroups} will ! have all articles that you read marked as expirable automatically. All ! articles that are marked as expirable have an @samp{E} in the first ! column in the summary buffer. ! Let's say you subscribe to a couple of mailing lists, and you want the ! articles you have read to disappear after a while: - @lisp - (setq gnus-auto-expirable-newsgroups - "mail.nonsense-list\\|mail.nice-list") - @end lisp ! Another way to have auto-expiry happen is to have the element ! @code{auto-expire} in the select method of the group. ! @vindex nnmail-expiry-wait ! The @code{nnmail-expiry-wait} variable supplies the default time an ! expirable article has to live. The default is seven days. ! Gnus also supplies a function that lets you fine-tune how long articles ! are to live, based on what group they are in. Let's say you want to ! have one month expiry period in the @samp{mail.private} group, a one day ! expiry period in the @samp{mail.junk} group, and a six day expiry period ! everywhere else: ! @lisp ! (setq nnmail-expiry-wait-function ! (lambda (group) ! (cond ((string= group "mail.private") ! 31) ! ((string= group "mail.junk") ! 1) ! (t ! 6)))) ! @end lisp ! @vindex nnmail-keep-last-article ! If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never ! expire the final article in a mail newsgroup. This is to make life ! easier for procmail users. ! By the way, that line up there about Gnus never expiring non-expirable ! articles is a lie. If you put @code{total-expire} in the group ! parameters, articles will not be marked as expirable, but all read ! articles will be put through the expiry process. Use with extreme ! caution. ! Note that at present, Gnus will not actually delete any expirable ! articles automatically. You have to enter one of the expiry functions ! (eg. `C-c M-c-x' in the group buffer) to actually run articles through ! the expiry process. Or you can add a call to the expiry function in the ! group exit hook. Gnus will probably do all this automatically in the ! future. ! @node Not Reading Mail ! @subsubsection Not Reading Mail ! If you start using any of the mail backends, they have the annoying ! habit of assuming that you want to read mail with them. This might not ! be unreasonable, but it might not be what you want. - If you set @code{nnmail-spool-file} to @code{nil}, none of the backends - will ever attempt to read incoming mail, which should help. ! @vindex nnbabyl-get-new-mail ! @vindex nnmbox-get-new-mail ! @vindex nnml-get-new-mail ! @vindex nnmh-get-new-mail ! @vindex nnfolder-get-new-mail ! This might be too much, if, for instance, you are reading mail quite ! happily with @code{nnml} and just want to peek at some old @sc{rmail} ! file you have stashed away with @code{nnbabyl}. All backends have ! variables called backend-@code{get-new-mail}. If you want to disable ! the @code{nnbabyl} mail reading, you edit the virtual server for the ! group to have a setting where @code{nnbabyl-get-new-mail} to @code{nil}. ! All the mail backends will call @code{nn}*@code{-prepare-save-mail-hook} ! narrowed to the article to be saved before saving it when reading ! incoming mail. ! @node nnmbox ! @subsubsection nnmbox ! @cindex nnmbox ! @cindex unix mail box ! @vindex nnmbox-active-file ! @vindex nnmbox-mbox-file ! The @dfn{nnmbox} backend will use the standard Un*x mbox file to store ! mail. @code{nnmbox} will add extra headers to each mail article to say ! which group it belongs in. ! Virtual server settings: ! @table @code ! @item nnmbox-mbox-file ! @vindex nnmbox-mbox-file ! The name of the mail box in the user's home directory. ! @item nnmbox-active-file ! @vindex nnmbox-active-file ! The name of the active file for the mail box. ! @item nnmbox-get-new-mail ! @vindex nnmbox-get-new-mail ! If non-@code{nil}, @code{nnmbox} will read incoming mail and split it ! into groups. @end table - @node nnbabyl - @subsubsection nnbabyl - @cindex nnbabyl - @cindex rmail mbox ! @vindex nnbabyl-active-file ! @vindex nnbabyl-mbox-file ! The @dfn{nnbabyl} backend will use a babyl mail box (aka. @dfn{rmail ! mbox}) to store mail. @code{nnbabyl} will add extra headers to each mail ! article to say which group it belongs in. ! Virtual server settings: ! @table @code ! @item nnbabyl-mbox-file ! @vindex nnbabyl-mbox-file ! The name of the rmail mbox file. ! @item nnbabyl-active-file ! @vindex nnbabyl-active-file ! The name of the active file for the rmail box. - @item nnbabyl-get-new-mail - @vindex nnbabyl-get-new-mail - If non-@code{nil}, @code{nnbabyl} will read incoming mail. @end table - @node nnml - @subsubsection nnml - @cindex nnml - @cindex mail @sc{nov} spool ! The @dfn{nnml} spool mail format isn't compatible with any other known ! format. It should be used with some caution. ! @vindex nnml-directory ! If you use this backend, Gnus will split all incoming mail into files; ! one file for each mail, and put the articles into the correct ! directories under the directory specified by the @code{nnml-directory} ! variable. The default value is @file{~/Mail/}. ! You do not have to create any directories beforehand; Gnus will take ! care of all that. - If you have a strict limit as to how many files you are allowed to store - in your account, you should not use this backend. As each mail gets its - own file, you might very well occupy thousands of inodes within a few - weeks. If this is no problem for you, and it isn't a problem for you - having your friendly systems administrator walking around, madly, - shouting "Who is eating all my inodes?! Who? Who!?!", then you should - know that this is probably the fastest format to use. You do not have - to trudge through a big mbox file just to read your new mail. ! @code{nnml} is probably the slowest backend when it comes to article ! splitting. It has to create lots of files, and it also generates ! @sc{nov} databases for the incoming mails. This makes is the fastest ! backend when it comes to reading mail. ! Virtual server settings: ! @table @code ! @item nnml-directory ! @vindex nnml-directory ! All @code{nnml} directories will be placed under this directory. ! @item nnml-active-file ! @vindex nnml-active-file ! The active file for the @code{nnml} server. - @item nnml-newsgroups-file - @vindex nnml-newsgroups-file - The @code{nnml} group description file. ! @item nnml-get-new-mail ! @vindex nnml-get-new-mail ! If non-@code{nil}, @code{nnml} will read incoming mail. ! @item nnml-nov-is-evil ! @vindex nnml-nov-is-evil ! If non-@code{nil}, this backend will ignore any @sc{nov} files. ! @item nnml-nov-file-name ! @vindex nnml-nov-file-name ! The name of the @sc{nov} files. The default is @file{.overview}. @end table ! @findex nnml-generate-nov-databases ! If your @code{nnml} groups and @sc{nov} files get totally out of whack, ! you can do a complete update by typing @kbd{M-x ! nnml-generate-nov-databases}. This command will trawl through the ! entire @code{nnml} hierarchy, looking at each and every article, so it ! might take a while to complete. ! @node nnmh ! @subsubsection nnmh ! @cindex nnmh ! @cindex mh-e mail spool ! @code{nnmh} is just like @code{nnml}, except that is doesn't generate ! @sc{nov} databases and it doesn't keep an active file. This makes ! @code{nnmh} a @emph{much} slower backend than @code{nnml}, but it also ! makes it easier to write procmail scripts for. - Virtual server settings: ! @table @code ! @item nnmh-directory ! @vindex nnmh-directory ! All @code{nnmh} directories will be located under this directory. ! @item nnmh-get-new-mail ! @vindex nnmh-get-new-mail ! If non-@code{nil}, @code{nnmh} will read incoming mail. ! @item nnmh-be-safe ! @vindex nnmh-be-safe ! If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make ! sure that the articles in the folder is actually what Gnus think they ! are. It will check date stamps, and stat everything in sight, so ! setting this to @code{t} will mean a serious slow-down. If you never ! use anything by Gnus to read the nnmh articles, you do not have to set ! this variable to @code{t}. @end table - @node nnfolder - @subsubsection nnfolder - @cindex nnfolder - @cindex mbox folders - - @code{nnfolder} is a backend for storing each mail group in a separate - file. Each file is in the standard Un*x mbox format. @code{nnfolder} - will add extra headers to keep track of article numbers and arrival - dates. ! Virtual server settings: @table @code - @item nnfolder-directory - @vindex nnfolder-directory - All the @code{nnfolder} mail boxes will be stored under this directory. - - @item nnfolder-active-file - @vindex nnfolder-active-file - The name of the active file. - - @item nnfolder-newsgroups-file - @vindex nnfolder-newsgroups-file - The name of the group description file. ! @item nnfolder-get-new-mail ! @vindex nnfolder-get-new-mail ! If non-@code{nil}, @code{nnfolder} will read incoming mail. ! @end table ! @node Group Parameters ! @section Group Parameters ! @cindex group parameters ! Gnus stores all information on a group in a list that is usually known ! as the @dfn{group info}. This list has from three to six elements. ! Here's an example info. @lisp ! ("nnml:mail.ding" 3 ((1 . 232) 244 (256 . 270)) ((tick 246 249)) ! (nnml "private") ((to-address . "ding@@ifi.uio.no"))) @end lisp - The first element is the @dfn{group name}, as Gnus knows the group, - anyway. The second element is the @dfn{subscription level}, which - normally is a small integer. The third element is a list of ranges of - read articles. The fourth element is a list of lists of article marks - of various kinds. The fifth element is the select method (or virtual - server, if you like). The sixth element is a list of @dfn{group - parameters}, which is what this section is about. - - Any of the last three elements may be missing if they are not required. - In fact, the vast majority of groups will normally only have the first - three elements, which saves quite a lot of cons cells. ! At present, there's not much you can put in the group parameters list: ! @table @code ! @item to-address ! @cindex to-address ! If the group parameter list contains an element that looks like ! @samp{(to-address . "some@@where.com")}, that address will be used by ! the backend when doing followups and posts. This is primarily useful in ! mail groups that represent mailing lists. You just set this address to ! whatever the list address is. ! This trick will actually work whether the group is foreign or not. ! Let's say there's a group on the server that is called @samp{fa.4ad-l}. ! This is a real newsgroup, but the server has gotten the articles from a ! mail-to-news gateway. Posting directly to this group is therefore ! impossible - you have to send mail to the mailing list address instead. ! @item to-group ! @cindex to-group ! IF the group parameter list contains an element like @code{(to-group ! . "some.group.name")}, all posts will be sent to that groups. ! @item auto-expire ! @cindex auto-expire ! If this symbol is present in the group parameter list, all articles that ! are read will be marked as expirable. For an alternative approach, ! @xref{Expiring Old Mail Articles}. ! @item total-expire ! @cindex total-expire ! If this symbol is present, all read articles will be put through the ! expiry process, even if they are not marked as expirable. Use with ! caution. ! @end table ! If you want to change the group parameters (or anything else of the ! group info) you can use the @kbd{G E} to edit enter a buffer where you ! can edit the group info. ! You usually don't want to edit the entire group info, so you'd be better ! off using the @kbd{G p} command to just edit the group parameters. ! @node Listing Groups ! @section Listing Groups ! @cindex group listing ! These commands all list various slices of the groups that are available. ! @table @kbd ! @item l ! @itemx A s ! @kindex A s (Group) ! @kindex l (Group) ! @findex gnus-group-list-groups ! List all groups that have unread articles ! (@code{gnus-group-list-groups}). If the numeric prefix is used, this ! command will list only groups of level ARG and lower. By default, it ! only lists groups of level five or lower (i.e., just subscribed groups). ! @item L ! @itemx A u ! @kindex A u (Group) ! @kindex L (Group) ! @findex gnus-group-list-all-groups ! List all groups, whether they have unread articles or not ! (@code{gnus-group-list-all-groups}). If the numeric prefix is used, ! this command will list only groups of level ARG and lower. By default, ! it lists groups of level seven or lower (i.e., just subscribed and ! unsubscribed groups). ! @item A k ! @kindex A k (Group) ! @findex gnus-group-list-killed ! List all killed groups (@code{gnus-group-list-killed}). ! @item A z ! @kindex A z (Group) ! @findex gnus-group-list-zombies ! List all zombie groups (@code{gnus-group-list-zombies}). ! @item A m ! @kindex A m (Group) ! @findex gnus-group-list-matching ! List all subscribed groups with unread articles that match a regexp ! (@code{gnus-group-list-matching}). ! @item A M ! @kindex A M (Group) ! @findex gnus-group-list-all-matching ! List groups that match a regexp (@code{gnus-group-list-all-matching}). ! @end table ! @node Group Maintenance ! @section Group Maintenance ! @cindex bogus groups ! @table @kbd ! @item b ! @kindex b (Group) ! @findex gnus-group-check-bogus-groups ! Find bogus groups and delete them ! (@code{gnus-group-check-bogus-groups}). ! @item F ! @kindex F (Group) ! @findex gnus-find-new-newsgroups ! Find new groups and process them (@code{gnus-find-new-newsgroups}). ! @item C-c C-x ! @kindex C-c C-x (Group) ! @findex gnus-group-expire-articles ! Run all expirable articles in the current group through the expiry ! process (if any) (@code{gnus-group-expire-articles}). ! @item C-c M-C-x ! @kindex C-c M-C-x (Group) ! @findex gnus-group-expire-all-groups ! Run all articles in all groups through the expiry process ! (@code{gnus-group-expire-all-groups}). ! @item C-c C-s ! @kindex C-c C-s (Group) ! @findex gnus-group-sort-groups ! @findex gnus-group-sort-by-level ! @findex gnus-group-sort-by-unread ! @findex gnus-group-sort-by-alphabet ! @vindex gnus-group-sort-function ! Sort the groups according to the function given by the ! @code{gnus-group-sort-function} variable ! (@code{gnus-group-sort-groups}). Available sorting functions include ! @code{gnus-group-sort-by-alphabet} (the default), ! @code{gnus-group-sort-by-unread} and @code{gnus-group-sort-by-level}. ! @end table ! @node Browse Foreign Server ! @section Browse Foreign Server ! @cindex foreign servers ! @cindex browsing servers - @table @kbd - @item B - @kindex B (Group) - @findex gnus-group-browse-foreign-server - You will be queried for a select method and a server name. Gnus will - then attempt to contact this server and let you browse the groups there - (@code{gnus-group-browse-foreign-server}). @end table - @findex gnus-browse-server-mode - A new buffer with a list of available groups will appear. This buffer - will be use the @code{gnus-browse-server-mode}. This buffer looks a bit - (well, a lot) like a normal group buffer, but with one major difference - - you can't enter any of the groups. If you want to read any of the - news available on that server, you have to subscribe to the groups you - think may be interesting, and then you have to exit this buffer. The - new groups will be added to the group buffer, and then you can read them - as you would any other group. ! Future versions of Gnus may possibly permit reading groups straight from ! the browse buffer. ! Here's a list of keystrokes available in the browse mode: @table @kbd ! @item n ! @kindex n (Browse) ! @findex gnus-group-next-group ! Go to the next group (@code{gnus-group-next-group}). ! @item p ! @kindex p (Browse) ! @findex gnus-group-prev-group ! Go to the previous group (@code{gnus-group-prev-group}). ! @item SPC ! @kindex SPC (Browse) ! @findex gnus-browse-read-group ! Enter the current group and display the first article ! (@code{gnus-browse-read-group}). ! @item RET ! @kindex RET (Browse) ! @findex gnus-browse-select-group ! Enter the current group (@code{gnus-browse-select-group}). ! @item u ! @kindex u (Browse) ! @findex gnus-browse-unsubscribe-current-group ! Unsubscribe to the current group, or, as will be the case here, ! subscribe to it (@code{gnus-browse-unsubscribe-current-group}). ! @item l ! @itemx q ! @kindex q (Browse) ! @kindex l (Browse) ! @findex gnus-browse-exit ! Exit browse mode (@code{gnus-browse-exit}). ! @item ? ! @kindex ? (Browse) ! @findex gnus-browse-describe-briefly ! Describe browse mode briefly (well, there's not much to describe, is ! there) (@code{gnus-browse-describe-briefly}). ! @end table ! @node Exiting Gnus ! @section Exiting Gnus ! @cindex exiting Gnus ! Yes, Gnus is ex(c)iting. ! @table @kbd ! @item z ! @kindex z (Group) ! @findex gnus-group-suspend ! Suspend Gnus (@code{gnus-group-suspend}). This doesn't really exit Gnus, ! but it kills all buffers except the Group buffer. I'm not sure why this ! is a gain, but then who am I to judge? ! @item q ! @kindex q (Group) ! @findex gnus-group-exit ! Quit Gnus (@code{gnus-group-exit}). ! @item Q ! @kindex Q (Group) ! @findex gnus-group-quit ! Quit Gnus without saving any startup files (@code{gnus-group-quit}). ! @end table ! @vindex gnus-exit-gnus-hook ! @vindex gnus-suspend-gnus-hook ! @code{gnus-suspend-gnus-hook} is called when you suspend Gnus and ! @code{gnus-exit-gnus-hook} is called when you quit Gnus. ! @findex gnus-unload ! @cindex unloading ! If you wish to completely unload Gnus and all its adherents, you can use ! the @code{gnus-unload} command. This command is also very handy when ! trying to customize meta-variables. ! Note: ! @quotation ! Miss Lisa Cannifax, while sitting in English class, feels her feet go ! numbly heavy and herself fall into a hazy trance as the boy sitting ! behind her drew repeated lines with his pencil across the back of her ! plastic chair. ! @end quotation ! @node Misc Group Stuff ! @section Misc Group Stuff @table @kbd - @item g - @kindex g (Group) - @findex gnus-group-get-new-news - Check server for new articles. If the numeric prefix is used, this - command will check only groups of level ARG and lower - (@code{gnus-group-get-new-news}). - @item M-g - @kindex M-g (Group) - @findex gnus-group-get-new-news-this-group - Check whether new articles have arrived in the current group - (@code{gnus-group-get-new-news-this-group}). ! @item ^ ! @kindex ^ (Group) ! @findex gnus-group-enter-server-mode ! Enter the server buffer (@code{gnus-group-enter-server-mode}). @xref{The ! Server Buffer}. ! @item M-f ! @kindex M-f (Group) ! @findex gnus-group-fetch-faq ! Try to fetch the FAQ for the current group ! (@code{gnus-group-fetch-faq}). Gnus will try to get the FAQ from ! @code{gnus-group-faq-directory}, which is usually a directory on a ! remote machine. ange-ftp will be used for fetching the file. ! @item R ! @kindex R (Group) ! @findex gnus-group-restart ! Restart Gnus (@code{gnus-group-restart}). ! @item r ! @kindex r (Group) ! @findex gnus-group-read-init-file ! @vindex gnus-init-file ! Read the init file (@code{gnus-init-file}, which defaults to ! @file{~/.gnus}) (@code{gnus-group-read-init-file}). ! @item s ! @kindex s (Group) ! @findex gnus-group-save-newsrc ! Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted) ! (@code{gnus-group-save-newsrc}). ! @item Z ! @kindex Z (Group) ! @findex gnus-group-clear-dribble ! Clear the dribble buffer (@code{gnus-group-clear-dribble}). ! @item D ! @kindex D (Group) ! @findex gnus-group-describe-group ! Describe the current group (@code{gnus-group-describe-group}). If given ! a prefix, force Gnus to re-read the description from the server. ! @item G a ! @kindex G a (Group) ! @findex gnus-group-apropos ! List all groups that have names that match a regexp ! (@code{gnus-group-apropos}). ! @item G d ! @kindex G d (Group) ! @findex gnus-group-description-apropos ! List all groups that have names or descriptions that match a regexp ! (@code{gnus-group-description-apropos}). ! @item a ! @kindex a (Group) ! @findex gnus-group-post-news ! Post an article to a group (@code{gnus-group-post-news}). ! @item m ! @kindex m (Group) ! @findex gnus-group-mail ! Mail a message somewhere (@code{gnus-group-mail}). ! @item C-x C-t ! @kindex C-x C-t (Group) ! @findex gnus-group-transpose-groups ! Transpose two groups (@code{gnus-group-transpose-groups}). ! @item V ! @kindex V (Group) ! @findex gnus-version ! Display current Gnus version numbers (@code{gnus-version}). ! @item M-d ! @kindex M-d (Group) ! @findex gnus-group-describe-all-groups ! Describe all groups (@code{gnus-group-describe-all-groups}). If given a ! prefix, force Gnus to re-read the description file from the server. ! @item ? ! @kindex ? (Group) ! @findex gnus-group-describe-briefly ! Give a very short help message (@code{gnus-group-describe-briefly}). ! @item C-c C-i ! @kindex C-c C-i (Group) ! @findex gnus-info-find-node ! Go to the Gnus info node (@code{gnus-info-find-node}). ! @end table ! @vindex gnus-group-prepare-hook ! @code{gnus-group-prepare-hook} is called after the group buffer is ! generated. It may be used to modify the buffer in some strange, ! unnatural way. ! @node The Summary Buffer ! @chapter The Summary Buffer ! @cindex summary buffer ! A line for each article is displayed in the summary buffer. You can ! move around, read articles, post articles and reply to articles. ! @menu ! * Summary Buffer Format:: Deciding how the summary buffer is to look. ! * Summary Maneuvering:: Moving around the summary buffer. ! * Choosing Articles:: Reading articles. ! * Paging the Article:: Scrolling the current article. ! * Reply Followup and Post:: Posting articles. ! * Canceling and Superseding:: "Whoops, I shouldn't have called him that." ! * Marking Articles:: Marking articles as read, expirable, etc. ! * Threading:: How threads are made. ! * Asynchronous Fetching:: Gnus might be able to pre-fetch articles. ! * Article Caching:: You may store articles in a cache. ! * Exiting the Summary Buffer:: Returning to the Group buffer. ! * Process/Prefix:: A convention used by many treatment commands. ! * Saving Articles:: Ways of customizing article saving. ! * Decoding Articles:: Gnus can treat series of (uu)encoded articles. ! * Various Article Stuff:: Various stuff dealing with articles. ! * Summary Sorting:: You can sort the summary buffer four ways. ! * Finding the Parent:: No child support? Get the parent. ! * Score Files:: Maintaining a score file. ! * Mail Group Commands:: Some commands can only be used in mail groups. ! * Various Summary Stuff:: What didn't fit anywhere else. ! @end menu ! @node Summary Buffer Format ! @section Summary Buffer Format ! @cindex summary buffer format @menu ! * Summary Buffer Lines:: You can specify how summary lines should look. ! * Summary Buffer Mode Line:: You can say how the mode line should look. @end menu - @findex mail-extract-address-components - @findex gnus-extract-address-components - @vindex gnus-extract-address-components - Gnus will use the value of the @code{gnus-extract-address-components} - variable as a function for getting the name and address parts of a - @code{From} header. Two pre-defined function exist: - @code{gnus-extract-address-components}, which is the default, quite - fast, and too simplistic solution, and - @code{mail-extract-address-components}, which works very nicely, but is - slower. ! @vindex gnus-summary-same-subject ! @code{gnus-summary-same-subject} is a string indicating that the current ! article has the same subject as the previous. This string will be used ! with those specs that require it. ! @node Summary Buffer Lines ! @subsection Summary Buffer Lines ! @vindex gnus-summary-line-format ! You can change the format of the lines in the summary buffer by changing ! the @code{gnus-summary-line-format} variable. It works along the same ! lines a a normal @code{format} string, with some extensions. ! The default string is @samp{"%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"}. ! The following format specification characters are understood: ! @table @samp ! @item N ! Article number. ! @item S ! Subject string. ! @item s ! Subject if the article is the root, @code{gnus-summary-same-subject} ! otherwise. ! @item F ! Full @code{From} line. ! @item n ! The name (from the @code{From} header). ! @item a ! The name (from the @code{From} header). This differs from the @code{n} ! spec in that it uses @code{gnus-extract-address-components}, which is ! slower, but may be more thorough. ! @item A ! The address (from the @code{From} header). This works the same way as ! the @code{a} spec. ! @item L ! Number of lines in the article. ! @item c ! Number of characters in the article. ! @item I ! Indentation based on thread level (@pxref{Customizing Threading}). ! @item T ! Nothing if the article is a root and lots of spaces if it isn't (it ! pushes everything after it off the screen). ! @item \[ ! Opening bracket, which is normally @samp{\[}, but can also be @samp{<} ! for adopted articles. ! @item \] ! Closing bracket, which is normally @samp{\]}, but can also be @samp{>} ! for adopted articles. ! @item < ! One space for each thread level. ! @item > ! Twenty minus thread level spaces. ! @item U ! Unread. ! @item R ! Replied. ! @item i ! Score as a number. ! @item z ! @vindex gnus-summary-zcore-fuzz ! Zcore, @samp{+} if above the default level and @samp{-} if below the ! default level. If the difference between ! @code{gnus-summary-default-level} and the score is less than ! @code{gnus-summary-zcore-fuzz}, this spec will not be used. ! @item x ! @code{Xref}. ! @item D ! @code{Date}. ! @item M ! @code{Message-Id}. ! @item r ! @code{References}. ! @item t ! Number of articles in the current sub-thread. Using this spec will slow ! down summary buffer generation somewhat. ! @item e ! A single character will be displayed if the article has any children. ! @item u ! User defined specifier. The next character in the format string should ! be a letter. @sc{gnus} will call the function ! @code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter ! following @samp{%u}. The function will be passed the current header as ! argument. The function should return a string, which will be inserted ! into the summary just like information from any other summary specifier. ! @end table ! Text between @samp{%(} and @samp{%)} will be highlighted with ! @code{gnus-mouse-face} when the mouse point is placed inside the area. ! There can only be one such area. ! The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs ! have to be handled with care. For reasons of efficiency, Gnus will ! compute what column these characters will end up in, and "hard-code" ! that. This means that it is illegal to have these specs after a ! variable-length spec. Well, you might not be arrested, but your summary ! buffer will look strange, which is bad enough. ! The smart choice is to have these specs as far to the left as possible. ! (Isn't that the case with everything, though? But I digress.) ! This restriction may disappear in later versions of Gnus. ! @node Summary Buffer Mode Line ! @subsection Summary Buffer Mode Line - @vindex gnus-summary-mode-line-format - You can also change the format of the summary mode bar. Set - @code{gnus-summary-mode-line-format} to whatever you like. Here are the - elements you can play with: ! @table @samp ! @item G ! Group name. ! @item A ! Current article number. ! @item V ! Gnus version. ! @item U ! Number of unread articles in this group. ! @item e ! Number of unselected articles in this group. ! @item Z ! A string with the number of unread and unselected articles represented ! either as @samp{<%U(+%u) more>} if there are both unread and unselected ! articles, and just as @samp{<%U more>} if there are just unread articles ! and no unselected ones. ! @item g ! Shortish group name. For instance, @samp{rec.arts.anime} will be ! shortened to @samp{r.a.anime}. ! @item S ! Subject of the current article. ! @item u ! Used-defined spec. ! @item s ! Name of the current score file. ! @end table ! @node Summary Maneuvering ! @section Summary Maneuvering ! @cindex summary movement ! All the straight movement commands understand the numeric prefix and ! behave pretty much as you'd expect. ! None of these commands select articles. ! @table @kbd ! @item G M-n ! @itemx M-n ! @kindex M-n (Summary) ! @kindex G M-n (Summary) ! @findex gnus-summary-next-unread-subject ! Go to the next summary line of an unread article ! (@code{gnus-summary-next-unread-subject}). ! @item G M-p ! @itemx M-p ! @kindex M-p (Summary) ! @kindex G M-p (Summary) ! @findex gnus-summary-prev-unread-subject ! Go to the previous summary line of an unread article ! (@code{gnus-summary-prev-unread-subject}). ! @item G g ! @itemx j ! @kindex j (Summary) ! @kindex G g (Summary) ! @findex gnus-summary-goto-subject ! Ask for an article number and then go to this summary line ! (@code{gnus-summary-goto-subject}). @end table - @vindex gnus-auto-select-next - If you are at the end of the group and issue one of the movement - commands, Gnus will offer to go to the next group. If - @code{gnus-auto-select-next} is @code{t} and the next group is empty, - Gnus will exit summary mode and return to the group buffer. If this - variable is neither @code{t} nor @code{nil}, Gnus will select the next - group, no matter whether it has any unread articles or not. As a - special case, if this variable is @code{quietly}, Gnus will select the - next group without asking for confirmation. Also @xref{Group Levels}. ! If Gnus asks you to press a key to confirm going to the next group, you ! can use the @kbd{C-n} and @kbd{C-p} keys to move around the group ! buffer, searching for the next group to read without actually returning ! to the group buffer. ! @vindex gnus-auto-select-same ! If @code{gnus-auto-select-same} is non-@code{nil}, all the movement ! commands will try to go to the next article with the same subject as the ! current. This variable is not particularly useful if you use a threaded ! display. ! @vindex gnus-summary-check-current ! If @code{gnus-summary-check-current} is non-@code{nil}, all the "unread" ! movement commands will not proceed to the next (or previous) article if ! the current article is unread. Instead, they will choose the current ! article. ! @vindex gnus-auto-center-summary ! If @code{gnus-auto-center-summary} is non-@code{nil}, Gnus will keep the ! point in the summary buffer centered at all times. This makes things ! quite tidy, but if you have a slow network connection, or simply do not ! like this un-Emacsism, you can set this variable to @code{nil} to get ! the normal Emacs scrolling action. ! @node Choosing Articles ! @section Choosing Articles ! @cindex selecting articles ! None of the following movement commands understand the numeric prefix, ! and they all select and display an article. ! @table @kbd ! @item SPACE ! @kindex SPACE (Summary) ! @findex gnus-summary-next-page ! Select the current article, or, if that one's read already, the next ! unread article (@code{gnus-summary-next-page}). ! @item G n ! @itemx n ! @kindex n (Summary) ! @kindex G n (Summary) ! @findex gnus-summary-next-unread-article ! Go to next unread article (@code{gnus-summary-next-unread-article}). ! @item G p ! @itemx p ! @kindex p (Summary) ! @findex gnus-summary-prev-unread-article ! Go to previous unread article (@code{gnus-summary-prev-unread-article}). ! @item G N ! @itemx N ! @kindex N (Summary) ! @kindex G N (Summary) ! @findex gnus-summary-next-article ! Go to the next article (@code{gnus-summary-next-article}). ! @item G P ! @itemx P ! @kindex P (Summary) ! @kindex G P (Summary) ! @findex gnus-summary-prev-article ! Go to the previous article (@code{gnus-summary-prev-article}). ! @item G C-n ! @kindex G C-n (Summary) ! @findex gnus-summary-next-same-subject ! Go to the next article with the same subject ! (@code{gnus-summary-next-same-subject}). ! @item G C-p ! @kindex G C-p (Summary) ! @findex gnus-summary-prev-same-subject ! Go to the previous article with the same subject ! (@code{gnus-summary-prev-same-subject}). ! @item G f ! @itemx . ! @kindex G f (Summary) ! @kindex . (Summary) ! @findex gnus-summary-first-unread-article ! Go to the first unread article ! (@code{gnus-summary-first-unread-article}). ! @item G b ! @itemx , ! @kindex G b (Summary) ! @kindex , (Summary) ! Go to the article with the highest score ! (@code{gnus-summary-best-unread-article}). ! @item G l ! @itemx l ! @kindex l (Summary) ! @kindex G l (Summary) ! @findex gnus-summary-goto-last-article ! Go to the previous article read (@code{gnus-summary-goto-last-article}). ! @item G p ! @kindex G p (Summary) ! @findex gnus-summary-pop-article ! Pop an article off the summary history and go to this article ! (@code{gnus-summary-pop-article}). This command differs from the ! command above in that you can pop as many previous articles off the ! history as you like. ! @end table ! Some variables that are relevant for moving and selecting articles: ! @table @code ! @item gnus-auto-extend-newsgroup ! @vindex gnus-auto-extend-newsgroup ! All the movement commands will try to go to the previous (or next) ! article, even if that article isn't displayed in the Summary buffer if ! this variable is non-@code{nil}. Gnus will then fetch the article from ! the server and display it in the article buffer. ! @item gnus-select-article-hook ! @vindex gnus-select-article-hook ! This hook is called whenever an article is selected. By default it ! exposes any threads hidden under the selected article. ! @item gnus-mark-article-hook ! @vindex gnus-mark-article-hook ! This hook is called whenever an article is selected. It is intended to ! be used for marking articles as read. ! @item gnus-visual-mark-article-hook ! @vindex gnus-visual-mark-article-hook ! This hook is run after selecting an article. It is meant to be used for ! highlighting the article in some way. It is not run if ! @code{gnus-visual} is @code{nil}. ! @item gnus-summary-update-hook ! @vindex gnus-summary-update-hook ! This hook is called when a summary line is changed. It is not run if ! @code{gnus-visual} is @code{nil}. ! @item gnus-summary-selected-face ! @vindex gnus-summary-selected-face ! This is the face (or @dfn{font} as some people call it) that is used to ! highlight the current article in the summary buffer. ! @item gnus-summary-highlight ! @vindex gnus-summary-highlight ! Summary lines are highlighted according to this variable, which is a ! list where the elements are on the format @code{(FORM . FACE)}. If you ! would, for instance, like ticked articles to be italic and high-scored ! articles to be bold, you could set this variable to something like ! @lisp ! (((eq mark gnus-ticked-mark) . italic) ! ((> score default) . bold)) ! @end lisp ! As you may have guessed, if @var{FORM} returns a non-@code{nil} value, ! @var{FACE} will be applied to the line. ! @end table ! @node Paging the Article ! @section Scrolling the Article ! @cindex article scrolling - @table @kbd - @item SPACE - @kindex SPACE (Summary) - @findex gnus-summary-next-page - Pressing @kbd{SPACE} will scroll the current article forward one page, - or, if you have come to the end of the current article, will choose the - next article (@code{gnus-summary-next-page}). - @item DEL - @kindex DEL (Summary) - @findex gnus-summary-prev-page - Scroll the current article back one page (@code{gnus-summary-prev-page}). - @item RET - @kindex RET (Summary) - @findex gnus-summary-scroll-up - Scroll the current article one line forward - (@code{gnus-summary-scroll-up}). - @item A < - @itemx < - @kindex < (Summary) - @kindex A < (Summary) - @findex gnus-summary-beginning-of-article - Scroll to the beginning of the article - (@code{gnus-summary-beginning-of-article}). - @item A > - @itemx > - @kindex > (Summary) - @kindex A > (Summary) - @findex gnus-summary-end-of-article - Scroll to the end of the article (@code{gnus-summary-end-of-article}). - @end table ! @node Reply Followup and Post ! @section Reply, Followup and Post ! @cindex reply ! @cindex followup ! @cindex post ! @kindex C-c C-c (Post) ! All the commands for posting and mailing will put you in a post or mail ! buffer where you can edit the article all you like, before you send the ! article by pressing @kbd{C-c C-c}. If you are in a foreign news group, ! and you wish to post the article using the foreign server, you can give ! a prefix to @kbd{C-c C-c} to make Gnus try to post using the foreign ! server. ! @menu ! * Mail:: Mailing & replying. ! * Post:: Posting and following up. ! * Mail & Post:: Mailing and posting at the same time. @end menu ! @node Mail ! @subsection Mail ! Commands for composing a mail message: ! @table @kbd ! @item S r ! @itemx r ! @kindex S r (Summary) ! @kindex r (Summary) ! @findex gnus-summary-reply ! Mail a reply to the author of the current article ! (@code{gnus-summary-reply}). ! @item S R ! @itemx R ! @kindex R (Summary) ! @kindex S R (Summary) ! @findex gnus-summary-reply-with-original ! Mail a reply to the author of the current article and include the ! original message (@code{gnus-summary-reply-with-original}). This ! command uses the process/prefix convention. ! @item S o m ! @kindex S o m (Summary) ! @findex gnus-summary-mail-forward ! Forward the current article to some other person ! (@code{gnus-summary-mail-forward}). ! @item S o p ! @kindex S o p (Summary) ! @findex gnus-summary-post-forward ! Forward the current article to a newsgroup ! (@code{gnus-summary-post-forward}). ! @item S m ! @itemx m ! @kindex m (Summary) ! @kindex S m (Summary) ! @findex gnus-summary-mail-other-window ! Send a mail to some other person ! (@code{gnus-summary-mail-other-window}). ! @item S O m ! @kindex S O m (Summary) ! @findex gnus-uu-digest-mail-forward ! Digest the current series and forward the result using mail ! (@code{gnus-uu-digest-mail-forward}). This command uses the ! process/prefix convention (@pxref{Process/Prefix}). ! @item S O p ! @kindex S O p (Summary) ! @findex gnus-uu-digest-post-forward ! Digest the current series and forward the result to a newsgroup ! (@code{gnus-uu-digest-mail-forward}). @end table - Variables for customizing outgoing mail: ! @table @code ! @item gnus-reply-to-function ! @vindex gnus-reply-to-function ! Gnus uses the normal methods to determine where replies are to go, but ! you can change the behavior to suit your needs by fiddling with this ! variable. ! ! If you want the replies to go to the @samp{Sender} instead of the ! @samp{From} in the group @samp{mail.stupid-list}, you could do something ! like this: ! @lisp ! (setq gnus-reply-to-function ! (lambda (group) ! (cond ((string= group "mail.stupid-list") ! (mail-fetch-field "sender")) ! (t ! nil)))) ! @end lisp ! This function will be called narrowed to the head of the article that is ! being replied to. ! As you can see, this function should return a string if it has an ! opinion as to what the To header should be. If it does not, it should ! just return @code{nil}, and the normal methods for determining the To ! header will be used. ! ! This function can also return a list. In that case, each list element ! should be a cons, where the car should be the name of an header ! (eg. @samp{Cc}) and the cdr should be the header value ! (eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into ! the head of the outgoing mail. ! ! @item gnus-mail-send-method ! @vindex gnus-mail-send-method ! This variable says how a mail should be mailed. It uses the function in ! the @code{send-mail-function} variable as the default. ! @item gnus-uu-digest-headers ! @vindex gnus-uu-digest-headers ! List of regexps to match headers included in digested messages. The ! headers will be included in the sequence they are matched. ! @item gnus-mail-hook ! Hook called as the last thing after setting up a mail buffer. ! @end table ! There are three "methods" for handling all mail. The default is ! @code{sendmail}. Some people like what @code{mh} does better, and some ! people prefer @code{vm}. ! Three variables for customizing what to use when: ! @table @code ! @vindex gnus-mail-reply-method ! @item gnus-mail-reply-method ! This function is used to compose replies. The three functions available ! are: ! @findex gnus-mail-reply-using-vm ! @findex gnus-mail-reply-using-mhe ! @findex gnus-mail-reply-using-mail ! @itemize @bullet ! @item ! @code{gnus-mail-reply-using-mail} (sendmail) ! @item ! @code{gnus-mail-reply-using-mhe} (mh) ! @item ! @code{gnus-mail-reply-using-vm} (vm) ! @end itemize ! @vindex gnus-mail-forward-method ! @item gnus-mail-forward-method ! This function is used to forward messages. The three functions available ! are: ! @findex gnus-mail-forward-using-vm ! @findex gnus-mail-forward-using-mhe ! @findex gnus-mail-forward-using-mail ! @itemize @bullet ! @item ! @code{gnus-mail-forward-using-mail} (sendmail) ! @item ! @code{gnus-mail-forward-using-mhe} (mh) ! @item ! @code{gnus-mail-forward-using-vm} (vm) ! @end itemize ! @vindex gnus-mail-other-window-method ! @item gnus-mail-other-window-method ! This function is used to send mails. The three functions available are: ! ! @findex gnus-mail-other-window-using-vm ! @findex gnus-mail-other-window-using-mhe ! @findex gnus-mail-other-window-using-mail ! @itemize @bullet ! @item ! @code{gnus-mail-other-window-using-mail} (sendmail) ! @item ! @code{gnus-mail-other-window-using-mhe} (mh) ! @item ! @code{gnus-mail-other-window-using-vm} (vm) ! @end itemize @end table ! @node Post ! @subsection Post ! Commands for posting an article: ! @table @kbd ! @item S p ! @itemx a ! @kindex a (Summary) ! @kindex S p (Summary) ! @findex gnus-summary-post-news ! Post an article to the current group ! (@code{gnus-summary-post-news}). ! @item S f ! @itemx f ! @kindex f (Summary) ! @kindex S f (Summary) ! @findex gnus-summary-followup ! Post a followup to the current article (@code{gnus-summary-followup}). ! @item S F ! @itemx F ! @kindex S F (Summary) ! @kindex F (Summary) ! @findex gnus-summary-followup-with-original ! Post a followup to the current article and include the original message ! (@code{gnus-summary-followup-with-original}). This command uses the ! process/prefix convention. ! @item S u ! @kindex S u (Summary) ! @findex gnus-uu-post-news ! Uuencode a file, split it into parts, and post it as a series ! (@code{gnus-uu-post-news}). ! @c (@pxref{Uuencoding & Posting}). ! @end table ! ! @vindex gnus-required-headers ! @code{gnus-required-headers} a list of header symbols. These headers ! will either be automatically generated, or, if that's impossible, they ! will be prompted for. The following symbols are legal: ! ! @table @code ! @item From ! This required header will be filled out with the result of the ! @code{gnus-inews-user-name} function, which depends on the ! @code{gnus-user-from-line}, @code{gnus-user-login-name}, ! @code{gnus-local-domain} and @code{user-mail-address} variables. ! @item Subject ! This required header will be prompted for if not present already. ! @item Newsgroups ! This required header says which newsgroups the article is to be posted ! to. If it isn't present already, it will be prompted for. ! @item Organization ! @cindex organization ! @vindex gnus-local-organization ! @vindex gnus-organization-file ! This optional header will be filled out depending on the ! @code{gnus-local-organization} variable. @code{gnus-organization-file} ! will be used if that variable is nil. ! @item Lines ! This optional header will be computed by Gnus. ! @item Message-ID ! This required header will be generated by Gnus. A unique ID will be ! created based on date, time, user name and system name. ! @item X-Newsreader ! This optional header will be filled out with the Gnus version numbers. ! @end table ! ! In addition, you can enter conses into this list. The car of this cons ! should be a symbol who's name is the name of the header, and the cdr can ! either a string to be entered verbatim as the value of this header, or ! it can be a function to be called. This function should return a string ! to be inserted. For instance, if you want to insert @samp{Mime-Version: ! 1.0}, you should enter @code{(Mime-Version . "1.0")} into the list. If ! you want to insert a funny quote, you could enter something like ! @code{(X-Yow . yow)} into the list. The function @code{yow} will then ! be called without any arguments. ! ! Other variables for customizing outgoing articles: ! ! @table @code ! @item gnus-post-method ! @vindex gnus-post-method ! If non-@code{nil}, Gnus will use this method instead of the default ! select method when posting. ! ! @item nntp-news-default-headers ! @vindex nntp-news-default-headers ! If non-@code{nil}, this variable will override ! @code{mail-default-headers} when posting. This variable should then be ! a string. This string will be inserted, as is, in the head of all ! outgoing articles. ! ! @item gnus-use-followup-to ! @vindex gnus-use-followup-to ! If @code{nil}, always ignore the Followup-To header. If it is @code{t}, ! use its value, but ignore the special value @samp{poster}, which will ! send the followup as a reply mail to the person you are responding to. ! If it is the symbol @code{ask}, query the user before posting. ! If it is the symbol @code{use}, always use the value. ! ! @item gnus-followup-to-function ! @vindex gnus-followup-to-function ! This variable is most useful in mail groups, where "following up" really ! means sending a mail to a list address. Gnus uses the normal methods to ! determine where follow-ups are to go, but you can change the behavior ! to suit your needs by fiddling with this variable. ! ! If you want the followups to go to the @samp{Sender} instead of the ! @samp{From} in the group @samp{mail.stupid-list}, you could do something ! like this: ! ! @lisp ! (setq gnus-followup-to-function ! (lambda (group) ! (cond ((string= group "mail.stupid-list") ! (mail-fetch-field "sender")) ! (t ! nil)))) ! @end lisp ! ! This function will be called narrowed to header of the article that is ! being followed up. ! ! @item gnus-removable-headers ! @vindex gnus-removable-headers ! Some headers that are generated are toxic to the @sc{nntp} server. ! These include the @code{NNTP-Posting-Host}, @code{Bcc} and @code{Xref}, ! so these headers are deleted if they are present in this list of ! symbols. ! ! @item gnus-deletable-headers ! @vindex gnus-deletable-headers ! Headers in this list that were previously generated by Gnus will be ! deleted before posting. Let's say you post an article. Then you decide ! to post it again to some other group, you naughty boy, so you jump back ! to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and ! ship it off again. By default, this variable makes sure that the old ! generated @code{Message-ID} is deleted, and a new one generated. If ! this isn't done, the entire empire would probably crumble, anarchy would ! prevail, and cats would start walking on two legs and rule the world. ! Allegedly. ! ! @item gnus-signature-function ! @vindex gnus-signature-function ! If non-@code{nil}, this variable should be a function that returns a ! signature file name. The function will be called with the name of the ! group being posted to. If the function returns a string that doesn't ! correspond to a file, the string itself is inserted. If the function ! returns @code{nil}, the @code{gnus-signature-file} variable will be used ! instead. ! ! @item gnus-post-prepare-function ! @vindex gnus-post-prepare-function ! This function is called with the name of the current group after the ! post buffer has been initialized, and can be used for inserting a ! signature. Nice if you use different signatures in different groups. ! ! @item gnus-post-prepare-hook ! @vindex gnus-post-prepare-hook ! This hook is called after a post buffer has been prepared. If you want ! to insert a signature at this point, you could put ! @code{gnus-inews-insert-signature} into this hook. ! ! @item news-reply-header-hook ! @vindex news-reply-header-hook ! A related variable when following up and replying is this variable, ! which inserts the @dfn{quote line}. The default value is: ! ! @lisp ! (defvar news-reply-header-hook ! (lambda () ! (insert "In article " news-reply-yank-message-id ! " " news-reply-yank-from " writes:\n\n"))) ! @end lisp ! ! This will create lines like: ! ! @example ! In article Lars Mars writes: ! @end example ! ! Having the @code{Message-Id} in this line is probably overkill, so I ! would suggest this hook instead: ! ! @lisp ! (setq news-reply-header-hook ! (lambda () (insert news-reply-yank-from " writes:\n\n"))) ! @end lisp ! ! @item gnus-prepare-article-hook ! @vindex gnus-prepare-article-hook ! This hook is called before the headers have been prepared. By default ! it inserts the signature specified by @code{gnus-signature-file}. ! ! @item gnus-inews-article-function ! @vindex gnus-inews-article-function ! This function is used to do the actual article processing and header ! checking/generation. ! ! @item gnus-inews-article-hook ! @vindex gnus-inews-article-hook ! This hook is called right before the article is posted. By default it ! handles FCC processing (i.e., saving the article to a file.) ! ! @item gnus-inews-article-header-hook ! @vindex gnus-inews-article-header-hook ! This hook is called after inserting the required headers in an article ! to be posted. The hook is called from the @code{*post-news*} buffer, ! narrowed to the head, and is intended for people who would like to ! insert additional headers, or just change headers in some way or other. ! ! @item gnus-check-before-posting ! @vindex gnus-check-before-posting ! If non-@code{nil}, Gnus will attempt to check the legality of the ! headers, as well as some other stuff, before posting. You can control ! the granularity of the check by adding or removing elements from this ! list. Legal elements are: ! ! @table @code ! @item subject-cmsg ! Check the subject for commands. ! @item multiple-headers ! Check for the existence of multiple equal headers. ! @item sendsys ! Check for the existence of version and sendsys commands. ! @item message-id ! Check whether the @code{Message-ID} looks ok. ! @item from ! Check whether the @code{From} header seems nice. ! @item long-lines ! Check for too long lines. ! @item control-chars ! Check for illegal characters. ! @item size ! Check for excessive size. ! @item new-text ! Check whether there is any new text in the messages. ! @item signature ! Check the length of the signature ! @end table ! ! @end table ! ! ! @node Mail & Post ! @subsection Mail & Post ! ! Commands for sending mail and post at the same time: ! ! @table @kbd ! @item S b ! @kindex S b (Summary) ! @findex gnus-summary-followup-and-reply ! Post a followup and send a reply to the current article ! (@code{gnus-summary-followup-and-reply}). ! @item S B ! @kindex S B (Summary) ! @findex gnus-summary-followup-and-reply-with-original ! Post a followup and send a reply to the current article and include the ! original message (@code{gnus-summary-followup-and-reply-with-original}). ! This command uses the process/prefix convention. ! @end table ! ! Here's a list of variables that are relevant to both mailing and ! posting: ! ! @table @code ! @item gnus-signature-file ! @itemx mail-signature ! @vindex mail-signature ! @vindex gnus-signature-file ! @cindex double signature ! @cindex signature ! If @code{gnus-signature-file} is non-@code{nil}, it should be the name ! of a file containing a signature (@samp{~/.signature} by default). This ! signature will be appended to all outgoing post. Most people find it ! more convenient to use @code{mail-signature}, which (sort of) does the ! same, but inserts the signature into the buffer before you start editing ! the post (or mail). So - if you have both of these variables set, you ! will get two signatures. Note that @code{mail-signature} does not work ! the same way as @code{gnus-signature-file}, which is a bit confusing. ! If @code{mail-signature} is @code{t}, it will insert ! @file{~/.signature}. If it is a string, this string will be inserted. ! ! Note that RFC1036 says that a signature should be preceded by the three ! characters @samp{-- } on a line by themselves. This is to make it ! easier for the recipient to automatically recognize and process the ! signature. So don't remove those characters, even though you might feel ! that they ruin you beautiful design, like, totally. ! ! Also note that no signature should be more than four lines long. ! Including ASCII graphics is an efficient way to get everybody to believe ! that you are silly and have nothing important to say. ! ! @item mail-yank-prefix ! @vindex mail-yank-prefix ! @cindex yanking ! @cindex quoting ! When you are replying to or following up an article, you normally want ! to quote the person you are answering. Inserting quoted text is done by ! @dfn{yanking}, and each quoted line you yank will have ! @code{mail-yank-prefix} prepended to it. This is @samp{ } by default, ! which isn't very pretty. Most everybody prefers that lines are ! prepended with @samp{> }, so @code{(setq mail-yank-prefix "> ")} in your ! @file{.emacs} file. ! ! @item mail-yank-ignored-headers ! @vindex mail-yank-ignored-headers ! When you yank a message, you do not want to quote any headers, so ! @code{(setq mail-yank-ignored-headers ":")}. ! ! @item user-mail-address ! @vindex user-mail-address ! If all of @code{gnus-user-login-name}, @code{gnus-use-generic-from} and ! @code{gnus-local-domain} are @code{nil}, Gnus will use ! @code{user-mail-address} as the address part of the @code{From} header. ! ! @item gnus-user-from-line ! @vindex gnus-user-from-line ! Your full, complete e-mail address. This variable overrides the other ! Gnus variables if it is non-@code{nil}. ! ! Here are two example values of this variable: @samp{"larsi@@ifi.uio.no ! (Lars Magne Ingebrigtsen)"} and @samp{"Lars Magne Ingebrigtsen ! "}. The latter version is recommended, but the name ! has to be quoted if it contains non-alpha-numerical characters - ! @samp{"\"Lars M. Ingebrigtsen\" "}. ! ! @item mail-default-headers ! @vindex mail-default-headers ! This is a string that will be inserted into the header of all outgoing ! mail messages and news articles. Convenient to use to insert standard ! headers. If @code{nntp-news-default-headers} is non-@code{nil}, that ! variable will override this one when posting articles. ! ! @item gnus-auto-mail-to-author ! @vindex gnus-auto-mail-to-author ! If @code{ask}, you will be prompted for whether you want to send a mail ! copy to the author of the article you are following up. If ! non-@code{nil} and not @code{ask}, Gnus will send a mail with a copy of ! all follow-ups to the authors of the articles you follow up. It's nice ! in one way - you make sure that the person you are responding to gets ! your response. Other people loathe this method and will hate you dearly ! for it, because it means that they will first get a mail, and then have ! to read the same article later when they read the news. It is ! @code{nil} by default. ! ! @item gnus-mail-courtesy-message ! @vindex gnus-mail-courtesy-message ! This is a string that will be prepended to all mails that are the result ! of using the variable described above. ! ! @end table ! ! You may want to do spell-checking on messages that you send out. Or, if ! you don't want to spell-check by hand, you could add automatic ! spell-checking via the @code{ispell} package: ! ! @vindex news-inews-hook ! @lisp ! (add-hook 'news-inews-hook 'ispell-message) ;For news posts ! (add-hook 'mail-send-hook 'ispell-message) ;for mail posts via sendmail ! @end lisp ! ! @findex gnus-inews-insert-mime-headers ! If you want to insert some @sc{mime} headers into the articles you post, ! without doing any actual encoding, you could add ! @code{gnus-inews-insert-mime-headers} to @code{gnus-inews-article-hook}. ! ! ! @node Canceling and Superseding ! @section Canceling Articles ! @cindex canceling articles ! @cindex superseding articles ! ! Have you ever written something, and then decided that you really, ! really, really wish you hadn't posted that? ! ! Well, you can't cancel mail, but you can cancel posts. ! ! @findex gnus-summary-cancel-article ! @kindex C (Summary) ! Find the article you wish to cancel (you can only cancel your own ! articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S ! c} (@code{gnus-summary-cancel-article}). Your article will be ! canceled - machines all over the world will be deleting your article. ! ! Be aware, however, that not all sites honor cancels, so your article may ! live on here and there, while most sites will delete the article in ! question. ! ! If you discover that you have made some mistakes and want to do some ! corrections, you can post a @dfn{superseding} article that will replace ! your original article. ! ! @findex gnus-summary-supersede-article ! @kindex S (Summary) ! Go to the original article and press @kbd{S s} ! (@code{gnus-summary-supersede-article}). You will be put in a buffer ! where you can edit the article all you want before sending it off the ! usual way. ! ! @vindex gnus-delete-supersedes-headers ! You probably want to delete some of the old headers before sending the ! superseding article - @code{Path} and @code{Date} are probably ! incorrect. Set @code{gnus-delete-supersedes-headers} to a regexp to ! match the lines you want removed. The default is ! @samp{"^Path:\\|^Date"}. ! ! The same goes for superseding as for canceling, only more so: Some ! sites do not honor superseding. On those sites, it will appear that you ! have posted almost the same article twice. ! ! If you have just posted the article, and change your mind right away, ! there is a trick you can use to cancel/supersede the article without ! waiting for the article to appear on your site first. You simply return ! to the post buffer (which is called @code{*post-buf*}). There you will ! find the article you just posted, with all the headers intact. Change ! the @samp{Message-ID} header to a @samp{Cancel} or @samp{Supersedes} ! header by substituting one of those words for @samp{Message-ID}. Then ! just press @kbd{C-c C-c} to send the article as you would do normally. ! The previous article will be canceled/superseded. ! ! Just remember, kids: There is no 'c' in 'supersede'. ! ! @node Marking Articles ! @section Marking Articles ! @cindex article marking ! @cindex article ticking ! @cindex marks ! ! There are several marks you can set on an article. ! ! You have marks that decide the @dfn{readed-ness} (whoo, neato-keano ! neologism ohoy!) of the article. Alphabetic marks generally mean ! @dfn{read}, while non-alphabetic characters generally mean @dfn{unread}. ! ! In addition, you also have marks that do not affect readedness. ! ! @menu ! * Unread Articles:: Marks for unread articles. ! * Read Articles:: Marks for read articles. ! * Other Marks:: Marks that do not affect readedness. ! @end menu ! ! @ifinfo ! There's a plethora of commands for manipulating these marks: ! @end ifinfo ! ! @menu ! * Setting Marks:: How to set and remove marks. ! * Setting Process Marks:: How to mark articles for later processing. ! @end menu ! ! @node Unread Articles ! @subsection Unread Articles ! ! The following marks mark articles as unread, in one form or other. ! ! @vindex gnus-dormant-mark ! @vindex gnus-ticked-mark ! @table @samp ! @item ! ! @dfn{Ticked articles} are articles that will remain visible always. If ! you see an article that you find interesting, or you want to put off ! reading it, or replying to it, until sometime later, you'd typically ! tick it. However, articles can be expired, so if you want to keep an ! article forever, you'll have to save it. Ticked articles have a ! @samp{!} (@code{gnus-ticked-mark}) in the first column. ! @item ? ! A @dfn{dormant} article is marked with a @samp{?} ! (@code{gnus-dormant-mark}), and will only appear in the summary buffer ! if there are followups to it. ! @item SPC ! An @dfn{unread} article is marked with a @samp{SPC} ! (@code{gnus-unread-mark}). These are articles that haven't been read at ! all yet. ! @end table ! ! @node Read Articles ! @subsection Read Articles ! @cindex expirable mark ! ! All the following marks mark articles as read. ! ! @table @samp ! @item D ! Articles that are marked as read. They have a @samp{r} ! (@code{gnus-del-mark}) in the first column. These are articles that the ! user has marked as read more or less manually. ! @item d ! Articles that are actually read are marked with @samp{R} ! (@code{gnus-read-mark}). ! @item A ! Articles that were marked as read in previous sessions are now ! @dfn{old} and marked with @samp{O} (@code{gnus-ancient-mark}). ! @item K ! Marked as killed (@code{gnus-killed-mark}). ! @item X ! Marked as killed by kill files (@code{gnus-kill-file-mark}). ! @item Y ! Marked as read by having a too low score (@code{gnus-low-score-mark}). ! @item C ! Marked as read by a catchup (@code{gnus-catchup-mark}). ! @item G ! Canceled article (@code{gnus-cancelled-mark}) ! @end table ! ! All these marks just mean that the article is marked as read, really. ! They are interpreted differently by the adaptive scoring scheme, ! however. ! ! One more special mark, though: ! ! @table @samp ! @item E ! You can also mark articles as @dfn{expirable} (or have them marked as ! such automatically). That doesn't make much sense in normal groups, ! because a user does not control the expiring of news articles, but in ! mail groups, for instance, articles that are marked as @dfn{expirable} ! can be deleted by Gnus at any time. Expirable articles are marked with ! @samp{E} (@code{gnus-expirable-mark}). ! @end table ! ! @node Other Marks ! @subsection Other Marks ! @cindex process mark ! @cindex bookmarks ! ! There are some marks that have nothing to do with whether the article is ! read or not. You can set a bookmark in the current article. Say you are reading a ! long thesis on cat's urinary tracts, and have to go home for dinner before you've finished reading the thesis. You can then set a bookmark in the article, and Gnus will jump to this bookmark the next time it encounters the article. All articles that you have replied to or made a followup to (i.e., have answered) will be marked with an @samp{A} in the second column (@code{gnus-replied-mark}). @vindex gnus-not-empty-thread-mark @vindex gnus-empty-thread-mark It the @samp{%e} spec is used, the presence of threads or not will be marked with @code{gnus-not-empty-thread-mark} and ! @code{gnus-empty-thread-mark}, respectively. @vindex gnus-process-mark Finally we have the @dfn{process mark} (@code{gnus-process-mark}. A --- 1394,3150 ---- Gnus will check all foreign groups with this level or lower at startup. This might take quite a while, especially if you subscribe to lots of ! groups from different @sc{nntp} servers. ! @node Group Parameters ! @section Group Parameters ! @cindex group parameters ! Gnus stores all information on a group in a list that is usually known ! as the @dfn{group info}. This list has from three to six elements. ! Here's an example info. ! @lisp ! ("nnml:mail.ding" 3 ((1 . 232) 244 (256 . 270)) ((tick 246 249)) ! (nnml "private") ((to-address . "ding@@ifi.uio.no"))) ! @end lisp ! ! The first element is the @dfn{group name}, as Gnus knows the group, ! anyway. The second element is the @dfn{subscription level}, which ! normally is a small integer. The third element is a list of ranges of ! read articles. The fourth element is a list of lists of article marks ! of various kinds. The fifth element is the select method (or virtual ! server, if you like). The sixth element is a list of @dfn{group ! parameters}, which is what this section is about. ! ! Any of the last three elements may be missing if they are not required. ! In fact, the vast majority of groups will normally only have the first ! three elements, which saves quite a lot of cons cells. ! ! The group parameters store information local to a particular group: @table @code ! @item to-address ! @cindex to-address ! If the group parameter list contains an element that looks like ! @code{(to-address . "some@@where.com")}, that address will be used by ! the backend when doing followups and posts. 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, it means that members won't receive two ! copies of your followups. ! ! Using @code{to-address} will actually work whether the group is foreign ! or not. Let's say there's a group on the server that is called ! @samp{fa.4ad-l}. This is a real newsgroup, but the server has gotten ! the articles from a mail-to-news gateway. Posting directly to this ! group is therefore impossible---you have to send mail to the mailing ! list address instead. ! ! @item to-list ! @cindex to-list ! If the group parameter list has an element that looks like ! @code{(to-list . "some@@where.com")}, that address will be used when ! doing a @kbd{a} in any 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 @kbd{f}. ! ! @item broken-reply-to ! @cindex broken-reply-to ! Elements like @code{(broken-reply-to . t)} signals that @code{Reply-To} ! headers in this group are to be ignored. This can be useful if you're ! reading a mailing list group where the listserv has inserted ! @code{Reply-To} headers that point back to the listserv itself. This is ! broken behavior. So there! ! @item to-group ! @cindex to-group ! If the group parameter list contains an element like @code{(to-group ! . "some.group.name")}, all posts will be sent to that group. ! @item auto-expire ! @cindex auto-expire ! If this symbol is present in the group parameter list, all articles that ! are read will be marked as expirable. For an alternative approach, ! @pxref{Expiring Mail}. ! @item total-expire ! @cindex total-expire ! If this symbol is present, all read articles will be put through the ! expiry process, even if they are not marked as expirable. Use with ! caution. ! @item expiry-wait ! @cindex expiry-wait ! @vindex nnmail-expiry-wait-function ! If the group parameter has an element that looks like @code{(expiry-wait ! . 10)}, this value will override any @code{nnmail-expiry-wait} and ! @code{nnmail-expiry-wait-function} when expiring expirable messages. ! The value can either be a number of days (not necessarily an integer) or ! the symbols @code{never} or @code{immediate}. ! ! @item score-file ! Elements that look like @code{(score-file . "file")} will make ! @samp{file} into the current score file for the group in question. This ! means that all score commands you issue will end up in that file. ! ! @item admin-address ! When unsubscribing to a mailing list you should never send the ! unsubscription notice to the mailing list itself. Instead, you'd send ! messages to the administrative address. This parameter allows you to ! put the admin address somewhere convenient. ! ! @item comment ! This parameter allows you to enter a arbitrary comment on the group. ! ! @item @var{(variable form)} ! You can use the group parameters to set variables local to the group you ! are entering. Say you want to turn threading off in ! @samp{news.answers}. You'd then put @code{(gnus-show-threads nil)} in ! the group parameters of that group. @code{gnus-show-threads} will be ! made into a local variable in the summary buffer you enter, and the form ! @code{nil} will be @code{eval}ed there. ! ! This can also be used as a group-specific hook function, if you'd like. ! If you want to hear a beep when you enter the group ! @samp{alt.binaries.pictures.furniture}, you could put something like ! @code{(dummy-variable (ding))} in the parameters of that group. ! @code{dummy-variable} will be set to the result of the @code{(ding)} ! form, but who cares? ! @end table ! If you want to change the group info you can use the @kbd{G E} command ! to enter a buffer where you can edit it. ! You usually don't want to edit the entire group info, so you'd be better ! off using the @kbd{G p} command to just edit the group parameters. ! @node Listing Groups ! @section Listing Groups ! @cindex group listing ! These commands all list various slices of the groups that are available. ! @table @kbd ! @item l ! @itemx A s ! @kindex A s (Group) ! @kindex l (Group) ! @findex gnus-group-list-groups ! List all groups that have unread articles ! (@code{gnus-group-list-groups}). If the numeric prefix is used, this ! command will list only groups of level ARG and lower. By default, it ! only lists groups of level five or lower (i.e., just subscribed groups). ! @item L ! @itemx A u ! @kindex A u (Group) ! @kindex L (Group) ! @findex gnus-group-list-all-groups ! List all groups, whether they have unread articles or not ! (@code{gnus-group-list-all-groups}). If the numeric prefix is used, ! this command will list only groups of level ARG and lower. By default, ! it lists groups of level seven or lower (i.e., just subscribed and ! unsubscribed groups). ! @item A l ! @kindex A l (Group) ! @findex gnus-group-list-level ! List all unread groups on a specific level ! (@code{gnus-group-list-level}). If given a prefix, also list the groups ! with no unread articles. ! @item A k ! @kindex A k (Group) ! @findex gnus-group-list-killed ! List all killed groups (@code{gnus-group-list-killed}). If given a ! prefix argument, really list all groups that are available, but aren't ! currently (un)subscribed. This could entail reading the active file ! from the server. ! @item A z ! @kindex A z (Group) ! @findex gnus-group-list-zombies ! List all zombie groups (@code{gnus-group-list-zombies}). ! @item A m ! @kindex A m (Group) ! @findex gnus-group-list-matching ! List all subscribed groups with unread articles that match a regexp ! (@code{gnus-group-list-matching}). ! @item A M ! @kindex A M (Group) ! @findex gnus-group-list-all-matching ! List groups that match a regexp (@code{gnus-group-list-all-matching}). ! @item A A ! @kindex A A (Group) ! @findex gnus-group-list-active ! List absolutely all groups that are in the active file(s) of the ! server(s) you are connected to (@code{gnus-group-list-active}). This ! might very well take quite a while. It might actually be a better idea ! to do a @kbd{A m} to list all matching, and just give @samp{.} as the ! thing to match on. ! @item A a ! @kindex A a (Group) ! @findex gnus-group-apropos ! List all groups that have names that match a regexp ! (@code{gnus-group-apropos}). ! @item A d ! @kindex A d (Group) ! @findex gnus-group-description-apropos ! List all groups that have names or descriptions that match a regexp ! (@code{gnus-group-description-apropos}). ! @end table ! @vindex gnus-permanently-visible-groups ! @cindex visible group parameter ! Groups that match the @code{gnus-permanently-visible-groups} regexp will ! always be shown, whether they have unread articles or not. You can also ! add the @code{visible} element to the group parameters in question to ! get the same effect. ! ! @vindex gnus-list-groups-with-ticked-articles ! Groups that have just ticked articles in it are normally listed in the ! group buffer. If @code{gnus-list-groups-with-ticked-articles} is ! @code{nil}, these groups will be treated just like totally empty ! groups. It is @code{t} by default. ! ! ! @node Sorting Groups ! @section Sorting Groups ! @cindex sorting groups ! @kindex C-c C-s (Group) ! @findex gnus-group-sort-groups ! @vindex gnus-group-sort-function ! The @kbd{C-c C-s} (@code{gnus-group-sort-groups}) command sorts the ! group buffer according to the function(s) given by the ! @code{gnus-group-sort-function} variable. Available sorting functions ! include: ! @table @code ! @item gnus-group-sort-by-alphabet ! @findex gnus-group-sort-by-alphabet ! Sort the group names alphabetically. This is the default. ! @item gnus-group-sort-by-level ! @findex gnus-group-sort-by-level ! Sort by group level. ! @item gnus-group-sort-by-score ! @findex gnus-group-sort-by-score ! Sort by group score. ! ! @item gnus-group-sort-by-rank ! @findex gnus-group-sort-by-rank ! Sort by group score and then the group level. The level and the score ! are, when taken together, the group's @dfn{rank}. ! @item gnus-group-sort-by-unread ! @findex gnus-group-sort-by-unread ! Sort by number of unread articles. ! @item gnus-group-sort-by-method ! @findex gnus-group-sort-by-method ! Sort by alphabetically on the select method. ! @end table ! @code{gnus-group-sort-function} can also be a list of sorting ! functions. In that case, the most significant sort key function must be ! the last one. ! There are also a number of commands for sorting directly according to ! some sorting criteria: ! @table @kbd ! @item G S a ! @kindex G S a (Group) ! @findex gnus-group-sort-groups-by-alphabet ! Sort the group buffer alphabetically by group name ! (@code{gnus-group-sort-groups-by-alphabet}). ! @item G S u ! @kindex G S u (Group) ! @findex gnus-group-sort-groups-by-unread ! Sort the group buffer by the number of unread articles ! (@code{gnus-group-sort-groups-by-unread}). ! @item G S l ! @kindex G S l (Group) ! @findex gnus-group-sort-groups-by-level ! Sort the group buffer by group level ! (@code{gnus-group-sort-groups-by-level}). ! @item G S v ! @kindex G S v (Group) ! @findex gnus-group-sort-groups-by-score ! Sort the group buffer by group score ! (@code{gnus-group-sort-groups-by-score}). ! @item G S r ! @kindex G S r (Group) ! @findex gnus-group-sort-groups-by-rank ! Sort the group buffer by group level ! (@code{gnus-group-sort-groups-by-rank}). ! @item G S m ! @kindex G S m (Group) ! @findex gnus-group-sort-groups-by-method ! Sort the group buffer alphabetically by backend name ! (@code{gnus-group-sort-groups-by-method}). ! @end table ! When given a prefix, all these commands will sort in reverse order. ! @node Group Maintenance ! @section Group Maintenance ! @cindex bogus groups ! @table @kbd ! @item b ! @kindex b (Group) ! @findex gnus-group-check-bogus-groups ! Find bogus groups and delete them ! (@code{gnus-group-check-bogus-groups}). ! @item F ! @kindex F (Group) ! @findex gnus-find-new-newsgroups ! Find new groups and process them (@code{gnus-find-new-newsgroups}). If ! given a prefix, use the @code{ask-server} method to query the server for ! new groups. ! @item C-c C-x ! @kindex C-c C-x (Group) ! @findex gnus-group-expire-articles ! Run all expirable articles in the current group through the expiry ! process (if any) (@code{gnus-group-expire-articles}). ! @item C-c M-C-x ! @kindex C-c M-C-x (Group) ! @findex gnus-group-expire-all-groups ! Run all articles in all groups through the expiry process ! (@code{gnus-group-expire-all-groups}). ! @end table ! @node Browse Foreign Server ! @section Browse Foreign Server ! @cindex foreign servers ! @cindex browsing servers ! @table @kbd ! @item B ! @kindex B (Group) ! @findex gnus-group-browse-foreign-server ! You will be queried for a select method and a server name. Gnus will ! then attempt to contact this server and let you browse the groups there ! (@code{gnus-group-browse-foreign-server}). ! @end table ! @findex gnus-browse-mode ! A new buffer with a list of available groups will appear. This buffer ! will be use the @code{gnus-browse-mode}. This buffer looks a bit ! (well, a lot) like a normal group buffer, but with one major difference ! - you can't enter any of the groups. If you want to read any of the ! news available on that server, you have to subscribe to the groups you ! think may be interesting, and then you have to exit this buffer. The ! new groups will be added to the group buffer, and then you can read them ! as you would any other group. ! Future versions of Gnus may possibly permit reading groups straight from ! the browse buffer. ! Here's a list of keystrokes available in the browse mode: ! @table @kbd ! @item n ! @kindex n (Browse) ! @findex gnus-group-next-group ! Go to the next group (@code{gnus-group-next-group}). ! @item p ! @kindex p (Browse) ! @findex gnus-group-prev-group ! Go to the previous group (@code{gnus-group-prev-group}). ! @item SPACE ! @kindex SPACE (Browse) ! @findex gnus-browse-read-group ! Enter the current group and display the first article ! (@code{gnus-browse-read-group}). ! @item RET ! @kindex RET (Browse) ! @findex gnus-browse-select-group ! Enter the current group (@code{gnus-browse-select-group}). ! @item u ! @kindex u (Browse) ! @findex gnus-browse-unsubscribe-current-group ! Unsubscribe to the current group, or, as will be the case here, ! subscribe to it (@code{gnus-browse-unsubscribe-current-group}). ! @item l ! @itemx q ! @kindex q (Browse) ! @kindex l (Browse) ! @findex gnus-browse-exit ! Exit browse mode (@code{gnus-browse-exit}). ! @item ? ! @kindex ? (Browse) ! @findex gnus-browse-describe-briefly ! Describe browse mode briefly (well, there's not much to describe, is ! there) (@code{gnus-browse-describe-briefly}). @end table ! @node Exiting Gnus ! @section Exiting Gnus ! @cindex exiting Gnus ! Yes, Gnus is ex(c)iting. ! @table @kbd ! @item z ! @kindex z (Group) ! @findex gnus-group-suspend ! Suspend Gnus (@code{gnus-group-suspend}). This doesn't really exit Gnus, ! but it kills all buffers except the Group buffer. I'm not sure why this ! is a gain, but then who am I to judge? ! @item q ! @kindex q (Group) ! @findex gnus-group-exit ! Quit Gnus (@code{gnus-group-exit}). ! @item Q ! @kindex Q (Group) ! @findex gnus-group-quit ! Quit Gnus without saving any startup files (@code{gnus-group-quit}). @end table ! @vindex gnus-exit-gnus-hook ! @vindex gnus-suspend-gnus-hook ! @code{gnus-suspend-gnus-hook} is called when you suspend Gnus and ! @code{gnus-exit-gnus-hook} is called when you quit Gnus, while ! @code{gnus-after-exiting-gnus-hook} is called as the final item when ! exiting Gnus. ! @findex gnus-unload ! @cindex unloading ! If you wish to completely unload Gnus and all its adherents, you can use ! the @code{gnus-unload} command. This command is also very handy when ! trying to customize meta-variables. ! Note: ! @quotation ! Miss Lisa Cannifax, while sitting in English class, feels her feet go ! numbly heavy and herself fall into a hazy trance as the boy sitting ! behind her drew repeated lines with his pencil across the back of her ! plastic chair. ! @end quotation ! @node Group Topics ! @section Group Topics ! @cindex topics ! ! If you read lots and lots of groups, it might be convenient to group ! them hierarchically according to topics. You put your Emacs groups over ! here, your sex groups over there, and the rest (what, two groups or so?) ! you put in some misc section that you never bother with anyway. You can ! even group the Emacs sex groups as a sub-topic to either the Emacs ! groups or the sex groups---or both! Go wild! ! ! @findex gnus-topic-mode ! @kindex t (Group) ! To get this @emph{fab} functionality you simply turn on (ooh!) the ! @code{gnus-topic} minor mode---type @kbd{t} in the group buffer. (This ! is a toggling command.) ! ! Go ahead, just try it. I'll still be here when you get back. La de ! dum... Nice tune, that... la la la... What, you're back? Yes, and now ! press @kbd{l}. There. All your groups are now listed under ! @samp{misc}. Doesn't that make you feel all warm and fuzzy? Hot and ! bothered? ! If you want this permanently enabled, you should add that minor mode to ! the hook for the group mode: ! @lisp ! (add-hook 'gnus-group-mode-hook 'gnus-topic-mode) ! @end lisp ! @menu ! * Topic Variables:: How to customize the topics the Lisp Way. ! * Topic Commands:: Interactive E-Z commands. ! * Topic Topology:: A map of the world. ! @end menu ! @node Topic Variables ! @subsection Topic Variables ! @cindex topic variables ! ! Now, if you select a topic, if will fold/unfold that topic, which is ! really neat, I think. ! ! @vindex gnus-topic-line-format ! The topic lines themselves are created according to the ! @code{gnus-topic-line-format} variable. @xref{Formatting Variables}. ! Elements allowed are: ! @table @samp ! @item i ! Indentation. ! @item n ! Topic name. ! @item v ! Visibility. ! @item l ! Level. ! @item g ! Number of groups in the topic. ! @item a ! Number of unread articles in the topic. ! @item A ! Number of unread articles in the topic and all its subtopics. ! @end table ! @vindex gnus-topic-indent-level ! Each sub-topic (and the groups in the sub-topics) will be indented with ! @code{gnus-topic-indent-level} times the topic level number of spaces. ! The default is @code{2}. ! @vindex gnus-topic-mode-hook ! @code{gnus-topic-mode-hook} is called in topic minor mode buffers. ! @node Topic Commands ! @subsection Topic Commands ! @cindex topic commands ! When the topic minor mode is turned on, a new @kbd{T} submap will be ! available. In addition, a few of the standard keys change their ! definitions slightly. ! @table @kbd ! @item T n ! @kindex T n (Group) ! @findex gnus-topic-create-topic ! Prompt for a new topic name and create it ! (@code{gnus-topic-create-topic}). ! ! @item T m ! @kindex T m (Group) ! @findex gnus-topic-move-group ! Move the current group to some other topic ! (@code{gnus-topic-move-group}). This command understands the ! process/prefix convention (@pxref{Process/Prefix}). ! @item T c ! @kindex T c (Group) ! @findex gnus-topic-copy-group ! Copy the current group to some other topic ! (@code{gnus-topic-copy-group}). This command understands the ! process/prefix convention (@pxref{Process/Prefix}). ! @item T D ! @kindex T D (Group) ! @findex gnus-topic-remove-group ! Remove a group from the current topic (@code{gnus-topic-remove-group}). ! This command understands the process/prefix convention ! (@pxref{Process/Prefix}). ! @item T M ! @kindex T M (Group) ! @findex gnus-topic-move-matching ! Move all groups that match some regular expression to a topic ! (@code{gnus-topic-move-matching}). ! ! @item T C ! @kindex T C (Group) ! @findex gnus-topic-copy-matching ! Copy all groups that match some regular expression to a topic ! (@code{gnus-topic-copy-matching}). ! @item T # ! @kindex T # (Group) ! @findex gnus-topic-mark-topic ! Mark all groups in the current topic with the process mark ! (@code{gnus-topic-mark-topic}). ! ! @item T M-# ! @kindex T M-# (Group) ! @findex gnus-topic-unmark-topic ! Remove the process mark from all groups in the current topic ! (@code{gnus-topic-unmark-topic}). ! @item RET ! @kindex RET (Group) ! @findex gnus-topic-select-group ! @itemx SPACE ! Either select a group or fold a topic (@code{gnus-topic-select-group}). ! When you perform this command on a group, you'll enter the group, as ! usual. When done on a topic line, the topic will be folded (if it was ! visible) or unfolded (if it was folded already). So it's basically a ! toggling command on topics. In addition, if you give a numerical ! prefix, group on that level (and lower) will be displayed. ! ! @item T TAB ! @kindex T TAB (Group) ! @findex gnus-topic-indent ! ``Indent'' the current topic so that it becomes a sub-topic of the ! previous topic (@code{gnus-topic-indent}). If given a prefix, ! ``un-indent'' the topic instead. ! @item C-k ! @kindex C-k (Group) ! @findex gnus-topic-kill-group ! Kill a group or topic (@code{gnus-topic-kill-group}). ! @item C-y ! @kindex C-y (Group) ! @findex gnus-topic-yank-group ! Yank the previously killed group or topic (@code{gnus-topic-yank-group}). ! Note that all topics will be yanked before all groups. ! @item T r ! @kindex T r (Group) ! @findex gnus-topic-rename ! Rename a topic (@code{gnus-topic-rename}). ! @item T DEL ! @kindex T DEL (Group) ! @findex gnus-topic-delete ! Delete an empty topic (@code{gnus-topic-delete}). ! @item A T ! @kindex A T (Group) ! @findex gnus-topic-list-active ! List all groups that Gnus knows about in a topics-ified way ! (@code{gnus-topic-list-active}). ! @end table ! @node Topic Topology ! @subsection Topic Topology ! @cindex topic topology ! @cindex topology ! So, let's have a look at an example group buffer: ! @example ! Gnus ! Emacs -- I wuw it! ! 3: comp.emacs ! 2: alt.religion.emacs ! Naughty Emacs ! 452: alt.sex.emacs ! 0: comp.talk.emacs.recovery ! Misc ! 8: comp.binaries.fractals ! 13: comp.sources.unix ! @end example ! So, here we have one top-level topic, two topics under that, and one ! sub-topic under one of the sub-topics. (There is always just one (1) ! top-level topic). This topology can be expressed as follows: ! ! @lisp ! (("Gnus" visible) ! (("Emacs -- I wuw it!" visible) ! (("Naughty Emacs" visible))) ! (("Misc" visible))) ! @end lisp ! ! @vindex gnus-topic-topology ! This is in fact how the variable @code{gnus-topic-topology} would look ! for the display above. That variable is saved in the @file{.newsrc.eld} ! file, and shouldn't be messed with manually---unless you really want ! to. Since this variable is read from the @file{.newsrc.eld} file, ! setting it in any other startup files will have no effect. ! ! This topology shows what topics are sub-topics of what topics (right), ! and which topics are visible. Two settings are currently ! allowed---@code{visible} and @code{invisible}. ! @node Misc Group Stuff ! @section Misc Group Stuff ! @menu ! * Scanning New Messages:: Asking Gnus to see whether new messages have arrived. ! * Group Information:: Information and help on groups and Gnus. ! * File Commands:: Reading and writing the Gnus files. ! @end menu ! @table @kbd ! @item ^ ! @kindex ^ (Group) ! @findex gnus-group-enter-server-mode ! Enter the server buffer (@code{gnus-group-enter-server-mode}). @xref{The ! Server Buffer}. ! @item a ! @kindex a (Group) ! @findex gnus-group-post-news ! Post an article to a group (@code{gnus-group-post-news}). The current ! group name will be used as the default. ! @item m ! @kindex m (Group) ! @findex gnus-group-mail ! Mail a message somewhere (@code{gnus-group-mail}). + @end table ! Variables for the group buffer: ! @table @code ! @item gnus-group-mode-hook ! @vindex gnus-group-mode-hook ! @code{gnus-group-mode-hook} is called after the group buffer has been ! created. ! @item gnus-group-prepare-hook ! @vindex gnus-group-prepare-hook ! @code{gnus-group-prepare-hook} is called after the group buffer is ! generated. It may be used to modify the buffer in some strange, ! unnatural way. ! @item gnus-permanently-visible-groups ! @vindex gnus-permanently-visible-groups ! Groups matching this regexp will always be listed in the group buffer, ! whether they are empty or not. ! @end table ! @node Scanning New Messages ! @subsection Scanning New Messages ! @cindex new messages ! @cindex scanning new news ! @table @kbd ! @item g ! @kindex g (Group) ! @findex gnus-group-get-new-news ! Check the server(s) for new articles. If the numerical prefix is used, ! this command will check only groups of level @var{arg} and lower ! (@code{gnus-group-get-new-news}). If given a non-numerical prefix, this ! command will force a total rereading of the active file(s) from the ! backend(s). ! @item M-g ! @kindex M-g (Group) ! @findex gnus-group-get-new-news-this-group ! @vindex gnus-goto-next-group-when-activating ! Check whether new articles have arrived in the current group ! (@code{gnus-group-get-new-news-this-group}). The ! @code{gnus-goto-next-group-when-activating} variable controls whether ! this command is to move point to the next group or not. It is @code{t} ! by default. ! @findex gnus-activate-all-groups ! @cindex activating groups ! @item C-c M-g ! @kindex C-c M-g (Group) ! Activate absolutely all groups (@code{gnus-activate-all-groups}). ! @item R ! @kindex R (Group) ! @cindex restarting ! @findex gnus-group-restart ! Restart Gnus (@code{gnus-group-restart}). ! @end table ! @vindex gnus-get-new-news-hook ! @code{gnus-get-new-news-hook} is run just before checking for new news. ! @vindex gnus-after-getting-new-news-hook ! @code{gnus-after-getting-new-news-hook} is run after checking for new ! news. ! @node Group Information ! @subsection Group Information ! @cindex group information ! @cindex information on groups ! @table @kbd ! @item M-f ! @kindex M-f (Group) ! @findex gnus-group-fetch-faq ! @cindex FAQ ! @cindex ange-ftp ! Try to fetch the FAQ for the current group ! (@code{gnus-group-fetch-faq}). Gnus will try to get the FAQ from ! @code{gnus-group-faq-directory}, which is usually a directory on a ! remote machine. @code{ange-ftp} will be used for fetching the file. ! @item D ! @kindex D (Group) ! @cindex describing groups ! @cindex group description ! @findex gnus-group-describe-group ! Describe the current group (@code{gnus-group-describe-group}). If given ! a prefix, force Gnus to re-read the description from the server. ! @item M-d ! @kindex M-d (Group) ! @findex gnus-group-describe-all-groups ! Describe all groups (@code{gnus-group-describe-all-groups}). If given a ! prefix, force Gnus to re-read the description file from the server. ! @item V ! @kindex V (Group) ! @cindex version ! @findex gnus-version ! Display current Gnus version numbers (@code{gnus-version}). ! @item ? ! @kindex ? (Group) ! @findex gnus-group-describe-briefly ! Give a very short help message (@code{gnus-group-describe-briefly}). ! @item C-c C-i ! @kindex C-c C-i (Group) ! @cindex info ! @cindex manual ! @findex gnus-info-find-node ! Go to the Gnus info node (@code{gnus-info-find-node}). @end table ! @node File Commands ! @subsection File Commands ! @cindex file commands ! @table @kbd ! @item r ! @kindex r (Group) ! @findex gnus-group-read-init-file ! @vindex gnus-init-file ! @cindex reading init file ! Read the init file (@code{gnus-init-file}, which defaults to ! @file{~/.gnus}) (@code{gnus-group-read-init-file}). ! @item s ! @kindex s (Group) ! @findex gnus-group-save-newsrc ! @cindex saving .newsrc ! Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted) ! (@code{gnus-group-save-newsrc}). If given a prefix, force saving the ! file(s) whether Gnus thinks it is necessary or not. ! ! @c @item Z ! @c @kindex Z (Group) ! @c @findex gnus-group-clear-dribble ! @c Clear the dribble buffer (@code{gnus-group-clear-dribble}). @end table ! @node The Summary Buffer ! @chapter The Summary Buffer ! @cindex summary buffer ! A line for each article is displayed in the summary buffer. You can ! move around, read articles, post articles and reply to articles. ! @menu ! * Summary Buffer Format:: Deciding how the summary buffer is to look. ! * Summary Maneuvering:: Moving around the summary buffer. ! * Choosing Articles:: Reading articles. ! * Paging the Article:: Scrolling the current article. ! * Reply Followup and Post:: Posting articles. ! * Canceling and Superseding:: ``Whoops, I shouldn't have called him that.'' ! * Marking Articles:: Marking articles as read, expirable, etc. ! * Limiting:: You can limit the summary buffer. ! * Threading:: How threads are made. ! * Sorting:: How articles and threads are sorted. ! * Asynchronous Fetching:: Gnus might be able to pre-fetch articles. ! * Article Caching:: You may store articles in a cache. ! * Persistent Articles:: Making articles expiry-resistant. ! * Article Backlog:: Having already read articles hang around. ! * Saving Articles:: Ways of customizing article saving. ! * Decoding Articles:: Gnus can treat series of (uu)encoded articles. ! * Article Treatment:: The article buffer can be mangled at will. ! * Summary Sorting:: Sorting the summary buffer in various ways. ! * Finding the Parent:: No child support? Get the parent. ! * Alternative Approaches:: Reading using non-default summaries. ! * Tree Display:: A more visual display of threads. ! * Mail Group Commands:: Some commands can only be used in mail groups. ! * Various Summary Stuff:: What didn't fit anywhere else. ! * Exiting the Summary Buffer:: Returning to the Group buffer. ! @end menu ! @node Summary Buffer Format ! @section Summary Buffer Format ! @cindex summary buffer format ! @menu ! * Summary Buffer Lines:: You can specify how summary lines should look. ! * Summary Buffer Mode Line:: You can say how the mode line should look. ! * Summary Highlighting:: Making the summary buffer all pretty and nice. ! @end menu ! @findex mail-extract-address-components ! @findex gnus-extract-address-components ! @vindex gnus-extract-address-components ! Gnus will use the value of the @code{gnus-extract-address-components} ! variable as a function for getting the name and address parts of a ! @code{From} header. Two pre-defined function exist: ! @code{gnus-extract-address-components}, which is the default, quite ! fast, and too simplistic solution; and ! @code{mail-extract-address-components}, which works very nicely, but is ! slower. The default function will return the wrong answer in 5% of the ! cases. If this is unacceptable to you, use the other function instead. ! @vindex gnus-summary-same-subject ! @code{gnus-summary-same-subject} is a string indicating that the current ! article has the same subject as the previous. This string will be used ! with those specs that require it. The default is @samp{}. ! @node Summary Buffer Lines ! @subsection Summary Buffer Lines ! @vindex gnus-summary-line-format ! You can change the format of the lines in the summary buffer by changing ! the @code{gnus-summary-line-format} variable. It works along the same ! lines a a normal @code{format} string, with some extensions. ! The default string is @samp{%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n}. + The following format specification characters are understood: + + @table @samp + @item N + Article number. + @item S + Subject string. + @item s + Subject if the article is the root, @code{gnus-summary-same-subject} + otherwise. + @item F + Full @code{From} line. + @item n + The name (from the @code{From} header). + @item a + The name (from the @code{From} header). This differs from the @code{n} + spec in that it uses @code{gnus-extract-address-components}, which is + slower, but may be more thorough. + @item A + The address (from the @code{From} header). This works the same way as + the @code{a} spec. + @item L + Number of lines in the article. + @item c + Number of characters in the article. + @item I + Indentation based on thread level (@pxref{Customizing Threading}). + @item T + Nothing if the article is a root and lots of spaces if it isn't (it + pushes everything after it off the screen). + @item \[ + Opening bracket, which is normally @samp{\[}, but can also be @samp{<} + for adopted articles. + @item \] + Closing bracket, which is normally @samp{\]}, but can also be @samp{>} + for adopted articles. + @item > + One space for each thread level. + @item < + Twenty minus thread level spaces. + @item U + Unread. + @item R + Replied. + @item i + Score as a number. + @item z + @vindex gnus-summary-zcore-fuzz + Zcore, @samp{+} if above the default level and @samp{-} if below the + default level. If the difference between + @code{gnus-summary-default-level} and the score is less than + @code{gnus-summary-zcore-fuzz}, this spec will not be used. + @item V + Total thread score. + @item x + @code{Xref}. + @item D + @code{Date}. + @item M + @code{Message-ID}. + @item r + @code{References}. + @item t + Number of articles in the current sub-thread. Using this spec will slow + down summary buffer generation somewhat. + @item e + A single character will be displayed if the article has any children. + @item u + User defined specifier. The next character in the format string should + be a letter. @sc{gnus} will call the function + @code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter + following @samp{%u}. The function will be passed the current header as + argument. The function should return a string, which will be inserted + into the summary just like information from any other summary specifier. @end table ! The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs ! have to be handled with care. For reasons of efficiency, Gnus will ! compute what column these characters will end up in, and ``hard-code'' ! that. This means that it is illegal to have these specs after a ! variable-length spec. Well, you might not be arrested, but your summary ! buffer will look strange, which is bad enough. ! The smart choice is to have these specs as far to the left as possible. ! (Isn't that the case with everything, though? But I digress.) ! This restriction may disappear in later versions of Gnus. ! @node Summary Buffer Mode Line ! @subsection Summary Buffer Mode Line ! @vindex gnus-summary-mode-line-format ! You can also change the format of the summary mode bar. Set ! @code{gnus-summary-mode-line-format} to whatever you like. Here are the ! elements you can play with: ! @table @samp ! @item G ! Group name. ! @item p ! Unprefixed group name. ! @item A ! Current article number. ! @item V ! Gnus version. ! @item U ! Number of unread articles in this group. ! @item e ! Number of unselected articles in this group. ! @item Z ! A string with the number of unread and unselected articles represented ! either as @samp{<%U(+%u) more>} if there are both unread and unselected ! articles, and just as @samp{<%U more>} if there are just unread articles ! and no unselected ones. ! @item g ! Shortish group name. For instance, @samp{rec.arts.anime} will be ! shortened to @samp{r.a.anime}. ! @item S ! Subject of the current article. ! @item u ! Used-defined spec. ! @item s ! Name of the current score file. ! @item d ! Number of dormant articles. ! @item t ! Number of ticked articles. ! @item r ! Number of articles that have been marked as read in this session. ! @item E ! Number of articles expunged by the score files. @end table ! @node Summary Highlighting ! @subsection Summary Highlighting @table @code ! @item gnus-visual-mark-article-hook ! @vindex gnus-visual-mark-article-hook ! This hook is run after selecting an article. It is meant to be used for ! highlighting the article in some way. It is not run if ! @code{gnus-visual} is @code{nil}. ! @item gnus-summary-update-hook ! @vindex gnus-summary-update-hook ! This hook is called when a summary line is changed. It is not run if ! @code{gnus-visual} is @code{nil}. ! @item gnus-summary-selected-face ! @vindex gnus-summary-selected-face ! This is the face (or @dfn{font} as some people call it) that is used to ! highlight the current article in the summary buffer. + @item gnus-summary-highlight + @vindex gnus-summary-highlight + Summary lines are highlighted according to this variable, which is a + list where the elements are on the format @code{(FORM . FACE)}. If you + would, for instance, like ticked articles to be italic and high-scored + articles to be bold, you could set this variable to something like @lisp ! (((eq mark gnus-ticked-mark) . italic) ! ((> score default) . bold)) @end lisp + As you may have guessed, if @var{FORM} returns a non-@code{nil} value, + @var{FACE} will be applied to the line. + @end table ! @node Summary Maneuvering ! @section Summary Maneuvering ! @cindex summary movement ! All the straight movement commands understand the numeric prefix and ! behave pretty much as you'd expect. ! None of these commands select articles. ! @table @kbd ! @item G M-n ! @itemx M-n ! @kindex M-n (Summary) ! @kindex G M-n (Summary) ! @findex gnus-summary-next-unread-subject ! Go to the next summary line of an unread article ! (@code{gnus-summary-next-unread-subject}). ! @item G M-p ! @itemx M-p ! @kindex M-p (Summary) ! @kindex G M-p (Summary) ! @findex gnus-summary-prev-unread-subject ! Go to the previous summary line of an unread article ! (@code{gnus-summary-prev-unread-subject}). ! @item G j ! @itemx j ! @kindex j (Summary) ! @kindex G j (Summary) ! @findex gnus-summary-goto-article ! Ask for an article number and then go that article ! (@code{gnus-summary-goto-article}). ! @item G g ! @kindex G g (Summary) ! @findex gnus-summary-goto-subject ! Ask for an article number and then go the summary line of that article ! (@code{gnus-summary-goto-subject}). ! @end table ! If Gnus asks you to press a key to confirm going to the next group, you ! can use the @kbd{C-n} and @kbd{C-p} keys to move around the group ! buffer, searching for the next group to read without actually returning ! to the group buffer. ! Variables related to summary movement: ! @table @code ! @vindex gnus-auto-select-next ! @item gnus-auto-select-next ! If you are at the end of the group and issue one of the movement ! commands, Gnus will offer to go to the next group. If this variable is ! @code{t} and the next group is empty, Gnus will exit summary mode and ! return to the group buffer. If this variable is neither @code{t} nor ! @code{nil}, Gnus will select the next group, no matter whether it has ! any unread articles or not. As a special case, if this variable is ! @code{quietly}, Gnus will select the next group without asking for ! confirmation. If this variable is @code{almost-quietly}, the same will ! happen only if you are located on the last article in the group. ! Finally, if this variable is @code{slightly-quietly}, the @kbd{Z n} ! command will go to the next group without confirmation. Also ! @pxref{Group Levels}. ! @item gnus-auto-select-same ! @vindex gnus-auto-select-same ! If non-@code{nil}, all the movement commands will try to go to the next ! article with the same subject as the current. This variable is not ! particularly useful if you use a threaded display. ! @item gnus-summary-check-current ! @vindex gnus-summary-check-current ! If non-@code{nil}, all the ``unread'' movement commands will not proceed ! to the next (or previous) article if the current article is unread. ! Instead, they will choose the current article. ! @item gnus-auto-center-summary ! @vindex gnus-auto-center-summary ! If non-@code{nil}, Gnus will keep the point in the summary buffer ! centered at all times. This makes things quite tidy, but if you have a ! slow network connection, or simply do not like this un-Emacsism, you can ! set this variable to @code{nil} to get the normal Emacs scrolling ! action. This will also inhibit horizontal re-centering of the summary ! buffer, which might make it more inconvenient to read extremely long ! threads. @end table ! @node Choosing Articles ! @section Choosing Articles ! @cindex selecting articles ! None of the following movement commands understand the numeric prefix, ! and they all select and display an article. @table @kbd ! @item SPACE ! @kindex SPACE (Summary) ! @findex gnus-summary-next-page ! Select the current article, or, if that one's read already, the next ! unread article (@code{gnus-summary-next-page}). ! @item G n ! @itemx n ! @kindex n (Summary) ! @kindex G n (Summary) ! @findex gnus-summary-next-unread-article ! Go to next unread article (@code{gnus-summary-next-unread-article}). ! @item G p ! @itemx p ! @kindex p (Summary) ! @findex gnus-summary-prev-unread-article ! Go to previous unread article (@code{gnus-summary-prev-unread-article}). ! @item G N ! @itemx N ! @kindex N (Summary) ! @kindex G N (Summary) ! @findex gnus-summary-next-article ! Go to the next article (@code{gnus-summary-next-article}). ! @item G P ! @itemx P ! @kindex P (Summary) ! @kindex G P (Summary) ! @findex gnus-summary-prev-article ! Go to the previous article (@code{gnus-summary-prev-article}). ! @item G C-n ! @kindex G C-n (Summary) ! @findex gnus-summary-next-same-subject ! Go to the next article with the same subject ! (@code{gnus-summary-next-same-subject}). ! @item G C-p ! @kindex G C-p (Summary) ! @findex gnus-summary-prev-same-subject ! Go to the previous article with the same subject ! (@code{gnus-summary-prev-same-subject}). ! @item G f ! @itemx . ! @kindex G f (Summary) ! @kindex . (Summary) ! @findex gnus-summary-first-unread-article ! Go to the first unread article ! (@code{gnus-summary-first-unread-article}). ! @item G b ! @itemx , ! @kindex G b (Summary) ! @kindex , (Summary) ! @findex gnus-summary-best-unread-article ! Go to the article with the highest score ! (@code{gnus-summary-best-unread-article}). ! @item G l ! @itemx l ! @kindex l (Summary) ! @kindex G l (Summary) ! @findex gnus-summary-goto-last-article ! Go to the previous article read (@code{gnus-summary-goto-last-article}). ! @item G p ! @kindex G p (Summary) ! @findex gnus-summary-pop-article ! Pop an article off the summary history and go to this article ! (@code{gnus-summary-pop-article}). This command differs from the ! command above in that you can pop as many previous articles off the ! history as you like. ! @end table ! Some variables that are relevant for moving and selecting articles: ! @table @code ! @item gnus-auto-extend-newsgroup ! @vindex gnus-auto-extend-newsgroup ! All the movement commands will try to go to the previous (or next) ! article, even if that article isn't displayed in the Summary buffer if ! this variable is non-@code{nil}. Gnus will then fetch the article from ! the server and display it in the article buffer. ! @item gnus-select-article-hook ! @vindex gnus-select-article-hook ! This hook is called whenever an article is selected. By default it ! exposes any threads hidden under the selected article. ! @item gnus-mark-article-hook ! @vindex gnus-mark-article-hook ! @findex gnus-summary-mark-unread-as-read ! @findex gnus-summary-mark-read-and-unread-as-read ! @findex gnus-unread-mark ! This hook is called whenever an article is selected. It is intended to ! be used for marking articles as read. The default value is ! @code{gnus-summary-mark-read-and-unread-as-read}, and will change the ! mark of almost any article you read to @code{gnus-unread-mark}. The ! only articles not affected by this function are ticked, dormant, and ! expirable articles. If you'd instead like to just have unread articles ! marked as read, you can use @code{gnus-summary-mark-unread-as-read} ! instead. It will leave marks like @code{gnus-low-score-mark}, ! @code{gnus-del-mark} (and so on) alone. ! ! @end table ! ! ! @node Paging the Article ! @section Scrolling the Article ! @cindex article scrolling @table @kbd ! @item SPACE ! @kindex SPACE (Summary) ! @findex gnus-summary-next-page ! Pressing @kbd{SPACE} will scroll the current article forward one page, ! or, if you have come to the end of the current article, will choose the ! next article (@code{gnus-summary-next-page}). ! @item DEL ! @kindex DEL (Summary) ! @findex gnus-summary-prev-page ! Scroll the current article back one page (@code{gnus-summary-prev-page}). ! @item RET ! @kindex RET (Summary) ! @findex gnus-summary-scroll-up ! Scroll the current article one line forward ! (@code{gnus-summary-scroll-up}). ! @item A g ! @itemx g ! @kindex A g (Summary) ! @kindex g (Summary) ! @findex gnus-summary-show-article ! (Re)fetch the current article (@code{gnus-summary-show-article}). If ! given a prefix, fetch the current article, but don't run any of the ! article treatment functions. This will give you a ``raw'' article, just ! the way it came from the server. ! @item A < ! @itemx < ! @kindex < (Summary) ! @kindex A < (Summary) ! @findex gnus-summary-beginning-of-article ! Scroll to the beginning of the article ! (@code{gnus-summary-beginning-of-article}). ! @item A > ! @itemx > ! @kindex > (Summary) ! @kindex A > (Summary) ! @findex gnus-summary-end-of-article ! Scroll to the end of the article (@code{gnus-summary-end-of-article}). ! @item A s ! @kindex A s (Summary) ! @findex gnus-summary-isearch-article ! Perform an isearch in the article buffer ! (@code{gnus-summary-isearch-article}). ! ! @end table ! ! ! @node Reply Followup and Post ! @section Reply, Followup and Post @menu ! * Summary Mail Commands:: Sending mail. ! * Summary Post Commands:: Sending news. @end menu ! @node Summary Mail Commands ! @subsection Summary Mail Commands ! @cindex mail ! @cindex composing mail ! Commands for composing a mail message: ! @table @kbd ! @item S r ! @itemx r ! @kindex S r (Summary) ! @kindex r (Summary) ! @findex gnus-summary-reply ! Mail a reply to the author of the current article ! (@code{gnus-summary-reply}). ! @item S R ! @itemx R ! @kindex R (Summary) ! @kindex S R (Summary) ! @findex gnus-summary-reply-with-original ! Mail a reply to the author of the current article and include the ! original message (@code{gnus-summary-reply-with-original}). This ! command uses the process/prefix convention. ! @item S o m ! @kindex S o m (Summary) ! @findex gnus-summary-mail-forward ! Forward the current article to some other person ! (@code{gnus-summary-mail-forward}). ! @item S o p ! @kindex S o p (Summary) ! @findex gnus-summary-post-forward ! Forward the current article to a newsgroup ! (@code{gnus-summary-post-forward}). ! @item S m ! @itemx m ! @kindex m (Summary) ! @kindex S m (Summary) ! @findex gnus-summary-mail-other-window ! Send a mail to some other person ! (@code{gnus-summary-mail-other-window}). ! @item S D b ! @kindex S D b (Summary) ! @findex gnus-summary-resend-bounced-mail ! @cindex bouncing mail ! If you have sent a mail, but the mail was bounced back to you for some ! reason (wrong address, transient failure), you can use this command to ! resend that bounced mail (@code{gnus-summary-resend-bounced-mail}). You ! will be popped into a mail buffer where you can edit the headers before ! sending the mail off again. If you give a prefix to this command, and ! the bounced mail is a reply to some other mail, Gnus will try to fetch ! that mail and display it for easy perusal of its headers. This might ! very well fail, though. ! ! @item S D r ! @kindex S D r (Summary) ! @findex gnus-summary-resend-message ! Not to be confused with the previous command, ! @code{gnus-summary-resend-message} will prompt you for an address to ! send the current message off to, and then send it to that place. The ! headers of the message won't be altered---but lots of headers that say ! @code{Resent-To}, @code{Resent-From} and so on will be added. This ! means that you actually send a mail to someone that has a @code{To} ! header that (probably) points to yourself. This will confuse people. ! So, natcherly you'll only do that if you're really eVIl. ! ! This command is mainly used if you have several accounts and want to ! ship a mail to a different account of yours. (If you're both ! @code{root} and @code{postmaster} and get a mail for @code{postmaster} ! to the @code{root} account, you may want to resend it to ! @code{postmaster}. Ordnung muss sein! ! @item S O m ! @kindex S O m (Summary) ! @findex gnus-uu-digest-mail-forward ! Digest the current series and forward the result using mail ! (@code{gnus-uu-digest-mail-forward}). This command uses the ! process/prefix convention (@pxref{Process/Prefix}). ! @item S O p ! @kindex S O p (Summary) ! @findex gnus-uu-digest-post-forward ! Digest the current series and forward the result to a newsgroup ! (@code{gnus-uu-digest-mail-forward}). ! @end table ! @node Summary Post Commands ! @subsection Summary Post Commands ! @cindex post ! @cindex composing news + Commands for posting an article: ! @table @kbd ! @item S p ! @itemx a ! @kindex a (Summary) ! @kindex S p (Summary) ! @findex gnus-summary-post-news ! Post an article to the current group ! (@code{gnus-summary-post-news}). ! @item S f ! @itemx f ! @kindex f (Summary) ! @kindex S f (Summary) ! @findex gnus-summary-followup ! Post a followup to the current article (@code{gnus-summary-followup}). ! @item S F ! @itemx F ! @kindex S F (Summary) ! @kindex F (Summary) ! @findex gnus-summary-followup-with-original ! Post a followup to the current article and include the original message ! (@code{gnus-summary-followup-with-original}). This command uses the ! process/prefix convention. ! @item S u ! @kindex S u (Summary) ! @findex gnus-uu-post-news ! Uuencode a file, split it into parts, and post it as a series ! (@code{gnus-uu-post-news}). (@pxref{Uuencoding and Posting}). @end table ! @node Canceling and Superseding ! @section Canceling Articles ! @cindex canceling articles ! @cindex superseding articles ! Have you ever written something, and then decided that you really, ! really, really wish you hadn't posted that? ! Well, you can't cancel mail, but you can cancel posts. ! @findex gnus-summary-cancel-article ! @kindex C (Summary) ! Find the article you wish to cancel (you can only cancel your own ! articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S ! c} (@code{gnus-summary-cancel-article}). Your article will be ! canceled---machines all over the world will be deleting your article. ! Be aware, however, that not all sites honor cancels, so your article may ! live on here and there, while most sites will delete the article in ! question. ! If you discover that you have made some mistakes and want to do some ! corrections, you can post a @dfn{superseding} article that will replace ! your original article. ! @findex gnus-summary-supersede-article ! @kindex S (Summary) ! Go to the original article and press @kbd{S s} ! (@code{gnus-summary-supersede-article}). You will be put in a buffer ! where you can edit the article all you want before sending it off the ! usual way. ! The same goes for superseding as for canceling, only more so: Some ! sites do not honor superseding. On those sites, it will appear that you ! have posted almost the same article twice. ! If you have just posted the article, and change your mind right away, ! there is a trick you can use to cancel/supersede the article without ! waiting for the article to appear on your site first. You simply return ! to the post buffer (which is called @code{*post-buf*}). There you will ! find the article you just posted, with all the headers intact. Change ! the @code{Message-ID} header to a @code{Cancel} or @code{Supersedes} ! header by substituting one of those words for @code{Message-ID}. Then ! just press @kbd{C-c C-c} to send the article as you would do normally. ! The previous article will be canceled/superseded. ! Just remember, kids: There is no 'c' in 'supersede'. ! @node Marking Articles ! @section Marking Articles ! @cindex article marking ! @cindex article ticking ! @cindex marks ! There are several marks you can set on an article. ! You have marks that decide the @dfn{readedness} (whoo, neato-keano ! neologism ohoy!) of the article. Alphabetic marks generally mean ! @dfn{read}, while non-alphabetic characters generally mean @dfn{unread}. ! ! In addition, you also have marks that do not affect readedness. ! ! @menu ! * Unread Articles:: Marks for unread articles. ! * Read Articles:: Marks for read articles. ! * Other Marks:: Marks that do not affect readedness. @end menu ! @ifinfo ! There's a plethora of commands for manipulating these marks: ! @end ifinfo ! @menu ! * Setting Marks:: How to set and remove marks. ! * Setting Process Marks:: How to mark articles for later processing. ! @end menu ! ! @node Unread Articles ! @subsection Unread Articles ! ! The following marks mark articles as unread, in one form or other. ! ! @vindex gnus-dormant-mark ! @vindex gnus-ticked-mark ! @table @samp ! @item ! ! @dfn{Ticked articles} are articles that will remain visible always. If ! you see an article that you find interesting, or you want to put off ! reading it, or replying to it, until sometime later, you'd typically ! tick it. However, articles can be expired, so if you want to keep an ! article forever, you'll have to save it. Ticked articles have a ! @samp{!} (@code{gnus-ticked-mark}) in the first column. ! ! @item ? ! @vindex gnus-dormant-mark ! A @dfn{dormant} article is marked with a @samp{?} ! (@code{gnus-dormant-mark}), and will only appear in the summary buffer ! if there are followups to it. ! ! @item SPACE ! @vindex gnus-unread-mark ! An @dfn{unread} article is marked with a @samp{SPACE} ! (@code{gnus-unread-mark}). These are articles that haven't been read at ! all yet. @end table ! @node Read Articles ! @subsection Read Articles ! @cindex expirable mark ! All the following marks mark articles as read. ! @table @samp ! @item r ! @vindex gnus-del-mark ! Articles that are marked as read. They have a @samp{r} ! (@code{gnus-del-mark}) in the first column. These are articles that the ! user has marked as read more or less manually. ! @item R ! @vindex gnus-read-mark ! Articles that are actually read are marked with @samp{R} ! (@code{gnus-read-mark}). ! @item O ! @vindex gnus-ancient-mark ! Articles that were marked as read in previous sessions are now ! @dfn{old} and marked with @samp{O} (@code{gnus-ancient-mark}). ! @item K ! @vindex gnus-killed-mark ! Marked as killed (@code{gnus-killed-mark}). ! @item X ! @vindex gnus-kill-file-mark ! Marked as killed by kill files (@code{gnus-kill-file-mark}). ! @item Y ! @vindex gnus-low-score-mark ! Marked as read by having a too low score (@code{gnus-low-score-mark}). ! @item C ! @vindex gnus-catchup-mark ! Marked as read by a catchup (@code{gnus-catchup-mark}). ! @item G ! @vindex gnus-canceled-mark ! Canceled article (@code{gnus-canceled-mark}) ! @item F ! @vindex gnus-souped-mark ! @sc{SOUP}ed article (@code{gnus-souped-mark}). ! @item Q ! @vindex gnus-sparse-mark ! Sparsely reffed article (@code{gnus-sparse-mark}). ! @end table ! All these marks just mean that the article is marked as read, really. ! They are interpreted differently by the adaptive scoring scheme, ! however. ! One more special mark, though: + @table @samp + @item E + @vindex gnus-expirable-mark + You can also mark articles as @dfn{expirable} (or have them marked as + such automatically). That doesn't make much sense in normal groups, + because a user does not control the expiring of news articles, but in + mail groups, for instance, articles that are marked as @dfn{expirable} + can be deleted by Gnus at any time. Expirable articles are marked with + @samp{E} (@code{gnus-expirable-mark}). @end table ! @node Other Marks ! @subsection Other Marks ! @cindex process mark ! @cindex bookmarks ! There are some marks that have nothing to do with whether the article is ! read or not. ! @itemize @bullet + @item You can set a bookmark in the current article. Say you are reading a ! long thesis on cats' urinary tracts, and have to go home for dinner before you've finished reading the thesis. You can then set a bookmark in the article, and Gnus will jump to this bookmark the next time it encounters the article. + @item + @vindex gnus-replied-mark All articles that you have replied to or made a followup to (i.e., have answered) will be marked with an @samp{A} in the second column (@code{gnus-replied-mark}). + @item + @vindex gnus-cached-mark + Articles that are stored in the article cache will be marked with an + @samp{*} in the second column (@code{gnus-cached-mark}). + + @item + @vindex gnus-saved-mark + Articles that are ``saved'' (in some manner or other; not necessarily + religiously) are marked with an @samp{S} in the second column + (@code{gnus-saved-mark}. + + @item @vindex gnus-not-empty-thread-mark @vindex gnus-empty-thread-mark It the @samp{%e} spec is used, the presence of threads or not will be marked with @code{gnus-not-empty-thread-mark} and ! @code{gnus-empty-thread-mark} in the third column, respectively. + @item @vindex gnus-process-mark Finally we have the @dfn{process mark} (@code{gnus-process-mark}. A *************** all articles that have been marked with *** 4047,4050 **** --- 3154,3168 ---- marked with the process mark have a @samp{#} in the second column. + @end itemize + + You might have noticed that most of these ``non-readedness'' marks + appear in the second column by default. So if you have a cached, saved, + replied article that you have process-marked, what will that look like? + + Nothing much. The precedence rules go as follows: process -> cache -> + replied -> saved. So if the article is in the cache and is replied, + you'll only see the cache mark and not the replied mark. + + @node Setting Marks @subsection Setting Marks *************** All the marking commands understand the *** 4060,4063 **** --- 3178,3182 ---- @findex gnus-summary-tick-article-forward Tick the current article (@code{gnus-summary-tick-article-forward}). + @item M ? @itemx ? *************** Tick the current article (@code{gnus-sum *** 4067,4070 **** --- 3186,3190 ---- Mark the current article as dormant (@code{gnus-summary-mark-as-dormant}). + @item M d @itemx d *************** Mark the current article as dormant *** 4074,4077 **** --- 3194,3198 ---- Mark the current article as read (@code{gnus-summary-mark-as-read-forward}). + @item M k @itemx k *************** Mark all articles that have the same sub *** 4082,4085 **** --- 3203,3207 ---- and then select the next unread article (@code{gnus-summary-kill-same-subject-and-select}). + @item M K @itemx C-k *************** and then select the next unread article *** 4089,4100 **** Mark all articles that have the same subject as the current one as read (@code{gnus-summary-kill-same-subject}). @item M C @kindex M C (Summary) @findex gnus-summary-catchup ! Catchup the current group (@code{gnus-summary-catchup}). @item M C-c @kindex M C-c (Summary) @findex gnus-summary-catchup-all ! Catchup all articles in the current group (@code{gnus-summary-catchup-all}). @item M H @kindex M H (Summary) --- 3211,3227 ---- Mark all articles that have the same subject as the current one as read (@code{gnus-summary-kill-same-subject}). + @item M C @kindex M C (Summary) @findex gnus-summary-catchup ! Mark all unread articles in the group as read ! (@code{gnus-summary-catchup}). ! @item M C-c @kindex M C-c (Summary) @findex gnus-summary-catchup-all ! Mark all articles in the group as read---even the ticked and dormant ! articles (@code{gnus-summary-catchup-all}). ! @item M H @kindex M H (Summary) *************** Catchup all articles in the current grou *** 4102,4105 **** --- 3229,3233 ---- Catchup the current group to point (@code{gnus-summary-catchup-to-here}). + @item C-w @kindex C-w (Summary) *************** Catchup the current group to point *** 4107,4110 **** --- 3235,3245 ---- Mark all articles between point and mark as read (@code{gnus-summary-mark-region-as-read}). + + @item M V k + @kindex M V k (Summary) + @findex gnus-summary-kill-below + Kill all articles with scores below the default score (or below the + numeric prefix) (@code{gnus-summary-kill-below}). + @item M c @itemx M-u *************** Mark all articles between point and mark *** 4114,4117 **** --- 3249,3253 ---- Clear all readedness-marks from the current article (@code{gnus-summary-clear-mark-forward}). + @item M e @itemx E *************** Clear all readedness-marks from the curr *** 4121,4124 **** --- 3257,3261 ---- Mark the current article as expirable (@code{gnus-summary-mark-as-expirable}). + @item M b @kindex M b (Summary) *************** Mark the current article as expirable *** 4126,4129 **** --- 3263,3267 ---- Set a bookmark in the current article (@code{gnus-summary-set-bookmark}). + @item M B @kindex M B (Summary) *************** Set a bookmark in the current article *** 4131,4163 **** Remove the bookmark from the current article (@code{gnus-summary-remove-bookmark}). ! @item M M-r ! @itemx x ! @kindex M M-r (Summary) ! @kindex M-d (Summary) ! @findex gnus-summary-remove-lines-marked-as-read ! Expunge all deleted articles from the summary buffer ! (@code{gnus-summary-remove-lines-marked-as-read}). ! @item M M-C-r ! @kindex M M-C-r (Summary) ! @findex gnus-summary-remove-lines-marked-with ! Ask for a mark and then expunge all articles that have been marked with ! that mark (@code{gnus-summary-remove-lines-marked-with}). ! @item M S ! @kindex M S (Summary) ! @findex gnus-summary-show-all-expunged ! Display all expunged articles (@code{gnus-summary-show-all-expunged}). ! @item M D ! @kindex M D (Summary) ! @findex gnus-summary-show-all-dormant ! Display all dormant articles (@code{gnus-summary-show-all-dormant}). ! @item M M-D ! @kindex M M-D (Summary) ! @findex gnus-summary-hide-all-dormant ! Hide all dormant articles (@code{gnus-summary-hide-all-dormant}). ! @item M V k ! @kindex M V k (Summary) ! @findex gnus-summary-kill-below ! Kill all articles with scores below the default score (or below the ! numeric prefix) (@code{gnus-summary-kill-below}). @item M V c @kindex M V c (Summary) --- 3269,3273 ---- Remove the bookmark from the current article (@code{gnus-summary-remove-bookmark}). ! @item M V c @kindex M V c (Summary) *************** numeric prefix) (@code{gnus-summary-kill *** 4165,4168 **** --- 3275,3279 ---- Clear all marks from articles with scores over the default score (or over the numeric prefix) (@code{gnus-summary-clear-above}). + @item M V u @kindex M V u (Summary) *************** over the numeric prefix) (@code{gnus-sum *** 4170,4173 **** --- 3281,3285 ---- Tick all articles with scores over the default score (or over the numeric prefix) (@code{gnus-summary-tick-above}). + @item M V m @kindex M V m (Summary) *************** score (or over the numeric prefix) with *** 4178,4186 **** @end table ! @code{gnus-summary-goto-unread} The @code{gnus-summary-goto-unread} variable controls what action should be taken after setting a mark. If non-@code{nil}, point will move to the next/previous unread article. If @code{nil}, point will just move ! one line up or down. @node Setting Process Marks --- 3290,3302 ---- @end table ! @vindex gnus-summary-goto-unread The @code{gnus-summary-goto-unread} variable controls what action should be taken after setting a mark. If non-@code{nil}, point will move to the next/previous unread article. If @code{nil}, point will just move ! one line up or down. As a special case, if this variable is ! @code{never}, all the marking commands as well as other commands (like ! @kbd{SPACE}) will move to the next article, whether it is unread or not. ! The default is @code{t}. ! @node Setting Process Marks *************** one line up or down. *** 4189,4192 **** --- 3305,3309 ---- @table @kbd + @item M P p @itemx # *************** Mark the current article with the proces *** 4197,4200 **** --- 3314,3318 ---- (@code{gnus-summary-mark-as-processable}). @findex gnus-summary-unmark-as-processable + @item M P u @itemx M-# *************** Mark the current article with the proces *** 4203,4206 **** --- 3321,3325 ---- Remove the process mark, if any, from the current article (@code{gnus-summary-unmark-as-processable}). + @item M P U @kindex M P U (Summary) *************** Remove the process mark, if any, from th *** 4208,4219 **** --- 3327,3341 ---- Remove the process mark from all articles (@code{gnus-summary-unmark-all-processable}). + @item M P R @kindex M P R (Summary) @findex gnus-uu-mark-by-regexp Mark articles by a regular expression (@code{gnus-uu-mark-by-regexp}). + @item M P r @kindex M P r (Summary) @findex gnus-uu-mark-region Mark articles in region (@code{gnus-uu-mark-region}). + @item M P t @kindex M P t (Summary) *************** Mark articles in region (@code{gnus-uu-m *** 4221,4228 **** --- 3343,3364 ---- Mark all articles in the current (sub)thread (@code{gnus-uu-mark-thread}). + + @item M P T + @kindex M P T (Summary) + @findex gnus-uu-unmark-thread + Unmark all articles in the current (sub)thread + (@code{gnus-uu-unmark-thread}). + + @item M P v + @kindex M P v (Summary) + @findex gnus-uu-mark-over + Mark all articles that have a score above the prefix argument + (@code{gnus-uu-mark-over}). + @item M P s @kindex M P s (Summary) @findex gnus-uu-mark-series Mark all articles in the current series (@code{gnus-uu-mark-series}). + @item M P S @kindex M P S (Summary) *************** Mark all articles in the current series *** 4230,4239 **** --- 3366,3477 ---- Mark all series that have already had some articles marked (@code{gnus-uu-mark-sparse}). + @item M P a @kindex M P a (Summary) @findex gnus-uu-mark-all Mark all articles in series order (@code{gnus-uu-mark-series}). + + @item M P b + @kindex M P b (Summary) + @findex gnus-uu-mark-buffer + Mark all articles in the buffer in the order they appear + (@code{gnus-uu-mark-buffer}). + @end table + + + @node Limiting + @section Limiting + @cindex limiting + + It can be convenient to limit the summary buffer to just show some + subset of the articles currently in the group. The effect most limit + commands have is to remove a few (or many) articles from the summary + buffer. + + @table @kbd + + @item / / + @itemx / s + @kindex / / (Summary) + @findex gnus-summary-limit-to-subject + Limit the summary buffer to articles that match some subject + (@code{gnus-summary-limit-to-subject}). + + @item / a + @kindex / a (Summary) + @findex gnus-summary-limit-to-author + Limit the summary buffer to articles that match some author + (@code{gnus-summary-limit-to-author}). + + @item / u + @itemx x + @kindex / u (Summary) + @kindex x (Summary) + @findex gnus-summary-limit-to-unread + Limit the summary buffer to articles that are not marked as read + (@code{gnus-summary-limit-to-unread}). If given a prefix, limit the + buffer to articles that are strictly unread. This means that ticked and + dormant articles will also be excluded. + + @item / m + @kindex / m (Summary) + @findex gnus-summary-limit-to-marks + Ask for a mark and then limit to all articles that have not been marked + with that mark (@code{gnus-summary-limit-to-marks}). + + @item / n + @kindex / n (Summary) + @findex gnus-summary-limit-to-articles + Limit the summary buffer to the current article + (@code{gnus-summary-limit-to-articles}). Uses the process/prefix + convention (@pxref{Process/Prefix}). + + @item / w + @kindex / w (Summary) + @findex gnus-summary-pop-limit + Pop the previous limit off the stack and restore it + (@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off + the stack. + + @item / v + @kindex / v (Summary) + @findex gnus-summary-limit-to-score + Limit the summary buffer to articles that have a score at or above some + score (@code{gnus-summary-limit-to-score}). + + @item / E + @itemx M S + @kindex M S (Summary) + @kindex / E (Summary) + @findex gnus-summary-limit-include-expunged + Display all expunged articles + (@code{gnus-summary-limit-include-expunged}). + + @item / D + @kindex / D (Summary) + @findex gnus-summary-limit-include-dormant + Display all dormant articles (@code{gnus-summary-limit-include-dormant}). + + @item / d + @kindex / d (Summary) + @findex gnus-summary-limit-exclude-dormant + Hide all dormant articles (@code{gnus-summary-limit-exclude-dormant}). + + @item / c + @kindex / c (Summary) + @findex gnus-summary-limit-exclude-childless-dormant + Hide all dormant articles that have no children + (@code{gnus-summary-limit-exclude-childless-dormant}). + + @item / C + @kindex / C (Summary) + @findex gnus-summary-limit-mark-excluded-as-read + Mark all excluded unread articles as read + (@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix, + also mark excluded ticked and dormant articles as read. + @end table + @node Threading @section Threading *************** Mark all articles in series order (@code *** 4242,4246 **** Gnus threads articles by default. @dfn{To thread} is to put replies to ! articles directly after the articles they reply to - in a hierarchical fashion. --- 3480,3484 ---- Gnus threads articles by default. @dfn{To thread} is to put replies to ! articles directly after the articles they reply to---in a hierarchical fashion. *************** fashion. *** 4250,4253 **** --- 3488,3492 ---- @end menu + @node Customizing Threading @subsection Customizing Threading *************** fashion. *** 4257,4260 **** --- 3496,3500 ---- @table @code + @item gnus-show-threads @vindex gnus-show-threads *************** the rest of the variables here will have *** 4263,4279 **** off will speed group selection up a bit, but it is sure to make reading slower and more awkward. @item gnus-fetch-old-headers @vindex gnus-fetch-old-headers If non-@code{nil}, Gnus will attempt to build old threads by fetching ! more old headers - headers to articles that are marked as read. If you would like to display as few summary lines as possible, but still connect as many loose threads as possible, you should set this variable ! to @code{some}. In either case, fetching old headers only works if the ! backend you are using carries overview files -- this would normally be ! @code{nntp}, @code{nnspool} and @code{nnml}. Also remember that if the ! root of the thread has been expired by the server, there's not much Gnus ! can do about that. @item gnus-summary-gather-subject-limit Loose threads are gathered by comparing subjects of articles. If this variable is @code{nil}, Gnus requires an exact match between the --- 3503,3537 ---- off will speed group selection up a bit, but it is sure to make reading slower and more awkward. + @item gnus-fetch-old-headers @vindex gnus-fetch-old-headers If non-@code{nil}, Gnus will attempt to build old threads by fetching ! more old headers---headers to articles that are marked as read. If you would like to display as few summary lines as possible, but still connect as many loose threads as possible, you should set this variable ! to @code{some} or a number. If you set it to a number, no more than ! that number of extra old headers will be fetched. In either case, ! fetching old headers only works if the backend you are using carries ! overview files---this would normally be @code{nntp}, @code{nnspool} and ! @code{nnml}. Also remember that if the root of the thread has been ! expired by the server, there's not much Gnus can do about that. ! ! @item gnus-build-sparse-threads ! @vindex gnus-build-sparse-threads ! Fetching old headers can be slow. A low-rent similar effect can be ! gotten by setting this variable to @code{some}. Gnus will then look at ! the complete @code{References} headers of all articles and try to string ! articles that belong in the same thread together. This will leave ! @dfn{gaps} in the threading display where Gnus guesses that an article ! is missing from the thread. (These gaps appear like normal summary ! lines. If you select a gap, Gnus will try to fetch the article in ! question.) If this variable is @code{t}, Gnus will display all these ! ``gaps'' without regard for whether they are useful for completing the ! thread or not. Finally, if this variable is @code{more}, Gnus won't cut ! off sparse leaf nodes that don't lead anywhere. This variable is ! @code{nil} by default. @item gnus-summary-gather-subject-limit + @vindex gnus-summary-gather-subject-limit Loose threads are gathered by comparing subjects of articles. If this variable is @code{nil}, Gnus requires an exact match between the *************** presence of stupid newsreaders that chop *** 4283,4287 **** you think so, set this variable to, say, 20 to require that only the first 20 characters of the subjects have to match. If you set this ! variable to a real low number, you'll find that Gnus will gather everything in sight into one thread, which isn't very helpful. --- 3541,3545 ---- you think so, set this variable to, say, 20 to require that only the first 20 characters of the subjects have to match. If you set this ! variable to a really low number, you'll find that Gnus will gather everything in sight into one thread, which isn't very helpful. *************** If you set this variable to the special *** 4290,4293 **** --- 3548,3625 ---- use a fuzzy string comparison algorithm on the subjects. + @item gnus-simplify-subject-fuzzy-regexp + @vindex gnus-simplify-subject-fuzzy-regexp + This can either be a regular expression or list of regular expressions + that match strings that will be removed from subjects if fuzzy subject + simplification is used. + + @item gnus-simplify-ignored-prefixes + @vindex gnus-simplify-ignored-prefixes + If you set @code{gnus-summary-gather-subject-limit} to something as low + as 10, you might consider setting this variable to something sensible: + + @c Written by Michael Ernst + @lisp + (setq gnus-simplify-ignored-prefixes + (concat + "\\`\\[?\\(" + (mapconcat 'identity + '("looking" + "wanted" "followup" "summary\\( of\\)?" + "help" "query" "problem" "question" + "answer" "reference" "announce" + "How can I" "How to" "Comparison of" + ;; ... + ) + "\\|") + "\\)\\s *\\(" + (mapconcat 'identity + '("for" "for reference" "with" "about") + "\\|") + "\\)?\\]?:?[ \t]*")) + @end lisp + + All words that match this regexp will be removed before comparing two + subjects. + + @item gnus-summary-gather-exclude-subject + @vindex gnus-summary-gather-exclude-subject + Since loose thread gathering is done on subjects only, that might lead + to many false hits, especially with certain common subjects like + @samp{} and @samp{(none)}. To make the situation slightly better, + you can use the regexp @code{gnus-summary-gather-exclude-subject} to say + what subjects should be excluded from the gathering process. The + default is @samp{^ *$\\|^(none)$}. + + @item gnus-summary-thread-gathering-function + @vindex gnus-summary-thread-gathering-function + Gnus gathers threads by looking at @code{Subject} headers. This means + that totally unrelated articles may end up in the same ``thread'', which + is confusing. An alternate approach is to look at all the + @code{Message-ID}s in all the @code{References} headers to find matches. + This will ensure that no gathered threads ever includes unrelated + articles, but it's also means that people who have posted with broken + newsreaders won't be gathered properly. The choice is yours---plague or + cholera: + + @table @code + @item gnus-gather-threads-by-subject + @findex gnus-gather-threads-by-subject + This function is the default gathering function and looks at + @code{Subject}s exclusively. + + @item gnus-gather-threads-by-references + @findex gnus-gather-threads-by-references + This function looks at @code{References} headers exclusively. + @end table + + If you want to test gathering by @code{References}, you could say + something like: + + @lisp + (setq gnus-summary-thread-gathering-function + 'gnus-gather-threads-by-references) + @end lisp + @item gnus-summary-make-false-root @vindex gnus-summary-make-false-root *************** Yup.) Loose subtrees occur when the rea *** 4297,6857 **** read or killed the root in a previous session. ! When there is no real root of a thread, Gnus will have to fudge ! something. This variable says what fudging method Gnus should use. ! There are four possible values: ! @cindex adopting articles ! @table @code ! @item adopt ! Gnus will make the first of the orphaned articles the parent. This ! parent will adopt all the other articles. The adopted articles will be ! marked as such by pointy brackets (@samp{<>}) instead of the standard ! square brackets (@samp{[]}). This is the default method. ! @item dummy ! Gnus will create a dummy summary line that will pretend to be the ! parent. This dummy line does not correspond to any real article, so ! selecting it will just select the first real article after the dummy ! article. ! @item empty ! Gnus won't actually make any article the parent, but simply leave the ! subject field of all orphans except the first empty. (Actually, it will ! use @code{gnus-summary-same-subject} as the subject (@pxref{Summary ! Buffer Format}).) ! @item none ! Don't make any article parent at all. Just gather the threads and ! display them after one another. ! @item nil ! Don't gather loose threads. ! @end table ! @item gnus-thread-hide-subtree ! @vindex gnus-thread-hide-subtree ! If non-@code{nil}, all threads will be hidden when the summary buffer is ! generated. ! @item gnus-thread-hide-killed ! @vindex gnus-thread-hide-killed ! if you kill a thread and this variable is non-@code{nil}, the subtree ! will be hidden. ! @item gnus-thread-ignore-subject ! @vindex gnus-thread-ignore-subject ! Sometimes somebody changes the subject in the middle of a thread. If ! this variable is non-@code{nil}, the subject change is ignored. If it ! is @code{nil}, which is the default, a change in the subject will result ! in a new thread. ! @item gnus-thread-indent-level ! @vindex gnus-thread-indent-level ! This is a number that says how much each sub-thread should be indented. ! The default is @samp{4}. ! @end table ! @node Thread Commands ! @subsection Thread Commands ! @cindex thread commands ! @table @kbd ! @item T k ! @itemx M-C-k ! @kindex T k (Summary) ! @kindex M-C-k (Summary) ! @findex gnus-summary-kill-thread ! Mark all articles in the current sub-thread as read ! (@code{gnus-summary-kill-thread}). If the prefix argument is positive, ! remove all marks instead. If the prefix argument is negative, tick ! articles instead. ! @item T l ! @itemx M-C-l ! @kindex T l (Summary) ! @kindex M-C-l (Summary) ! @findex gnus-summary-lower-thread ! Lower the score of the current thread ! (@code{gnus-summary-lower-thread}). ! @item T i ! @kindex T i (Summary) ! @findex gnus-summary-raise-thread ! Increase the score of the current thread ! (@code{gnus-summary-raise-thread}). ! @item T # ! @kindex T # (Summary) ! @findex gnus-uu-mark-thread ! Mark the current thread with the process mark ! (@code{gnus-uu-mark-thread}). ! @item T T ! @kindex T T (Summary) ! @findex gnus-summary-toggle-threads ! Toggle threading (@code{gnus-summary-toggle-threads}). ! @item T s ! @kindex T s (Summary) ! @findex gnus-summary-show-thread ! Expose the thread hidden under the current article, if any ! (@code{gnus-summary-show-thread}). ! @item T h ! @kindex T h (Summary) ! @findex gnus-summary-hide-thread ! Hide the current (sub)thread (@code{gnus-summary-hide-thread}). ! @item T S ! @kindex T S (Summary) ! @findex gnus-summary-show-all-threads ! Expose all hidden threads (@code{gnus-summary-show-all-threads}). ! @item T H ! @kindex T H (Summary) ! @findex gnus-summary-hide-all-threads ! Hide all threads (@code{gnus-summary-hide-all-threads}). ! @end table ! The following commands are thread movement commands. They all ! understand the numeric prefix. ! @table @kbd ! @item T n ! @kindex T n (Summary) ! @findex gnus-summary-next-thread ! Go to the next thread (@code{gnus-summary-next-thread}). ! @item T p ! @kindex T p (Summary) ! @findex gnus-summary-prev-thread ! Go to the previous thread (@code{gnus-summary-prev-thread}). ! @item T d ! @kindex T d (Summary) ! @findex gnus-summary-down-thread ! Descend the thread (@code{gnus-summary-down-thread}). ! @item T u ! @kindex T u (Summary) ! @findex gnus-summary-up-thread ! Ascend the thread (@code{gnus-summary-up-thread}). ! @end table ! @node Asynchronous Fetching ! @section Asynchronous Article Fetching ! @cindex asynchronous article fetching ! If you read your news from an @sc{nntp} server that's far away, the ! network latencies may make reading articles a chore. You have to wait ! for a while after pressing @kbd{n} to go to the next article before the ! article appears. Why can't Gnus just go ahead and fetch the article ! while you are reading the previous one? Why not, indeed. ! First, some caveats. There are some pitfalls to using asynchronous ! article fetching, especially the way Gnus does it. ! Let's say you are reading article 1, which is short, and article 2 is ! quite long, and you are not interested in reading that. Gnus does not ! know this, so it goes ahead and fetches article 2. You decide to read ! article 3, but since Gnus is in the process of fetching article 2, the ! connection is blocked. - To avoid these situations, Gnus will open two (count 'em two) - connections to the server. Some people may think this isn't a very nice - thing to do, but I don't see any real alternatives. Setting up that - extra connection takes some time, so Gnus startup will be slower. ! Gnus will fetch more articles than you will read. This will mean that ! the link between your machine and the @sc{nntp} server will become more ! loaded than if you didn't use article pre-fetch. The server itself will ! also become more loaded - both with the extra article requests, and the ! extra connection. ! Ok, so now you know that you shouldn't really use this thing... unless ! you really want to. ! @vindex gnus-asynchronous ! Here's how: Set @code{gnus-asynchronous} to @code{t}. The rest should ! happen automatically. ! @vindex nntp-async-number ! You can control how many articles that are to be pre-fetched by setting ! @code{nntp-async-number}. This is five by default, which means that when ! you read an article in the group, @code{nntp} will pre-fetch the next ! five articles. If this variable is @code{t}, @code{nntp} will pre-fetch ! all the articles that it can without bound. If it is @code{nil}, no ! pre-fetching will be made. ! @vindex gnus-asynchronous-article-function ! You may wish to create some sort of scheme for choosing which articles ! that @code{nntp} should consider as candidates for pre-fetching. For ! instance, you may wish to pre-fetch all articles with high scores, and ! not pre-fetch low-scored articles. You can do that by setting the ! @code{gnus-asynchronous-article-function}, which will be called with an ! alist where the keys are the article numbers. Your function should ! return an alist where the articles you are not interested in have been ! removed. You could also do sorting on article score and the like. - @node Article Caching - @section Article Caching - @cindex article caching - @cindex caching ! If you have an @emph{extremely} slow @sc{nntp} connection, you may ! consider turning article caching on. Each article will then be stored ! locally under your home directory. As you may surmise, this could ! potentially use @emph{huge} amounts of disk space, as well as eat up all ! your inodes so fast it will make your head swim. In vodka. ! Used carefully, though, it could be just an easier way to save articles. ! @vindex gnus-use-long-file-name ! @vindex gnus-cache-directory ! @vindex gnus-use-cache ! To turn caching on, set @code{gnus-use-cache} to @code{t}. By default, ! all articles that are ticked or marked as dormant will then be copied ! over to your local cache (@code{gnus-cache-directory}). Whether this ! cache is flat or hierarchal is controlled by the ! @code{gnus-use-long-file-name} variable, as usual. ! When re-select a ticked or dormant article, it will be fetched from the ! cache instead of from the server. As articles in your cache will never ! expire, this might serve as a method of saving articles while still ! keeping them where they belong. Just mark all articles you want to save ! as dormant, and don't worry. ! When an article is marked as read, is it removed from the cache. ! @vindex gnus-cache-remove-articles ! @vindex gnus-cache-enter-articles ! The entering/removal of articles from the cache is controlled by the ! @code{gnus-cache-enter-articles} and @code{gnus-cache-remove-articles} ! variables. Both are lists of symbols. The first is @code{(ticked ! dormant)} by default, meaning that ticked and dormant articles will be ! put in the cache. The latter is @code{(read)} by default, meaning that ! articles that are marked as read are removed from the cache. Possibly ! symbols in these two lists are @code{ticked}, @code{dormant}, ! @code{unread} and @code{read}. - @findex gnus-jog-cache - So where does the massive article-fetching and storing come into the - picture? The @code{gnus-jog-cache} command will go through all - subscribed newsgroups, request all unread articles, and store them in - the cache. You should only ever, ever ever ever, use this command if 1) - your connection to the @sc{nntp} server is really, really, really slow - and 2) you have a really, really, really huge disk. Seriously. ! @node Exiting the Summary Buffer ! @section Exiting the Summary Buffer ! @cindex summary exit ! Exiting from the summary buffer will normally update all info on the ! group and return you to the group buffer. ! @table @kbd ! @item Z Z ! @itemx q ! @kindex Z Z (Summary) ! @kindex q (Summary) ! @findex gnus-summary-exit ! @vindex gnus-summary-exit-hook ! @vindex gnus-summary-prepare-exit-hook ! Exit the current group and update all information on the group ! (@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is ! called before doing much of the exiting, and calls ! @code{gnus-summary-expire-articles} by default. ! @code{gnus-summary-exit-hook} is called after finishing the exiting ! process. ! @item Z E ! @itemx Q ! @kindex Z E (Summary) ! @kindex Q (Summary) ! @findex gnus-summary-exit-no-update ! Exit the current group without updating any information on the group ! (@code{gnus-summary-exit-no-update}). ! @item Z c ! @itemx c ! @kindex Z c (Summary) ! @kindex c (Summary) ! @findex gnus-summary-catchup-and-exit ! Mark all unticked articles in the group as read and then exit ! (@code{gnus-summary-catchup-and-exit}). ! @item Z C ! @kindex Z C (Summary) ! @findex gnus-summary-catchup-all-and-exit ! Mark all articles, even the ticked ones, as read and then exit ! (@code{gnus-summary-catchup-all-and-exit}). ! @item Z n ! @kindex Z n (Summary) ! @findex gnus-summary-catchup-and-goto-next-group ! Mark all articles as read and go to the next group ! (@code{gnus-summary-catchup-and-goto-next-group}). ! @item Z R ! @kindex Z R (Summary) ! @findex gnus-summary-reselect-current-group ! Exit this group, and then enter it again ! (@code{gnus-summary-reselect-current-group}). If given a prefix, select ! all articles, both read and unread. ! @item Z G ! @itemx M-g ! @kindex Z G (Summary) ! @kindex M-g (Summary) ! @findex gnus-summary-rescan-group ! Exit the group, check for new articles in the group, and select the ! group (@code{gnus-summary-rescan-group}). If given a prefix, select all ! articles, both read and unread. ! @item Z N ! @kindex Z N (Summary) ! @findex gnus-summary-next-group ! Exit the group and go to the next group ! (@code{gnus-summary-next-group}). ! @item Z P ! @kindex Z P (Summary) ! @findex gnus-summary-prev-group ! Exit the group and go to the previous group ! (@code{gnus-summary-prev-group}). ! @end table - @vindex gnus-exit-group-hook - @code{gnus-exit-group-hook} is called when you exit the current - group. ! @vindex gnus-use-cross-reference ! The data on the current group will be updated (which articles you have ! read, which articles you have replied to, etc.) when you exit the ! summary buffer. If the @code{gnus-use-cross-reference} variable is ! @code{t}, articles that are cross-referenced to this group and are ! marked as read, will also be marked as read in the other subscribed ! groups they were cross-posted to. If this variable is neither ! @code{nil} nor @code{t}, the article will be marked as read in both ! subscribed and unsubscribed groups. ! Marking cross-posted articles as read ensures that you'll never have to ! read the same article more than once. Unless, of course, somebody has ! posted it to several groups separately. Posting the same article to ! several groups (not cross-posting) is called @dfn{spamming}, and you are ! by law required to send nasty-grams to anyone who perpetrates such a ! heinous crime. ! Remember: Cross-posting is kinda ok, but posting the same article ! separately to several groups is not. ! One thing that may cause Gnus to not do the cross-posting thing ! correctly is if you use an @sc{nntp} server that supports @sc{xover} ! (which is very nice, because it speeds things up considerably) which ! does not include the @code{Xref} header in its @sc{nov} lines. This is ! Evil, but all too common, alas, alack. Gnus tries to Do The Right Thing ! even with @sc{xover} by registering the @code{Xref} lines of all ! articles you actually read, but if you kill the articles, or just mark ! them as read without reading them, Gnus will not get a chance to snoop ! the @code{Xref} lines out of these articles, and will be unable to use ! the cross reference mechanism. ! @vindex gnus-nov-is-evil ! If you want Gnus to get the @code{Xref}s right all the time, you have to ! set @code{gnus-nov-is-evil} to @code{t}, which slows things down ! considerably. ! C'est la vie. ! @node Process/Prefix ! @section Process/Prefix ! @cindex process/prefix convention ! Many functions, among them functions for moving, decoding and saving ! articles, use what is known as the @dfn{Process/Prefix convention}. ! This is a method for figuring out what articles that the user wants the ! command to be performed on. ! It goes like this: ! If the numeric prefix is N, perform the operation on the next N ! articles, starting with the current one. If the numeric prefix is ! negative, perform the operation on the previous N articles, starting ! with the current one. ! If there is no numeric prefix, but some articles are marked with the ! process mark, perform the operation on the articles that are marked with ! the process mark. ! If there is neither a numeric prefix nor any articles marked with the ! process mark, just perform the operation on the current article. ! Quite simple, really, but it needs to be made clear so that surprises ! are avoided. - @node Saving Articles - @section Saving Articles - @cindex saving articles ! Gnus can save articles in a number of ways. Below is the documentation ! for saving articles in a fairly straight-forward fashion (i.e., little ! processing of the article is done before it is saved). For a different ! approach (uudecoding, unsharing) you should use @code{gnus-uu} ! (@pxref{Decoding Articles}). ! @vindex gnus-save-all-headers ! If @code{gnus-save-all-headers} is non-@code{nil}, Gnus will not delete ! unwanted headers before saving the article. ! @table @kbd ! @item O o ! @itemx o ! @kindex O o (Summary) ! @kindex o (Summary) ! @findex gnus-summary-save-article ! Save the current article using the default article saver ! (@code{gnus-summary-save-article}). ! @item O m ! @kindex O m (Summary) ! @findex gnus-summary-save-article-mail ! Save the current article in mail format ! (@code{gnus-summary-save-article-mail}). ! @item O r ! @kindex O r (Summary) ! @findex gnus-summary-save-article-mail ! Save the current article in rmail format ! (@code{gnus-summary-save-article-rmail}). ! @item O f ! @kindex O f (Summary) ! @findex gnus-summary-save-article-file ! Save the current article in plain file format ! (@code{gnus-summary-save-article-file}). ! @item O h ! @kindex O h (Summary) ! @findex gnus-summary-save-article-folder ! Save the current article in mh folder format ! (@code{gnus-summary-save-article-folder}). ! @item O p ! @kindex O p (Summary) ! @findex gnus-summary-pipe-output ! Save the current article in a pipe. Uhm, like, what I mean is - Pipe ! the current article to a process (@code{gnus-summary-pipe-output}). ! @end table ! All these commands use the process/prefix convention ! (@pxref{Process/Prefix}). ! @vindex gnus-default-article-saver ! You can customize the @code{gnus-default-article-saver} variable to make ! Gnus do what you want it to. You can use any of the four ready-made ! functions below, or you can create your own. ! @table @code ! @item gnus-summary-save-in-rmail ! @vindex gnus-summary-save-in-rmail ! This is the default format, @dfn{babyl}. Uses the function in the ! @code{gnus-rmail-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-plain-save-name}. ! @item gnus-summary-save-in-mail ! @vindex gnus-summary-save-in-mail ! Save in a Unix mail (mbox) file. Uses the function in the ! @code{gnus-mail-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-plain-save-name}. ! @item gnus-summary-save-in-file ! @vindex gnus-summary-save-in-file ! Append the article straight to an ordinary file. Uses the function in ! the @code{gnus-file-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-numeric-save-name}. ! @item gnus-summary-save-in-folder ! @vindex gnus-summary-save-in-folder ! Save the article to an MH folder using @code{rcvstore} from the MH ! library. ! @item gnus-summary-save-in-vm ! @vindex gnus-summary-save-in-vm ! Save the article in a VM folder. You have to have the VM mail ! reader to use this setting. ! @end table ! All of these functions, except for the last one, will save the article ! in the @code{gnus-article-save-directory}, which is initialized from the ! @samp{SAVEDIR} environment variable. ! As you can see above, the functions use different functions to find a ! suitable name of a file to save the article in. Below is a list of ! available functions that generate names: ! @table @code ! @item gnus-Numeric-save-name ! @findex gnus-Numeric-save-name ! Generates file names that look like @samp{~/News/Alt.andrea-dworkin/45}. ! @item gnus-numeric-save-name ! @findex gnus-numeric-save-name ! Generates file names that look like @samp{~/News/alt.andrea-dworkin/45}. ! @item gnus-Plain-save-name ! @findex gnus-Plain-save-name ! Generates file names that look like @samp{~/News/Alt.andrea-dworkin}. ! @item gnus-plain-save-name ! @findex gnus-plain-save-name ! Generates file names that look like @samp{~/News/alt.andrea-dworkin}. @end table ! @vindex gnus-use-long-file-name ! Finally, you have the @code{gnus-use-long-file-name} variable. If it is ! @code{nil}, all the preceding functions will replace all periods ! (@samp{.}) in the group names with slashes (@samp{/}) - which means that ! the functions will generate hierarchies of directories instead of having ! all the files in the toplevel directory ! (@samp{~/News/alt/andrea-dworkin} instead of ! @samp{~/News/alt.andrea-dworkin}.) ! This function also affects kill and score file names. If this variable ! is a list, and the list contains the element @code{not-score}, long file ! names will not be used for score files, if it contains the element ! @code{not-save}, long file names will not be used for saving, and if it ! contains the element @code{not-kill}, long file names will not be used ! for kill files. ! If you'd like to save articles in a hierarchy that looks something like ! a spool, you could ! @lisp ! (setq gnus-use-long-file-name '(not-save)) ; to get a hierarchy ! (setq gnus-default-article-save 'gnus-summary-save-in-file) ; no encoding ! @end lisp ! Then just save with @kbd{o}. You'd then read this hierarchy with ! ephemeral @code{nneething} groups - @kbd{G D} in the group buffer, and ! the toplevel directory as the argument (@file{~/News/}). Then just walk ! around to the groups/directories with @code{nneething}. ! @node Decoding Articles ! @section Decoding Articles ! @cindex decoding articles ! Sometime users post articles (or series of articles) that have been ! encoded in some way or other. Gnus can decode them for you. ! @menu ! * Uuencoded Articles:: Uudecode articles. ! * Shared Articles:: Unshar articles. ! * PostScript Files:: Split PostScript. ! * Decoding Variables:: Variables for a happy decoding. ! * Viewing Files:: You want to look at the result of the decoding? ! @end menu - All these functions use the process/prefix convention - (@pxref{Process/Prefix}) for finding out what articles to work on, with - the extension that a "single article" means "a single series". Gnus can - find out by itself what articles belong to a series, decode all the - articles and unpack/view/save the resulting file(s). ! Gnus guesses what articles are in the series according to the following ! simplish rule: The subjects must be (nearly) identical, except for the ! last two numbers of the line. (Spaces are largely ignored, however.) ! For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus ! will find all the articles that match the regexp @samp{^cat.gif ! ([0-9]+/[0-9]+).*$}. - Subjects that are nonstandard, like @samp{cat.gif (2/3) Part 6 of a - series}, will not be properly recognized by any of the automatic viewing - commands, and you have to mark the articles manually with @key{#}. ! @node Uuencoded Articles ! @subsection Uuencoded Articles ! @cindex uudecode ! @cindex uuencoded articles ! @table @kbd ! @item X u ! @kindex X u (Summary) ! @findex gnus-uu-decode-uu ! Uudecodes the current series (@code{gnus-uu-decode-uu}). ! @item X U ! @kindex X U (Summary) ! @findex gnus-uu-decode-uu-and-save ! Uudecodes and saves the current series ! (@code{gnus-uu-decode-uu-and-save}). ! @item X v u ! @kindex X v u (Summary) ! @findex gnus-uu-decode-uu-view ! Uudecodes and views the current series (@code{gnus-uu-decode-uu-view}). ! @item X v U ! @kindex X v U (Summary) ! @findex gnus-uu-decode-uu-and-save-view ! Uudecodes, views and saves the current series ! (@code{gnus-uu-decode-uu-and-save-view}). ! @end table ! Remember that these all react to the presence of articles marked with ! the process mark. If, for instance, you'd like to uncode and save an ! entire newsgroup, you'd typically do @kbd{M P a} ! (@code{gnus-uu-mark-all}) and then @kbd{X U} ! (@code{gnus-uu-decode-uu-and-save}). ! All this is very much different from how @code{gnus-uu} worked with ! @sc{gnus 4.1}, where you had explicit keystrokes for everything under ! the sun. This version of @code{gnus-uu} generally assumes that you mark ! articles in some way (@pxref{Setting Process Marks}) and then press ! @kbd{X u}. ! Note: When trying to decode articles that have names matching ! @code{gnus-uu-notify-files}, which is hard-coded to ! @samp{[Cc][Ii][Nn][Dd][Yy][0-9]+.\\(gif\\|jpg\\)}, @code{gnus-uu} will ! automatically post an article on @samp{comp.unix.wizards} saying that ! you have just viewed the file in question. This feature can't be turned ! off. ! @node Shared Articles ! @subsection Shared Articles ! @cindex unshar ! @cindex shared articles - @table @kbd - @item X s - @kindex X s (Summary) - @findex gnus-uu-decode-unshar - Unshars the current series (@code{gnus-uu-decode-unshar}). - @item X S - @kindex X S (Summary) - @findex gnus-uu-decode-unshar-and-save - Unshars and saves the current series (@code{gnus-uu-decode-unshar-and-save}). - @item X v s - @kindex X v s (Summary) - @findex gnus-uu-decode-unshar-view - Unshars and views the current series (@code{gnus-uu-decode-unshar-view}). - @item X v S - @kindex X v S (Summary) - @findex gnus-uu-decode-unshar-and-save-view - Unshars, views and saves the current series - (@code{gnus-uu-decode-unshar-and-save-view}). @end table ! @node PostScript Files ! @subsection PostScript Files ! @cindex PostScript @table @kbd - @item X p - @kindex X p (Summary) - @findex gnus-uu-decode-postscript - Unpack the current PostScript series (@code{gnus-uu-decode-postscript}). - @item X P - @kindex X P (Summary) - @findex gnus-uu-decode-postscript-and-save - Unpack and save the current PostScript series - (@code{gnus-uu-decode-postscript-and-save}). - @item X v p - @kindex X v p (Summary) - @findex gnus-uu-decode-postscript-view - View the current PostScript series - (@code{gnus-uu-decode-postscript-view}). - @item X v P - @kindex X v P (Summary) - @findex gnus-uu-decode-postscript-and-save-view - View and save the current PostScript series - (@code{gnus-uu-decode-postscript-and-save-view}). - @end table ! @node Decoding Variables ! @subsection Decoding Variables ! Adjective, not verb. ! @menu ! * Rule Variables:: Variables that say how a file is to be viewed. ! * Other Decode Variables:: Other decode variables. ! * Uuencoding & Posting:: Variables for customizing uuencoding. ! @end menu ! @node Rule Variables ! @subsubsection Rule Variables ! @cindex rule variables ! Gnus uses @dfn{rule variables} to decide how to view a file. All these ! variables are on the form ! ! @lisp ! (list '(regexp1 command2) ! '(regexp2 command2) ! ...) ! @end lisp - @table @code - @item gnus-uu-user-view-rules - @vindex gnus-uu-user-view-rules - This variable is consulted first when viewing files. If you wish to use, - for instance, @code{sox} to convert an @samp{.au} sound file, you could - say something like: - @lisp - (setq gnus-uu-user-view-rules - (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) - @end lisp - @item gnus-uu-user-view-rules-end - @vindex gnus-uu-user-view-rules-end - This variable is consulted if Gnus couldn't make any matches from the - user and default view rules. - @item gnus-uu-user-archive-rules - @vindex gnus-uu-user-archive-rules - This variable can be used to say what commands should be used to unpack - archives. @end table ! @node Other Decode Variables ! @subsubsection Other Decode Variables - @table @code - @item gnus-uu-ignore-files-by-name - @vindex gnus-uu-ignore-files-by-name - Files with name matching this regular expression won't be viewed. ! @item gnus-uu-ignore-files-by-type ! @vindex gnus-uu-ignore-files-by-type ! Files with a @sc{mime} type matching this variable won't be viewed. ! Note that Gnus tries to guess what type the file is based on the name. ! @code{gnus-uu} is not a @sc{mime} package (yet), so this is slightly ! kludgey. ! @item gnus-uu-tmp-dir ! @vindex gnus-uu-tmp-dir ! Where @code{gnus-uu} does its work. ! @item gnus-uu-do-not-unpack-archives ! @vindex gnus-uu-do-not-unpack-archives ! Non-@code{nil} means that @code{gnus-uu} won't peek inside archives ! looking for files to display. ! @item gnus-uu-view-and-save ! @vindex gnus-uu-view-and-save ! Non-@code{nil} means that the user will always be asked to save a file ! after viewing it. ! @item gnus-uu-ignore-default-view-rules ! @vindex gnus-uu-ignore-default-view-rules ! Non-@code{nil} means that @code{gnus-uu} will ignore the default viewing ! rules. ! @item gnus-uu-ignore-default-archive-rules ! @vindex gnus-uu-ignore-default-archive-rules ! Non-@code{nil} means that @code{gnus-uu} will ignore the default archive ! unpacking commands. ! @item gnus-uu-kill-carriage-return ! @vindex gnus-uu-kill-carriage-return ! Non-@code{nil} means that @code{gnus-uu} will strip all carriage returns ! from articles. ! @item gnus-uu-unmark-articles-not-decoded ! @vindex gnus-uu-unmark-articles-not-decoded ! Non-@code{nil} means that @code{gnus-uu} will mark articles that were ! unsuccessfully decoded as unread. ! @item gnus-uu-correct-stripped-uucode ! @vindex gnus-uu-correct-stripped-uucode ! Non-@code{nil} means that @code{gnus-uu} will @emph{try} to fix ! uuencoded files that have had trailing spaces deleted. ! @item gnus-uu-view-with-metamail ! @vindex gnus-uu-view-with-metamail ! Non-@code{nil} means that @code{gnus-uu} will ignore the viewing ! commands defined by the rule variables and just fudge a @sc{mime} ! content type based on the file name. The result will be fed to ! @code{metamail} for viewing. ! @item gnus-uu-save-in-digest ! @vindex gnus-uu-save-in-digest ! Non-@code{nil} means that @code{gnus-uu}, when asked to save without ! decoding, will save in digests. If this variable is @code{nil}, ! @code{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, so I ! simply dropped them. @end table ! @node Uuencoding & Posting ! @subsubsection Uuencoding & Posting @table @code ! @item gnus-uu-post-include-before-composing ! @vindex gnus-uu-post-include-before-composing ! Non-@code{nil} means that @code{gnus-uu} will ask for a file to encode ! before you compose the article. If this variable is @code{t}, you can ! either include an encoded file with @key{C-c C-i} or have one included ! for you when you post the article. ! @item gnus-uu-post-length ! @vindex gnus-uu-post-length ! Maximum length of an article. The encoded file will be split into how ! many articles it takes to post the entire file. ! @item gnus-uu-post-threaded ! @vindex gnus-uu-post-threaded ! Non-@code{nil} means that @code{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 - @code{gnus-uu}, but somehow, I don't ! think that counts...) Default is @code{nil}. ! @item gnus-uu-post-separate-description ! @vindex gnus-uu-post-separate-description ! Non-@code{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 @code{nil}, the description the user enters will be included ! at the beginning of the first article, which will be numbered (1/x). ! Default is @code{t}. @end table - @node Viewing Files - @subsection Viewing Files - @cindex viewing files - @cindex pseudo-articles - After decoding, if the file is some sort of archive, Gnus will attempt - to unpack the archive and see if any of the files in the archive can be - viewed. For instance, if you have a gzipped tar file @file{pics.tar.gz} - containing the files @file{pic1.jpg} and @file{pic2.gif}, Gnus will - uncompress and detar the main file, and then view the two pictures. - This unpacking process is recursive, so if the archive contains archives - of archives, it'll all be unpacked. ! Finally, Gnus will normally insert a @dfn{pseudo-article} for each ! extracted file into the summary buffer. If you go to these "articles", ! you will be prompted for a command to run (usually Gnus will make a ! suggestion), and then the command will be run. ! @vindex gnus-view-pseudo-asynchronously ! If @code{gnus-view-pseudo-asynchronously} is @code{nil}, Emacs will wait ! until the viewing is done before proceeding. - @vindex gnus-view-pseudos - If @code{gnus-view-pseudos} is @code{automatic}, Gnus will not insert - the pseudo-articles into the summary buffer, but view them - immediately. If this variable is @code{not-confirm}, the user won't even - be asked for a confirmation before viewing is done. ! @vindex gnus-view-pseudos-separately ! If @code{gnus-view-pseudos-separately} is non-@code{nil}, one ! pseudo-article will be created for each file to be viewed. If ! @code{nil}, all files that use the same viewing command will be given as ! a list of parameters to that command. ! So; there you are, reading your @emph{pseudo-articles} in your ! @emph{virtual newsgroup} from the @emph{virtual server}; and you think: ! Why isn't anything real anymore? How did we get here? ! @node Various Article Stuff ! @section Various Article Stuff ! @table @kbd ! @item W l ! @kindex W l (Summary) ! @findex gnus-summary-stop-page-breaking ! Remove page breaks from the current article ! (@code{gnus-summary-stop-page-breaking}). ! @item A s ! @kindex A s (Summary) ! @findex gnus-summary-isearch-article ! Perform an isearch in the article buffer ! (@code{gnus-summary-isearch-article}). ! @item W r ! @kindex W r (Summary) ! @findex gnus-summary-caesar-message ! Do a Caesar rotate (rot13) on the article buffer ! (@code{gnus-summary-caesar-message}). ! @item A g ! @kindex A g (Summary) ! @findex gnus-summary-show-article ! (Re)fetch the current article (@code{gnus-summary-show-article}). If ! given a prefix, don't actually refetch any articles, just jump to the ! current article and configure the windows to display the current ! article. ! @item W t ! @kindex W t (Summary) ! @findex gnus-summary-toggle-header ! Toggle whether to display all headers in the article buffer ! (@code{gnus-summary-toggle-header}). ! @item W m ! @kindex W m (Summary) ! @findex gnus-summary-toggle-mime ! Toggle whether to run the article through @sc{mime} before displaying ! (@code{gnus-summary-toggle-mime}). ! @end table ! There's a battery of commands for washing the article buffer: ! @table @kbd ! @item W W h ! @kindex W W h (Summary) ! @findex gnus-article-hide-headers ! Hide headers (@code{gnus-article-hide-headers}). ! @item W W s ! @kindex W W s (Summary) ! @findex gnus-article-hide-signature ! Hide signature (@code{gnus-article-hide-signature}). ! @item W W c ! @kindex W W c (Summary) ! @findex gnus-article-hide-citation ! Hide citation (@code{gnus-article-hide-citation}). ! @item W o ! @kindex W o (Summary) ! @findex gnus-article-treat-overstrike ! Treat overstrike (@code{gnus-article-treat-overstrike}). ! @item W w ! @kindex W w (Summary) ! @findex gnus-article-word-wrap ! Do word wrap (@code{gnus-article-word-wrap}). ! @item W c ! @kindex W c (Summary) ! @findex gnus-article-remove-cr ! Remove CR (@code{gnus-article-remove-cr}). ! @item W q ! @kindex W q (Summary) ! @findex gnus-article-de-quoted-unreadable ! Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). ! @item W f ! @kindex W f (Summary) ! @cindex x-face ! @findex gnus-article-display-x-face ! @findex gnus-article-x-face-command ! @vindex gnus-article-x-face-command ! @vindex gnus-article-x-face-too-ugly ! Look for and display any X-Face headers ! (@code{gnus-article-display-x-face}). The command executed by this ! function is given by the @code{gnus-article-x-face-command} variable. If ! this variable is a string, this string will be executed in a sub-shell. ! If it is a function, this function will be called with the face as the ! argument. If the @code{gnus-article-x-face-too-ugly} (which is a regexp) ! matches the @code{From} header, the face will not be shown. ! @item W H a ! @kindex W H a ! @findex gnus-article-highlight ! Highlight the current article (@code{gnus-article-highlight}). ! @item W H h ! @kindex W H h ! @findex gnus-article-highlight-headers ! Highlight the headers (@code{gnus-article-highlight-headers}). ! @item W H c ! @kindex W H c ! @findex gnus-article-highlight-citation ! Highlight cited text (@code{gnus-article-highlight-citation}). ! @item W H s ! @kindex W H s ! @findex gnus-article-highlight-signature ! Highlight the signature (@code{gnus-article-highlight-signature}). - @item W T u - @kindex W T u - @findex gnus-article-date-ut - Display the date in UT (aka. GMT, aka ZULU) - (@code{gnus-article-date-ut}). ! @item W T l ! @kindex W T l ! @findex gnus-article-date-local ! Display the date in the local timezone (@code{gnus-article-date-local}). ! @item W T e ! @kindex W T e ! @findex gnus-article-date-lapsed ! Say how much time has (e)lapsed between the article was posted and now ! (@code{gnus-article-date-lapsed}). @end table - @node Summary Sorting - @section Summary Sorting - @cindex summary sorting ! You can have the summary buffer sorted in various ways, even though I ! can't really see why you'd want that. ! @table @kbd ! @item C-c C-s C-n ! @kindex C-c C-s C-n (Summary) ! @findex gnus-summary-sort-by-number ! Sort by article number (@code{gnus-summary-sort-by-number}). ! @item C-c C-s C-a ! @kindex C-c C-s C-a (Summary) ! @findex gnus-summary-sort-by-author ! Sort by author (@code{gnus-summary-sort-by-author}). ! @item C-c C-s C-s ! @kindex C-c C-s C-s (Summary) ! @findex gnus-summary-sort-by-subject ! Sort by subject (@code{gnus-summary-sort-by-subject}). ! @item C-c C-s C-d ! @kindex C-c C-s C-d (Summary) ! @findex gnus-summary-sort-by-date ! Sort by date (@code{gnus-summary-sort-by-date}). ! @item C-c C-s C-i ! @kindex C-c C-s C-i (Summary) ! @findex gnus-summary-sort-by-score ! Sort by score (@code{gnus-summary-sort-by-score}). ! @end table ! These functions will work both when you use threading and when you don't ! use threading. In the latter case, all summary lines will be sorted, ! line by line. In the former case, sorting will be done on a ! root-by-root basis, which might not be what you were looking for. To ! toggle whether to use threading, type @kbd{T T} (@pxref{Thread ! Commands}). ! @node Finding the Parent ! @section Finding the Parent ! @cindex parent articles ! @cindex referring articles ! @findex gnus-summary-refer-parent-article ! @kindex ^ (Summary) ! If you'd like to read the parent of the current article, and it is not ! displayed in the article buffer, you might still be able to. That is, ! if the current group is fetched by @sc{nntp}, the parent hasn't expired ! and the @code{References} in the current article are not mangled, you ! can just press @kbd{^} or @kbd{A r} ! (@code{gnus-summary-refer-parent-article}). If everything goes well, ! you'll get the parent. If the parent is already displayed in the ! summary buffer, point will just move to this article. ! @findex gnus-summary-refer-article ! @kindex M-^ (Summary) ! You can also ask the @sc{nntp} server for an arbitrary article, no ! matter what group it belongs to. @kbd{M-^} ! (@code{gnus-summary-refer-article}) will ask you for a ! @code{Message-Id}, which is one of those long thingies that look ! something like @samp{<38o6up$6f2@@hymir.ifi.uio.no>}. You have to get ! it all exactly right. No fuzzy searches, I'm afraid. ! @vindex gnus-refer-article-method ! If the group you are reading is located on a backend that does not ! support fetching by @code{Message-Id} very well (like @code{nnspool}), ! you can set @code{gnus-refer-article-method} to an @sc{nntp} method. It ! would, perhaps, be best if the @sc{nntp} server you consult is the same ! as the one that keeps the spool you are reading from updated, but that's ! not really necessary. ! @node Score Files ! @section Score Files ! @cindex score files ! Other people use @dfn{kill files}, but we here at Gnus Towers like ! scoring better than killing, so we'd rather switch than fight. They do ! something completely different as well, so sit up straight and pay ! attention! ! @vindex gnus-summary-mark-below ! All articles have a default score (@code{gnus-summary-default-score}). ! This score may be raised or lowered either interactively or by score ! files. Articles that have a score lower than ! @code{gnus-summary-mark-below} are marked as read. ! Gnus will read any @dfn{score files} that apply to the current group ! before generating the summary buffer. ! There are several commands in the summary buffer that insert score ! entries based on the current article. You can, for instance, ask Gnus to ! lower or increase the score of all articles with a certain subject. ! There are two sorts of scoring entries: Permanent and temporary. ! Temporary score entries are self-expiring entries. Any entries that are ! temporary and have not been used for, say, a week, will be removed ! silently to help keep the sizes of the score files down. ! @menu ! * Summary Score Commands:: Adding score commands to the score file. ! * Score Variables:: Customize your scoring. (My, what terminology). ! * Score File Format:: What a score file may contain. ! * Score File Editing:: You can edit score files by hand as well. ! * Adaptive Scoring:: Big Sister Gnus *knows* what you read. ! * Scoring Tips:: How to score effectively. ! * Reverse Scoring:: That problem child of old is not problem. ! * Global Score Files:: Earth-spanning, ear-splitting score files. ! * Kill Files:: They are still here, but they can be ignored. ! @end menu ! @node Summary Score Commands ! @subsection Summary Score Commands ! @cindex score commands ! The score commands that alter score entries do not actually modify real ! score files. That would be too inefficient. Gnus maintains a cache of ! previously loaded score files, one of which is considered the ! @dfn{current score file alist}. The score commands simply insert ! entries into this list, and upon group exit, this list is saved. ! The current score file is by default the group's local score file, even ! if no such score file actually exists. To insert score commands into ! some other score file (eg. @file{all.SCORE}), you must first make this ! score file the current one. ! General score commands that don't actually change the score file: ! @table @kbd ! @item V s ! @kindex V s (Summary) ! @findex gnus-summary-set-score ! Set the score of the current article (@code{gnus-summary-set-score}). ! @item V S ! @kindex V S (Summary) ! @findex gnus-summary-current-score ! Display the score of the current article ! (@code{gnus-summary-current-score}). ! @item V t ! @kindex V t (Summary) ! @findex gnus-score-find-trace ! Display all score rules that have been used on the current article ! (@code{gnus-score-find-trace}). ! @item V a ! @kindex V a (Summary) ! @findex gnus-summary-score-entry ! Add a new score entry, and allow specifying all elements ! (@code{gnus-summary-score-entry}). ! @item V c ! @kindex V c (Summary) ! @findex gnus-score-change-score-file ! Make a different score file the current ! (@code{gnus-score-change-score-file}). ! @item V e ! @kindex V e (Summary) ! @findex gnus-score-edit-alist ! Edit the current score file (@code{gnus-score-edit-alist}). You will be ! popped into a @code{gnus-score-mode} buffer (@pxref{Score File ! Editing}). ! @item V f ! @kindex V f (Summary) ! @findex gnus-score-edit-file ! Edit a score file and make this score file the current one ! (@code{gnus-score-edit-file}). ! @item I C-i ! @kindex I C-i (Summary) ! @findex gnus-summary-raise-score ! Increase the score of the current article ! (@code{gnus-summary-raise-score}). ! @item L C-l ! @kindex L C-l (Summary) ! @findex gnus-summary-lower-score ! Lower the score of the current article ! (@code{gnus-summary-lower-score}). ! @end table ! The rest of these commands modify the local score file. ! @table @kbd ! @item V m ! @kindex V m (Summary) ! @findex gnus-score-set-mark-below ! Prompt for a score, and mark all articles with a score below this as ! read (@code{gnus-score-set-mark-below}). ! @item V E ! @kindex V E (Summary) ! @findex gnus-score-set-expunge-below ! Expunge all articles with a score below the default score (or the ! numeric prefix) (@code{gnus-score-set-expunge-below}). ! @end table ! The keystrokes for actually making score entries follow a very regular ! pattern, so there's no need to list all the commands. (Hundreds of ! them.) - @enumerate - @item - The first key is either @kbd{I} (upper case i) for increasing the score - or @kbd{L} for lowering the score. - @item - The second key says what header you want to score on. The following - keys are available: - @table @kbd - @item a - Score on the author name. - @item s - Score on the subject line. - @item x - Score on the Xref line - i.e., the cross-posting line. - @item t - Score on thread - the References line. - @item d - Score on the date. - @item l - Score on the number of lines. - @item i - Score on the Message-ID. - @item f - Score on followups. - @item b - Score on the body. - @item h - Score on the head. - @end table ! @item ! The third key is the match type. Which match types are legal depends on ! what headers you are scoring on. ! @table @code ! @item strings ! @table @kbd ! @item e ! Exact matching. ! @item s ! Substring matching. ! @item f ! Fuzzy matching. ! @item r ! Regexp matching ! @end table ! @item date ! @table @kbd ! @item b ! Before date. ! @item a ! At date. ! @item n ! This date. ! @end table - @item number - @table @kbd - @item < - Less than number. - @item = - Equal to number. - @item > - Greater than number. - @end table - @end table ! @item ! The fourth and final key says whether this is a temporary (i.e., expiring) ! score entry, or a permanent (i.e., non-expiring) score entry, or whether ! it is to be done immediately, without adding to the score file. ! @table @kbd ! @item t ! Temporary score entry. ! @item p ! Permanent score entry. ! @item i ! Immediately scoring. ! @end table ! @end enumerate ! So, let's say you want to increase the score on the current author with ! exact matching permanently: @kbd{I a e p}. If you want to lower the ! score based on the subject line, using substring matching, and make a ! temporary score entry: @kbd{L s s t}. Pretty easy. ! To make things a bit more complicated, there are shortcuts. If you use ! a capital letter on either the second or third keys, Gnus will use ! defaults for the remaining one or two keystrokes. The defaults are ! "substring" and "temporary". So @kbd{I A} is the same as @kbd{I a s t}, ! and @kbd{I a R} is the same as @kbd{I a r t}. ! @vindex gnus-score-mimic-keymap ! The @code{gnus-score-mimic-keymap} says whether these commands will ! pretend they are keymaps or not. ! @node Score Variables ! @subsection Score Variables ! @cindex score variables - @table @code - @item gnus-use-scoring - @vindex gnus-use-scoring - If @code{nil}, Gnus will not check for score files, and will not, in - general, do any score-related work. - @item gnus-kill-killed - @vindex gnus-kill-killed - If this variable is @code{nil}, Gnus will never apply score files to - articles that have already been through the kill process. While this - may save you lots of time, it also means that if you apply a kill file - to a group, and then change the kill file and want to run it over you - group again to kill more articles, it won't work. You have to set this - variable to @code{t} to do that. - @item gnus-kill-files-directory - @vindex gnus-kill-files-directory - All kill and score files will be stored in this directory, which is - initialized from the @samp{SAVEDIR} environment variable by default. - @item gnus-score-file-suffix - @vindex gnus-score-file-suffix - Suffix to add to the group name to arrive at the score file name - (@samp{SCORE} by default.) - @item gnus-score-interactive-default-score - @vindex gnus-score-interactive-default-score - Score used by all the interactive raise/lower commands to raise/lower - score with. Default is 1000, which may seem excessive, but this is to - ensure that the adaptive scoring scheme gets enough room to play with. - We don't want the small changes from the adaptive scoring to overwrite - manually entered data. - @item gnus-summary-default-score - @vindex gnus-summary-default-score - Default score of an article, which is 0 by default. - @item gnus-score-over-mark - @vindex gnus-score-over-mark - Mark (in the third column) used for articles with a score over the - default. Default is @samp{+}. - @item gnus-score-below-mark - @vindex gnus-score-below-mark - Mark (in the third column) used for articles with a score below the - default. Default is @samp{-}. - @item gnus-score-find-score-files-function - @vindex gnus-score-find-score-files-function - Function used to find score files for the current group. This function - is called with the name of the group as the argument. ! Predefined functions available are: ! @table @code ! @item gnus-score-find-single ! @findex gnus-score-find-single ! Only apply the group's own score file. ! @item gnus-score-find-bnews ! @findex gnus-score-find-bnews ! Apply all score files that match, using bnews syntax. For instance, if ! the current group is @samp{gnu.emacs.gnus}, @samp{all.emacs.all.SCORE}, ! @samp{not.alt.all.SCORE} and @samp{gnu.all.SCORE} would all apply. In ! short, the instances of @samp{all} in the score file names are ! translated into @samp{.*}, and then a regexp match is done. ! ! If @code{gnus-use-long-file-name} is non-@code{nil}, this won't work ! very will. It will find stuff like @file{gnu/all/SCORE}, but will not ! find files like @file{not/gnu/all/SCORE}. ! @item gnus-score-find-hierarchical ! @findex gnus-score-find-hierarchical ! Apply all score files from all the parent groups. ! @end table ! This variable can also be a list of functions. In that case, all these ! functions will be called, and all the returned lists of score files will ! be applied. These functions can also return lists of score alists ! directly. In that case, the functions that return these non-file score ! alists should probably be placed before the "real" score file functions, ! to ensure that the last score file returned is the local score file. ! Phu. ! @item gnus-score-expiry-days ! @vindex gnus-score-expiry-days ! This variable says how many days should pass before an unused score file ! entry is expired. The default is 7. @end table ! @node Score File Format ! @subsection Score File Format ! @cindex score file format ! A score file is an @code{emacs-lisp} file that normally contains just a ! single form. Casual users are not expected to edit these files; ! everything can be changed from the summary buffer. ! Anyway, if you'd like to dig into it yourself, here's an example: @lisp ! (("from" ! ("Lars Ingebrigtsen" -10000) ! ("Per Abrahamsen") ! ("larsi\\|lmi" -50000 nil R)) ! ("subject" ! ("Ding is Badd" nil 728373)) ! ("xref" ! ("alt.politics" -1000 728372 s)) ! ("lines" ! (2 -100 nil <)) ! (mark 0) ! (expunge -1000) ! (mark-and-expunge -10) ! (read-only nil) ! (orphan -10) ! (adapt t) ! (files "/hom/larsi/News/gnu.SCORE") ! (local (gnus-newsgroup-auto-expire t) ! (gnus-summary-make-false-root 'empty)) ! (eval (ding))) @end lisp ! This example demonstrates absolutely everything about a score file. ! ! Even though this looks much like lisp code, nothing here is actually ! @code{eval}ed. The lisp reader is used to read this form, though, so it ! has to be legal syntactically, if not semantically. ! Six keys are supported by this alist: @table @code ! @item STRING ! If the key is a string, it is the name of the header to perform the ! match on. Scoring can only be performed on these eight headers: ! @samp{From}, @samp{Subject}, @samp{References}, @samp{Message-ID}, ! @samp{Xref}, @samp{Lines}, @samp{Chars} and @samp{Date}. In addition to ! these headers, there are three strings to tell Gnus to fetch the entire ! article and do the match on larger parts of the article: @samp{Body} ! will perform the match on the body of the article, @samp{Head} will ! perform the match on the head of the article, and @samp{All} will ! perform the match on the entire article. Note that using any of these ! last three keys will slow down group entry @emph{considerably}. ! Following this key is a random number of score entries, where each score ! entry has one to four elements. ! @enumerate ! @item ! The first element is the @dfn{match element}. On most headers this will ! be a string, but on the Lines and Chars headers, this must be an ! integer. ! @item ! If the second element is present, it should be a number - the @dfn{score ! element}. This number should be an integer in the neginf to posinf ! interval. This number is added to the score of the article if the match ! is successful. If this element is not present, the ! @code{gnus-score-interactive-default-score} number will be used instead. ! @item ! If the third element is present, it should be a number - the @dfn{date ! element}. This date says when the last time this score entry matched, ! which provides a mechanism for expiring the score entries. It this ! element is not present, the score entry is permanent. The date is ! represented by the number of days since December 31, 1 ce. ! @item ! If the fourth element is present, it should be a symbol - the @dfn{type ! element}. This element specifies what function should be used to see ! whether this score entry matches the article. What match types that can ! be used depends on what header you wish to perform the match on. ! @table @dfn ! @item From, Subject, References, Xref, Message-ID ! For most header types, there are the @code{r} and @code{R} (regexp) as ! well as @code{s} and @code{S} (substring) types and @code{e} and ! @code{E} (exact match) types. If this element is not present, Gnus will ! assume that substring matching should be used. @code{R} and @code{S} ! differ from the other two in that the matches will be done in a ! case-sensitive manner. All these one-letter types are really just ! abbreviations for the @code{regexp}, @code{string} and @code{exact} ! types, which you can use instead, if you feel like. ! @item Lines, Chars ! These two headers use different match types: @code{<}, @code{>}, ! @code{=}, @code{>=} and @code{<=}. ! @item Date ! For the Date header we have three match types: @code{before}, @code{at} ! and @code{after}. I can't really imagine this ever being useful, but, ! like, it would feel kinda silly not to provide this function. Just in ! case. You never know. Better safe than sorry. Once burnt, twice shy. ! Don't judge a book by its cover. Never not have sex on a first date. ! @item Head, Body, All ! These three match keys use the same match types as the @code{From} (etc) ! header uses. ! @item Followup ! This match key will add a score entry on all articles that followup to ! some author. Uses the same match types as the @code{From} header uses. @end table - @end enumerate ! @item mark ! The value of this entry should be a number. Any articles with a score ! lower than this number will be marked as read. ! @item expunge ! 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. ! @item mark-and-expunge ! 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. ! @item files ! 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. ! @item exclude-files ! The clue of this entry should be any number of files. This files will ! not be loaded, even though they would normally be so, for some reason or ! other. ! @item eval ! The value of this entry will be @code{eval}el. This element will be ! ignored when handling global score files. ! @item read-only ! Read-only score files will not be updated or saved. Global score files ! should feature this atom (@pxref{Global Score Files}). ! @item orphan ! The value of this entry should be a number. Articles that do not have ! parents will get this number added to their scores. ! @item adapt ! This entry controls the adaptive scoring. If it is @code{t}, the ! default adaptive scoring rules will be used. If it is @code{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. If it isn't present, ! or is something other than @code{t} or @code{ignore}, the default ! adaptive scoring rules will be used. If you want to use adaptive ! scoring on most groups, you'd set @code{gnus-use-adaptive-scoring} to ! @code{t}, and insert an @code{(adapt ignore)} in the groups where you do ! not want adaptive scoring. If you only want adaptive scoring in a few ! groups, you'd set @code{gnus-use-adaptive-scoring} to @code{nil}, and ! insert @code{(adapt t)} in the score files of the groups where you want ! it. ! @item local ! @cindex local variables ! The value of this entry should be a list of @code{(VAR VALUE)} pairs. ! Each @var{var} will be made buffer-local to the current summary buffer, ! and set to the value specified. This is a convenient, if somewhat ! strange, way of setting variables in some groups if you don't like hooks ! much. @end table - @node Score File Editing - @subsection Score File Editing ! You normally enter all scoring commands from the summary buffer, but you ! might feel the urge to edit them by hand as well, so we've supplied you ! with a mode for that. ! It's simply a slightly customized @code{emacs-lisp} mode, with these ! additional commands: ! @table @kbd ! @item C-c C-c ! @kindex C-c C-c (Score) ! @findex gnus-score-edit-done ! Save the changes you have made and return to the summary buffer ! (@code{gnus-score-edit-done}). ! @item C-c C-d ! @kindex C-c C-d (Score) ! @findex gnus-score-edit-insert-date ! Insert the current date in numerical format ! (@code{gnus-score-edit-insert-date}). This is really the day number, if ! you were wondering. @end table ! @node Adaptive Scoring ! @subsection Adaptive Scoring ! @cindex adaptive scoring - If all this scoring is getting you down, Gnus has a way of making it all - happen automatically - as if by magic. Or rather, as if by artificial - stupidity, to be precise. ! @vindex gnus-use-adaptive-scoring ! When you read an article, or mark an article as read, or kill an ! article, you leave marks behind. On exit from the group, Gnus can sniff ! these marks and add score elements depending on what marks it finds. ! You turn on this ability by setting @code{gnus-use-adaptive-scoring} to ! @code{t}. ! @vindex gnus-default-adaptive-score-alist ! To give you complete control over the scoring process, you can customize ! the @code{gnus-default-adaptive-score-alist} variable. By default, it ! looks something like this: @lisp ! (defvar gnus-default-adaptive-score-alist ! '((gnus-unread-mark) ! (gnus-ticked-mark (from 4)) ! (gnus-dormant-mark (from 5)) ! (gnus-del-mark (from -4) (subject -1)) ! (gnus-read-mark (from 4) (subject 2)) ! (gnus-expirable-mark (from -1) (subject -1)) ! (gnus-killed-mark (from -1) (subject -3)) ! (gnus-kill-file-mark) ! (gnus-catchup-mark (from -1) (subject -1)))) @end lisp ! As you see, each element in this alist has a mark as a key (either a ! variable name or a "real" mark - a character). Following this key is a ! random number of header/score pairs. ! To take @code{gnus-del-mark} as an example - this alist says that all ! articles that have that mark (i.e., are marked with @samp{D}) will have a ! score entry added to lower based on the @code{From} header by -4, and ! lowered by @code{Subject} by -1. Change this to fit your prejudices. ! If you use this scheme, you should set @code{mark-below} to something ! small - like -300, perhaps, to avoid having small random changes result ! in articles getting marked as read. ! After using adaptive scoring for a week or so, Gnus should start to ! become properly trained and enhance the authors you like best, and kill ! the authors you like least, without you having to say so explicitly. ! You can control what groups the adaptive scoring is to be performed on ! by using the score files (@pxref{Score File Format}). This will also ! let you use different rules in different groups. ! @vindex gnus-adaptive-file-suffix ! The adaptive score entries will be put into a file where the name is the ! group name with @code{gnus-adaptive-file-suffix} appended. ! @vindex gnus-score-exact-adapt-limit ! When doing adaptive scoring, substring or fuzzy matching would probably ! give you the best results in most cases. However, if the header one ! matches is short, the possibility for false positives is great, so if ! the length of the match is less than ! @code{gnus-score-exact-adapt-limit}, exact matching will be used. If ! this variable is @code{nil}, exact matching will always be used to avoid ! this problem. ! @node Scoring Tips ! @subsection Scoring Tips ! @cindex scoring tips ! @table @dfn ! @item Crossposts ! If you want to lower the score of crossposts, the line to match on is ! the @code{Xref} header. ! @lisp ! ("xref" (" talk.politics.misc:" -1000)) ! @end lisp ! @item Multiple crossposts ! If you want to lower the score of articles that have been crossposted to ! more than, say, 3 groups: ! @lisp ! ("xref" ("[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+" -1000 nil r)) ! @end lisp ! @item Matching on the body ! This is generally not a very good idea - it takes a very long time. ! Gnus actually has to fetch each individual article from the server. But ! you might want to anyway, I guess. Even though there are three match ! keys (@code{Head}, @code{Body} and @code{All}), you should choose one ! and stick with it in each score file. If you use any two, each article ! will be fetched @emph{twice}. If you want to match a bit on the ! @code{Head} and a bit on the @code{Body}, just use @code{All} for all ! the matches. ! @item Marking as read ! You will probably want to mark articles that has a score below a certain ! number as read. This is most easily achieved by putting the following ! in your @file{all.SCORE} file: @lisp ! ((mark -100)) @end lisp - You may also consider doing something similar with @code{expunge}. ! @item Negated character classes ! If you say stuff like @code{[^abcd]*}, you may get unexpected results. ! That will match newlines, which might lead to, well, The Unknown. Say ! @code{[^abcd\n]*} instead. @end table ! @node Reverse Scoring ! @subsection Reverse Scoring ! @cindex reverse scoring ! If you want to keep just articles that have @samp{Sex with Emacs} in the ! subject header, and expunge all other articles, you could put something ! like this in your score file: @lisp ! (("subject" ! ("Sex with Emacs" 2)) ! (mark 1) ! (expunge 1)) @end lisp - So, you raise all articles that match @samp{Sex with Emacs} and mark the - rest as read, and expunge them to boot. ! @node Global Score Files ! @subsection Global Score Files ! @cindex global score files ! Sure, other newsreaders have "global kill files". These are usually ! nothing more than a single kill file that applies to all groups, stored ! in the user's home directory. Bah! Puny, weak newsreaders! ! What I'm talking about here are Global Score Files. Score files from ! all over the world, from users everywhere, uniting all nations in one ! big, happy score file union! Ange-score! New and untested! ! @vindex gnus-global-score-files ! All you have to do to use other people's score files is to set the ! @code{gnus-global-score-files} variable. One entry for each score file, ! or each score file directory. Gnus will decide by itself what score ! files are applicable to which group. ! Say you want to use all score files in the ! @file{/ftp@@ftp.some-where:/pub/score} directory and the single score ! file @file{/ftp@@ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE}: @lisp ! (setq gnus-global-score-files ! '("/ftp@@ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE" ! "/ftp@@ftp.some-where:/pub/score/")) @end lisp - @findex gnus-score-search-global-directories - Simple, eh? Directory names must end with a @samp{/}. These - directories are typically scanned only once during each Gnus session. - If you feel the need to manually re-scan the remote directories, you can - use the @code{gnus-score-search-global-directories} command. ! Note that, at present, using this option will slow down group entry ! somewhat. (That is - a lot.) - If you want to start maintaining score files for other people to use, - just put your score file up for anonymous ftp and announce it to the - world. Become a retro-moderator! Participate in the retro-moderator - wars sure to ensue, where retro-moderators battle it out for the - sympathy of the people, luring them to use their score files on false - premises! Yay! The net is saved! ! Here are some tips for the would-be retro-moderator, off the top of my ! head: ! @itemize @bullet ! @item ! Articles that are heavily crossposted are probably junk. ! @item ! To lower a single inappropriate article, lower by @code{Message-Id}. ! @item ! Particularly brilliant authors can be raised on a permanent basis. ! @item ! Authors that repeatedly post off-charter for the group can safely be ! lowered out of existence. ! @item ! Set the @code{mark} and @code{expunge} atoms to obliterate the nastiest ! articles completely. ! @item ! Use expiring score entries to keep the size of the file down. You ! should probably have a long expiry period, though, as some sites keep ! old articles for a long time. ! @end itemize - ... I wonder whether other newsreaders will support global score files - in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue - Wave, xrn and 1stReader are bound to implement scoring. Should we start - holding our breath yet? ! @node Kill Files ! @subsection Kill Files ! @cindex kill files ! Gnus still supports those pesky old kill files. In fact, the kill file ! entries can now be expiring, which is something I wrote before Per ! thought of doing score files, so I've left the code in there. ! In short, kill processing is a lot slower (and I do mean @emph{a lot}) ! than score processing, so it might be a good idea to rewrite your kill ! files into score files. ! Anyway, a kill file is a normal @code{emacs-lisp} file. You can put any ! forms into this file, which means that you can use kill files as some ! sort of primitive hook function to be run on group entry, even though ! that isn't a very good idea. ! XCNormal kill files look like this: ! @lisp ! (gnus-kill "From" "Lars Ingebrigtsen") ! (gnus-kill "Subject" "ding") ! (gnus-expunge "X") ! @end lisp ! This will mark every article written by me as read, and remove them from ! the summary buffer. Very useful, you'll agree. - Other programs use a totally different kill file syntax. If Gnus - encounters what looks like a @code{rn} kill file, it will take a stab at - interpreting it. ! Two functions for editing a GNUS kill file: ! @table @kbd ! @item M-k ! @kindex M-k (Summary) ! @findex gnus-summary-edit-local-kill ! Edit this group's kill file (@code{gnus-summary-edit-local-kill}). ! @item M-K ! @kindex M-K (Summary) ! @findex gnus-summary-edit-global-kill ! Edit the general kill file (@code{gnus-summary-edit-global-kill}). ! @end table ! @vindex gnus-kill-file-name ! A kill file for the group @samp{soc.motss} is normally called ! @file{soc.motss.KILL}. The suffix appended to the group name to get ! this file name is detailed by the @code{gnus-kill-file-name} variable. ! The "global" kill file (not in the score file sense of "global", of ! course) is called just @file{KILL}. ! @vindex gnus-kill-save-kill-file ! If @code{gnus-kill-save-kill-file} is non-@code{nil}, Gnus will save the ! kill file after processing, which is necessary if you use expiring ! kills. ! @node Mail Group Commands ! @section Mail Group Commands ! @cindex mail group commands ! Some commands only make sense in mail groups. If these commands are ! illegal in the current group, they will raise a hell and let you know. ! All these commands (except the expiry and edit commands) use the ! process/prefix convention (@pxref{Process/Prefix}). ! @table @kbd ! @item B e ! @kindex B e (Summary) ! @findex gnus-summary-expire-articles ! Expire all expirable articles in the group ! (@code{gnus-summary-expire-articles}). ! @item B M-C-e ! @kindex B M-C-e (Summary) ! @findex gnus-summary-expire-articles-now ! Expunge all the expirable articles in the group ! (@code{gnus-summary-expire-articles-now}). This means that @strong{all} ! articles that are eligible for expiry in the current group will ! disappear forever into that big @file{/dev/null} in the sky. ! @item B DEL ! @kindex B DEL (Summary) ! @findex gnus-summary-delete-articles ! Delete the mail article. This is "delete" as in "delete it from your ! disk forever and ever, never to return again." Use with caution. ! (@code{gnus-summary-delete-article}). ! @item B m ! @kindex B m (Summary) ! @cindex move mail ! @findex gnus-summary-move-article ! Move the article from one mail group to another ! (@code{gnus-summary-move-article}). ! @item B c ! @kindex B c (Summary) ! @cindex copy mail ! @findex gnus-summary-copy-article ! Copy the article from one group (mail group or not) to a mail group ! (@code{gnus-summary-copy-article}). ! @item B i ! @kindex B i (Summary) ! @findex gnus-summary-import-article ! Import a random file into the current mail newsgroup ! (@code{gnus-summary-import-article}). You will be prompted for a file ! name, a @code{From} header and a @code{Subject} header. ! @item B r ! @kindex B r (Summary) ! @findex gnus-summary-respool-article ! Respool the mail article (@code{gnus-summary-move-article}). ! @item B w ! @itemx e ! @kindex B w (Summary) ! @kindex e (Summary) ! @findex gnus-summary-edit-article ! @kindex C-c C-c (Article) ! Edit the current article (@code{gnus-summary-edit-article}). To finish ! editing and make the changes permanent, type @kbd{C-c C-c} ! (@kbd{gnus-summary-edit-article-done}). ! @item B q ! @kindex B q (Summary) ! @findex gnus-summary-fancy-query ! If you are using fancy splitting, this command will tell you where an ! article would go (@code{gnus-summary-fancy-query}). ! @end table - @node Various Summary Stuff - @section Various Summary Stuff ! @menu ! * Group Information:: Information oriented commands. ! * Searching for Articles:: Multiple article commands. ! * Really Various Summary Commands:: Those pesky non-conformant commands. ! @end menu ! @vindex gnus-summary-prepare-hook ! @code{gnus-summary-prepare-hook} is called after the summary buffer has ! been generated. You might use it to, for instance, highlight lines or ! modify the look of the buffer in some other ungodly manner. I don't ! care. ! @node Group Information ! @subsection Group Information ! @table @kbd ! @item H f ! @kindex H f (Summary) ! @findex gnus-summary-fetch-faq ! @vindex gnus-group-faq-directory ! Try to fetch the FAQ (list of frequently asked questions) for the ! current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the ! FAQ from @code{gnus-group-faq-directory}, which is usually a directory ! on a remote machine. @code{ange-ftp} will be used for fetching the file. ! @item H d ! @kindex H d (Summary) ! @findex gnus-summary-describe-group ! Give a brief description of the current group ! (@code{gnus-summary-describe-group}). If given a prefix, force ! rereading the description from the server. ! @item H h ! @kindex H h (Summary) ! @findex gnus-summary-describe-briefly ! Give a very brief description of the most important summary keystrokes ! (@code{gnus-summary-describe-briefly}). ! @item H i ! @kindex H i (Summary) ! @findex gnus-info-find-node ! Go to the Gnus info node (@code{gnus-info-find-node}). ! @end table ! @node Searching for Articles ! @subsection Searching for Articles ! @table @kbd ! @item M-s ! @kindex M-s (Summary) ! @findex gnus-summary-search-article-forward ! Search through all subsequent articles for a regexp ! (@code{gnus-summary-search-article-forward}). ! @item M-r ! @kindex M-r (Summary) ! @findex gnus-summary-search-article-backward ! Search through all previous articles for a regexp ! (@code{gnus-summary-search-article-backward}). ! @item & ! @kindex & (Summary) ! @findex gnus-summary-execute-command ! This command will prompt you for a header field, a regular expression to ! match on this field, and a command to be executed if the match is made ! (@code{gnus-summary-execute-command}). ! @item M-& ! @kindex M-& (Summary) ! @findex gnus-summary-universal-argument ! Perform any operation on all articles that have been marked with ! the process mark (@code{gnus-summary-universal-argument}). ! @end table ! @node Really Various Summary Commands ! @subsection Really Various Summary Commands ! @table @kbd ! @item A D ! @kindex A D (Summary) ! @findex gnus-summary-enter-digest-group ! If the current article is a digest, you might use this command to enter ! you into a group based on the current digest to ease reading ! (@code{gnus-summary-enter-digest-group}). ! @item C-t ! @kindex C-t (Summary) ! @findex gnus-summary-toggle-truncation ! Toggle truncation of summary lines (@code{gnus-summary-toggle-truncation}). ! @item = ! @kindex = (Summary) ! @findex gnus-summary-expand-window ! Expand the summary buffer window (@code{gnus-summary-expand-window}). ! If given a prefix, force an @code{article} window configuration. ! @end table ! @node The Article Buffer ! @chapter The Article Buffer ! @cindex article buffer ! The articles are displayed in the article buffer, of which there is only ! one. All the summary buffer share the same article buffer. ! @menu ! * Hiding Headers:: Deciding what headers should be displayed. ! * Using Mime:: Pushing articles through @sc{mime} before reading them. ! * Customizing Articles:: Tailoring the look of the articles. ! * Article Keymap:: Keystrokes available in the article buffer ! * Misc Article:: Other stuff. ! @end menu ! @node Hiding Headers ! @section Hiding Headers ! @cindex hiding headers ! @cindex deleting headers ! The top section of each article is the @dfn{head}. (The rest is the ! @dfn{body}, but you may have guessed that already.) - @vindex gnus-show-all-headers - There is a lot of useful information in the head: the name of the person - who wrote the article, the date it was written and the subject of the - article. That's well and nice, but there's also lots of information - most people do not want to see - what systems the article has passed - through before reaching you, the @code{Message-Id}, the - @code{References}, etc. ad nauseum - and you'll probably want to get rid - of some of those lines. If you want to keep all those lines in the - article buffer, you can set @code{gnus-show-all-headers} to @code{t}. ! Gnus provides you with two variables for sifting headers: ! @table @code ! @item gnus-visible-headers ! @vindex gnus-visible-headers ! If this variable is non-@code{nil}, it should be a regular expression ! that says what headers you wish to keep in the article buffer. All ! headers that do not match this variable will be hidden. ! For instance, if you only want to see the name of the person who wrote ! the article and the subject, you'd say: ! @lisp ! (setq gnus-visible-headers "^From:\\|^Subject:") ! @end lisp ! @item gnus-ignored-headers ! @vindex gnus-ignored-headers ! This variable is the reverse of @code{gnus-visible-headers}. If this ! variable is set (and @code{gnus-visible-headers} is @code{nil}), it ! should be a regular expression that matches all lines that you want to ! hide. All lines that do not match this variable will remain visible. ! For instance, if you just want to get rid of the @code{References} line ! and the @code{Xref} line, you might say: ! @lisp ! (setq gnus-ignored-headers "^References:\\|^Xref:") ! @end lisp ! Note that if @code{gnus-visible-headers} is non-@code{nil}, this ! variable will have no effect. ! @end table ! @vindex gnus-sorted-header-list ! Gnus can also sort the headers for you. (It does this by default.) You ! can control the sorting by setting the @code{gnus-sorted-header-list} ! variable. It is a list of regular expressions that says in what order ! the headers are to be displayed. ! For instance, if you want the name of the author of the article first, ! and then the subject, you might say something like: ! @lisp ! (setq gnus-sorted-header-list '("^From:" "^Subject:")) ! @end lisp ! Any headers that are to remain visible, but are not listed in this ! variable, will be displayed in random order after all the headers that ! are listed in this variable. ! @node Using Mime ! @section Using Mime ! @cindex @sc{mime} ! Mime is a standard for waving your hands through the air, aimlessly, ! while people stand around yawning. ! @sc{mime}, however, is a standard for encoding your articles, aimlessly, ! while all newsreaders die of fear. ! @sc{mime} may specify what character set the article uses, the encoding ! of the characters, and it also makes it possible to embed pictures and ! other naughty stuff in innocent-looking articles. - @vindex gnus-show-mime - @vindex gnus-show-mime-method - Gnus handles @sc{mime} by shoving the articles through - @code{gnus-show-mime-method}, which is @code{metamail-buffer} by - default. If @code{gnus-strict-mime} is non-@code{nil}, the @sc{mime} - method will only be used it there are @sc{mime} headers in the article. - Set @code{gnus-show-mime} to @code{t} if you want to use @sc{mime} all - the time; it might be best to just use the toggling functions from the - summary buffer to avoid getting nasty surprises. (For instance, you - enter the group @samp{alt.sing-a-long} and, before you know it, - @sc{mime} has decoded the sound file in the article and some horrible - sing-a-long song comes streaming out out your speakers, and you can't - find the volume button, because there isn't one, and people are starting - to look at you, and you try to stop the program, but you can't, and you - can't find the program to control the volume, and everybody else in the - room suddenly decides to look at you disdainfully, and you'll feel - rather stupid.) ! Any similarity to real events and people is purely coincidental. Ahem. ! @node Customizing Articles ! @section Customizing Articles ! @cindex article customization ! @vindex gnus-article-display-hook ! The @code{gnus-article-display-hook} is called after the article has ! been inserted into the article buffer. It is meant to handle all ! treatment of the article before it is displayed. By default it contains ! @code{gnus-article-hide-headers}, which hides unwanted headers. ! @findex gnus-article-subcite ! @findex gnus-article-hide-signature ! @findex gnus-article-hide-citation ! Other useful functions you might add to this hook is: ! @table @code ! @item gnus-article-hide-citation ! Hide all cited text. ! @item gnus-article-hide-signature ! Umn, hides the signature. ! @item gnus-article-treat-overstrike ! Treat @samp{^H_} in a reasonable manner. ! @item gnus-article-maybe-highlight ! Do fancy article highlighting. ! @item gnus-article-remove-cr ! Removes trailing carriage returns. ! @item gnus-article-de-quoted-unreadable ! Do naive decoding of articles encoded with Quoted-Printable. ! @item gnus-article-display-x-face ! Displays any X-Face headers. ! @end table ! You can, of course, write your own functions. The functions are called ! from the article buffer, and you can do anything you like, pretty much. ! There is no information that you have to keep in the buffer - you can ! change everything. However, you shouldn't delete any headers. Instead ! make them invisible if you want to make them go away. ! @node Article Keymap ! @section Article Keymap ! @c Most of the keystrokes in the summary buffer can also be used in the ! @c article buffer. They should behave as if you typed them in the summary ! @c buffer, which means that you don't actually have to have a summary ! @c buffer displayed while reading. You can do it all from the article ! @c buffer. ! A few additional keystrokes are available: ! @table @kbd ! @item SPACE ! @kindex SPACE (Article) ! @findex gnus-article-next-page ! Scroll forwards one page (@code{gnus-article-next-page}). ! @item DEL ! @kindex DEL (Article) ! @findex gnus-article-prev-page ! Scroll backwards one page (@code{gnus-article-prev-page}). ! @item C-c ^ ! @kindex C-c ^ (Article) ! @findex gnus-article-refer-article ! If point is in the neighborhood of a @code{Message-Id} and you press ! @kbd{r}, Gnus will try to get that article from the server ! (@code{gnus-article-refer-article}). ! @item C-c C-m ! @kindex C-c C-m (Article) ! @findex gnus-article-mail ! Send a reply to the address near point (@code{gnus-article-mail}). If ! given a prefix, include the mail. ! @item s ! @kindex s (Article) ! @findex gnus-article-show-summary ! Reconfigure the buffers so that the summary buffer becomes visible ! (@code{gnus-article-show-summary}). ! @item ? ! @kindex ? (Article) ! @findex gnus-article-describe-briefly ! Give a very brief description of the available keystrokes ! (@code{gnus-article-describe-briefly}). ! @end table ! @node Misc Article ! @section Misc Article ! @table @code ! @vindex gnus-article-prepare-hook ! @item gnus-article-prepare-hook ! This hook is called right after the article has been inserted into the ! article buffer. It is mainly intended for functions that do something ! depending on the contents; it should probably not be used for changing ! the contents of the article buffer. ! @vindex gnus-article-display-hook ! @item gnus-article-display-hook ! This hook is called as the last thing when displaying an article, and is ! intended for modifying the contents of the buffer, doing highlights, ! hiding headers, and the like. ! @vindex gnus-article-mode-line-format ! @item gnus-article-mode-line-format ! This variable is a format string along the same lines as ! @code{gnus-summary-mode-line-format}. It accepts exactly the same ! format specifications as that variable. ! @vindex gnus-break-pages ! @item gnus-break-pages ! Controls whether @dfn{page breaking} is to take place. If this variable ! is non-@code{nil}, the articles will be divided into pages whenever a ! page delimiter appears in the article. If this variable is @code{nil}, ! paging will not be done. ! @item gnus-page-delimiter ! @vindex gnus-page-delimiter ! This is the delimiter mentioned above. By default, it is @samp{^L} ! (form linefeed). ! @end table ! @node The Server Buffer ! @chapter The Server Buffer ! Traditionally, a @dfn{server} is a machine or a piece of software that ! one connects to, and then requests information from. Gnus does not ! connect directly to any real servers, but does all transactions through ! one backend or other. But that's just putting one layer more between ! the actual media and Gnus, so we might just as well say that each ! backend represents a virtual server. ! For instance, the @code{nntp} backend may be used to connect to several ! different actual nntp servers, or, perhaps, to many different ports on ! the same actual nntp server. You tell Gnus which backend to use, and ! what parameters to set by specifying a @dfn{select method}. ! These select methods specifications can sometimes become quite ! complicated - say, for instance, that you want to read from the nntp ! server @samp{news.funet.fi} on port number @samp{13}, which hangs if ! queried for @sc{nov} headers and has a buggy select. Ahem. Anyways, if ! you had to specify that for each group that used this server, that would ! be too much work, so Gnus offers a way of putting names to methods, ! which is what you do in the server buffer. ! @menu ! * Server Buffer Format:: You can customize the look of this buffer. ! * Server Commands:: Commands to manipulate servers. ! * Example Methods:: Examples server specifications. ! * Servers & Methods:: You can use server names as select methods. ! @end menu ! @node Server Buffer Format ! @section Server Buffer Format ! @cindex server buffer format ! @vindex gnus-server-line-format ! You can change the look of the server buffer lines by changing the ! @code{gnus-server-line-format} variable. This is a @code{format}-like ! variable, with some simple extensions: ! @table @samp ! @item h ! How the news is fetched - the backend name. ! @item n ! The name of this server. ! @item w ! Where the news is to be fetched from - the address. ! @end table ! @node Server Commands ! @section Server Commands ! @cindex server commands ! @table @kbd ! @item SPC ! Browse the current server (@code{gnus-server-read-server}). ! @item q ! Return to the group buffer (@code{gnus-server-exit}). ! @item l ! List all servers (@code{gnus-server-list-servers}). ! @item k ! Kill the current server (@code{gnus-server-kill-server}). ! @item y ! Yank the previously killed server (@code{gnus-server-yank-server}). ! @item c ! Copy the current server (@code{gnus-server-copy-server}). ! @item a ! Add a new server (@code{gnus-server-add-server}). ! @item e ! Edit a server (@code{gnus-server-edit-server}). ! @end table ! @node Example Methods ! @section Example Methods - Most select methods are pretty simple and self-explanatory: ! @lisp ! (nntp "news.funet.fi") ! @end lisp ! Reading directly from the spool is even simpler: ! @lisp ! (nnspool "") ! @end lisp ! As you can see, the first element in a select method is the name of the ! backend, and the second is the @dfn{address}, or @dfn{name}, if you ! will. ! After these two elements, there may be a random number of @var{(variable ! form)} pairs. ! To go back to the first example - imagine that you want to read from ! port @code{15} from that machine. This is what the select method should ! look like then: ! @lisp ! (nntp "news.funet.fi" (nntp-port-number 15)) ! @end lisp ! You should read the documentation to each backend to find out what ! variables are relevant, but here's an @code{nnmh} example. ! @code{nnmh} is a mail backend that reads a spool-like structure. Say ! you have two structures that you wish to access: One is your private ! mail spool, and the other is a public one. Here's the possible spec for ! you private mail: ! @lisp ! (nnmh "private" (nnmh-directory "~/private/mail/")) ! @end lisp ! (This server is then called @samp{private}, but you may have guessed ! that. ! Here's the method for the public spool: ! @lisp ! (nnmh "public" ! (nnmh-directory "/usr/information/spool/") ! (nnmh-get-new-mail nil)) ! @end lisp ! @node Servers & Methods ! @section Servers & Methods ! Wherever you would normally use a select method ! (eg. @code{gnus-secondary-select-method}, in the group select method, ! when browsing a foreign server) you can use a virtual server name ! instead. This could potentially save lots of typing. And it's nice all ! over. ! @node Various ! @chapter Various ! @menu ! * Interactive:: Making Gnus ask you many questions. ! * Windows Configuration:: Configuring the Gnus buffer windows. ! * Buttons:: Get tendinitis in ten easy steps! ! * Various Various:: Things that are really various. ! @end menu ! @node Interactive ! @section Interactive ! @cindex interaction ! @table @code ! @item gnus-novice-user ! @vindex gnus-novice-user ! If this variable is non-@code{nil}, you are either a newcomer to the ! World of Usenet, or you are very cautious, which is a nice thing to be, ! really. You will be given questions of the type "Are you sure you want ! to do this?" before doing anything dangerous. ! @item gnus-expert-user ! @vindex gnus-expert-user ! If this variable is non-@code{nil}, you will never ever be asked any ! questions by Gnus. It will simply assume you know what your are doing, ! no matter how strange. ! @item gnus-interactive-catchup ! @vindex gnus-interactive-catchup ! Require confirmation before catching up a group if non-@code{nil}. ! @item gnus-interactive-post ! @vindex gnus-interactive-post ! If non-@code{nil}, the user will be prompted for a group name when ! posting an article. ! @item gnus-interactive-exit ! @vindex gnus-interactive-exit ! Require confirmation before exiting Gnus. ! @end table ! @node Windows Configuration ! @section Windows Configuration ! @cindex windows configuration ! No, there's nothing here about X, so be quiet. ! @table @code ! @item gnus-use-full-window ! @vindex gnus-use-full-window ! If non-@code{nil}, Gnus will delete all other windows and occupy the ! entire Emacs screen by itself. It is @code{t} by default. ! @item gnus-buffer-configuration ! @vindex gnus-buffer-configuration ! This variable describes how much space each Gnus buffer should be given. ! Here's an excerpt of this variable: ! @lisp ! ((group ([group 1.0 point] ! (if gnus-carpal [group-carpal 4]))) ! (article ([summary 0.25 point] ! [article 1.0]))) ! @end lisp ! This is an alist. The @dfn{key} is a symbol that names some action or ! other. For instance, when displaying the group buffer, the window ! configuration function will use @code{group} as the key. A full list of ! possible names is listed below. ! The @dfn{value} is a @dfn{rule} that says how much space each buffer ! should occupy. To take the @code{article} rule as an example - ! @lisp ! (article ([summary 0.25 point] ! [article 1.0])) ! @end lisp - This rule says that the summary buffer should occupy 25% of the screen, - and that it is placed over the article buffer. As you may have noticed, - 100% + 25% is actually 125% (yup, I saw y'all reaching for that - calculator there). However, the special number @code{1.0} is used to - signal that this buffer should soak up all the rest of the space - available after the rest of the buffers have taken whatever they need. - There should be only one buffer with the @code{1.0} size spec. ! Point will be put in the buffer that has the optional third element ! @code{point}. ! Here's a more complicated example: ! @lisp ! (article ([group 4] ! [summary 0.25 point] ! (if gnus-carpal [summary-carpal 4]) ! [article 1.0]) ! @end lisp ! If the size spec is an integer instead of a floating point number, ! then that number will be used to say how many lines a buffer should ! occupy, not a percentage. ! If an element is a list instead of a vector, this list will be ! @code{eval}ed. If the result is non-@code{nil}, it will be used. This ! means that there will be three buffers if @code{gnus-carpal} is ! @code{nil}, and four buffers if @code{gnus-carpal} is non-@code{nil}. ! Not complicated enough for you? Well, try this on for size: - @lisp - (article ([group 1.0] - [gnus-carpal 4]) - ((horizontal 0.5) - [summary 0.25 point] - [summary-carpal 4] - [article 1.0])) - @end lisp ! Whoops. Two buffers with the mystery 100% tag. And what's that ! @code{horizontal} thingy? ! If the first element in one of the rule lists is a list with ! @code{horizontal} as the first element, Gnus will split the window ! horizontally, giving you two windows side-by-side. Inside each of these ! strips you may carry on all you like in the normal fashion. The number ! following @code{horizontal} says what percentage of the screen is to be ! given to this strip. ! ! For each horizontal split, there @emph{must} be one element that has the ! 100% tag. The splitting is never accurate, and this buffer will eat any ! leftover lines from the splits. ! Here's a list of all possible keys: ! @code{group}, @code{summary}, @code{article}, @code{server}, ! @code{browse}, @code{group-mail}, @code{summary-mail}, ! @code{summary-reply}, @code{info}, @code{summary-faq}, ! @code{edit-group}, @code{edit-server}, @code{reply}, @code{reply-yank}, ! @code{followup}, @code{followup-yank}, @code{edit-score}. ! @findex gnus-add-configuration ! Since this variable is so long and complicated, there's a function you ! can use to ease changing the config of a single setting: ! @code{gnus-add-configuration}. If, for instance, you want to change the ! @code{article} setting, you could say: ! @lisp ! (gnus-add-configuration ! '(article ([group 4] ! [summary .25 point] ! [article 1.0]))) ! @end lisp ! @end table ! @node Buttons ! @section Buttons ! @cindex buttons ! @cindex mouse ! @cindex click ! Those new-fangled @dfn{mouse} contraptions is very popular with the ! young, hep kids who don't want to learn the proper way to do things ! these days. Why, I remember way back in the summer of '89, when I was ! using Emacs on a Tops 20 system. Three hundred users on one single ! machine, and every user was running Simula compilers. Bah! ! Right. ! @vindex gnus-carpal ! Well, you can make Gnus display bufferfuls of buttons you can click to ! do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple, ! really. Tell the chiropractor I sent you. ! @table @code ! @item gnus-carpal-mode-hook ! @vindex gnus-carpal-mode-hook ! Hook run in all carpal mode buffers. ! @item gnus-carpal-button-face ! @vindex gnus-carpal-button-face ! Face used on buttons. ! @item gnus-carpal-group-buffer-buttons ! @vindex gnus-carpal-group-buffer-buttons ! Buttons in the group buffer. ! @item gnus-carpal-summary-buffer-buttons ! @vindex gnus-carpal-summary-buffer-buttons ! Buttons in the summary buffer. ! @item gnus-carpal-server-buffer-buttons ! @vindex gnus-carpal-server-buffer-buttons ! Buttons in the server buffer. ! @item gnus-carpal-browse-buffer-buttons ! @vindex gnus-carpal-browse-buffer-buttons ! Buttons in the browse buffer. ! @end table ! All the @code{buttons} variables are lists. The elements in these list ! is either a cons cell where the car contains a text to be displayed and ! the cdr contains a function symbol, or a simple string. ! @node Various Various ! @section Various Various ! @cindex mode lines ! @cindex highlights ! @table @code ! @item gnus-verbose ! @vindex gnus-verbose ! This variable is an integer between zero and ten. The higher the value, ! the more messages will be displayed. If this variable is zero, Gnus ! will never flash any messages, if it is seven, most important messages ! will be shown, and if it is ten, Gnus won't ever shut up, but will flash ! so many messages it will make your head swim. ! @item gnus-updated-mode-lines ! @vindex gnus-updated-mode-lines ! This is a list of buffers that should keep their mode lines updated. ! The list may contain the symbols @code{group}, @code{article} and ! @code{summary}. If the corresponding symbol is present, Gnus will keep ! that mode line updated with information that may be pertinent. If this ! variable is @code{nil}, screen refresh may be quicker. ! @cindex display-time ! @item gnus-mode-non-string-length ! @vindex gnus-mode-non-string-length ! By default, Gnus displays information on the current article in the mode ! lines of the summary and article buffers. The information Gnus wishes ! to display (eg. the subject of the article) is often longer than the ! mode lines, and therefore have to be cut off at some point. This ! variable says how long the other elements on the line is (i.e., the ! non-info part). If you put additional elements on the mode line (eg. a ! clock), you should modify this variable: ! @c Hook written by Keinonen Kari . ! @lisp ! (add-hook 'display-time-hook ! (lambda () ! (setq gnus-mode-non-string-length ! (+ 21 (length display-time-string))))) ! @end lisp ! @item gnus-visual ! @vindex gnus-visual ! If @code{nil}, Gnus won't attempt to create menus or use fancy colors ! or fonts. This will also inhibit loading the @file{gnus-visual.el} ! file. ! @item gnus-mouse-face ! @vindex gnus-mouse-face ! This is the face (i.e., font) used for mouse highlighting in Gnus. No ! mouse highlights will be done if @code{gnus-visual} is @code{nil}. ! @item gnus-display-type ! @vindex gnus-display-type ! This variable is symbol indicating the display Emacs is running under. ! The symbol should be one of @code{color}, @code{grayscale} or ! @code{mono}. If Gnus guesses this display attribute wrongly, either set ! this variable in your @file{~/.emacs} or set the resource ! @code{Emacs.displayType} in your @file{~/.Xdefaults}. ! @item gnus-background-mode ! @vindex gnus-background-mode ! This is a symbol indicating the Emacs background brightness. The symbol ! should be one of @code{light} or @code{dark}. If Gnus guesses this ! frame attribute wrongly, either set this variable in your @file{~/.emacs} or ! set the resource @code{Emacs.backgroundMode} in your @file{~/.Xdefaults}. ! `gnus-display-type'. @end table @node Customization ! @chapter Customization @cindex general customization --- 3629,11502 ---- read or killed the root in a previous session. ! When there is no real root of a thread, Gnus will have to fudge ! something. This variable says what fudging method Gnus should use. ! There are four possible values: ! ! @cindex adopting articles ! ! @table @code ! ! @item adopt ! Gnus will make the first of the orphaned articles the parent. This ! parent will adopt all the other articles. The adopted articles will be ! marked as such by pointy brackets (@samp{<>}) instead of the standard ! square brackets (@samp{[]}). This is the default method. ! ! @item dummy ! @vindex gnus-summary-dummy-line-format ! Gnus will create a dummy summary line that will pretend to be the ! parent. This dummy line does not correspond to any real article, so ! selecting it will just select the first real article after the dummy ! article. @code{gnus-summary-dummy-line-format} is used to specify the ! format of the dummy roots. It accepts only one format spec: @samp{S}, ! which is the subject of the article. @xref{Formatting Variables}. ! ! @item empty ! Gnus won't actually make any article the parent, but simply leave the ! subject field of all orphans except the first empty. (Actually, it will ! use @code{gnus-summary-same-subject} as the subject (@pxref{Summary ! Buffer Format}).) ! ! @item none ! Don't make any article parent at all. Just gather the threads and ! display them after one another. ! ! @item nil ! Don't gather loose threads. ! @end table ! ! @item gnus-thread-hide-subtree ! @vindex gnus-thread-hide-subtree ! If non-@code{nil}, all threads will be hidden when the summary buffer is ! generated. ! ! @item gnus-thread-hide-killed ! @vindex gnus-thread-hide-killed ! if you kill a thread and this variable is non-@code{nil}, the subtree ! will be hidden. ! ! @item gnus-thread-ignore-subject ! @vindex gnus-thread-ignore-subject ! Sometimes somebody changes the subject in the middle of a thread. If ! this variable is non-@code{nil}, the subject change is ignored. If it ! is @code{nil}, which is the default, a change in the subject will result ! in a new thread. ! ! @item gnus-thread-indent-level ! @vindex gnus-thread-indent-level ! This is a number that says how much each sub-thread should be indented. ! The default is @code{4}. ! @end table ! ! ! @node Thread Commands ! @subsection Thread Commands ! @cindex thread commands ! ! @table @kbd ! ! @item T k ! @itemx M-C-k ! @kindex T k (Summary) ! @kindex M-C-k (Summary) ! @findex gnus-summary-kill-thread ! Mark all articles in the current sub-thread as read ! (@code{gnus-summary-kill-thread}). If the prefix argument is positive, ! remove all marks instead. If the prefix argument is negative, tick ! articles instead. ! ! @item T l ! @itemx M-C-l ! @kindex T l (Summary) ! @kindex M-C-l (Summary) ! @findex gnus-summary-lower-thread ! Lower the score of the current thread ! (@code{gnus-summary-lower-thread}). ! ! @item T i ! @kindex T i (Summary) ! @findex gnus-summary-raise-thread ! Increase the score of the current thread ! (@code{gnus-summary-raise-thread}). ! ! @item T # ! @kindex T # (Summary) ! @findex gnus-uu-mark-thread ! Set the process mark on the current thread ! (@code{gnus-uu-mark-thread}). ! ! @item T M-# ! @kindex T M-# (Summary) ! @findex gnus-uu-unmark-thread ! Remove the process mark from the current thread ! (@code{gnus-uu-unmark-thread}). ! ! @item T T ! @kindex T T (Summary) ! @findex gnus-summary-toggle-threads ! Toggle threading (@code{gnus-summary-toggle-threads}). ! ! @item T s ! @kindex T s (Summary) ! @findex gnus-summary-show-thread ! Expose the thread hidden under the current article, if any ! (@code{gnus-summary-show-thread}). ! ! @item T h ! @kindex T h (Summary) ! @findex gnus-summary-hide-thread ! Hide the current (sub)thread (@code{gnus-summary-hide-thread}). ! ! @item T S ! @kindex T S (Summary) ! @findex gnus-summary-show-all-threads ! Expose all hidden threads (@code{gnus-summary-show-all-threads}). ! ! @item T H ! @kindex T H (Summary) ! @findex gnus-summary-hide-all-threads ! Hide all threads (@code{gnus-summary-hide-all-threads}). ! ! @item T t ! @kindex T t (Summary) ! @findex gnus-summary-rethread-current ! Re-thread the thread the current article is part of ! (@code{gnus-summary-rethread-current}). This works even when the ! summary buffer is otherwise unthreaded. ! ! @item T ^ ! @kindex T ^ (Summary) ! @findex gnus-summary-reparent-thread ! Make the current article the child of the marked (or previous) article ! (@code{gnus-summary-reparent-thread}. ! ! @end table ! ! The following commands are thread movement commands. They all ! understand the numeric prefix. ! ! @table @kbd ! ! @item T n ! @kindex T n (Summary) ! @findex gnus-summary-next-thread ! Go to the next thread (@code{gnus-summary-next-thread}). ! ! @item T p ! @kindex T p (Summary) ! @findex gnus-summary-prev-thread ! Go to the previous thread (@code{gnus-summary-prev-thread}). ! ! @item T d ! @kindex T d (Summary) ! @findex gnus-summary-down-thread ! Descend the thread (@code{gnus-summary-down-thread}). ! ! @item T u ! @kindex T u (Summary) ! @findex gnus-summary-up-thread ! Ascend the thread (@code{gnus-summary-up-thread}). ! ! @item T o ! @kindex T o (Summary) ! @findex gnus-summary-top-thread ! Go to the top of the thread (@code{gnus-summary-top-thread}). ! @end table ! ! @vindex gnus-thread-operation-ignore-subject ! If you ignore subject while threading, you'll naturally end up with ! threads that have several different subjects in them. If you then issue ! a command like `T k' (@code{gnus-summary-kill-thread}) you might not ! wish to kill the entire thread, but just those parts of the thread that ! have the same subject as the current article. If you like this idea, ! you can fiddle with @code{gnus-thread-operation-ignore-subject}. If is ! is non-@code{nil} (which it is by default), subjects will be ignored ! when doing thread commands. If this variable is @code{nil}, articles in ! the same thread with different subjects will not be included in the ! operation in question. If this variable is @code{fuzzy}, only articles ! that have subjects that are fuzzily equal will be included. ! ! ! @node Sorting ! @section Sorting ! ! @findex gnus-thread-sort-by-total-score ! @findex gnus-thread-sort-by-date ! @findex gnus-thread-sort-by-score ! @findex gnus-thread-sort-by-subject ! @findex gnus-thread-sort-by-author ! @findex gnus-thread-sort-by-number ! @vindex gnus-thread-sort-functions ! If you are using a threaded summary display, you can sort the threads by ! setting @code{gnus-thread-sort-functions}, which is a list of functions. ! By default, sorting is done on article numbers. Ready-made sorting ! predicate functions include @code{gnus-thread-sort-by-number}, ! @code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, ! @code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and ! @code{gnus-thread-sort-by-total-score}. ! ! Each function takes two threads and return non-@code{nil} if the first ! thread should be sorted before the other. Note that sorting really is ! normally done by looking only at the roots of each thread. If you use ! more than one function, the primary sort key should be the last function ! in the list. You should probably always include ! @code{gnus-thread-sort-by-number} in the list of sorting ! functions---preferably first. This will ensure that threads that are ! equal with respect to the other sort criteria will be displayed in ! ascending article order. ! ! If you would like to sort by score, then by subject, and finally by ! number, you could do something like: ! ! @lisp ! (setq gnus-thread-sort-functions ! '(gnus-thread-sort-by-number ! gnus-thread-sort-by-subject ! gnus-thread-sort-by-score)) ! @end lisp ! ! The threads that have highest score will be displayed first in the ! summary buffer. When threads have the same score, they will be sorted ! alphabetically. The threads that have the same score and the same ! subject will be sorted by number, which is (normally) the sequence in ! which the articles arrived. ! ! If you want to sort by score and then reverse arrival order, you could ! say something like: ! ! @lisp ! (setq gnus-thread-sort-functions ! '((lambda (t1 t2) ! (not (gnus-thread-sort-by-number t1 t2))) ! gnus-thread-sort-by-score)) ! @end lisp ! ! @vindex gnus-thread-score-function ! The function in the @code{gnus-thread-score-function} variable (default ! @code{+}) is used for calculating the total score of a thread. Useful ! functions might be @code{max}, @code{min}, or squared means, or whatever ! tickles your fancy. ! ! @findex gnus-article-sort-functions ! @findex gnus-article-sort-by-date ! @findex gnus-article-sort-by-score ! @findex gnus-article-sort-by-subject ! @findex gnus-article-sort-by-author ! @findex gnus-article-sort-by-number ! If you are using an unthreaded display for some strange reason or other, ! you have to fiddle with the @code{gnus-article-sort-functions} variable. ! It is very similar to the @code{gnus-thread-sort-functions}, except that ! is uses slightly different functions for article comparison. Available ! sorting predicate functions are @code{gnus-article-sort-by-number}, ! @code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject}, ! @code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}. ! ! If you want to sort an unthreaded summary display by subject, you could ! say something like: ! ! @lisp ! (setq gnus-article-sort-functions ! '(gnus-article-sort-by-number ! gnus-article-sort-by-subject)) ! @end lisp ! ! ! ! @node Asynchronous Fetching ! @section Asynchronous Article Fetching ! @cindex asynchronous article fetching ! ! If you read your news from an @sc{nntp} server that's far away, the ! network latencies may make reading articles a chore. You have to wait ! for a while after pressing @kbd{n} to go to the next article before the ! article appears. Why can't Gnus just go ahead and fetch the article ! while you are reading the previous one? Why not, indeed. ! ! First, some caveats. There are some pitfalls to using asynchronous ! article fetching, especially the way Gnus does it. ! ! Let's say you are reading article 1, which is short, and article 2 is ! quite long, and you are not interested in reading that. Gnus does not ! know this, so it goes ahead and fetches article 2. You decide to read ! article 3, but since Gnus is in the process of fetching article 2, the ! connection is blocked. ! ! To avoid these situations, Gnus will open two (count 'em two) ! connections to the server. Some people may think this isn't a very nice ! thing to do, but I don't see any real alternatives. Setting up that ! extra connection takes some time, so Gnus startup will be slower. ! ! Gnus will fetch more articles than you will read. This will mean that ! the link between your machine and the @sc{nntp} server will become more ! loaded than if you didn't use article pre-fetch. The server itself will ! also become more loaded---both with the extra article requests, and the ! extra connection. ! ! Ok, so now you know that you shouldn't really use this thing... unless ! you really want to. ! ! @vindex gnus-asynchronous ! Here's how: Set @code{gnus-asynchronous} to @code{t}. The rest should ! happen automatically. ! ! @vindex nntp-async-number ! You can control how many articles that are to be pre-fetched by setting ! @code{nntp-async-number}. This is five by default, which means that when ! you read an article in the group, @code{nntp} will pre-fetch the next ! five articles. If this variable is @code{t}, @code{nntp} will pre-fetch ! all the articles that it can without bound. If it is @code{nil}, no ! pre-fetching will be made. ! ! @vindex gnus-asynchronous-article-function ! You may wish to create some sort of scheme for choosing which articles ! that @code{nntp} should consider as candidates for pre-fetching. For ! instance, you may wish to pre-fetch all articles with high scores, and ! not pre-fetch low-scored articles. You can do that by setting the ! @code{gnus-asynchronous-article-function}, which will be called with an ! alist where the keys are the article numbers. Your function should ! return an alist where the articles you are not interested in have been ! removed. You could also do sorting on article score and the like. ! ! ! @node Article Caching ! @section Article Caching ! @cindex article caching ! @cindex caching ! ! If you have an @emph{extremely} slow @sc{nntp} connection, you may ! consider turning article caching on. Each article will then be stored ! locally under your home directory. As you may surmise, this could ! potentially use @emph{huge} amounts of disk space, as well as eat up all ! your inodes so fast it will make your head swim. In vodka. ! ! Used carefully, though, it could be just an easier way to save articles. ! ! @vindex gnus-use-long-file-name ! @vindex gnus-cache-directory ! @vindex gnus-use-cache ! To turn caching on, set @code{gnus-use-cache} to @code{t}. By default, ! all articles that are ticked or marked as dormant will then be copied ! over to your local cache (@code{gnus-cache-directory}). Whether this ! cache is flat or hierarchal is controlled by the ! @code{gnus-use-long-file-name} variable, as usual. ! ! When re-select a ticked or dormant article, it will be fetched from the ! cache instead of from the server. As articles in your cache will never ! expire, this might serve as a method of saving articles while still ! keeping them where they belong. Just mark all articles you want to save ! as dormant, and don't worry. ! ! When an article is marked as read, is it removed from the cache. ! ! @vindex gnus-cache-remove-articles ! @vindex gnus-cache-enter-articles ! The entering/removal of articles from the cache is controlled by the ! @code{gnus-cache-enter-articles} and @code{gnus-cache-remove-articles} ! variables. Both are lists of symbols. The first is @code{(ticked ! dormant)} by default, meaning that ticked and dormant articles will be ! put in the cache. The latter is @code{(read)} by default, meaning that ! articles that are marked as read are removed from the cache. Possibly ! symbols in these two lists are @code{ticked}, @code{dormant}, ! @code{unread} and @code{read}. ! ! @findex gnus-jog-cache ! So where does the massive article-fetching and storing come into the ! picture? The @code{gnus-jog-cache} command will go through all ! subscribed newsgroups, request all unread articles, and store them in ! the cache. You should only ever, ever ever ever, use this command if 1) ! your connection to the @sc{nntp} server is really, really, really slow ! and 2) you have a really, really, really huge disk. Seriously. ! ! @vindex gnus-uncacheable-groups ! It is likely that you do not want caching on some groups. For instance, ! if your @code{nnml} mail is located under your home directory, it makes no ! sense to cache it somewhere else under your home directory. Unless you ! feel that it's neat to use twice as much space. To limit the caching, ! you could set the @code{gnus-uncacheable-groups} regexp to ! @samp{^nnml}, for instance. This variable is @code{nil} by ! default. ! ! @findex gnus-cache-generate-nov-databases ! @findex gnus-cache-generate-active ! @vindex gnus-cache-active-file ! The cache stores information on what articles it contains in its active ! file (@code{gnus-cache-active-file}). If this file (or any other parts ! of the cache) becomes all messed up for some reason or other, Gnus ! offers two functions that will try to set things right. @kbd{M-x ! gnus-cache-generate-nov-databases} will (re)build all the @sc{nov} ! files, and @kbd{gnus-cache-generate-active} will (re)generate the active ! file. ! ! ! @node Persistent Articles ! @section Persistent Articles ! @cindex persistent articles ! ! Closely related to article caching, we have @dfn{persistent articles}. ! In fact, it's just a different way of looking at caching, and much more ! useful in my opinion. ! ! Say you're reading a newsgroup, and you happen on to some valuable gem ! that you want to keep and treasure forever. You'd normally just save it ! (using one of the many saving commands) in some file. The problem with ! that is that it's just, well, yucky. Ideally you'd prefer just having ! the article remain in the group where you found it forever; untouched by ! the expiry going on at the news server. ! ! This is what a @dfn{persistent article} is---an article that just won't ! be deleted. It's implemented using the normal cache functions, but ! you use two explicit commands for managing persistent articles: ! ! @table @kbd ! ! @item * ! @kindex * (Summary) ! @findex gnus-cache-enter-article ! Make the current article persistent (@code{gnus-cache-enter-article}). ! ! @item M-* ! @kindex M-* (Summary) ! @findex gnus-cache-remove-article ! Remove the current article from the persistent articles ! (@code{gnus-cache-remove-article}). This will normally delete the ! article. ! @end table ! ! Both these commands understand the process/prefix convention. ! ! To avoid having all ticked articles (and stuff) entered into the cache, ! you should set @code{gnus-use-cache} to @code{passive} if you're just ! interested in persistent articles: ! ! @lisp ! (setq gnus-use-cache 'passive) ! @end lisp ! ! ! @node Article Backlog ! @section Article Backlog ! @cindex backlog ! @cindex article backlog ! ! If you have a slow connection, but the idea of using caching seems ! unappealing to you (and it is, really), you can help the situation some ! by switching on the @dfn{backlog}. This is where Gnus will buffer ! already read articles so that it doesn't have to re-fetch articles ! you've already read. This only helps if you are in the habit of ! re-selecting articles you've recently read, of course. If you never do ! that, turning the backlog on will slow Gnus down a little bit, and ! increase memory usage some. ! ! @vindex gnus-keep-backlog ! If you set @code{gnus-keep-backlog} to a number @var{n}, Gnus will store ! at most @var{n} old articles in a buffer for later re-fetching. If this ! variable is non-@code{nil} and is not a number, Gnus will store ! @emph{all} read articles, which means that your Emacs will grow without ! bound before exploding and taking your machine down with you. I put ! that in there just to keep y'all on your toes. ! ! This variable is @code{nil} by default. ! ! ! @node Saving Articles ! @section Saving Articles ! @cindex saving articles ! ! Gnus can save articles in a number of ways. Below is the documentation ! for saving articles in a fairly straight-forward fashion (i.e., little ! processing of the article is done before it is saved). For a different ! approach (uudecoding, unsharing) you should use @code{gnus-uu} ! (@pxref{Decoding Articles}). ! ! @vindex gnus-save-all-headers ! If @code{gnus-save-all-headers} is non-@code{nil}, Gnus will not delete ! unwanted headers before saving the article. ! ! @vindex gnus-saved-headers ! If the preceding variable is @code{nil}, all headers that match the ! @code{gnus-saved-headers} regexp will be kept, while the rest will be ! deleted before saving. ! ! @table @kbd ! ! @item O o ! @itemx o ! @kindex O o (Summary) ! @kindex o (Summary) ! @findex gnus-summary-save-article ! Save the current article using the default article saver ! (@code{gnus-summary-save-article}). ! ! @item O m ! @kindex O m (Summary) ! @findex gnus-summary-save-article-mail ! Save the current article in mail format ! (@code{gnus-summary-save-article-mail}). ! ! @item O r ! @kindex O r (Summary) ! @findex gnus-summary-save-article-rmail ! Save the current article in rmail format ! (@code{gnus-summary-save-article-rmail}). ! ! @item O f ! @kindex O f (Summary) ! @findex gnus-summary-save-article-file ! Save the current article in plain file format ! (@code{gnus-summary-save-article-file}). ! ! @item O b ! @kindex O b (Summary) ! @findex gnus-summary-save-article-body-file ! Save the current article body in plain file format ! (@code{gnus-summary-save-article-body-file}). ! ! @item O h ! @kindex O h (Summary) ! @findex gnus-summary-save-article-folder ! Save the current article in mh folder format ! (@code{gnus-summary-save-article-folder}). ! ! @item O v ! @kindex O v (Summary) ! @findex gnus-summary-save-article-vm ! Save the current article in a VM folder ! (@code{gnus-summary-save-article-vm}). ! ! @item O p ! @kindex O p (Summary) ! @findex gnus-summary-pipe-output ! Save the current article in a pipe. Uhm, like, what I mean is---Pipe ! the current article to a process (@code{gnus-summary-pipe-output}). ! @end table ! ! @vindex gnus-prompt-before-saving ! All these commands use the process/prefix convention ! (@pxref{Process/Prefix}). If you save bunches of articles using these ! functions, you might get tired of being prompted for files to save each ! and every article in. The prompting action is controlled by ! the @code{gnus-prompt-before-saving} variable, which is @code{always} by ! default, giving you that excessive prompting action you know and ! loathe. If you set this variable to @code{t} instead, you'll be prompted ! just once for each series of articles you save. If you like to really ! have Gnus do all your thinking for you, you can even set this variable ! to @code{nil}, which means that you will never be prompted for files to ! save articles in. Gnus will simply save all the articles in the default ! files. ! ! ! @vindex gnus-default-article-saver ! You can customize the @code{gnus-default-article-saver} variable to make ! Gnus do what you want it to. You can use any of the four ready-made ! functions below, or you can create your own. ! ! @table @code ! ! @item gnus-summary-save-in-rmail ! @findex gnus-summary-save-in-rmail ! @vindex gnus-rmail-save-name ! @findex gnus-plain-save-name ! This is the default format, @dfn{babyl}. Uses the function in the ! @code{gnus-rmail-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-plain-save-name}. ! ! @item gnus-summary-save-in-mail ! @findex gnus-summary-save-in-mail ! @vindex gnus-mail-save-name ! Save in a Unix mail (mbox) file. Uses the function in the ! @code{gnus-mail-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-plain-save-name}. ! ! @item gnus-summary-save-in-file ! @findex gnus-summary-save-in-file ! @vindex gnus-file-save-name ! @findex gnus-numeric-save-name ! Append the article straight to an ordinary file. Uses the function in ! the @code{gnus-file-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-numeric-save-name}. ! ! @item gnus-summary-save-body-in-file ! @findex gnus-summary-save-body-in-file ! Append the article body to an ordinary file. Uses the function in the ! @code{gnus-file-save-name} variable to get a file name to save the ! article in. The default is @code{gnus-numeric-save-name}. ! ! @item gnus-summary-save-in-folder ! @findex gnus-summary-save-in-folder ! @findex gnus-folder-save-name ! @findex gnus-Folder-save-name ! @vindex gnus-folder-save-name ! @cindex rcvstore ! @cindex MH folders ! Save the article to an MH folder using @code{rcvstore} from the MH ! library. Uses the function in the @code{gnus-folder-save-name} variable ! to get a file name to save the article in. The default is ! @code{gnus-folder-save-name}, but you can also use ! @code{gnus-Folder-save-name}. The former creates capitalized names, and ! the latter does not. ! ! @item gnus-summary-save-in-vm ! @findex gnus-summary-save-in-vm ! Save the article in a VM folder. You have to have the VM mail ! reader to use this setting. ! @end table ! ! @vindex gnus-article-save-directory ! All of these functions, except for the last one, will save the article ! in the @code{gnus-article-save-directory}, which is initialized from the ! @code{SAVEDIR} environment variable. This is @file{~/News/} by ! default. ! ! As you can see above, the functions use different functions to find a ! suitable name of a file to save the article in. Below is a list of ! available functions that generate names: ! ! @table @code ! ! @item gnus-Numeric-save-name ! @findex gnus-Numeric-save-name ! Generates file names that look like @file{~/News/Alt.andrea-dworkin/45}. ! ! @item gnus-numeric-save-name ! @findex gnus-numeric-save-name ! Generates file names that look like @file{~/News/alt.andrea-dworkin/45}. ! ! @item gnus-Plain-save-name ! @findex gnus-Plain-save-name ! Generates file names that look like @file{~/News/Alt.andrea-dworkin}. ! ! @item gnus-plain-save-name ! @findex gnus-plain-save-name ! Generates file names that look like @file{~/News/alt.andrea-dworkin}. ! @end table ! ! @vindex gnus-split-methods ! You can have Gnus suggest where to save articles by plonking a regexp into ! the @code{gnus-split-methods} alist. For instance, if you would like to ! save articles related to Gnus in the file @file{gnus-stuff}, and articles ! related to VM in @code{vm-stuff}, you could set this variable to something ! like: ! ! @lisp ! (("^Subject:.*gnus\\|^Newsgroups:.*gnus" "gnus-stuff") ! ("^Subject:.*vm\\|^Xref:.*vm" "vm-stuff") ! (my-choosing-function "../other-dir/my-stuff") ! ((equal gnus-newsgroup-name "mail.misc") "mail-stuff")) ! @end lisp ! ! We see that this is a list where each element is a list that has two ! elements---the @dfn{match} and the @dfn{file}. The match can either be ! a string (in which case it is used as a regexp to match on the article ! head); it can be a symbol (which will be called as a function with the ! group name as a parameter); or it can be a list (which will be ! @code{eval}ed). If any of these actions have a non-@code{nil} result, ! the @dfn{file} will be used as a default prompt. In addition, the ! result of the operation itself will be used if the function or form ! called returns a string or a list of strings. ! ! You basically end up with a list of file names that might be used when ! saving the current article. (All ``matches'' will be used.) You will ! then be prompted for what you really want to use as a name, with file ! name completion over the results from applying this variable. ! ! This variable is @code{((gnus-article-archive-name))} by default, which ! means that Gnus will look at the articles it saves for an ! @code{Archive-name} line and use that as a suggestion for the file ! name. ! ! @vindex gnus-use-long-file-name ! Finally, you have the @code{gnus-use-long-file-name} variable. If it is ! @code{nil}, all the preceding functions will replace all periods ! (@samp{.}) in the group names with slashes (@samp{/})---which means that ! the functions will generate hierarchies of directories instead of having ! all the files in the toplevel directory ! (@file{~/News/alt/andrea-dworkin} instead of ! @file{~/News/alt.andrea-dworkin}.) This variable is @code{t} by default ! on most systems. However, for historical reasons, this is @code{nil} on ! Xenix and usg-unix-v machines by default. ! ! This function also affects kill and score file names. If this variable ! is a list, and the list contains the element @code{not-score}, long file ! names will not be used for score files, if it contains the element ! @code{not-save}, long file names will not be used for saving, and if it ! contains the element @code{not-kill}, long file names will not be used ! for kill files. ! ! If you'd like to save articles in a hierarchy that looks something like ! a spool, you could ! ! @lisp ! (setq gnus-use-long-file-name '(not-save)) ; to get a hierarchy ! (setq gnus-default-article-save 'gnus-summary-save-in-file) ; no encoding ! @end lisp ! ! Then just save with @kbd{o}. You'd then read this hierarchy with ! ephemeral @code{nneething} groups---@kbd{G D} in the group buffer, and ! the toplevel directory as the argument (@file{~/News/}). Then just walk ! around to the groups/directories with @code{nneething}. ! ! ! @node Decoding Articles ! @section Decoding Articles ! @cindex decoding articles ! ! Sometime users post articles (or series of articles) that have been ! encoded in some way or other. Gnus can decode them for you. ! ! @menu ! * Uuencoded Articles:: Uudecode articles. ! * Shared Articles:: Unshar articles. ! * PostScript Files:: Split PostScript. ! * Decoding Variables:: Variables for a happy decoding. ! * Viewing Files:: You want to look at the result of the decoding? ! @end menu ! ! All these functions use the process/prefix convention ! (@pxref{Process/Prefix}) for finding out what articles to work on, with ! the extension that a ``single article'' means ``a single series''. Gnus ! can find out by itself what articles belong to a series, decode all the ! articles and unpack/view/save the resulting file(s). ! ! Gnus guesses what articles are in the series according to the following ! simplish rule: The subjects must be (nearly) identical, except for the ! last two numbers of the line. (Spaces are largely ignored, however.) ! ! For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus ! will find all the articles that match the regexp @samp{^cat.gif ! ([0-9]+/[0-9]+).*$}. ! ! Subjects that are nonstandard, like @samp{cat.gif (2/3) Part 6 of a ! series}, will not be properly recognized by any of the automatic viewing ! commands, and you have to mark the articles manually with @kbd{#}. ! ! ! @node Uuencoded Articles ! @subsection Uuencoded Articles ! @cindex uudecode ! @cindex uuencoded articles ! ! @table @kbd ! ! @item X u ! @kindex X u (Summary) ! @findex gnus-uu-decode-uu ! Uudecodes the current series (@code{gnus-uu-decode-uu}). ! ! @item X U ! @kindex X U (Summary) ! @findex gnus-uu-decode-uu-and-save ! Uudecodes and saves the current series ! (@code{gnus-uu-decode-uu-and-save}). ! ! @item X v u ! @kindex X v u (Summary) ! @findex gnus-uu-decode-uu-view ! Uudecodes and views the current series (@code{gnus-uu-decode-uu-view}). ! ! @item X v U ! @kindex X v U (Summary) ! @findex gnus-uu-decode-uu-and-save-view ! Uudecodes, views and saves the current series ! (@code{gnus-uu-decode-uu-and-save-view}). ! @end table ! ! Remember that these all react to the presence of articles marked with ! the process mark. If, for instance, you'd like to decode and save an ! entire newsgroup, you'd typically do @kbd{M P a} ! (@code{gnus-uu-mark-all}) and then @kbd{X U} ! (@code{gnus-uu-decode-uu-and-save}). ! ! All this is very much different from how @code{gnus-uu} worked with ! @sc{gnus 4.1}, where you had explicit keystrokes for everything under ! the sun. This version of @code{gnus-uu} generally assumes that you mark ! articles in some way (@pxref{Setting Process Marks}) and then press ! @kbd{X u}. ! ! @vindex gnus-uu-notify-files ! Note: When trying to decode articles that have names matching ! @code{gnus-uu-notify-files}, which is hard-coded to ! @samp{[Cc][Ii][Nn][Dd][Yy][0-9]+.\\(gif\\|jpg\\)}, @code{gnus-uu} will ! automatically post an article on @samp{comp.unix.wizards} saying that ! you have just viewed the file in question. This feature can't be turned ! off. ! ! ! @node Shared Articles ! @subsection Shared Articles ! @cindex unshar ! @cindex shared articles ! ! @table @kbd ! ! @item X s ! @kindex X s (Summary) ! @findex gnus-uu-decode-unshar ! Unshars the current series (@code{gnus-uu-decode-unshar}). ! ! @item X S ! @kindex X S (Summary) ! @findex gnus-uu-decode-unshar-and-save ! Unshars and saves the current series (@code{gnus-uu-decode-unshar-and-save}). ! ! @item X v s ! @kindex X v s (Summary) ! @findex gnus-uu-decode-unshar-view ! Unshars and views the current series (@code{gnus-uu-decode-unshar-view}). ! ! @item X v S ! @kindex X v S (Summary) ! @findex gnus-uu-decode-unshar-and-save-view ! Unshars, views and saves the current series ! (@code{gnus-uu-decode-unshar-and-save-view}). ! @end table ! ! ! @node PostScript Files ! @subsection PostScript Files ! @cindex PostScript ! ! @table @kbd ! ! @item X p ! @kindex X p (Summary) ! @findex gnus-uu-decode-postscript ! Unpack the current PostScript series (@code{gnus-uu-decode-postscript}). ! ! @item X P ! @kindex X P (Summary) ! @findex gnus-uu-decode-postscript-and-save ! Unpack and save the current PostScript series ! (@code{gnus-uu-decode-postscript-and-save}). ! ! @item X v p ! @kindex X v p (Summary) ! @findex gnus-uu-decode-postscript-view ! View the current PostScript series ! (@code{gnus-uu-decode-postscript-view}). ! ! @item X v P ! @kindex X v P (Summary) ! @findex gnus-uu-decode-postscript-and-save-view ! View and save the current PostScript series ! (@code{gnus-uu-decode-postscript-and-save-view}). ! @end table ! ! ! @node Decoding Variables ! @subsection Decoding Variables ! ! Adjective, not verb. ! ! @menu ! * Rule Variables:: Variables that say how a file is to be viewed. ! * Other Decode Variables:: Other decode variables. ! * Uuencoding and Posting:: Variables for customizing uuencoding. ! @end menu ! ! ! @node Rule Variables ! @subsubsection Rule Variables ! @cindex rule variables ! ! Gnus uses @dfn{rule variables} to decide how to view a file. All these ! variables are on the form ! ! @lisp ! (list '(regexp1 command2) ! '(regexp2 command2) ! ...) ! @end lisp ! ! @table @code ! ! @item gnus-uu-user-view-rules ! @vindex gnus-uu-user-view-rules ! @cindex sox ! This variable is consulted first when viewing files. If you wish to use, ! for instance, @code{sox} to convert an @samp{.au} sound file, you could ! say something like: ! @lisp ! (setq gnus-uu-user-view-rules ! (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) ! @end lisp ! ! @item gnus-uu-user-view-rules-end ! @vindex gnus-uu-user-view-rules-end ! This variable is consulted if Gnus couldn't make any matches from the ! user and default view rules. ! ! @item gnus-uu-user-archive-rules ! @vindex gnus-uu-user-archive-rules ! This variable can be used to say what commands should be used to unpack ! archives. ! @end table ! ! ! @node Other Decode Variables ! @subsubsection Other Decode Variables ! ! @table @code ! @vindex gnus-uu-grabbed-file-functions ! ! @item gnus-uu-grabbed-file-functions ! All functions in this list will be called right each file has been ! successfully decoded---so that you can move or view files right away, ! and don't have to wait for all files to be decoded before you can do ! anything. Ready-made functions you can put in this list are: ! ! @table @code ! ! @item gnus-uu-grab-view ! @findex gnus-uu-grab-view ! View the file. ! ! @item gnus-uu-grab-move ! @findex gnus-uu-grab-move ! Move the file (if you're using a saving function.) ! @end table ! ! @item gnus-uu-ignore-files-by-name ! @vindex gnus-uu-ignore-files-by-name ! Files with name matching this regular expression won't be viewed. ! ! @item gnus-uu-ignore-files-by-type ! @vindex gnus-uu-ignore-files-by-type ! Files with a @sc{mime} type matching this variable won't be viewed. ! Note that Gnus tries to guess what type the file is based on the name. ! @code{gnus-uu} is not a @sc{mime} package (yet), so this is slightly ! kludgey. ! ! @item gnus-uu-tmp-dir ! @vindex gnus-uu-tmp-dir ! Where @code{gnus-uu} does its work. ! ! @item gnus-uu-do-not-unpack-archives ! @vindex gnus-uu-do-not-unpack-archives ! Non-@code{nil} means that @code{gnus-uu} won't peek inside archives ! looking for files to display. ! ! @item gnus-uu-view-and-save ! @vindex gnus-uu-view-and-save ! Non-@code{nil} means that the user will always be asked to save a file ! after viewing it. ! ! @item gnus-uu-ignore-default-view-rules ! @vindex gnus-uu-ignore-default-view-rules ! Non-@code{nil} means that @code{gnus-uu} will ignore the default viewing ! rules. ! ! @item gnus-uu-ignore-default-archive-rules ! @vindex gnus-uu-ignore-default-archive-rules ! Non-@code{nil} means that @code{gnus-uu} will ignore the default archive ! unpacking commands. ! ! @item gnus-uu-kill-carriage-return ! @vindex gnus-uu-kill-carriage-return ! Non-@code{nil} means that @code{gnus-uu} will strip all carriage returns ! from articles. ! ! @item gnus-uu-unmark-articles-not-decoded ! @vindex gnus-uu-unmark-articles-not-decoded ! Non-@code{nil} means that @code{gnus-uu} will mark articles that were ! unsuccessfully decoded as unread. ! ! @item gnus-uu-correct-stripped-uucode ! @vindex gnus-uu-correct-stripped-uucode ! Non-@code{nil} means that @code{gnus-uu} will @emph{try} to fix ! uuencoded files that have had trailing spaces deleted. ! ! @item gnus-uu-view-with-metamail ! @vindex gnus-uu-view-with-metamail ! @cindex metamail ! Non-@code{nil} means that @code{gnus-uu} will ignore the viewing ! commands defined by the rule variables and just fudge a @sc{mime} ! content type based on the file name. The result will be fed to ! @code{metamail} for viewing. ! ! @item gnus-uu-save-in-digest ! @vindex gnus-uu-save-in-digest ! Non-@code{nil} means that @code{gnus-uu}, when asked to save without ! decoding, will save in digests. If this variable is @code{nil}, ! @code{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, so I ! simply dropped them. ! ! @end table ! ! ! @node Uuencoding and Posting ! @subsubsection Uuencoding and Posting ! ! @table @code ! ! @item gnus-uu-post-include-before-composing ! @vindex gnus-uu-post-include-before-composing ! Non-@code{nil} means that @code{gnus-uu} will ask for a file to encode ! before you compose the article. If this variable is @code{t}, you can ! either include an encoded file with @kbd{C-c C-i} or have one included ! for you when you post the article. ! ! @item gnus-uu-post-length ! @vindex gnus-uu-post-length ! Maximum length of an article. The encoded file will be split into how ! many articles it takes to post the entire file. ! ! @item gnus-uu-post-threaded ! @vindex gnus-uu-post-threaded ! Non-@code{nil} means that @code{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---@code{gnus-uu}, but somehow, I don't ! think that counts...) Default is @code{nil}. ! ! @item gnus-uu-post-separate-description ! @vindex gnus-uu-post-separate-description ! Non-@code{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 @code{nil}, the description the user enters will be included ! at the beginning of the first article, which will be numbered (1/x). ! Default is @code{t}. ! ! @end table ! ! ! @node Viewing Files ! @subsection Viewing Files ! @cindex viewing files ! @cindex pseudo-articles ! ! After decoding, if the file is some sort of archive, Gnus will attempt ! to unpack the archive and see if any of the files in the archive can be ! viewed. For instance, if you have a gzipped tar file @file{pics.tar.gz} ! containing the files @file{pic1.jpg} and @file{pic2.gif}, Gnus will ! uncompress and de-tar the main file, and then view the two pictures. ! This unpacking process is recursive, so if the archive contains archives ! of archives, it'll all be unpacked. ! ! Finally, Gnus will normally insert a @dfn{pseudo-article} for each ! extracted file into the summary buffer. If you go to these ! ``articles'', you will be prompted for a command to run (usually Gnus ! will make a suggestion), and then the command will be run. ! ! @vindex gnus-view-pseudo-asynchronously ! If @code{gnus-view-pseudo-asynchronously} is @code{nil}, Emacs will wait ! until the viewing is done before proceeding. ! ! @vindex gnus-view-pseudos ! If @code{gnus-view-pseudos} is @code{automatic}, Gnus will not insert ! the pseudo-articles into the summary buffer, but view them ! immediately. If this variable is @code{not-confirm}, the user won't even ! be asked for a confirmation before viewing is done. ! ! @vindex gnus-view-pseudos-separately ! If @code{gnus-view-pseudos-separately} is non-@code{nil}, one ! pseudo-article will be created for each file to be viewed. If ! @code{nil}, all files that use the same viewing command will be given as ! a list of parameters to that command. ! ! @vindex gnus-insert-pseudo-articles ! If @code{gnus-insert-pseudo-articles} is non-@code{nil}, insert ! pseudo-articles when decoding. It is @code{t} by default. ! ! So; there you are, reading your @emph{pseudo-articles} in your ! @emph{virtual newsgroup} from the @emph{virtual server}; and you think: ! Why isn't anything real anymore? How did we get here? ! ! ! @node Article Treatment ! @section Article Treatment ! ! Reading through this huge manual, you may have quite forgotten that the ! object of newsreaders are to actually, like, read what people have ! written. Reading articles. Unfortunately, people are quite bad at ! writing, so there are tons of functions and variables to make reading ! these articles easier. ! ! @menu ! * Article Highlighting:: You want to make the article look like fruit salad. ! * Article Hiding:: You also want to make certain info go away. ! * Article Washing:: Lots of way-neat functions to make life better. ! * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. ! * Article Date:: Grumble, UT! ! @end menu ! ! ! @node Article Highlighting ! @subsection Article Highlighting ! @cindex highlight ! ! Not only do you want your article buffer to look like fruit salad, but ! you want it to look like technicolor fruit salad. ! ! @table @kbd ! ! @item W H a ! @kindex W H a (Summary) ! @findex gnus-article-highlight ! Highlight the current article (@code{gnus-article-highlight}). ! ! @item W H h ! @kindex W H h (Summary) ! @findex gnus-article-highlight-headers ! @vindex gnus-header-face-alist ! Highlight the headers (@code{gnus-article-highlight-headers}). The ! highlighting will be done according to the @code{gnus-header-face-alist} ! variable, which is a list where each element has the form @var{(regexp ! name content)}. @var{regexp} is a regular expression for matching the ! header, @var{name} is the face used for highlighting the header name and ! @var{content} is the face for highlighting the header value. The first ! match made will be used. Note that @var{regexp} shouldn't have @samp{^} ! prepended---Gnus will add one. ! ! @item W H c ! @kindex W H c (Summary) ! @findex gnus-article-highlight-citation ! Highlight cited text (@code{gnus-article-highlight-citation}). ! ! Some variables to customize the citation highlights: ! ! @table @code ! @vindex gnus-cite-parse-max-size ! ! @item gnus-cite-parse-max-size ! If the article size if bigger than this variable (which is 25000 by ! default), no citation highlighting will be performed. ! ! @item gnus-cite-prefix-regexp ! @vindex gnus-cite-prefix-regexp ! Regexp matching the longest possible citation prefix on a line. ! ! @item gnus-cite-max-prefix ! @vindex gnus-cite-max-prefix ! Maximum possible length for a citation prefix (default 20). ! ! @item gnus-cite-face-list ! @vindex gnus-cite-face-list ! 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. This should make it easier to ! see who wrote what. ! ! @item gnus-supercite-regexp ! @vindex gnus-supercite-regexp ! Regexp matching normal Supercite attribution lines. ! ! @item gnus-supercite-secondary-regexp ! @vindex gnus-supercite-secondary-regexp ! Regexp matching mangled Supercite attribution lines. ! ! @item gnus-cite-minimum-match-count ! @vindex gnus-cite-minimum-match-count ! Minimum number of identical prefixes we have to see before we believe ! that it's a citation. ! ! @item gnus-cite-attribution-prefix ! @vindex gnus-cite-attribution-prefix ! Regexp matching the beginning of an attribution line. ! ! @item gnus-cite-attribution-suffix ! @vindex gnus-cite-attribution-suffix ! Regexp matching the end of an attribution line. ! ! @item gnus-cite-attribution-face ! @vindex gnus-cite-attribution-face ! Face used for attribution lines. It is merged with the face for the ! cited text belonging to the attribution. ! ! @end table ! ! ! @item W H s ! @kindex W H s (Summary) ! @vindex gnus-signature-separator ! @vindex gnus-signature-face ! @findex gnus-article-highlight-signature ! Highlight the signature (@code{gnus-article-highlight-signature}). ! Everything after @code{gnus-signature-separator} in an article will be ! considered a signature and will be highlighted with ! @code{gnus-signature-face}, which is @code{italic} by default. ! ! @end table ! ! ! @node Article Hiding ! @subsection Article Hiding ! @cindex article hiding ! ! Or rather, hiding certain things in each article. There usually is much ! too much cruft in most articles. ! ! @table @kbd ! ! @item W W a ! @kindex W W a (Summary) ! @findex gnus-article-hide ! Do maximum hiding on the summary buffer (@kbd{gnus-article-hide}). ! ! @item W W h ! @kindex W W h (Summary) ! @findex gnus-article-hide-headers ! Hide headers (@code{gnus-article-hide-headers}). @xref{Hiding ! Headers}. ! ! @item W W b ! @kindex W W b (Summary) ! @findex gnus-article-hide-boring-headers ! Hide headers that aren't particularly interesting ! (@code{gnus-article-hide-boring-headers}). @xref{Hiding Headers}. ! ! @item W W s ! @kindex W W s (Summary) ! @findex gnus-article-hide-signature ! Hide signature (@code{gnus-article-hide-signature}). ! ! @item W W p ! @kindex W W p (Summary) ! @findex gnus-article-hide-pgp ! Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). ! ! @item W W c ! @kindex W W c (Summary) ! @findex gnus-article-hide-citation ! Hide citation (@code{gnus-article-hide-citation}). Some variables for ! customizing the hiding: ! ! @table @code ! ! @item gnus-cite-hide-percentage ! @vindex gnus-cite-hide-percentage ! If the cited text is of a bigger percentage than this variable (default ! 50), hide the cited text. ! ! @item gnus-cite-hide-absolute ! @vindex gnus-cite-hide-absolute ! The cited text must be have at least this length (default 10) before it ! is hidden. ! ! @item gnus-cited-text-button-line-format ! @vindex gnus-cited-text-button-line-format ! Gnus adds buttons show where the cited text has been hidden, and to ! allow toggle hiding the text. The format of the variable is specified ! by this format-like variable. These specs are legal: ! ! @table @samp ! @item b ! Start point of the hidden text. ! @item e ! End point of the hidden text. ! @item l ! Length of the hidden text. ! @end table ! ! @item gnus-cited-lines-visible ! @vindex gnus-cited-lines-visible ! The number of lines at the beginning of the cited text to leave shown. ! ! @end table ! ! @item W W C ! @kindex W W C (Summary) ! @findex gnus-article-hide-citation-in-followups ! Hide cited text in articles that aren't roots ! (@code{gnus-article-hide-citation-in-followups}). This isn't very ! useful as an interactive command, but might be a handy function to stick ! in @code{gnus-article-display-hook} (@pxref{Customizing Articles}). ! ! @end table ! ! All these ``hiding'' commands are toggles, but if you give a negative ! prefix to these commands, they will show what they have previously ! hidden. If you give a positive prefix, they will always hide. ! ! Also @pxref{Article Highlighting} for further variables for ! citation customization. ! ! @vindex gnus-signature-limit ! @code{gnus-signature-limit} provides a limit to what is considered a ! signature. If it is a number, no signature may not be longer (in ! characters) than that number. If it is a function, the function will be ! called without any parameters, and if it returns @code{nil}, there is no ! signature in the buffer. If it is a string, it will be used as a ! regexp. If it matches, the text in question is not a signature. ! ! ! @node Article Washing ! @subsection Article Washing ! @cindex washing ! @cindex article washing ! ! We call this ``article washing'' for a really good reason. Namely, the ! @kbd{A} key was taken, so we had to use the @kbd{W} key instead. ! ! @dfn{Washing} is defined by us as ``changing something from something to ! something else'', but normally results in something looking better. ! Cleaner, perhaps. ! ! @table @kbd ! ! @item W l ! @kindex W l (Summary) ! @findex gnus-summary-stop-page-breaking ! Remove page breaks from the current article ! (@code{gnus-summary-stop-page-breaking}). ! ! @item W r ! @kindex W r (Summary) ! @findex gnus-summary-caesar-message ! Do a Caesar rotate (rot13) on the article buffer ! (@code{gnus-summary-caesar-message}). ! ! @item W t ! @kindex W t (Summary) ! @findex gnus-summary-toggle-header ! Toggle whether to display all headers in the article buffer ! (@code{gnus-summary-toggle-header}). ! ! @item W v ! @kindex W v (Summary) ! @findex gnus-summary-verbose-header ! Toggle whether to display all headers in the article buffer permanently ! (@code{gnus-summary-verbose-header}). ! ! @item W m ! @kindex W m (Summary) ! @findex gnus-summary-toggle-mime ! Toggle whether to run the article through @sc{mime} before displaying ! (@code{gnus-summary-toggle-mime}). ! ! @item W o ! @kindex W o (Summary) ! @findex gnus-article-treat-overstrike ! Treat overstrike (@code{gnus-article-treat-overstrike}). ! ! @item W w ! @kindex W w (Summary) ! @findex gnus-article-fill-cited-article ! Do word wrap (@code{gnus-article-fill-cited-article}). ! ! @item W c ! @kindex W c (Summary) ! @findex gnus-article-remove-cr ! Remove CR (@code{gnus-article-remove-cr}). ! ! @item W L ! @kindex W L (Summary) ! @findex gnus-article-remove-trailing-blank-lines ! Remove all blank lines at the end of the article ! (@code{gnus-article-remove-trailing-blank-lines}). ! ! @item W q ! @kindex W q (Summary) ! @findex gnus-article-de-quoted-unreadable ! Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). ! ! @item W f ! @kindex W f (Summary) ! @cindex x-face ! @findex gnus-article-display-x-face ! @findex gnus-article-x-face-command ! @vindex gnus-article-x-face-command ! @vindex gnus-article-x-face-too-ugly ! Look for and display any X-Face headers ! (@code{gnus-article-display-x-face}). The command executed by this ! function is given by the @code{gnus-article-x-face-command} variable. If ! this variable is a string, this string will be executed in a sub-shell. ! If it is a function, this function will be called with the face as the ! argument. If the @code{gnus-article-x-face-too-ugly} (which is a regexp) ! matches the @code{From} header, the face will not be shown. The default ! action under Emacs is to fork off an @code{xv} to view the face; under ! XEmacs the default action is to display the face before the @code{From} ! header. (It's nicer if XEmacs has been compiled with X-Face support -- ! that will make display somewhat faster. If there's no native X-Face ! support, Gnus will try to convert the @code{X-Face} header using ! external programs from the @code{pbmplus} package and friends.) If you ! want to have this function in the display hook, it should probably come ! last. ! ! @item W b ! @kindex W b (Summary) ! @findex gnus-article-add-buttons ! Add clickable buttons to the article (@code{gnus-article-add-buttons}). ! ! @item W B ! @kindex W B (Summary) ! @findex gnus-article-add-buttons-to-head ! Add clickable buttons to the article headers ! (@code{gnus-article-add-buttons-to-head}). ! ! @end table ! ! ! @node Article Buttons ! @subsection Article Buttons ! @cindex buttons ! ! People often include references to other stuff in articles, and it would ! be nice if Gnus could just fetch whatever it is that people talk about ! with the minimum of fuzz. ! ! Gnus adds @dfn{buttons} to certain standard references by default: ! Well-formed URLs, mail addresses and Message-IDs. This is controlled by ! two variables, one that handles article bodies and one that handles ! article heads: ! ! @table @code ! ! @item gnus-button-alist ! @vindex gnus-button-alist ! This is an alist where each entry has this form: ! ! @lisp ! (REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR) ! @end lisp ! ! @table @var ! ! @item regexp ! All text that match this regular expression will be considered an ! external reference. Here's a typical regexp that match embedded URLs: ! @samp{]*\\)>}. ! ! @item button-par ! Gnus has to know which parts of the match is to be highlighted. This is ! a number that says what sub-expression of the regexp that is to be ! highlighted. If you want it all highlighted, you use @code{0} here. ! ! @item use-p ! This form will be @code{eval}ed, and if the result is non-@code{nil}, ! this is considered a match. This is useful if you want extra sifting to ! avoid false matches. ! ! @item function ! This function will be called when you click on this button. ! ! @item data-par ! As with @var{button-par}, this is a sub-expression number, but this one ! says which part of the match is to be sent as data to @var{function}. ! ! @end table ! ! So the full entry for buttonizing URLs is then ! ! @lisp ! ("]*\\)>" 0 t gnus-button-url 1) ! @end lisp ! ! @item gnus-header-button-alist ! @vindex gnus-header-button-alist ! This is just like the other alist, except that it is applied to the ! article head only, and that each entry has an additional element that is ! used to say what headers to apply the buttonize coding to: ! ! @lisp ! (HEADER REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR) ! @end lisp ! ! @var{header} is a regular expression. ! ! @item gnus-button-url-regexp ! @vindex gnus-button-url-regexp ! A regular expression that matches embedded URLs. It is used in the ! default values of the variables above. ! ! @item gnus-article-button-face ! @vindex gnus-article-button-face ! Face used on bottons. ! ! @item gnus-article-mouse-face ! @vindex gnus-article-mouse-face ! Face is used when the mouse cursor is over a button. ! ! @end table ! ! ! @node Article Date ! @subsection Article Date ! ! The date is most likely generated in some obscure timezone you've never ! heard of, so it's quite nice to be able to find out what the time was ! when the article was sent. ! ! @table @kbd ! ! @item W T u ! @kindex W T u (Summary) ! @findex gnus-article-date-ut ! Display the date in UT (aka. GMT, aka ZULU) ! (@code{gnus-article-date-ut}). ! ! @item W T l ! @kindex W T l (Summary) ! @findex gnus-article-date-local ! Display the date in the local timezone (@code{gnus-article-date-local}). ! ! @item W T e ! @kindex W T e (Summary) ! @findex gnus-article-date-lapsed ! Say how much time has (e)lapsed between the article was posted and now ! (@code{gnus-article-date-lapsed}). ! ! @item W T o ! @kindex W T o (Summary) ! @findex gnus-article-date-original ! Display the original date (@code{gnus-article-date-original}). This can ! be useful if you normally use some other conversion function and is ! worried that it might be doing something totally wrong. Say, claiming ! that the article was posted in 1854. Although something like that is ! @emph{totally} impossible. Don't you trust me? *titter* ! ! @end table ! ! ! @node Summary Sorting ! @section Summary Sorting ! @cindex summary sorting ! ! You can have the summary buffer sorted in various ways, even though I ! can't really see why you'd want that. ! ! @table @kbd ! ! @item C-c C-s C-n ! @kindex C-c C-s C-n (Summary) ! @findex gnus-summary-sort-by-number ! Sort by article number (@code{gnus-summary-sort-by-number}). ! ! @item C-c C-s C-a ! @kindex C-c C-s C-a (Summary) ! @findex gnus-summary-sort-by-author ! Sort by author (@code{gnus-summary-sort-by-author}). ! ! @item C-c C-s C-s ! @kindex C-c C-s C-s (Summary) ! @findex gnus-summary-sort-by-subject ! Sort by subject (@code{gnus-summary-sort-by-subject}). ! ! @item C-c C-s C-d ! @kindex C-c C-s C-d (Summary) ! @findex gnus-summary-sort-by-date ! Sort by date (@code{gnus-summary-sort-by-date}). ! ! @item C-c C-s C-i ! @kindex C-c C-s C-i (Summary) ! @findex gnus-summary-sort-by-score ! Sort by score (@code{gnus-summary-sort-by-score}). ! @end table ! ! These functions will work both when you use threading and when you don't ! use threading. In the latter case, all summary lines will be sorted, ! line by line. In the former case, sorting will be done on a ! root-by-root basis, which might not be what you were looking for. To ! toggle whether to use threading, type @kbd{T T} (@pxref{Thread ! Commands}). ! ! ! @node Finding the Parent ! @section Finding the Parent ! @cindex parent articles ! @cindex referring articles ! ! @findex gnus-summary-refer-parent-article ! @kindex ^ (Summary) ! If you'd like to read the parent of the current article, and it is not ! displayed in the summary buffer, you might still be able to. That is, ! if the current group is fetched by @sc{nntp}, the parent hasn't expired ! and the @code{References} in the current article are not mangled, you ! can just press @kbd{^} or @kbd{A r} ! (@code{gnus-summary-refer-parent-article}). If everything goes well, ! you'll get the parent. If the parent is already displayed in the ! summary buffer, point will just move to this article. ! ! @findex gnus-summary-refer-references ! @kindex A R (Summary) ! You can have Gnus fetch all articles mentioned in the @code{References} ! header of the article by pushing @kbd{A R} ! (@code{gnus-summary-refer-references}). ! ! @findex gnus-summary-refer-article ! @kindex M-^ (Summary) ! You can also ask the @sc{nntp} server for an arbitrary article, no ! matter what group it belongs to. @kbd{M-^} ! (@code{gnus-summary-refer-article}) will ask you for a ! @code{Message-ID}, which is one of those long thingies that look ! something like @samp{<38o6up$6f2@@hymir.ifi.uio.no>}. You have to get ! it all exactly right. No fuzzy searches, I'm afraid. ! ! @vindex gnus-refer-article-method ! If the group you are reading is located on a backend that does not ! support fetching by @code{Message-ID} very well (like @code{nnspool}), ! you can set @code{gnus-refer-article-method} to an @sc{nntp} method. It ! would, perhaps, be best if the @sc{nntp} server you consult is the same ! as the one that keeps the spool you are reading from updated, but that's ! not really necessary. ! ! Most of the mail backends support fetching by @code{Message-ID}, but do ! not do a particularly excellent job of it. That is, @code{nnmbox} and ! @code{nnbabyl} are able to locate articles from any groups, while ! @code{nnml} and @code{nnfolder} are only able to locate articles that ! have been posted to the current group. (Anything else would be too time ! consuming.) @code{nnmh} does not support this at all. ! ! ! @node Alternative Approaches ! @section Alternative Approaches ! ! Different people like to read news using different methods. This being ! Gnus, we offer a small selection of minor modes for the summary buffers. ! ! @menu ! * Pick and Read:: First mark articles and then read them. ! * Binary Groups:: Auto-decode all articles. ! @end menu ! ! ! @node Pick and Read ! @subsection Pick and Read ! @cindex pick and read ! ! Some newsreaders (like @code{nn} and, uhm, @code{nn}) use a two-phased ! reading interface. The user first marks the articles she wants to read ! from a summary buffer. Then she starts reading the articles with just ! an article buffer displayed. ! ! @findex gnus-pick-mode ! @kindex M-x gnus-pick-mode ! Gnus provides a summary buffer minor mode that allows ! this---@code{gnus-pick-mode}. This basically means that a few process ! mark commands become one-keystroke commands to allow easy marking, and ! it makes one additional command for switching to the summary buffer ! available. ! ! Here are the available keystrokes when using pick mode: ! ! @table @kbd ! @item SPACE ! @kindex SPACE (Pick) ! @findex gnus-summary-mark-as-processable ! Pick the article (@code{gnus-summary-mark-as-processable}). ! ! @item u ! @kindex u (Pick) ! @findex gnus-summary-unmark-as-processable ! Unpick the article (@code{gnus-summary-unmark-as-processable}). ! ! @item U ! @kindex U (Pick) ! @findex gnus-summary-unmark-all-processable ! Unpick all articles (@code{gnus-summary-unmark-all-processable}). ! ! @item t ! @kindex t (Pick) ! @findex gnus-uu-mark-thread ! Pick the thread (@code{gnus-uu-mark-thread}). ! ! @item T ! @kindex T (Pick) ! @findex gnus-uu-unmark-thread ! Unpick the thread (@code{gnus-uu-unmark-thread}). ! ! @item r ! @kindex r (Pick) ! @findex gnus-uu-mark-region ! Pick the region (@code{gnus-uu-mark-region}). ! ! @item R ! @kindex R (Pick) ! @findex gnus-uu-unmark-region ! Unpick the region (@code{gnus-uu-unmark-region}). ! ! @item e ! @kindex e (Pick) ! @findex gnus-uu-mark-by-regexp ! Pick articles that match a regexp (@code{gnus-uu-mark-by-regexp}). ! ! @item E ! @kindex E (Pick) ! @findex gnus-uu-unmark-by-regexp ! Unpick articles that match a regexp (@code{gnus-uu-unmark-by-regexp}). ! ! @item b ! @kindex b (Pick) ! @findex gnus-uu-mark-buffer ! Pick the buffer (@code{gnus-uu-mark-buffer}). ! ! @item B ! @kindex B (Pick) ! @findex gnus-uu-unmark-buffer ! Unpick the buffer (@code{gnus-uu-unmark-buffer}). ! ! @item RET ! @kindex RET (Pick) ! @findex gnus-pick-start-reading ! @vindex gnus-pick-display-summary ! Start reading the picked articles (@code{gnus-pick-start-reading}). If ! given a prefix, mark all unpicked articles as read first. If ! @code{gnus-pick-display-summary} is non-@code{nil}, the summary buffer ! will still be visible when you are reading. ! ! @end table ! ! If this sounds like a good idea to you, you could say: ! ! @lisp ! (add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) ! @end lisp ! ! @vindex gnus-pick-mode-hook ! @code{gnus-pick-mode-hook} is run in pick minor mode buffers. ! ! ! @node Binary Groups ! @subsection Binary Groups ! @cindex binary groups ! ! @findex gnus-binary-mode ! @kindex M-x gnus-binary-mode ! If you spend much time in binary groups, you may grow tired of hitting ! @kbd{X u}, @kbd{n}, @kbd{RET} all the time. @kbd{M-x gnus-binary-mode} ! is a minor mode for summary buffers that makes all ordinary Gnus article ! selection functions uudecode series of articles and display the result ! instead of just displaying the articles the normal way. ! ! @kindex g (Binary) ! @findex gnus-binary-show-article ! In fact, the only way to see the actual articles if you have turned this ! mode on is the @kbd{g} command (@code{gnus-binary-show-article}). ! ! @vindex gnus-binary-mode-hook ! @code{gnus-binary-mode-hook} is called in binary minor mode buffers. ! ! ! @node Tree Display ! @section Tree Display ! @cindex trees ! ! @vindex gnus-use-trees ! If you don't like the normal Gnus summary display, you might try setting ! @code{gnus-use-trees} to @code{t}. This will create (by default) an ! additional @dfn{tree buffer}. You can execute all summary mode commands ! in the tree buffer. ! ! There are a few variables to customize the tree display, of course: ! ! @table @code ! @item gnus-tree-mode-hook ! @vindex gnus-tree-mode-hook ! A hook called in all tree mode buffers. ! ! @item gnus-tree-mode-line-format ! @vindex gnus-tree-mode-line-format ! A format string for the mode bar in the tree mode buffers. The default ! is @samp{Gnus: %%b [%A] %Z}. For a list of legal specs, @pxref{Summary ! Buffer Mode Line}. ! ! @item gnus-selected-tree-face ! @vindex gnus-selected-tree-face ! Face used for highlighting the selected article in the tree buffer. The ! default is @code{modeline}. ! ! @item gnus-tree-line-format ! @vindex gnus-tree-line-format ! A format string for the tree nodes. The name is a bit of a misnomer, ! though---it doesn't define a line, but just the node. The default value ! is @samp{%(%[%3,3n%]%)}, which displays the first three characters of ! the name of the poster. It is vital that all nodes are of the same ! length, so you @emph{must} use @samp{%4,4n}-like specifiers. ! ! Legal specs are: ! ! @table @samp ! @item n ! The name of the poster. ! @item f ! The @code{From} header. ! @item N ! The number of the article. ! @item [ ! The opening bracket. ! @item ] ! The closing bracket. ! @item s ! The subject. ! @end table ! ! @xref{Formatting Variables}. ! ! Variables related to the display are: ! ! @table @code ! @item gnus-tree-brackets ! @vindex gnus-tree-brackets ! This is used for differentiating between ``real'' articles and ! ``sparse'' articles. The format is @var{((real-open . real-close) ! (sparse-open . sparse-close) (dummy-open . dummy-close))}, and the ! default is @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}))}. ! ! @item gnus-tree-parent-child-edges ! @vindex gnus-tree-parent-child-edges ! This is a list that contains the characters used for connecting parent ! nodes to their children. The default is @code{(?- ?\\ ?|)}. ! ! @end table ! ! @item gnus-tree-minimize-window ! @vindex gnus-tree-minimize-window ! If this variable is non-@code{nil}, Gnus will try to keep the tree ! buffer as small as possible to allow more room for the other Gnus ! windows. If this variable is a number, the tree buffer will never be ! higher than that number. The default is @code{t}. ! ! @item gnus-generate-tree-function ! @vindex gnus-generate-tree-function ! @findex gnus-generate-horizontal-tree ! @findex gnus-generate-vertical-tree ! The function that actually generates the thread tree. Two predefined ! functions are available: @code{gnus-generate-horizontal-tree} and ! @code{gnus-generate-vertical-tree} (which is the default). ! ! @end table ! ! Here's and example from a horizontal tree buffer: ! ! @example ! @{***@}-(***)-[odd]-[Gun] ! | \[Jan] ! | \[odd]-[Eri] ! | \(***)-[Eri] ! | \[odd]-[Paa] ! \[Bjo] ! \[Gun] ! \[Gun]-[Jor] ! @end example ! ! Here's the same thread displayed in a vertical tree buffer: ! ! @example ! @{***@} ! |--------------------------\-----\-----\ ! (***) [Bjo] [Gun] [Gun] ! |--\-----\-----\ | ! [odd] [Jan] [odd] (***) [Jor] ! | | |--\ ! [Gun] [Eri] [Eri] [odd] ! | ! [Paa] ! @end example ! ! ! @node Mail Group Commands ! @section Mail Group Commands ! @cindex mail group commands ! ! Some commands only make sense in mail groups. If these commands are ! illegal in the current group, they will raise a hell and let you know. ! ! All these commands (except the expiry and edit commands) use the ! process/prefix convention (@pxref{Process/Prefix}). ! ! @table @kbd ! ! @item B e ! @kindex B e (Summary) ! @findex gnus-summary-expire-articles ! Expire all expirable articles in the group ! (@code{gnus-summary-expire-articles}). ! ! @item B M-C-e ! @kindex B M-C-e (Summary) ! @findex gnus-summary-expire-articles-now ! Expunge all the expirable articles in the group ! (@code{gnus-summary-expire-articles-now}). This means that @strong{all} ! articles that are eligible for expiry in the current group will ! disappear forever into that big @file{/dev/null} in the sky. ! ! @item B DEL ! @kindex B DEL (Summary) ! @findex gnus-summary-delete-article ! Delete the mail article. This is ``delete'' as in ``delete it from your ! disk forever and ever, never to return again.'' Use with caution. ! (@code{gnus-summary-delete-article}). ! ! @item B m ! @kindex B m (Summary) ! @cindex move mail ! @findex gnus-summary-move-article ! Move the article from one mail group to another ! (@code{gnus-summary-move-article}). ! ! @item B c ! @kindex B c (Summary) ! @cindex copy mail ! @findex gnus-summary-copy-article ! Copy the article from one group (mail group or not) to a mail group ! (@code{gnus-summary-copy-article}). ! ! @item B C ! @kindex B C (Summary) ! @cindex crosspost mail ! @findex gnus-summary-crosspost-article ! Crosspost the current article to some other group ! (@code{gnus-summary-crosspost-article}). This will create a new copy of ! the article in the other group, and the Xref headers of the article will ! be properly updated. ! ! @item B i ! @kindex B i (Summary) ! @findex gnus-summary-import-article ! Import an arbitrary file into the current mail newsgroup ! (@code{gnus-summary-import-article}). You will be prompted for a file ! name, a @code{From} header and a @code{Subject} header. ! ! @item B r ! @kindex B r (Summary) ! @findex gnus-summary-respool-article ! Respool the mail article (@code{gnus-summary-move-article}). ! ! @item B w ! @itemx e ! @kindex B w (Summary) ! @kindex e (Summary) ! @findex gnus-summary-edit-article ! @kindex C-c C-c (Article) ! Edit the current article (@code{gnus-summary-edit-article}). To finish ! editing and make the changes permanent, type @kbd{C-c C-c} ! (@kbd{gnus-summary-edit-article-done}). ! ! @item B q ! @kindex B q (Summary) ! @findex gnus-summary-respool-query ! If you want to re-spool an article, you might be curious as to what group ! the article will end up in before you do the re-spooling. This command ! will tell you (@code{gnus-summary-respool-query}). ! @end table ! ! @vindex gnus-move-split-methods ! @cindex moving articles ! If you move (or copy) articles regularly, you might wish to have Gnus ! suggest where to put the articles. @code{gnus-move-split-methods} is a ! variable that uses the same syntax as @code{gnus-split-methods} ! (@pxref{Saving Articles}). You may customize that variable to create ! suggestions you find reasonable. ! ! ! @node Various Summary Stuff ! @section Various Summary Stuff ! ! @menu ! * Summary Group Information:: Information oriented commands. ! * Searching for Articles:: Multiple article commands. ! * Really Various Summary Commands:: Those pesky non-conformant commands. ! @end menu ! ! @table @code ! @vindex gnus-summary-mode-hook ! @item gnus-summary-mode-hook ! This hook is called when creating a summary mode buffer. ! ! @vindex gnus-summary-generate-hook ! @item gnus-summary-generate-hook ! This is called as the last thing before doing the threading and the ! generation of the summary buffer. It's quite convenient for customizing ! the threading variables based on what data the newsgroup has. This hook ! is called from the summary buffer after most summary buffer variables ! has been set. ! ! @vindex gnus-summary-prepare-hook ! @item gnus-summary-prepare-hook ! Is is called after the summary buffer has been generated. You might use ! it to, for instance, highlight lines or modify the look of the buffer in ! some other ungodly manner. I don't care. ! ! @end table ! ! ! @node Summary Group Information ! @subsection Summary Group Information ! ! @table @kbd ! ! @item H f ! @kindex H f (Summary) ! @findex gnus-summary-fetch-faq ! @vindex gnus-group-faq-directory ! Try to fetch the FAQ (list of frequently asked questions) for the ! current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the ! FAQ from @code{gnus-group-faq-directory}, which is usually a directory ! on a remote machine. This variable can also be a list of directories. ! In that case, giving a prefix to this command will allow you to choose ! between the various sites. @code{ange-ftp} probably will be used for ! fetching the file. ! ! @item H d ! @kindex H d (Summary) ! @findex gnus-summary-describe-group ! Give a brief description of the current group ! (@code{gnus-summary-describe-group}). If given a prefix, force ! rereading the description from the server. ! ! @item H h ! @kindex H h (Summary) ! @findex gnus-summary-describe-briefly ! Give a very brief description of the most important summary keystrokes ! (@code{gnus-summary-describe-briefly}). ! ! @item H i ! @kindex H i (Summary) ! @findex gnus-info-find-node ! Go to the Gnus info node (@code{gnus-info-find-node}). ! @end table ! ! ! @node Searching for Articles ! @subsection Searching for Articles ! ! @table @kbd ! ! @item M-s ! @kindex M-s (Summary) ! @findex gnus-summary-search-article-forward ! Search through all subsequent articles for a regexp ! (@code{gnus-summary-search-article-forward}). ! ! @item M-r ! @kindex M-r (Summary) ! @findex gnus-summary-search-article-backward ! Search through all previous articles for a regexp ! (@code{gnus-summary-search-article-backward}). ! ! @item & ! @kindex & (Summary) ! @findex gnus-summary-execute-command ! This command will prompt you for a header field, a regular expression to ! match on this field, and a command to be executed if the match is made ! (@code{gnus-summary-execute-command}). ! ! @item M-& ! @kindex M-& (Summary) ! @findex gnus-summary-universal-argument ! Perform any operation on all articles that have been marked with ! the process mark (@code{gnus-summary-universal-argument}). ! @end table ! ! ! @node Really Various Summary Commands ! @subsection Really Various Summary Commands ! ! @table @kbd ! ! @item A D ! @kindex A D (Summary) ! @findex gnus-summary-enter-digest-group ! If the current article is a collection of other articles (for instance, ! a digest), you might use this command to enter a group based on the that ! article (@code{gnus-summary-enter-digest-group}). Gnus will try to ! guess what article type is currently displayed unless you give a prefix ! to this command, which forces a ``digest'' interpretation. Basically, ! whenever you see a message that is a collection of other messages on ! some format, you @kbd{A D} and read these messages in a more convenient ! fashion. ! ! @item C-t ! @kindex C-t (Summary) ! @findex gnus-summary-toggle-truncation ! Toggle truncation of summary lines (@code{gnus-summary-toggle-truncation}). ! ! @item = ! @kindex = (Summary) ! @findex gnus-summary-expand-window ! Expand the summary buffer window (@code{gnus-summary-expand-window}). ! If given a prefix, force an @code{article} window configuration. ! @end table ! ! ! @node Exiting the Summary Buffer ! @section Exiting the Summary Buffer ! @cindex summary exit ! @cindex exiting groups ! ! Exiting from the summary buffer will normally update all info on the ! group and return you to the group buffer. ! ! @table @kbd ! ! @item Z Z ! @itemx q ! @kindex Z Z (Summary) ! @kindex q (Summary) ! @findex gnus-summary-exit ! @vindex gnus-summary-exit-hook ! @vindex gnus-summary-prepare-exit-hook ! Exit the current group and update all information on the group ! (@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is ! called before doing much of the exiting, and calls ! @code{gnus-summary-expire-articles} by default. ! @code{gnus-summary-exit-hook} is called after finishing the exiting ! process. ! ! @item Z E ! @itemx Q ! @kindex Z E (Summary) ! @kindex Q (Summary) ! @findex gnus-summary-exit-no-update ! Exit the current group without updating any information on the group ! (@code{gnus-summary-exit-no-update}). ! ! @item Z c ! @itemx c ! @kindex Z c (Summary) ! @kindex c (Summary) ! @findex gnus-summary-catchup-and-exit ! Mark all unticked articles in the group as read and then exit ! (@code{gnus-summary-catchup-and-exit}). ! ! @item Z C ! @kindex Z C (Summary) ! @findex gnus-summary-catchup-all-and-exit ! Mark all articles, even the ticked ones, as read and then exit ! (@code{gnus-summary-catchup-all-and-exit}). ! ! @item Z n ! @kindex Z n (Summary) ! @findex gnus-summary-catchup-and-goto-next-group ! Mark all articles as read and go to the next group ! (@code{gnus-summary-catchup-and-goto-next-group}). ! ! @item Z R ! @kindex Z R (Summary) ! @findex gnus-summary-reselect-current-group ! Exit this group, and then enter it again ! (@code{gnus-summary-reselect-current-group}). If given a prefix, select ! all articles, both read and unread. ! ! @item Z G ! @itemx M-g ! @kindex Z G (Summary) ! @kindex M-g (Summary) ! @findex gnus-summary-rescan-group ! Exit the group, check for new articles in the group, and select the ! group (@code{gnus-summary-rescan-group}). If given a prefix, select all ! articles, both read and unread. ! ! @item Z N ! @kindex Z N (Summary) ! @findex gnus-summary-next-group ! Exit the group and go to the next group ! (@code{gnus-summary-next-group}). ! ! @item Z P ! @kindex Z P (Summary) ! @findex gnus-summary-prev-group ! Exit the group and go to the previous group ! (@code{gnus-summary-prev-group}). ! @end table ! ! @vindex gnus-exit-group-hook ! @code{gnus-exit-group-hook} is called when you exit the current ! group. ! ! @findex gnus-summary-wake-up-the-dead ! @findex gnus-dead-summary-mode ! @vindex gnus-kill-summary-on-exit ! If you're in the habit of exiting groups, and then changing your mind ! about it, you might set @code{gnus-kill-summary-on-exit} to @code{nil}. ! If you do that, Gnus won't kill the summary buffer when you exit it. ! (Quelle surprise!) Instead it will change the name of the buffer to ! something like @samp{*Dead Summary ... *} and install a minor mode ! called @code{gnus-dead-summary-mode}. Now, if you switch back to this ! buffer, you'll find that all keys are mapped to a function called ! @code{gnus-summary-wake-up-the-dead}. So tapping any keys in a dead ! summary buffer will result in a live, normal summary buffer. ! ! There will never be more than one dead summary buffer at any one time. ! ! @vindex gnus-use-cross-reference ! The data on the current group will be updated (which articles you have ! read, which articles you have replied to, etc.) when you exit the ! summary buffer. If the @code{gnus-use-cross-reference} variable is ! @code{t} (which is the default), articles that are cross-referenced to ! this group and are marked as read, will also be marked as read in the ! other subscribed groups they were cross-posted to. If this variable is ! neither @code{nil} nor @code{t}, the article will be marked as read in ! both subscribed and unsubscribed groups. ! ! @cindex velveeta ! @cindex spamming ! Marking cross-posted articles as read ensures that you'll never have to ! read the same article more than once. Unless, of course, somebody has ! posted it to several groups separately. Posting the same article to ! several groups (not cross-posting) is called @dfn{spamming}, and you are ! by law required to send nasty-grams to anyone who perpetrates such a ! heinous crime. ! ! Remember: Cross-posting is kinda ok, but posting the same article ! separately to several groups is not. Massive cross-posting (aka. ! @dfn{velveeta}) is to be avoided. ! ! @cindex cross-posting ! @cindex Xref ! @cindex @sc{nov} ! One thing that may cause Gnus to not do the cross-posting thing ! correctly is if you use an @sc{nntp} server that supports @sc{xover} ! (which is very nice, because it speeds things up considerably) which ! does not include the @code{Xref} header in its @sc{nov} lines. This is ! Evil, but all too common, alas, alack. Gnus tries to Do The Right Thing ! even with @sc{xover} by registering the @code{Xref} lines of all ! articles you actually read, but if you kill the articles, or just mark ! them as read without reading them, Gnus will not get a chance to snoop ! the @code{Xref} lines out of these articles, and will be unable to use ! the cross reference mechanism. ! ! @cindex LIST overview.fmt ! @cindex overview.fmt ! To check whether your @sc{nntp} server includes the @code{Xref} header ! in its overview files, try @samp{telnet your.nntp.server nntp}, ! @samp{MODE READER} on @code{inn} servers, and then say @samp{LIST ! overview.fmt}. This may not work, but if it does, and the last line you ! get does not read @samp{Xref:full}, then you should shout and whine at ! your news admin until she includes the @code{Xref} header in the ! overview files. ! ! @vindex gnus-nov-is-evil ! If you want Gnus to get the @code{Xref}s right all the time, you have to ! set @code{gnus-nov-is-evil} to @code{t}, which slows things down ! considerably. ! ! C'est la vie. ! ! ! @node The Article Buffer ! @chapter The Article Buffer ! @cindex article buffer ! ! The articles are displayed in the article buffer, of which there is only ! one. All the summary buffers share the same article buffer unless you ! tell Gnus otherwise. ! ! @menu ! * Hiding Headers:: Deciding what headers should be displayed. ! * Using MIME:: Pushing articles through @sc{mime} before reading them. ! * Customizing Articles:: Tailoring the look of the articles. ! * Article Keymap:: Keystrokes available in the article buffer ! * Misc Article:: Other stuff. ! @end menu ! ! ! @node Hiding Headers ! @section Hiding Headers ! @cindex hiding headers ! @cindex deleting headers ! ! The top section of each article is the @dfn{head}. (The rest is the ! @dfn{body}, but you may have guessed that already.) ! ! @vindex gnus-show-all-headers ! There is a lot of useful information in the head: the name of the person ! who wrote the article, the date it was written and the subject of the ! article. That's well and nice, but there's also lots of information ! most people do not want to see---what systems the article has passed ! through before reaching you, the @code{Message-ID}, the ! @code{References}, etc. ad nauseum---and you'll probably want to get rid ! of some of those lines. If you want to keep all those lines in the ! article buffer, you can set @code{gnus-show-all-headers} to @code{t}. ! ! Gnus provides you with two variables for sifting headers: ! ! @table @code ! ! @item gnus-visible-headers ! @vindex gnus-visible-headers ! If this variable is non-@code{nil}, it should be a regular expression ! that says what headers you wish to keep in the article buffer. All ! headers that do not match this variable will be hidden. ! ! For instance, if you only want to see the name of the person who wrote ! the article and the subject, you'd say: ! ! @lisp ! (setq gnus-visible-headers "^From:\\|^Subject:") ! @end lisp ! ! This variable can also be a list of regexps to match headers that are to ! remain visible. ! ! @item gnus-ignored-headers ! @vindex gnus-ignored-headers ! This variable is the reverse of @code{gnus-visible-headers}. If this ! variable is set (and @code{gnus-visible-headers} is @code{nil}), it ! should be a regular expression that matches all lines that you want to ! hide. All lines that do not match this variable will remain visible. ! ! For instance, if you just want to get rid of the @code{References} line ! and the @code{Xref} line, you might say: ! ! @lisp ! (setq gnus-ignored-headers "^References:\\|^Xref:") ! @end lisp ! ! This variable can also be a list of regexps to match headers that are to ! be removed. ! ! Note that if @code{gnus-visible-headers} is non-@code{nil}, this ! variable will have no effect. ! ! @end table ! ! @vindex gnus-sorted-header-list ! Gnus can also sort the headers for you. (It does this by default.) You ! can control the sorting by setting the @code{gnus-sorted-header-list} ! variable. It is a list of regular expressions that says in what order ! the headers are to be displayed. ! ! For instance, if you want the name of the author of the article first, ! and then the subject, you might say something like: ! ! @lisp ! (setq gnus-sorted-header-list '("^From:" "^Subject:")) ! @end lisp ! ! Any headers that are to remain visible, but are not listed in this ! variable, will be displayed in random order after all the headers that ! are listed in this variable. ! ! @findex gnus-article-hide-boring-headers ! @vindex gnus-article-display-hook ! @vindex gnus-boring-article-headers ! You can hide further boring headers by entering ! @code{gnus-article-hide-boring-headers} into ! @code{gnus-article-display-hook}. What this function does depends on ! the @code{gnus-boring-article-headers} variable. It's a list, but this ! list doesn't actually contain header names. Instead is lists various ! @dfn{boring conditions} that Gnus can check and remove from sight. ! ! These conditions are: ! @table @code ! @item empty ! Remove all empty headers. ! @item newsgroups ! Remove the @code{Newsgroups} header if it only contains the current group ! name. ! @item followup-to ! Remove the @code{Followup-To} header if it is identical to the ! @code{Newsgroups} header. ! @item reply-to ! Remove the @code{Reply-To} header if it lists the same address as the ! @code{From} header. ! @item date ! Remove the @code{Date} header if the article is less than three days ! old. ! @end table ! ! To include the four first elements, you could say something like; ! ! @lisp ! (setq gnus-boring-article-headers ! '(empty newsgroups followup-to reply-to)) ! @end lisp ! ! This is also the default value for this variable. ! ! ! @node Using MIME ! @section Using @sc{mime} ! @cindex @sc{mime} ! ! Mime is a standard for waving your hands through the air, aimlessly, ! while people stand around yawning. ! ! @sc{mime}, however, is a standard for encoding your articles, aimlessly, ! while all newsreaders die of fear. ! ! @sc{mime} may specify what character set the article uses, the encoding ! of the characters, and it also makes it possible to embed pictures and ! other naughty stuff in innocent-looking articles. ! ! @vindex gnus-show-mime ! @vindex gnus-show-mime-method ! @vindex gnus-strict-mime ! @findex metamail-buffer ! Gnus handles @sc{mime} by shoving the articles through ! @code{gnus-show-mime-method}, which is @code{metamail-buffer} by ! default. Set @code{gnus-show-mime} to @code{t} if you want to use ! @sc{mime} all the time. However, if @code{gnus-strict-mime} is ! non-@code{nil}, the @sc{mime} method will only be used if there are ! @sc{mime} headers in the article. ! ! It might be best to just use the toggling functions from the summary ! buffer to avoid getting nasty surprises. (For instance, you enter the ! group @samp{alt.sing-a-long} and, before you know it, @sc{mime} has ! decoded the sound file in the article and some horrible sing-a-long song ! comes streaming out out your speakers, and you can't find the volume ! button, because there isn't one, and people are starting to look at you, ! and you try to stop the program, but you can't, and you can't find the ! program to control the volume, and everybody else in the room suddenly ! decides to look at you disdainfully, and you'll feel rather stupid.) ! ! Any similarity to real events and people is purely coincidental. Ahem. ! ! ! @node Customizing Articles ! @section Customizing Articles ! @cindex article customization ! ! @vindex gnus-article-display-hook ! The @code{gnus-article-display-hook} is called after the article has ! been inserted into the article buffer. It is meant to handle all ! treatment of the article before it is displayed. ! ! @findex gnus-article-maybe-highlight ! By default it contains @code{gnus-article-hide-headers}, ! @code{gnus-article-treat-overstrike}, and ! @code{gnus-article-maybe-highlight}, but there are thousands, nay ! millions, of functions you can put in this hook. For an overview of ! functions @pxref{Article Highlighting}, @pxref{Article Hiding}, ! @pxref{Article Washing}, @pxref{Article Buttons} and @pxref{Article ! Date}. ! ! You can, of course, write your own functions. The functions are called ! from the article buffer, and you can do anything you like, pretty much. ! There is no information that you have to keep in the buffer---you can ! change everything. However, you shouldn't delete any headers. Instead ! make them invisible if you want to make them go away. ! ! ! @node Article Keymap ! @section Article Keymap ! ! Most of the keystrokes in the summary buffer can also be used in the ! article buffer. They should behave as if you typed them in the summary ! buffer, which means that you don't actually have to have a summary ! buffer displayed while reading. You can do it all from the article ! buffer. ! ! A few additional keystrokes are available: ! ! @table @kbd ! ! @item SPACE ! @kindex SPACE (Article) ! @findex gnus-article-next-page ! Scroll forwards one page (@code{gnus-article-next-page}). ! ! @item DEL ! @kindex DEL (Article) ! @findex gnus-article-prev-page ! Scroll backwards one page (@code{gnus-article-prev-page}). ! ! @item C-c ^ ! @kindex C-c ^ (Article) ! @findex gnus-article-refer-article ! If point is in the neighborhood of a @code{Message-ID} and you press ! @kbd{r}, Gnus will try to get that article from the server ! (@code{gnus-article-refer-article}). ! ! @item C-c C-m ! @kindex C-c C-m (Article) ! @findex gnus-article-mail ! Send a reply to the address near point (@code{gnus-article-mail}). If ! given a prefix, include the mail. ! ! @item s ! @kindex s (Article) ! @findex gnus-article-show-summary ! Reconfigure the buffers so that the summary buffer becomes visible ! (@code{gnus-article-show-summary}). ! ! @item ? ! @kindex ? (Article) ! @findex gnus-article-describe-briefly ! Give a very brief description of the available keystrokes ! (@code{gnus-article-describe-briefly}). ! ! @item TAB ! @kindex TAB (Article) ! @findex gnus-article-next-button ! Go to the next button, if any (@code{gnus-article-next-button}. This ! only makes sense if you have buttonizing turned on. ! ! @item M-TAB ! @kindex M-TAB (Article) ! @findex gnus-article-prev-button ! Go to the previous button, if any (@code{gnus-article-prev-button}. ! ! @end table ! ! ! @node Misc Article ! @section Misc Article ! ! @table @code ! ! @item gnus-single-article-buffer ! @vindex gnus-single-article-buffer ! If non-@code{nil}, use the same article buffer for all the groups. ! (This is the default.) If @code{nil}, each group will have its own ! article buffer. ! ! @vindex gnus-article-prepare-hook ! @item gnus-article-prepare-hook ! This hook is called right after the article has been inserted into the ! article buffer. It is mainly intended for functions that do something ! depending on the contents; it should probably not be used for changing ! the contents of the article buffer. ! ! @vindex gnus-article-display-hook ! @item gnus-article-display-hook ! This hook is called as the last thing when displaying an article, and is ! intended for modifying the contents of the buffer, doing highlights, ! hiding headers, and the like. ! ! @item gnus-article-mode-hook ! @vindex gnus-article-mode-hook ! Hook called in article mode buffers. ! ! @vindex gnus-article-mode-line-format ! @item gnus-article-mode-line-format ! This variable is a format string along the same lines as ! @code{gnus-summary-mode-line-format}. It accepts exactly the same ! format specifications as that variable. ! @vindex gnus-break-pages ! ! @item gnus-break-pages ! Controls whether @dfn{page breaking} is to take place. If this variable ! is non-@code{nil}, the articles will be divided into pages whenever a ! page delimiter appears in the article. If this variable is @code{nil}, ! paging will not be done. ! ! @item gnus-page-delimiter ! @vindex gnus-page-delimiter ! This is the delimiter mentioned above. By default, it is @samp{^L} ! (form linefeed). ! @end table ! ! ! @node Composing Messages ! @chapter Composing Messages ! @cindex reply ! @cindex followup ! @cindex post ! ! @kindex C-c C-c (Post) ! All commands for posting and mailing will put you in a message buffer ! where you can edit the article all you like, before you send the article ! by pressing @kbd{C-c C-c}. @xref{Top, , Top, message, The Message ! Manual}. If you are in a foreign news group, and you wish to post the ! article using the foreign server, you can give a prefix to @kbd{C-c C-c} ! to make Gnus try to post using the foreign server. ! ! @menu ! * Mail:: Mailing and replying. ! * Post:: Posting and following up. ! * Posting Server:: What server should you post via? ! * Mail and Post:: Mailing and posting at the same time. ! * Archived Messages:: Where Gnus stores the messages you've sent. ! @c * Posting Styles:: An easier way to configure some key elements. ! @c * Drafts:: Postponing messages and rejected messages. ! @c * Rejected Articles:: What happens if the server doesn't like your article? ! @end menu ! ! Also see @pxref{Canceling and Superseding} for information on how to ! remove articles you shouldn't have posted. ! ! ! @node Mail ! @section Mail ! ! Variables for customizing outgoing mail: ! ! @table @code ! @item gnus-uu-digest-headers ! @vindex gnus-uu-digest-headers ! List of regexps to match headers included in digested messages. The ! headers will be included in the sequence they are matched. ! ! @end table ! ! ! @node Post ! @section Post ! ! Variables for composing news articles: ! ! @table @code ! @item gnus-sent-message-ids-file ! @vindex gnus-sent-message-ids-file ! Gnus will keep a @code{Message-ID} history file of all the mails it has ! sent. If it discovers that it has already sent a mail, it will ask the ! user whether to re-send the mail. (This is primarily useful when ! dealing with @sc{soup} packets and the like where one is apt to sent the ! same packet multiple times.) This variable says what the name of this ! history file is. It is @file{~/News/Sent-Message-IDs} by default. Set ! this variable to @code{nil} if you don't want Gnus to keep a history ! file. ! ! @item gnus-sent-message-ids-length ! @vindex gnus-sent-message-ids-length ! This variable says how many @code{Message-ID}s to keep in the history ! file. It is 1000 by default. ! ! @end table ! ! ! @node Posting Server ! @section Posting Server ! ! When you press those magical @kbd{C-c C-c} keys to ship off your latest ! (extremely intelligent, of course) article, where does it go? ! ! Thank you for asking. I hate you. ! ! @vindex gnus-post-method ! ! It can be quite complicated. Normally, Gnus will use the same native ! server. However. If your native server doesn't allow posting, just ! reading, you probably want to use some other server to post your ! (extremely intelligent and fabulously interesting) articles. You can ! then set the @code{gnus-post-method} to some other method: ! ! @lisp ! (setq gnus-post-method '(nnspool "")) ! @end lisp ! ! Now, if you've done this, and then this server rejects your article, or ! this server is down, what do you do then? To override this variable you ! can use a non-zero prefix to the @kbd{C-c C-c} command to force using ! the ``current'' server for posting. ! ! If you give a zero prefix (i. e., @kbd{C-u 0 C-c C-c}) to that command, ! Gnus will prompt you for what method to use for posting. ! ! You can also set @code{gnus-post-method} to a list of select methods. ! If that's the case, Gnus will always prompt you for what method to use ! for posting. ! ! ! @node Mail and Post ! @section Mail and Post ! ! Here's a list of variables that are relevant to both mailing and ! posting: ! ! @table @code ! @item gnus-mailing-list-groups ! @findex gnus-mailing-list-groups ! @cindex mailing lists ! ! If your news server offers groups that are really mailing lists that are ! gatewayed to the @sc{nntp} server, you can read those groups without ! problems, but you can't post/followup to them without some difficulty. ! One solution is to add a @code{to-address} to the group parameters ! (@pxref{Group Parameters}). An easier thing to do is set the ! @code{gnus-mailing-list-groups} to a regexp that match the groups that ! really are mailing lists. Then, at least, followups to the mailing ! lists will work most of the time. Posting to these groups (@kbd{a}) is ! still a pain, though. ! ! @end table ! ! You may want to do spell-checking on messages that you send out. Or, if ! you don't want to spell-check by hand, you could add automatic ! spell-checking via the @code{ispell} package: ! ! @cindex ispell ! @findex ispell-message ! @lisp ! (add-hook 'message-send-hook 'ispell-message) ! @end lisp ! ! ! @node Archived Messages ! @section Archived Messages ! @cindex archived messages ! @cindex sent messages ! ! Gnus provides a few different methods for storing the mail you send. ! The default method is to use the @dfn{archive virtual server} to store ! the mail. If you want to disable this completely, you should set ! @code{gnus-message-archive-group} to @code{nil}. ! ! @vindex gnus-message-archive-method ! @code{gnus-message-archive-method} says what virtual server Gnus is to ! use to store sent messages. It is @code{(nnfolder "archive" ! (nnfolder-directory "~/Mail/archive/"))} by default, but you can use any ! mail select method (@code{nnml}, @code{nnmbox}, etc.). However, ! @code{nnfolder} is a quite likeable select method for doing this sort of ! thing. If you don't like the default directory chosen, you could say ! something like: ! ! @lisp ! (setq gnus-message-archive-method ! '(nnfolder "archive" ! (nnfolder-inhibit-expiry t) ! (nnfolder-active-file "~/News/sent-mail/active") ! (nnfolder-directory "~/News/sent-mail/"))) ! @end lisp ! ! @vindex gnus-message-archive-group ! @cindex Gcc ! Gnus will insert @code{Gcc} headers in all outgoing messages that point ! to one or more group(s) on that server. Which group to use is ! determined by the @code{gnus-message-archive-group} variable. ! ! This variable can be: ! ! @itemize @bullet ! @item a string ! Messages will be saved in that group. ! @item a list of strings ! Messages will be saved in all those groups. ! @item an alist of regexps, functions and forms ! When a key ``matches'', the result is used. ! @end itemize ! ! Let's illustrate: ! ! Just saving to a single group called @samp{MisK}: ! @lisp ! (setq gnus-message-archive-group "MisK") ! @end lisp ! ! Saving to two groups, @samp{MisK} and @samp{safe}: ! @lisp ! (setq gnus-message-archive-group '("MisK" "safe")) ! @end lisp ! ! Save to different groups based on what group you are in: ! @lisp ! (setq gnus-message-archive-group ! '(("^alt" "sent-to-alt") ! ("mail" "sent-to-mail") ! (".*" "sent-to-misc"))) ! @end lisp ! ! More complex stuff: ! @lisp ! (setq gnus-message-archive-group ! '((if (message-news-p) ! "misc-news" ! "misc-mail"))) ! @end lisp ! ! This is the default. ! ! How about storing all news messages in one file, but storing all mail ! messages in one file per month: ! ! @lisp ! (setq gnus-message-archive-group ! '((if (message-news-p) ! "misc-news" ! (concat "mail." (format-time-string ! "%Y-%m" (current-time)))))) ! @end lisp ! ! Now, when you send a message off, it will be stored in the appropriate ! group. (If you want to disable storing for just one particular message, ! you can just remove the @code{Gcc} header that has been inserted.) The ! archive group will appear in the group buffer the next time you start ! Gnus, or the next time you press @kbd{F} in the group buffer. You can ! enter it and read the articles in it just like you'd read any other ! group. If the group gets really big and annoying, you can simply rename ! if (using @kbd{G r} in the group buffer) to something nice -- ! @samp{misc-mail-september-1995}, or whatever. New messages will ! continue to be stored in the old (now empty) group. ! ! That's the default method of archiving sent mail. Gnus also offers two ! other variables for the people who don't like the default method. In ! that case you should set @code{gnus-message-archive-group} to ! @code{nil}; this will disable archiving. ! ! XEmacs 19.13 doesn't have @code{format-time-string}, so you'll have to ! use a different value for @code{gnus-message-archive-group} there. ! ! ! @table @code ! @item gnus-outgoing-message-group ! @vindex gnus-outgoing-message-group ! All outgoing messages will be put in this group. If you want to store ! all your outgoing mail and articles in the group @samp{nnml:archive}, ! you set this variable to that value. This variable 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 ! current newsgroup name and then returns a suitable group name (or list ! of names). ! @end table ! ! ! @c @node Posting Styles ! @c @section Posting Styles ! @c @cindex posting styles ! @c @cindex styles ! @c ! @c All them variables, they make my head swim. ! @c ! @c So what if you want a different @code{Organization} and signature based ! @c on what groups you post to? And you post both from your home machine ! @c and your work machine, and you want different @code{From} lines, and so ! @c on? ! @c ! @c @vindex gnus-posting-styles ! @c One way to do stuff like that is to write clever hooks that change the ! @c variables you need to have changed. That's a bit boring, so somebody ! @c came up with the bright idea of letting the user specify these things in ! @c a handy alist. Here's an example of a @code{gnus-posting-styles} ! @c variable: ! @c ! @c @lisp ! @c ((".*" ! @c (signature . "Peace and happiness") ! @c (organization . "What me?")) ! @c ("^comp" ! @c (signature . "Death to everybody")) ! @c ("comp.emacs.i-love-it" ! @c (organization . "Emacs is it"))) ! @c @end lisp ! @c ! @c As you might surmise from this example, this alist consists of several ! @c @dfn{styles}. Each style will be applicable if the first element ! @c ``matches'', in some form or other. The entire alist will be iterated ! @c over, from the beginning towards the end, and each match will be ! @c applied, which means that attributes in later styles that match override ! @c the same attributes in earlier matching styles. So ! @c @samp{comp.programming.literate} will have the @samp{Death to everybody} ! @c signature and the @samp{What me?} @code{Organization} header. ! @c ! @c The first element in each style is called the @code{match}. If it's a ! @c string, then Gnus will try to regexp match it against the group name. ! @c If it's a function symbol, that function will be called with no ! @c arguments. If it's a variable symbol, then the variable will be ! @c referenced. If it's a list, then that list will be @code{eval}ed. In ! @c any case, if this returns a non-@code{nil} value, then the style is said ! @c to @dfn{match}. ! @c ! @c Each style may contain a arbitrary amount of @dfn{attributes}. Each ! @c attribute consists of a @var{(name . value)} pair. The attribute name ! @c can be one of @code{signature}, @code{organization} or @code{from}. The ! @c attribute name can also be a string. In that case, this will be used as ! @c a header name, and the value will be inserted in the headers of the ! @c article. ! @c ! @c The attribute value can be a string (used verbatim), a function (the ! @c return value will be used), a variable (its value will be used) or a ! @c list (it will be @code{eval}ed and the return value will be used). ! @c ! @c So here's a new example: ! @c ! @c @lisp ! @c (setq gnus-posting-styles ! @c '((".*" ! @c (signature . "~/.signature") ! @c (from . "user@@foo (user)") ! @c ("X-Home-Page" . (getenv "WWW_HOME")) ! @c (organization . "People's Front Against MWM")) ! @c ("^rec.humor" ! @c (signature . my-funny-signature-randomizer)) ! @c ((equal (system-name) "gnarly") ! @c (signature . my-quote-randomizer)) ! @c (posting-from-work-p ! @c (signature . "~/.work-signature") ! @c (from . "user@@bar.foo (user)") ! @c (organization . "Important Work, Inc")) ! @c ("^nn.+:" ! @c (signature . "~/.mail-signature")))) ! @c @end lisp ! ! @c @node Drafts ! @c @section Drafts ! @c @cindex drafts ! @c ! @c If you are writing a message (mail or news) and suddenly remember that ! @c you have a steak in the oven (or some pesto in the food processor, you ! @c craazy vegetarians), you'll probably wish there was a method to save the ! @c message you are writing so that you can continue editing it some other ! @c day, and send it when you feel its finished. ! @c ! @c Well, don't worry about it. Whenever you start composing a message of ! @c some sort using the Gnus mail and post commands, the buffer you get will ! @c automatically associate to an article in a special @dfn{draft} group. ! @c If you save the buffer the normal way (@kbd{C-x C-s}, for instance), the ! @c article will be saved there. (Auto-save files also go to the draft ! @c group.) ! @c ! @c @cindex nndraft ! @c @vindex gnus-draft-group-directory ! @c The draft group is a special group (which is implemented as an ! @c @code{nndraft} group, if you absolutely have to know) called ! @c @samp{nndraft:drafts}. The variable @code{gnus-draft-group-directory} ! @c controls both the name of the group and the location---the leaf element ! @c in the path will be used as the name of the group. What makes this ! @c group special is that you can't tick any articles in it or mark any ! @c articles as read---all articles in the group are permanently unread. ! @c ! @c If the group doesn't exist, it will be created and you'll be subscribed ! @c to it. ! @c ! @c @findex gnus-dissociate-buffer-from-draft ! @c @kindex C-c M-d (Mail) ! @c @kindex C-c M-d (Post) ! @c @findex gnus-associate-buffer-with-draft ! @c @kindex C-c C-d (Mail) ! @c @kindex C-c C-d (Post) ! @c If you're writing some super-secret message that you later want to ! @c encode with PGP before sending, you may wish to turn the auto-saving ! @c (and association with the draft group) off. You never know who might be ! @c interested in reading all your extremely valuable and terribly horrible ! @c and interesting secrets. The @kbd{C-c M-d} ! @c (@code{gnus-dissociate-buffer-from-draft}) command does that for you. ! @c If you change your mind and want to turn the auto-saving back on again, ! @c @kbd{C-c C-d} (@code{gnus-associate-buffer-with-draft} does that. ! @c ! @c @vindex gnus-use-draft ! @c To leave association with the draft group off by default, set ! @c @code{gnus-use-draft} to @code{nil}. It is @code{t} by default. ! @c ! @c @findex gnus-summary-send-draft ! @c @kindex S D c (Summary) ! @c When you want to continue editing the article, you simply enter the ! @c draft group and push @kbd{S D c} (@code{gnus-summary-send-draft}) to do ! @c that. You will be placed in a buffer where you left off. ! @c ! @c Rejected articles will also be put in this draft group (@pxref{Rejected ! @c Articles}). ! @c ! @c @findex gnus-summary-send-all-drafts ! @c If you have lots of rejected messages you want to post (or mail) without ! @c doing further editing, you can use the @kbd{S D a} command ! @c (@code{gnus-summary-send-all-drafts}). This command understands the ! @c process/prefix convention (@pxref{Process/Prefix}). ! @c ! @c ! @c @node Rejected Articles ! @c @section Rejected Articles ! @c @cindex rejected articles ! @c ! @c Sometimes a news server will reject an article. Perhaps the server ! @c doesn't like your face. Perhaps it just feels miserable. Perhaps ! @c @emph{there be demons}. Perhaps you have included too much cited text. ! @c Perhaps the disk is full. Perhaps the server is down. ! @c ! @c These situations are, of course, totally beyond the control of Gnus. ! @c (Gnus, of course, loves the way you look, always feels great, has angels ! @c fluttering around inside of it, doesn't care about how much cited text ! @c you include, never runs full and never goes down.) So Gnus saves these ! @c articles until some later time when the server feels better. ! @c ! @c The rejected articles will automatically be put in a special draft group ! @c (@pxref{Drafts}). When the server comes back up again, you'd then ! @c typically enter that group and send all the articles off. ! @c ! ! @node Select Methods ! @chapter Select Methods ! @cindex foreign groups ! @cindex select methods ! ! A @dfn{foreign group} is a group that is not read by the usual (or ! default) means. It could be, for instance, a group from a different ! @sc{nntp} server, it could be a virtual group, or it could be your own ! personal mail group. ! ! A foreign group (or any group, really) is specified by a @dfn{name} and ! a @dfn{select method}. To take the latter first, a select method is a ! list where the first element says what backend to use (eg. @code{nntp}, ! @code{nnspool}, @code{nnml}) and the second element is the @dfn{server ! name}. There may be additional elements in the select method, where the ! value may have special meaning for the backend in question. ! ! One could say that a select method defines a @dfn{virtual server}---so ! we do just that (@pxref{The Server Buffer}). ! ! The @dfn{name} of the group is the name the backend will recognize the ! group as. ! ! For instance, the group @samp{soc.motss} on the @sc{nntp} server ! @samp{some.where.edu} will have the name @samp{soc.motss} and select ! method @code{(nntp "some.where.edu")}. Gnus will call this group, in ! all circumstances, @samp{nntp+some.where.edu:soc.motss}, even though the ! @code{nntp} backend just knows this group as @samp{soc.motss}. ! ! The different methods all have their peculiarities, of course. ! ! @menu ! * The Server Buffer:: Making and editing virtual servers. ! * Getting News:: Reading USENET news with Gnus. ! * Getting Mail:: Reading your personal mail with Gnus. ! * Other Sources:: Reading directories, files, SOUP packets. ! * Combined Groups:: Combining groups into one group. ! @end menu ! ! ! @node The Server Buffer ! @section The Server Buffer ! ! Traditionally, a @dfn{server} is a machine or a piece of software that ! one connects to, and then requests information from. Gnus does not ! connect directly to any real servers, but does all transactions through ! one backend or other. But that's just putting one layer more between ! the actual media and Gnus, so we might just as well say that each ! backend represents a virtual server. ! ! For instance, the @code{nntp} backend may be used to connect to several ! different actual @sc{nntp} servers, or, perhaps, to many different ports ! on the same actual @sc{nntp} server. You tell Gnus which backend to ! use, and what parameters to set by specifying a @dfn{select method}. ! ! These select methods specifications can sometimes become quite ! complicated---say, for instance, that you want to read from the ! @sc{nntp} server @samp{news.funet.fi} on port number @code{13}, which ! hangs if queried for @sc{nov} headers and has a buggy select. Ahem. ! Anyways, if you had to specify that for each group that used this ! server, that would be too much work, so Gnus offers a way of naming ! select methods, which is what you do in the server buffer. ! ! To enter the server buffer, user the @kbd{^} ! (@code{gnus-group-enter-server-mode}) command in the group buffer. ! ! @menu ! * Server Buffer Format:: You can customize the look of this buffer. ! * Server Commands:: Commands to manipulate servers. ! * Example Methods:: Examples server specifications. ! * Creating a Virtual Server:: An example session. ! * Servers and Methods:: You can use server names as select methods. ! * Unavailable Servers:: Some servers you try to contact may be down. ! @end menu ! ! @vindex gnus-server-mode-hook ! @code{gnus-server-mode-hook} is run when creating the server buffer. ! ! ! @node Server Buffer Format ! @subsection Server Buffer Format ! @cindex server buffer format ! ! @vindex gnus-server-line-format ! You can change the look of the server buffer lines by changing the ! @code{gnus-server-line-format} variable. This is a @code{format}-like ! variable, with some simple extensions: ! ! @table @samp ! ! @item h ! How the news is fetched---the backend name. ! ! @item n ! The name of this server. ! ! @item w ! Where the news is to be fetched from---the address. ! ! @item s ! The opened/closed/denied status of the server. ! @end table ! ! @vindex gnus-server-mode-line-format ! The mode line can also be customized by using the ! @code{gnus-server-mode-line-format} variable. The following specs are ! understood: ! ! @table @samp ! @item S ! Server name. ! ! @item M ! Server method. ! @end table ! ! Also @pxref{Formatting Variables}. ! ! ! @node Server Commands ! @subsection Server Commands ! @cindex server commands ! ! @table @kbd ! ! @item a ! @kindex a (Server) ! @findex gnus-server-add-server ! Add a new server (@code{gnus-server-add-server}). ! ! @item e ! @kindex e (Server) ! @findex gnus-server-edit-server ! Edit a server (@code{gnus-server-edit-server}). ! ! @item SPACE ! @kindex SPACE (Server) ! @findex gnus-server-read-server ! Browse the current server (@code{gnus-server-read-server}). ! ! @item q ! @kindex q (Server) ! @findex gnus-server-exit ! Return to the group buffer (@code{gnus-server-exit}). ! ! @item k ! @kindex k (Server) ! @findex gnus-server-kill-server ! Kill the current server (@code{gnus-server-kill-server}). ! ! @item y ! @kindex y (Server) ! @findex gnus-server-yank-server ! Yank the previously killed server (@code{gnus-server-yank-server}). ! ! @item c ! @kindex c (Server) ! @findex gnus-server-copy-server ! Copy the current server (@code{gnus-server-copy-server}). ! ! @item l ! @kindex l (Server) ! @findex gnus-server-list-servers ! List all servers (@code{gnus-server-list-servers}). ! ! @end table ! ! ! @node Example Methods ! @subsection Example Methods ! ! Most select methods are pretty simple and self-explanatory: ! ! @lisp ! (nntp "news.funet.fi") ! @end lisp ! ! Reading directly from the spool is even simpler: ! ! @lisp ! (nnspool "") ! @end lisp ! ! As you can see, the first element in a select method is the name of the ! backend, and the second is the @dfn{address}, or @dfn{name}, if you ! will. ! ! After these two elements, there may be a arbitrary number of ! @var{(variable form)} pairs. ! ! To go back to the first example---imagine that you want to read from ! port @code{15} from that machine. This is what the select method should ! look like then: ! ! @lisp ! (nntp "news.funet.fi" (nntp-port-number 15)) ! @end lisp ! ! You should read the documentation to each backend to find out what ! variables are relevant, but here's an @code{nnmh} example. ! ! @code{nnmh} is a mail backend that reads a spool-like structure. Say ! you have two structures that you wish to access: One is your private ! mail spool, and the other is a public one. Here's the possible spec for ! you private mail: ! ! @lisp ! (nnmh "private" (nnmh-directory "~/private/mail/")) ! @end lisp ! ! (This server is then called @samp{private}, but you may have guessed ! that.) ! ! Here's the method for a public spool: ! ! @lisp ! (nnmh "public" ! (nnmh-directory "/usr/information/spool/") ! (nnmh-get-new-mail nil)) ! @end lisp ! ! ! @node Creating a Virtual Server ! @subsection Creating a Virtual Server ! ! If you're saving lots of articles in the cache by using persistent ! articles, you may want to create a virtual server to read the cache. ! ! First you need to add a new server. The @kbd{a} command does that. It ! would probably be best to use @code{nnspool} to read the cache. You ! could also use @code{nnml} or @code{nnmh}, though. ! ! Type @kbd{a nnspool RET cache RET}. ! ! You should now have a brand new @code{nnspool} virtual server called ! @samp{cache}. You now need to edit it to have the right definitions. ! Type @kbd{e} to edit the server. You'll be entered into a buffer that ! will contain the following: ! ! @lisp ! (nnspool "cache") ! @end lisp ! ! Change that to: ! ! @lisp ! (nnspool "cache" ! (nnspool-spool-directory "~/News/cache/") ! (nnspool-nov-directory "~/News/cache/") ! (nnspool-active-file "~/News/cache/active")) ! @end lisp ! ! Type @kbd{C-c C-c} to return to the server buffer. If you now press ! @kbd{RET} over this virtual server, you should be entered into a browse ! buffer, and you should be able to enter any of the groups displayed. ! ! ! @node Servers and Methods ! @subsection Servers and Methods ! ! Wherever you would normally use a select method ! (eg. @code{gnus-secondary-select-method}, in the group select method, ! when browsing a foreign server) you can use a virtual server name ! instead. This could potentially save lots of typing. And it's nice all ! over. ! ! ! @node Unavailable Servers ! @subsection Unavailable Servers ! ! If a server seems to be unreachable, Gnus will mark that server as ! @code{denied}. That means that any subsequent attempt to make contact ! with that server will just be ignored. ``It can't be opened,'' Gnus ! will tell you, without making the least effort to see whether that is ! actually the case or not. ! ! That might seem quite naughty, but it does make sense most of the time. ! Let's say you have 10 groups subscribed to the server ! @samp{nepholococcygia.com}. This server is located somewhere quite far ! away from you, the machine is quite, so it takes 1 minute just to find ! out that it refuses connection from you today. If Gnus were to attempt ! to do that 10 times, you'd be quite annoyed, so Gnus won't attempt to do ! that. Once it has gotten a single ``connection refused'', it will ! regard that server as ``down''. ! ! So, what happens if the machine was only feeling unwell temporarily? ! How do you test to see whether the machine has come up again? ! ! You jump to the server buffer (@pxref{The Server Buffer}) and poke it ! with the following commands: ! ! @table @kbd ! ! @item O ! @kindex O (Server) ! @findex gnus-server-open-server ! Try to establish connection to the server on the current line ! (@code{gnus-server-open-server}). ! ! @item C ! @kindex C (Server) ! @findex gnus-server-close-server ! Close the connection (if any) to the server ! (@code{gnus-server-close-server}). ! ! @item D ! @kindex D (Server) ! @findex gnus-server-deny-server ! Mark the current server as unreachable ! (@code{gnus-server-deny-server}). ! ! @item R ! @kindex R (Server) ! @findex gnus-server-remove-denials ! Remove all marks to whether Gnus was denied connection from all servers ! (@code{gnus-server-remove-denials}). ! ! @end table ! ! ! @node Getting News ! @section Getting News ! @cindex reading news ! @cindex news backends ! ! A newsreader is normally used for reading news. Gnus currently provides ! only two methods of getting news -- it can read from an @sc{nntp} ! server, or it can read from a local spool. ! ! @menu ! * NNTP:: Reading news from an @sc{nntp} server. ! * News Spool:: Reading news from the local spool. ! @end menu ! ! ! @node NNTP ! @subsection @sc{nntp} ! @cindex nntp ! ! Subscribing to a foreign group from an @sc{nntp} server is rather easy. ! You just specify @code{nntp} as method and the address of the @sc{nntp} ! server as the, uhm, address. ! ! If the @sc{nntp} server is located at a non-standard port, setting the ! third element of the select method to this port number should allow you ! to connect to the right port. You'll have to edit the group info for ! that (@pxref{Foreign Groups}). ! ! The name of the foreign group can be the same as a native group. In ! fact, you can subscribe to the same group from as many different servers ! you feel like. There will be no name collisions. ! ! The following variables can be used to create a virtual @code{nntp} ! server: ! ! @table @code ! ! @item nntp-server-opened-hook ! @vindex nntp-server-opened-hook ! @cindex @sc{mode reader} ! @cindex authinfo ! @cindex authentification ! @cindex nntp authentification ! @findex nntp-send-authinfo ! @findex nntp-send-mode-reader ! @code{nntp-server-opened-hook} is run after a connection has been made. ! It can be used to send commands to the @sc{nntp} server after it has ! been contacted. By default is sends the command @code{MODE READER} to ! the server with the @code{nntp-send-mode-reader} function. Another ! popular function is @code{nntp-send-authinfo}, which will prompt you for ! an @sc{nntp} password and stuff. ! ! @item nntp-server-action-alist ! @vindex nntp-server-action-alist ! This is an list of regexps to match on server types and actions to be ! taken when matches are made. For instance, if you want Gnus to beep ! every time you connect to innd, you could say something like: ! ! @lisp ! (setq nntp-server-action-alist ! '(("innd" (ding)))) ! @end lisp ! ! You probably don't want to do that, though. ! ! The default value is ! ! @lisp ! '(("nntpd 1\\.5\\.11t" ! (remove-hook 'nntp-server-opened-hook nntp-send-mode-reader))) ! @end lisp ! ! This ensures that Gnus doesn't send the @code{MODE READER} command to ! nntpd 1.5.11t, since that command chokes that server, I've been told. ! ! @item nntp-maximum-request ! @vindex nntp-maximum-request ! If the @sc{nntp} server doesn't support @sc{nov} headers, this backend ! will collect headers by sending a series of @code{head} commands. To ! speed things up, the backend sends lots of these commands without ! waiting for reply, and then reads all the replies. This is controlled ! by the @code{nntp-maximum-request} variable, and is 400 by default. If ! your network is buggy, you should set this to 1. ! ! @item nntp-connection-timeout ! @vindex nntp-connection-timeout ! If you have lots of foreign @code{nntp} groups that you connect to ! regularly, you're sure to have problems with @sc{nntp} servers not ! responding properly, or being too loaded to reply within reasonable ! time. This is can lead to awkward problems, which can be helped ! somewhat by setting @code{nntp-connection-timeout}. This is an integer ! that says how many seconds the @code{nntp} backend should wait for a ! connection before giving up. If it is @code{nil}, which is the default, ! no timeouts are done. ! ! @item nntp-command-timeout ! @vindex nntp-command-timeout ! @cindex PPP connections ! @cindex dynamic IP addresses ! If you're running Gnus on a machine that has a dynamically assigned ! address, Gnus may become confused. If the address of your machine ! changes after connecting to the @sc{nntp} server, Gnus will simply sit ! waiting forever for replies from the server. To help with this ! unfortunate problem, you can set this command to a number. Gnus will ! then, if it sits waiting longer than that number of seconds for a reply ! from the server, shut down the connection, start a new one, and resend ! the command. This should hopefully be transparent to the user. A ! likely number is 30 seconds. ! ! @item nntp-retry-on-break ! @vindex nntp-retry-on-break ! If this variable is non-@code{nil}, you can also @kbd{C-g} if Gnus ! hangs. This will have much the same effect as the command timeout ! described above. ! ! @item nntp-server-hook ! @vindex nntp-server-hook ! This hook is run as the last step when connecting to an @sc{nntp} ! server. ! ! @findex nntp-open-rlogin ! @findex nntp-open-network-stream ! @item nntp-open-server-function ! @vindex nntp-open-server-function ! This function is used to connect to the remote system. Two pre-made ! functions are @code{nntp-open-network-stream}, which is the default, and ! simply connects to some port or other on the remote system. The other ! is @code{nntp-open-rlogin}, which does an rlogin on the remote system, ! and then does a telnet to the @sc{nntp} server available there. ! ! @item nntp-rlogin-parameters ! @vindex nntp-rlogin-parameters ! If you use @code{nntp-open-rlogin} as the ! @code{nntp-open-server-function}, this list will be used as the ! parameter list given to @code{rsh}. ! ! @item nntp-end-of-line ! @vindex nntp-end-of-line ! String to use as end-of-line markers when talking to the @sc{nntp} ! server. This is @samp{\r\n} by default, but should be @samp{\n} when ! using @code{rlogin} to talk to the server. ! ! @item nntp-rlogin-user-name ! @vindex nntp-rlogin-user-name ! User name on the remote system when using the @code{rlogin} connect ! function. ! ! @item nntp-address ! @vindex nntp-address ! The address of the remote system running the @sc{nntp} server. ! ! @item nntp-port-number ! @vindex nntp-port-number ! Port number to connect to when using the @code{nntp-open-network-stream} ! connect function. ! ! @item nntp-buggy-select ! @vindex nntp-buggy-select ! Set this to non-@code{nil} if your select routine is buggy. ! ! @item nntp-nov-is-evil ! @vindex nntp-nov-is-evil ! If the @sc{nntp} server does not support @sc{nov}, you could set this ! variable to @code{t}, but @code{nntp} usually checks whether @sc{nov} ! can be used automatically. ! ! @item nntp-xover-commands ! @vindex nntp-xover-commands ! @cindex nov ! @cindex XOVER ! List of strings that are used as commands to fetch @sc{nov} lines from a ! server. The default value of this variable is @code{("XOVER" ! "XOVERVIEW")}. ! ! @item nntp-nov-gap ! @vindex nntp-nov-gap ! @code{nntp} normally sends just one big request for @sc{nov} lines to ! the server. The server responds with one huge list of lines. However, ! if you have read articles 2-5000 in the group, and only want to read ! article 1 and 5001, that means that @code{nntp} will fetch 4999 @sc{nov} ! lines that you do not want, and will not use. This variable says how ! big a gap between two consecutive articles is allowed to be before the ! @code{XOVER} request is split into several request. Note that if your ! network is fast, setting this variable to a really small number means ! that fetching will probably be slower. If this variable is @code{nil}, ! @code{nntp} will never split requests. ! ! @item nntp-prepare-server-hook ! @vindex nntp-prepare-server-hook ! A hook run before attempting to connect to an @sc{nntp} server. ! ! @item nntp-async-number ! @vindex nntp-async-number ! How many articles should be pre-fetched when in asynchronous mode. If ! this variable is @code{t}, @code{nntp} will pre-fetch all the articles ! that it can without bound. If it is @code{nil}, no pre-fetching will be ! made. ! ! @item nntp-warn-about-losing-connection ! @vindex nntp-warn-about-losing-connection ! If this variable is non-@code{nil}, some noise will be made when a ! server closes connection. ! ! @end table ! ! ! @node News Spool ! @subsection News Spool ! @cindex nnspool ! @cindex news spool ! ! Subscribing to a foreign group from the local spool is extremely easy, ! and might be useful, for instance, to speed up reading groups like ! @samp{alt.binaries.pictures.furniture}. ! ! Anyways, you just specify @code{nnspool} as the method and @samp{} (or ! anything else) as the address. ! ! If you have access to a local spool, you should probably use that as the ! native select method (@pxref{Finding the News}). It is normally faster ! than using an @code{nntp} select method, but might not be. It depends. ! You just have to try to find out what's best at your site. ! ! @table @code ! ! @item nnspool-inews-program ! @vindex nnspool-inews-program ! Program used to post an article. ! ! @item nnspool-inews-switches ! @vindex nnspool-inews-switches ! Parameters given to the inews program when posting an article. ! ! @item nnspool-spool-directory ! @vindex nnspool-spool-directory ! Where @code{nnspool} looks for the articles. This is normally ! @file{/usr/spool/news/}. ! ! @item nnspool-nov-directory ! @vindex nnspool-nov-directory ! Where @code{nnspool} will look for @sc{nov} files. This is normally ! @file{/usr/spool/news/over.view/}. ! ! @item nnspool-lib-dir ! @vindex nnspool-lib-dir ! Where the news lib dir is (@file{/usr/lib/news/} by default). ! ! @item nnspool-active-file ! @vindex nnspool-active-file ! The path of the active file. ! ! @item nnspool-newsgroups-file ! @vindex nnspool-newsgroups-file ! The path of the group descriptions file. ! ! @item nnspool-history-file ! @vindex nnspool-history-file ! The path of the news history file. ! ! @item nnspool-active-times-file ! @vindex nnspool-active-times-file ! The path of the active date file. ! ! @item nnspool-nov-is-evil ! @vindex nnspool-nov-is-evil ! If non-@code{nil}, @code{nnspool} won't try to use any @sc{nov} files ! that it finds. ! ! @item nnspool-sift-nov-with-sed ! @vindex nnspool-sift-nov-with-sed ! @cindex sed ! If non-@code{nil}, which is the default, use @code{sed} to get the ! relevant portion from the overview file. If nil, @code{nnspool} will ! load the entire file into a buffer and process it there. ! ! @end table ! ! ! @node Getting Mail ! @section Getting Mail ! @cindex reading mail ! @cindex mail ! ! Reading mail with a newsreader---isn't that just plain WeIrD? But of ! course. ! ! @menu ! * Getting Started Reading Mail:: A simple cookbook example. ! * Splitting Mail:: How to create mail groups. ! * Mail Backend Variables:: Variables for customizing mail handling. ! * Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail. ! * Mail and Procmail:: Reading mail groups that procmail create. ! * Incorporating Old Mail:: What about the old mail you have? ! * Expiring Mail:: Getting rid of unwanted mail. ! * Duplicates:: Dealing with duplicated mail. ! * Not Reading Mail:: Using mail backends for reading other files. ! * Choosing a Mail Backend:: Gnus can read a variety of mail formats. ! @end menu ! ! ! @node Getting Started Reading Mail ! @subsection Getting Started Reading Mail ! ! It's quite easy to use Gnus to read your new mail. You just plonk the ! mail backend of your choice into @code{gnus-secondary-select-methods}, ! and things will happen automatically. ! ! For instance, if you want to use @code{nnml} (which is a one file per ! mail backend), you could put the following in your @file{.gnus} file: ! ! @lisp ! (setq gnus-secondary-select-methods ! '((nnml "private"))) ! @end lisp ! ! Now, the next time you start Gnus, this backend will be queried for new ! articles, and it will move all the messages in your spool file to its ! directory, which is @code{~/Mail/} by default. The new group that will ! be created (@samp{mail.misc}) will be subscribed, and you can read it ! like any other group. ! ! You will probably want to split the mail into several groups, though: ! ! @lisp ! (setq nnmail-split-methods ! '(("junk" "^From:.*Lars Ingebrigtsen") ! ("crazy" "^Subject:.*die\\|^Organization:.*flabby") ! ("other" ""))) ! @end lisp ! ! This will result in three new mail groups being created: ! @samp{nnml:junk}, @samp{nnml:crazy}, and @samp{nnml:other}. All the ! mail that doesn't fit into the first two groups will be placed in the ! latter group. ! ! This should be sufficient for reading mail with Gnus. You might want to ! give the other sections in this part of the manual a perusal, though, ! especially @pxref{Choosing a Mail Backend} and @pxref{Expiring Mail}. ! ! ! @node Splitting Mail ! @subsection Splitting Mail ! @cindex splitting mail ! @cindex mail splitting ! ! @vindex nnmail-split-methods ! The @code{nnmail-split-methods} variable says how the incoming mail is ! to be split into groups. ! ! @lisp ! (setq nnmail-split-methods ! '(("mail.junk" "^From:.*Lars Ingebrigtsen") ! ("mail.crazy" "^Subject:.*die\\|^Organization:.*flabby") ! ("mail.other" ""))) ! @end lisp ! ! This variable is a list of lists, where the first element of each of ! these lists is the name of the mail group (they do not have to be called ! something beginning with @samp{mail}, by the way), and the second ! element is a regular expression used on the header of each mail to ! determine if it belongs in this mail group. ! ! The second element can also be a function. In that case, it will be ! called narrowed to the headers with the first element of the rule as the ! argument. It should return a non-@code{nil} value if it thinks that the ! mail belongs in that group. ! ! The last of these groups should always be a general one, and the regular ! expression should @emph{always} be @samp{} so that it matches any ! mails that haven't been matched by any of the other regexps. ! ! If you like to tinker with this yourself, you can set this variable to a ! function of your choice. This function will be called without any ! arguments in a buffer narrowed to the headers of an incoming mail ! message. The function should return a list of groups names that it ! thinks should carry this mail message. ! ! Note that the mail backends are free to maul the poor, innocent ! incoming headers all they want to. They all add @code{Lines} headers; ! some add @code{X-Gnus-Group} headers; most rename the Unix mbox ! @code{From} line to something else. ! ! @vindex nnmail-crosspost ! The mail backends all support cross-posting. If several regexps match, ! the mail will be ``cross-posted'' to all those groups. ! @code{nnmail-crosspost} says whether to use this mechanism or not. Note ! that no articles are crossposted to the general (@samp{}) group. ! ! @vindex nnmail-crosspost-link-function ! @cindex crosspost ! @cindex links ! @code{nnmh} and @code{nnml} makes crossposts by creating hard links to ! the crossposted articles. However, not all files systems support hard ! links. If that's the case for you, set ! @code{nnmail-crosspost-link-function} to @code{copy-file}. (This ! variable is @code{add-name-to-file} by default.) ! ! Gnus gives you all the opportunity you could possibly want for shooting ! yourself in the foot. Let's say you create a group that will contain ! all the mail you get from your boss. And then you accidentally ! unsubscribe from the group. Gnus will still put all the mail from your ! boss in the unsubscribed group, and so, when your boss mails you ``Have ! that report ready by Monday or you're fired!'', you'll never see it and, ! come Tuesday, you'll still believe that you're gainfully employed while ! you really should be out collecting empty bottles to save up for next ! month's rent money. ! ! ! @node Mail Backend Variables ! @subsection Mail Backend Variables ! ! These variables are (for the most part) pertinent to all the various ! mail backends. ! ! @table @code ! @vindex nnmail-read-incoming-hook ! @item nnmail-read-incoming-hook ! The mail backends all call this hook after reading new mail. You can ! use this hook to notify any mail watch programs, if you want to. ! ! @vindex nnmail-spool-file ! @item nnmail-spool-file ! @cindex POP mail ! @cindex MAILHOST ! @cindex movemail ! @vindex nnmail-pop-password ! @vindex nnmail-pop-password-required ! The backends will look for new mail in this file. If this variable is ! @code{nil}, the mail backends will never attempt to fetch mail by ! themselves. If you are using a POP mail server and your name is ! @samp{larsi}, you should set this variable to @samp{po:larsi}. If ! your name is not @samp{larsi}, you should probably modify that ! slightly, but you may have guessed that already, you smart & handsome ! devil! You can also set this variable to @code{pop}, and Gnus will try ! to figure out the POP mail string by itself. In any case, Gnus will ! call @code{movemail} which will contact the POP server named in the ! @code{MAILHOST} environment variable. If the POP server needs a ! password, you can either set @code{nnmail-pop-password-required} to ! @code{t} and be prompted for the password, or set ! @code{nnmail-pop-password} to the password itself. ! ! When you use a mail backend, Gnus will slurp all your mail from your ! inbox and plonk it down in your home directory. Gnus doesn't move any ! mail if you're not using a mail backend---you have to do a lot of magic ! invocations first. At the time when you have finished drawing the ! pentagram, lightened the candles, and sacrificed the goat, you really ! shouldn't be too surprised when Gnus moves your mail. ! ! @vindex nnmail-use-procmail ! @vindex nnmail-procmail-suffix ! @item nnmail-use-procmail ! If non-@code{nil}, the mail backends will look in ! @code{nnmail-procmail-directory} for incoming mail. All the files in ! that directory that have names ending in @code{nnmail-procmail-suffix} ! will be considered incoming mailboxes, and will be searched for new ! mail. ! ! @vindex nnmail-crash-box ! @item nnmail-crash-box ! When the mail backends read a spool file, it is first moved to this ! file, which is @file{~/.gnus-crash-box} by default. If this file ! already exists, it will always be read (and incorporated) before any ! other spool files. ! ! @vindex nnmail-prepare-incoming-hook ! @item nnmail-prepare-incoming-hook ! This is run in a buffer that holds all the new incoming mail, and can be ! used for, well, anything, really. ! ! @vindex nnmail-pre-get-new-mail-hook ! @vindex nnmail-post-get-new-mail-hook ! @item nnmail-pre-get-new-mail-hook ! @itemx nnmail-post-get-new-mail-hook ! These are two useful hooks executed when treating new incoming ! mail---@code{nnmail-pre-get-new-mail-hook} (is called just before ! starting to handle the new mail) and ! @code{nnmail-post-get-new-mail-hook} (is called when the mail handling ! is done). Here's and example of using these two hooks to change the ! default file modes the new mail files get: ! ! @lisp ! (add-hook 'gnus-pre-get-new-mail-hook ! (lambda () (set-default-file-modes 511))) ! ! (add-hook 'gnus-post-get-new-mail-hook ! (lambda () (set-default-file-modes 551))) ! @end lisp ! ! @item nnmail-tmp-directory ! @vindex nnmail-tmp-directory ! This variable says where to move the incoming mail to while processing ! it. This is usually done in the same directory that the mail backend ! inhabits (i.e., @file{~/Mail/}), but if this variable is non-@code{nil}, ! it will be used instead. ! ! @item nnmail-movemail-program ! @vindex nnmail-movemail-program ! This program is executed to move mail from the user's inbox to her home ! directory. The default is @samp{movemail}. ! ! @item nnmail-delete-incoming ! @vindex nnmail-delete-incoming ! @cindex incoming mail files ! @cindex deleting incoming files ! If non-@code{nil}, the mail backends will delete the temporary incoming ! file after splitting mail into the proper groups. This is @code{nil} by ! default for reasons of security. ! ! @item nnmail-use-long-file-names ! @vindex nnmail-use-long-file-names ! If non-@code{nil}, the mail backends will use long file and directory ! names. Groups like @samp{mail.misc} will end up in directories like ! @file{mail.misc/}. If it is @code{nil}, the same group will end up in ! @file{mail/misc/}. ! ! @item nnmail-delete-file-function ! @vindex nnmail-delete-file-function ! @findex delete-file ! Function called to delete files. It is @code{delete-file} by default. ! ! @end table ! ! ! @node Fancy Mail Splitting ! @subsection Fancy Mail Splitting ! @cindex mail splitting ! @cindex fancy mail splitting ! ! @vindex nnmail-split-fancy ! @findex nnmail-split-fancy ! If the rather simple, standard method for specifying how to split mail ! doesn't allow you to do what you want, you can set ! @code{nnmail-split-methods} to @code{nnmail-split-fancy}. Then you can ! play with the @code{nnmail-split-fancy} variable. ! ! Let's look at an example value of this variable first: ! ! @lisp ! ;; Messages from the mailer daemon are not crossposted to any of ! ;; the ordinary groups. Warnings are put in a separate group ! ;; from real errors. ! (| ("from" mail (| ("subject" "warn.*" "mail.warning") ! "mail.misc")) ! ;; Non-error messages are crossposted to all relevant ! ;; groups, but we don't crosspost between the group for the ! ;; (ding) list and the group for other (ding) related mail. ! (& (| (any "ding@@ifi\\.uio\\.no" "ding.list") ! ("subject" "ding" "ding.misc")) ! ;; Other mailing lists... ! (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list") ! (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list") ! ;; People... ! (any "larsi@@ifi\\.uio\\.no" "people.Lars Magne Ingebrigtsen")) ! ;; Unmatched mail goes to the catch all group. ! "misc.misc"))") ! @end lisp ! ! This variable has the format of a @dfn{split}. A split is a (possibly) ! recursive structure where each split may contain other splits. Here are ! the four possible split syntaxes: ! ! @table @dfn ! ! @item GROUP ! If the split is a string, that will be taken as a group name. ! ! @item (FIELD VALUE SPLIT) ! If the split is a list, and the first element is a string, then that ! means that if header FIELD (a regexp) contains VALUE (also a regexp), ! then store the message as specified by SPLIT. ! ! @item (| SPLIT...) ! If the split is a list, and the first element is @code{|} (vertical ! bar), then process each SPLIT until one of them matches. A SPLIT is ! said to match if it will cause the mail message to be stored in one or ! more groups. ! ! @item (& SPLIT...) ! If the split is a list, and the first element is @code{&}, then process ! all SPLITs in the list. ! @end table ! ! In these splits, FIELD must match a complete field name. VALUE must ! match a complete word according to the fundamental mode syntax table. ! You can use @code{.*} in the regexps to match partial field names or ! words. ! ! @vindex nnmail-split-abbrev-alist ! FIELD and VALUE can also be lisp symbols, in that case they are expanded ! as specified by the variable @code{nnmail-split-abbrev-alist}. This is ! an alist of cons cells, where the car of the cells contains the key, and ! the cdr contains a string. ! ! @vindex nnmail-split-fancy-syntax-table ! @code{nnmail-split-fancy-syntax-table} is the syntax table in effect ! when all this splitting is performed. ! ! ! @node Mail and Procmail ! @subsection Mail and Procmail ! @cindex procmail ! ! @cindex slocal ! @cindex elm ! Many people use @code{procmail} (or some other mail filter program or ! external delivery agent---@code{slocal}, @code{elm}, etc) to split ! incoming mail into groups. If you do that, you should set ! @code{nnmail-spool-file} to @code{procmail} to ensure that the mail ! backends never ever try to fetch mail by themselves. ! ! This also means that you probably don't want to set ! @code{nnmail-split-methods} either, which has some, perhaps, unexpected ! side effects. ! ! When a mail backend is queried for what groups it carries, it replies ! with the contents of that variable, along with any groups it has figured ! out that it carries by other means. None of the backends (except ! @code{nnmh}) actually go out to the disk and check what groups actually ! exist. (It's not trivial to distinguish between what the user thinks is ! a basis for a newsgroup and what is just a plain old file or directory.) ! ! This means that you have to tell Gnus (and the backends) what groups ! exist by hand. ! ! Let's take the @code{nnmh} backend as an example. ! ! The folders are located in @code{nnmh-directory}, say, @file{~/Mail/}. ! There are three folders, @file{foo}, @file{bar} and @file{mail.baz}. ! ! Go to the group buffer and type @kbd{G m}. When prompted, answer ! @samp{foo} for the name and @samp{nnmh} for the method. Repeat ! twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure ! to include all your mail groups. ! ! That's it. You are now set to read your mail. An active file for this ! method will be created automatically. ! ! @vindex nnmail-procmail-suffix ! @vindex nnmail-procmail-directory ! If you use @code{nnfolder} or any other backend that store more than a ! single article in each file, you should never have procmail add mails to ! the file that Gnus sees. Instead, procmail should put all incoming mail ! in @code{nnmail-procmail-directory}. To arrive at the file name to put ! the incoming mail in, append @code{nnmail-procmail-suffix} to the group ! name. The mail backends will read the mail from these files. ! ! @vindex nnmail-resplit-incoming ! When Gnus reads a file called @file{mail.misc.spool}, this mail will be ! put in the @code{mail.misc}, as one would expect. However, if you want ! Gnus to split the mail the normal way, you could set ! @code{nnmail-resplit-incoming} to @code{t}. ! ! @vindex nnmail-keep-last-article ! 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. ! ! ! @node Incorporating Old Mail ! @subsection Incorporating Old Mail ! ! Most people have lots of old mail stored in various file formats. If ! you have set up Gnus to read mail using one of the spiffy Gnus mail ! backends, you'll probably wish to have that old mail incorporated into ! your mail groups. ! ! Doing so can be quite easy. ! ! To take an example: You're reading mail using @code{nnml} ! (@pxref{Mail Spool}), and have set @code{nnmail-split-methods} to a ! satisfactory value (@pxref{Splitting Mail}). You have an old Unix mbox ! file filled with important, but old, mail. You want to move it into ! your @code{nnml} groups. ! ! Here's how: ! ! @enumerate ! @item ! Go to the group buffer. ! ! @item ! Type `G f' and give the path of the mbox file when prompted to create an ! @code{nndoc} group from the mbox file (@pxref{Foreign Groups}). ! ! @item ! Type `SPACE' to enter the newly created group. ! ! @item ! Type `M P b' to process-mark all articles in this group (@pxref{Setting ! Process Marks}). ! ! @item ! Type `B r' to respool all the process-marked articles, and answer ! @samp{nnml} when prompted (@pxref{Mail Group Commands}). ! @end enumerate ! ! All the mail messages in the mbox file will now also be spread out over ! all your @code{nnml} groups. Try entering them and check whether things ! have gone without a glitch. If things look ok, you may consider ! deleting the mbox file, but I wouldn't do that unless I was absolutely ! sure that all the mail has ended up where it should be. ! ! Respooling is also a handy thing to do if you're switching from one mail ! backend to another. Just respool all the mail in the old mail groups ! using the new mail backend. ! ! ! @node Expiring Mail ! @subsection Expiring Mail ! @cindex article expiry ! ! Traditional mail readers have a tendency to remove mail articles when ! you mark them as read, in some way. Gnus takes a fundamentally ! different approach to mail reading. ! ! Gnus basically considers mail just to be news that has been received in ! a rather peculiar manner. It does not think that it has the power to ! actually change the mail, or delete any mail messages. If you enter a ! mail group, and mark articles as ``read'', or kill them in some other ! fashion, the mail articles will still exist on the system. I repeat: ! Gnus will not delete your old, read mail. Unless you ask it to, of ! course. ! ! To make Gnus get rid of your unwanted mail, you have to mark the ! articles as @dfn{expirable}. This does not mean that the articles will ! disappear right away, however. In general, a mail article will be ! deleted from your system if, 1) it is marked as expirable, AND 2) it is ! more than one week old. If you do not mark an article as expirable, it ! will remain on your system until hell freezes over. This bears ! repeating one more time, with some spurious capitalizations: IF you do ! NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES. ! ! @vindex gnus-auto-expirable-newsgroups ! You do not have to mark articles as expirable by hand. Groups that ! match the regular expression @code{gnus-auto-expirable-newsgroups} will ! have all articles that you read marked as expirable automatically. All ! articles that are marked as expirable have an @samp{E} in the first ! column in the summary buffer. ! ! Let's say you subscribe to a couple of mailing lists, and you want the ! articles you have read to disappear after a while: ! ! @lisp ! (setq gnus-auto-expirable-newsgroups ! "mail.nonsense-list\\|mail.nice-list") ! @end lisp ! ! Another way to have auto-expiry happen is to have the element ! @code{auto-expire} in the group parameters of the group. ! ! @vindex nnmail-expiry-wait ! The @code{nnmail-expiry-wait} variable supplies the default time an ! expirable article has to live. The default is seven days. ! ! Gnus also supplies a function that lets you fine-tune how long articles ! are to live, based on what group they are in. Let's say you want to ! have one month expiry period in the @samp{mail.private} group, a one day ! expiry period in the @samp{mail.junk} group, and a six day expiry period ! everywhere else: ! ! @vindex nnmail-expiry-wait-function ! @lisp ! (setq nnmail-expiry-wait-function ! (lambda (group) ! (cond ((string= group "mail.private") ! 31) ! ((string= group "mail.junk") ! 1) ! ((string= group "important") ! 'never) ! (t ! 6)))) ! @end lisp ! ! The group names that this function is fed are ``unadorned'' group ! names---no @samp{nnml:} prefixes and the like. ! ! The @code{nnmail-expiry-wait} variable and ! @code{nnmail-expiry-wait-function} function can be either a number (not ! necessarily an integer) or the symbols @code{immediate} or ! @code{never}. ! ! You can also use the @code{expiry-wait} group parameter to selectively ! change the expiry period (@pxref{Group Parameters}). ! ! @vindex nnmail-keep-last-article ! If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never ! expire the final article in a mail newsgroup. This is to make life ! easier for procmail users. ! ! @vindex gnus-total-expirable-newsgroups ! By the way, that line up there about Gnus never expiring non-expirable ! articles is a lie. If you put @code{total-expire} in the group ! parameters, articles will not be marked as expirable, but all read ! articles will be put through the expiry process. Use with extreme ! caution. Even more dangerous is the ! @code{gnus-total-expirable-newsgroups} variable. All groups that match ! this regexp will have all read articles put through the expiry process, ! which means that @emph{all} old mail articles in the groups in question ! will be deleted after a while. Use with extreme caution, and don't come ! crying to me when you discover that the regexp you used matched the ! wrong group and all your important mail has disappeared. Be a ! @emph{man}! Or a @emph{woman}! Whatever you feel more comfortable ! with! So there! ! ! ! @node Duplicates ! @subsection Duplicates ! ! @vindex nnmail-treat-duplicates ! @vindex nnmail-message-id-cache-length ! @vindex nnmail-message-id-cache-file ! @cindex duplicate mails ! If you are a member of a couple of mailing list, you will sometime ! receive two copies of the same mail. This can be quite annoying, so ! @code{nnmail} checks for and treats any duplicates it might find. To do ! this, it keeps a cache of old @code{Message-ID}s - ! @code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by ! default. The approximate maximum number of @code{Message-ID}s stored ! there is controlled by the @code{nnmail-message-id-cache-length} ! variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be ! 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. ! ! 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 ! the @code{Message-ID} as a parameter. The function must return either ! @code{nil}, @code{warn}, or @code{delete}. ! ! You can turn this feature off completely by setting the variable to ! @code{nil}. ! ! If you want all the duplicate mails to be put into a special ! @dfn{duplicates} group, you could do that using the normal mail split ! methods: ! ! @lisp ! (setq nnmail-split-fancy ! '(| ;; Messages duplicates go to a separate group. ! ("gnus-warning" "duplication of message" "duplicate") ! ;; Message from daemons, postmaster, and the like to another. ! (any mail "mail.misc") ! ;; Other rules. ! [ ... ] )) ! @end lisp ! ! Or something like: ! @lisp ! (setq nnmail-split-methods ! '(("duplicates" "^Gnus-Warning:") ! ;; Other rules. ! [...])) ! @end lisp ! ! Here's a neat feature: If you know that the recipient reads her mail ! with Gnus, and that she has @code{nnmail-treat-duplicates} set to ! @code{delete}, you can send her as many insults as you like, just by ! using a @code{Message-ID} of a mail that you know that she's already ! received. Think of all the fun! She'll never see any of it! Whee! ! ! ! @node Not Reading Mail ! @subsection Not Reading Mail ! ! If you start using any of the mail backends, they have the annoying ! habit of assuming that you want to read mail with them. This might not ! be unreasonable, but it might not be what you want. ! ! If you set @code{nnmail-spool-file} to @code{nil}, none of the backends ! will ever attempt to read incoming mail, which should help. ! ! @vindex nnbabyl-get-new-mail ! @vindex nnmbox-get-new-mail ! @vindex nnml-get-new-mail ! @vindex nnmh-get-new-mail ! @vindex nnfolder-get-new-mail ! This might be too much, if, for instance, you are reading mail quite ! happily with @code{nnml} and just want to peek at some old @sc{rmail} ! file you have stashed away with @code{nnbabyl}. All backends have ! variables called backend-@code{get-new-mail}. If you want to disable ! the @code{nnbabyl} mail reading, you edit the virtual server for the ! group to have a setting where @code{nnbabyl-get-new-mail} to @code{nil}. ! ! All the mail backends will call @code{nn}*@code{-prepare-save-mail-hook} ! narrowed to the article to be saved before saving it when reading ! incoming mail. ! ! ! @node Choosing a Mail Backend ! @subsection Choosing a Mail Backend ! ! Gnus will read the mail spool when you activate a mail group. The mail ! file is first copied to your home directory. What happens after that ! depends on what format you want to store your mail in. ! ! @menu ! * Unix Mail Box:: Using the (quite) standard Un*x mbox. ! * Rmail Babyl:: Emacs programs use the rmail babyl format. ! * Mail Spool:: Store your mail in a private spool? ! * MH Spool:: An mhspool-like backend. ! * Mail Folders:: Having one file for each group. ! @end menu ! ! ! @node Unix Mail Box ! @subsubsection Unix Mail Box ! @cindex nnmbox ! @cindex unix mail box ! ! @vindex nnmbox-active-file ! @vindex nnmbox-mbox-file ! The @dfn{nnmbox} backend will use the standard Un*x mbox file to store ! mail. @code{nnmbox} will add extra headers to each mail article to say ! which group it belongs in. ! ! Virtual server settings: ! ! @table @code ! @item nnmbox-mbox-file ! @vindex nnmbox-mbox-file ! The name of the mail box in the user's home directory. ! ! @item nnmbox-active-file ! @vindex nnmbox-active-file ! The name of the active file for the mail box. ! ! @item nnmbox-get-new-mail ! @vindex nnmbox-get-new-mail ! If non-@code{nil}, @code{nnmbox} will read incoming mail and split it ! into groups. ! @end table ! ! ! @node Rmail Babyl ! @subsubsection Rmail Babyl ! @cindex nnbabyl ! @cindex rmail mbox ! ! @vindex nnbabyl-active-file ! @vindex nnbabyl-mbox-file ! The @dfn{nnbabyl} backend will use a babyl mail box (aka. @dfn{rmail ! mbox}) to store mail. @code{nnbabyl} will add extra headers to each mail ! article to say which group it belongs in. ! ! Virtual server settings: ! ! @table @code ! @item nnbabyl-mbox-file ! @vindex nnbabyl-mbox-file ! The name of the rmail mbox file. ! ! @item nnbabyl-active-file ! @vindex nnbabyl-active-file ! The name of the active file for the rmail box. ! ! @item nnbabyl-get-new-mail ! @vindex nnbabyl-get-new-mail ! If non-@code{nil}, @code{nnbabyl} will read incoming mail. ! @end table ! ! ! @node Mail Spool ! @subsubsection Mail Spool ! @cindex nnml ! @cindex mail @sc{nov} spool ! ! The @dfn{nnml} spool mail format isn't compatible with any other known ! format. It should be used with some caution. ! ! @vindex nnml-directory ! If you use this backend, Gnus will split all incoming mail into files; ! one file for each mail, and put the articles into the correct ! directories under the directory specified by the @code{nnml-directory} ! variable. The default value is @file{~/Mail/}. ! ! You do not have to create any directories beforehand; Gnus will take ! care of all that. ! ! If you have a strict limit as to how many files you are allowed to store ! in your account, you should not use this backend. As each mail gets its ! own file, you might very well occupy thousands of inodes within a few ! weeks. If this is no problem for you, and it isn't a problem for you ! having your friendly systems administrator walking around, madly, ! shouting ``Who is eating all my inodes?! Who? Who!?!'', then you should ! know that this is probably the fastest format to use. You do not have ! to trudge through a big mbox file just to read your new mail. ! ! @code{nnml} is probably the slowest backend when it comes to article ! splitting. It has to create lots of files, and it also generates ! @sc{nov} databases for the incoming mails. This makes is the fastest ! backend when it comes to reading mail. ! ! Virtual server settings: ! ! @table @code ! @item nnml-directory ! @vindex nnml-directory ! All @code{nnml} directories will be placed under this directory. ! ! @item nnml-active-file ! @vindex nnml-active-file ! The active file for the @code{nnml} server. ! ! @item nnml-newsgroups-file ! @vindex nnml-newsgroups-file ! The @code{nnml} group descriptions file. @xref{Newsgroups File ! Format}. ! ! @item nnml-get-new-mail ! @vindex nnml-get-new-mail ! If non-@code{nil}, @code{nnml} will read incoming mail. ! ! @item nnml-nov-is-evil ! @vindex nnml-nov-is-evil ! If non-@code{nil}, this backend will ignore any @sc{nov} files. ! ! @item nnml-nov-file-name ! @vindex nnml-nov-file-name ! The name of the @sc{nov} files. The default is @file{.overview}. ! ! @item nnml-prepare-save-mail-hook ! @vindex nnml-prepare-save-mail-hook ! Hook run narrowed to an article before saving. ! ! @end table ! ! @findex nnml-generate-nov-databases ! If your @code{nnml} groups and @sc{nov} files get totally out of whack, ! you can do a complete update by typing @kbd{M-x ! nnml-generate-nov-databases}. This command will trawl through the ! entire @code{nnml} hierarchy, looking at each and every article, so it ! might take a while to complete. ! ! ! @node MH Spool ! @subsubsection MH Spool ! @cindex nnmh ! @cindex mh-e mail spool ! ! @code{nnmh} is just like @code{nnml}, except that is doesn't generate ! @sc{nov} databases and it doesn't keep an active file. This makes ! @code{nnmh} a @emph{much} slower backend than @code{nnml}, but it also ! makes it easier to write procmail scripts for. ! ! Virtual server settings: ! ! @table @code ! @item nnmh-directory ! @vindex nnmh-directory ! All @code{nnmh} directories will be located under this directory. ! ! @item nnmh-get-new-mail ! @vindex nnmh-get-new-mail ! If non-@code{nil}, @code{nnmh} will read incoming mail. ! ! @item nnmh-be-safe ! @vindex nnmh-be-safe ! If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make ! sure that the articles in the folder are actually what Gnus thinks they ! are. It will check date stamps and stat everything in sight, so ! setting this to @code{t} will mean a serious slow-down. If you never ! use anything but Gnus to read the @code{nnmh} articles, you do not have ! to set this variable to @code{t}. ! @end table ! ! ! @node Mail Folders ! @subsubsection Mail Folders ! @cindex nnfolder ! @cindex mbox folders ! @cindex mail folders ! ! @code{nnfolder} is a backend for storing each mail group in a separate ! file. Each file is in the standard Un*x mbox format. @code{nnfolder} ! will add extra headers to keep track of article numbers and arrival ! dates. ! ! Virtual server settings: ! ! @table @code ! @item nnfolder-directory ! @vindex nnfolder-directory ! All the @code{nnfolder} mail boxes will be stored under this directory. ! ! @item nnfolder-active-file ! @vindex nnfolder-active-file ! The name of the active file. ! ! @item nnfolder-newsgroups-file ! @vindex nnfolder-newsgroups-file ! The name of the group descriptions file. @xref{Newsgroups File Format}. ! ! @item nnfolder-get-new-mail ! @vindex nnfolder-get-new-mail ! If non-@code{nil}, @code{nnfolder} will read incoming mail. ! @end table ! ! @findex nnfolder-generate-active-file ! @kindex M-x nnfolder-generate-active-file ! If you have lots of @code{nnfolder}-like files you'd like to read with ! @code{nnfolder}, you can use the @kbd{M-x nnfolder-generate-active-file} ! command to make @code{nnfolder} aware of all likely files in ! @code{nnfolder-directory}. ! ! ! @node Other Sources ! @section Other Sources ! ! Gnus can do more than just read news or mail. The methods described ! below allow Gnus to view directories and files as if they were ! newsgroups. ! ! @menu ! * Directory Groups:: You can read a directory as if it was a newsgroup. ! * Anything Groups:: Dired? Who needs dired? ! * Document Groups:: Single files can be the basis of a group. ! * SOUP:: Reading @sc{SOUP} packets ``offline''. ! @end menu ! ! ! @node Directory Groups ! @subsection Directory Groups ! @cindex nndir ! @cindex directory groups ! ! If you have a directory that has lots of articles in separate files in ! it, you might treat it as a newsgroup. The files have to have numerical ! names, of course. ! ! This might be an opportune moment to mention @code{ange-ftp}, that most ! wonderful of all wonderful Emacs packages. When I wrote @code{nndir}, I ! didn't think much about it---a backend to read directories. Big deal. ! ! @code{ange-ftp} changes that picture dramatically. For instance, if you ! enter @file{"/ftp.hpc.uh.edu:/pub/emacs/ding-list/"} as the the ! directory name, ange-ftp will actually allow you to read this directory ! over at @samp{sina} as a newsgroup. Distributed news ahoy! ! ! @code{nndir} will use @sc{nov} files if they are present. ! ! @code{nndir} is a ``read-only'' backend---you can't delete or expire ! articles with this method. You can use @code{nnmh} or @code{nnml} for ! whatever you use @code{nndir} for, so you could switch to any of those ! methods if you feel the need to have a non-read-only @code{nndir}. ! ! ! @node Anything Groups ! @subsection Anything Groups ! @cindex nneething ! ! From the @code{nndir} backend (which reads a single spool-like ! directory), it's just a hop and a skip to @code{nneething}, which ! pretends that any arbitrary directory is a newsgroup. Strange, but ! true. ! ! When @code{nneething} is presented with a directory, it will scan this ! directory and assign article numbers to each file. When you enter such ! a group, @code{nneething} must create ``headers'' that Gnus can use. ! After all, Gnus is a newsreader, in case you're ! forgetting. @code{nneething} does this in a two-step process. First, it ! snoops each file in question. If the file looks like an article (i.e., ! the first few lines look like headers), it will use this as the head. ! If this is just some arbitrary file without a head (eg. a C source ! file), @code{nneething} will cobble up a header out of thin air. It ! will use file ownership, name and date and do whatever it can with these ! elements. ! ! All this should happen automatically for you, and you will be presented ! with something that looks very much like a newsgroup. Totally like a ! newsgroup, to be precise. If you select an article, it will be displayed ! in the article buffer, just as usual. ! ! If you select a line that represents a directory, Gnus will pop you into ! a new summary buffer for this @code{nneething} group. And so on. You can ! traverse the entire disk this way, if you feel like, but remember that ! Gnus is not dired, really, and does not intend to be, either. ! ! There are two overall modes to this action---ephemeral or solid. When ! doing the ephemeral thing (i.e., @kbd{G D} from the group buffer), Gnus ! will not store information on what files you have read, and what files ! are new, and so on. If you create a solid @code{nneething} group the ! normal way with @kbd{G m}, Gnus will store a mapping table between ! article numbers and file names, and you can treat this group like any ! other groups. When you activate a solid @code{nneething} group, you will ! be told how many unread articles it contains, etc., etc. ! ! Some variables: ! ! @table @code ! @item nneething-map-file-directory ! @vindex nneething-map-file-directory ! All the mapping files for solid @code{nneething} groups will be stored ! in this directory, which defaults to @file{~/.nneething/}. ! ! @item nneething-exclude-files ! @vindex nneething-exclude-files ! All files that match this regexp will be ignored. Nice to use to exclude ! auto-save files and the like, which is what it does by default. ! ! @item nneething-map-file ! @vindex nneething-map-file ! Name of the map files. ! @end table ! ! ! @node Document Groups ! @subsection Document Groups ! @cindex nndoc ! @cindex documentation group ! @cindex help group ! ! @code{nndoc} is a cute little thing that will let you read a single file ! as a newsgroup. Several files types are supported: ! ! @table @code ! @cindex babyl ! @cindex rmail mbox ! ! @item babyl ! The babyl (rmail) mail box. ! @cindex mbox ! @cindex Unix mbox ! ! @item mbox ! The standard Unix mbox file. ! ! @cindex MMDF mail box ! @item mmdf ! The MMDF mail box format. ! ! @item news ! Several news articles appended into a file. ! ! @item rnews ! @cindex rnews batch files ! The rnews batch transport format. ! @cindex forwarded messages ! ! @item forward ! Forwarded articles. ! ! @item mime-digest ! @cindex digest ! @cindex MIME digest ! @cindex 1153 digest ! @cindex RFC 1153 digest ! @cindex RFC 341 digest ! MIME (RFC 1341) digest format. ! ! @item standard-digest ! The standard (RFC 1153) digest format. ! ! @item slack-digest ! Non-standard digest format---matches most things, but does it badly. ! @end table ! ! You can also use the special ``file type'' @code{guess}, which means ! that @code{nndoc} will try to guess what file type it is looking at. ! @code{digest} means that @code{nndoc} should guess what digest type the ! file is. ! ! @code{nndoc} will not try to change the file or insert any extra headers into ! it---it will simply, like, let you use the file as the basis for a ! group. And that's it. ! ! If you have some old archived articles that you want to insert into your ! new & spiffy Gnus mail backend, @code{nndoc} can probably help you with ! that. Say you have an old @file{RMAIL} file with mail that you now want ! to split into your new @code{nnml} groups. You look at that file using ! @code{nndoc}, set the process mark on all the articles in the buffer ! (@kbd{M P b}, for instance), and then re-spool (@kbd{B r}) using ! @code{nnml}. If all goes well, all the mail in the @file{RMAIL} file is ! now also stored in lots of @code{nnml} directories, and you can delete ! that pesky @file{RMAIL} file. If you have the guts! ! ! Virtual server variables: ! ! @table @code ! @item nndoc-article-type ! @vindex nndoc-article-type ! This should be one of @code{mbox}, @code{babyl}, @code{digest}, ! @code{mmdf}, @code{forward}, @code{news}, @code{rnews}, ! @code{mime-digest}, @code{clari-briefs}, or @code{guess}. ! ! @item nndoc-post-type ! @vindex nndoc-post-type ! This variable says whether Gnus is to consider the group a news group or ! a mail group. There are two legal values: @code{mail} (the default) ! and @code{news}. ! @end table ! ! ! @node SOUP ! @subsection SOUP ! @cindex SOUP ! @cindex offline ! ! In the PC world people often talk about ``offline'' newsreaders. These ! are thingies that are combined reader/news transport monstrosities. ! With built-in modem programs. Yecchh! ! ! Of course, us Unix Weenie types of human beans use things like ! @code{uucp} and, like, @code{nntpd} and set up proper news and mail ! transport things like Ghod intended. And then we just use normal ! newsreaders. ! ! However, it can sometimes be convenient to do something a that's a bit ! easier on the brain if you have a very slow modem, and you're not really ! that interested in doing things properly. ! ! A file format called @sc{soup} has been developed for transporting news ! and mail from servers to home machines and back again. It can be a bit ! fiddly. ! ! @enumerate ! ! @item ! You log in on the server and create a @sc{soup} packet. You can either ! use a dedicated @sc{soup} thingie, or you can use Gnus to create the ! packet with the @kbd{O s} command. ! ! @item ! You transfer the packet home. Rail, boat, car or modem will do fine. ! ! @item ! You put the packet in your home directory. ! ! @item ! You fire up Gnus using the @code{nnsoup} backend as the native server. ! ! @item ! You read articles and mail and answer and followup to the things you ! want. ! ! @item ! You do the @kbd{G s r} command to pack these replies into a @sc{soup} ! packet. ! ! @item ! You transfer this packet to the server. ! ! @item ! You use Gnus to mail this packet out with the @kbd{G s s} command. ! ! @item ! You then repeat until you die. ! ! @end enumerate ! ! So you basically have a bipartite system---you use @code{nnsoup} for ! reading and Gnus for packing/sending these @sc{soup} packets. ! ! @menu ! * SOUP Commands:: Commands for creating and sending @sc{soup} packets ! * SOUP Groups:: A backend for reading @sc{soup} packets. ! * SOUP Replies:: How to enable @code{nnsoup} to take over mail and news. ! @end menu ! ! ! @node SOUP Commands ! @subsubsection SOUP Commands ! ! @table @kbd ! @item G s b ! @kindex G s b (Group) ! @findex gnus-group-brew-soup ! Pack all unread articles in the current group ! (@code{gnus-group-brew-soup}). This command understands the ! process/prefix convention. ! ! @item G s w ! @kindex G s w (Group) ! @findex gnus-soup-save-areas ! Save all data files (@code{gnus-soup-save-areas}). ! ! @item G s s ! @kindex G s s (Group) ! @findex gnus-soup-send-replies ! Send all replies from the replies packet ! (@code{gnus-soup-send-replies}). ! ! @item G s p ! @kindex G s p (Group) ! @findex gnus-soup-pack-packet ! Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}). ! ! @item G s r ! @kindex G s r (Group) ! @findex nnsoup-pack-replies ! Pack all replies into a replies packet (@code{nnsoup-pack-replies}). ! ! @item O s ! @kindex O s (Summary) ! @findex gnus-soup-add-article ! This summary-mode command adds the current article to a @sc{soup} packet ! (@code{gnus-soup-add-article}). It understands the process/prefix ! convention. ! ! @end table ! ! ! There are a few variables to customize where Gnus will put all these ! thingies: ! ! @table @code ! ! @item gnus-soup-directory ! @vindex gnus-soup-directory ! Directory where Gnus will save intermediate files while composing ! @sc{soup} packets. The default is @file{~/SoupBrew/}. ! ! @item gnus-soup-replies-directory ! @vindex gnus-soup-replies-directory ! This is what Gnus will use as a temporary directory while sending our ! reply packets. The default is @file{~/SoupBrew/SoupReplies/}. ! ! @item gnus-soup-prefix-file ! @vindex gnus-soup-prefix-file ! Name of the file where Gnus stores the last used prefix. The default is ! @samp{gnus-prefix}. ! ! @item gnus-soup-packer ! @vindex gnus-soup-packer ! A format string command for packing a @sc{soup} packet. The default is ! @samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}. ! ! @item gnus-soup-unpacker ! @vindex gnus-soup-unpacker ! Format string command for unpacking a @sc{soup} packet. The default is ! @samp{gunzip -c %s | tar xvf -}. ! ! @item gnus-soup-packet-directory ! @vindex gnus-soup-packet-directory ! Where Gnus will look for reply packets. The default is @file{~/}. ! ! @item gnus-soup-packet-regexp ! @vindex gnus-soup-packet-regexp ! Regular expression matching @sc{soup} reply packets in ! @code{gnus-soup-packet-directory}. ! ! @end table ! ! ! @node SOUP Groups ! @subsubsection @sc{soup} Groups ! @cindex nnsoup ! ! @code{nnsoup} is the backend for reading @sc{soup} packets. It will ! read incoming packets, unpack them, and put them in a directory where ! you can read them at leisure. ! ! These are the variables you can use to customize its behavior: ! ! @table @code ! ! @item nnsoup-tmp-directory ! @vindex nnsoup-tmp-directory ! When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this ! directory. (@file{/tmp/} by default.) ! ! @item nnsoup-directory ! @vindex nnsoup-directory ! @code{nnsoup} then moves each message and index file to this directory. ! The default is @file{~/SOUP/}. ! ! @item nnsoup-replies-directory ! @vindex nnsoup-replies-directory ! All replies will stored in this directory before being packed into a ! reply packet. The default is @file{~/SOUP/replies/"}. ! ! @item nnsoup-replies-format-type ! @vindex nnsoup-replies-format-type ! The @sc{soup} format of the replies packets. The default is @samp{?n} ! (rnews), and I don't think you should touch that variable. I probably ! shouldn't even have documented it. Drats! Too late! ! ! @item nnsoup-replies-index-type ! @vindex nnsoup-replies-index-type ! The index type of the replies packet. The is @samp{?n}, which means ! ``none''. Don't fiddle with this one either! ! ! @item nnsoup-active-file ! @vindex nnsoup-active-file ! Where @code{nnsoup} stores lots of information. This is not an ``active ! file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose ! this file or mess it up in any way, you're dead. The default is ! @file{~/SOUP/active}. ! ! @item nnsoup-packer ! @vindex nnsoup-packer ! Format string command for packing a reply @sc{soup} packet. The default ! is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}. ! ! @item nnsoup-unpacker ! @vindex nnsoup-unpacker ! Format string command for unpacking incoming @sc{soup} packets. The ! default is @samp{gunzip -c %s | tar xvf -}. ! ! @item nnsoup-packet-directory ! @vindex nnsoup-packet-directory ! Where @code{nnsoup} will look for incoming packets. The default is ! @file{~/}. ! ! @item nnsoup-packet-regexp ! @vindex nnsoup-packet-regexp ! Regular expression matching incoming @sc{soup} packets. The default is ! @samp{Soupout}. ! ! @end table ! ! ! @node SOUP Replies ! @subsubsection SOUP Replies ! ! Just using @code{nnsoup} won't mean that your postings and mailings end ! up in @sc{soup} reply packets automagically. You have to work a bit ! more for that to happen. ! ! @findex nnsoup-set-variables ! The @code{nnsoup-set-variables} command will set the appropriate ! variables to ensure that all your followups and replies end up in the ! @sc{soup} system. ! ! In specific, this is what it does: ! ! @lisp ! (setq gnus-inews-article-function 'nnsoup-request-post) ! (setq send-mail-function 'nnsoup-request-mail) ! @end lisp ! ! And that's it, really. If you only want news to go into the @sc{soup} ! system you just use the first line. If you only want mail to be ! @sc{soup}ed you use the second. ! ! ! @node Combined Groups ! @section Combined Groups ! ! Gnus allows combining a mixture of all the other group types into bigger ! groups. ! ! @menu ! * Virtual Groups:: Combining articles from many groups. ! * Kibozed Groups:: Looking through parts of the newsfeed for articles. ! @end menu ! ! ! @node Virtual Groups ! @subsection Virtual Groups ! @cindex nnvirtual ! @cindex virtual groups ! ! An @dfn{nnvirtual group} is really nothing more than a collection of ! other groups. ! ! For instance, if you are tired of reading many small group, you can ! put them all in one big group, and then grow tired of reading one ! big, unwieldy group. The joys of computing! ! ! You specify @code{nnvirtual} as the method. The address should be a ! regexp to match component groups. ! ! All marks in the virtual group will stick to the articles in the ! component groups. So if you tick an article in a virtual group, the ! article will also be ticked in the component group from whence it came. ! (And vice versa---marks from the component groups will also be shown in ! the virtual group.) ! ! Here's an example @code{nnvirtual} method that collects all Andrea Dworkin ! newsgroups into one, big, happy newsgroup: ! ! @lisp ! (nnvirtual "^alt\\.fan\\.andrea-dworkin$\\|^rec\\.dworkin.*") ! @end lisp ! ! The component groups can be native or foreign; everything should work ! smoothly, but if your computer explodes, it was probably my fault. ! ! Collecting the same group from several servers might actually be a good ! idea if users have set the Distribution header to limit distribution. ! If you would like to read @samp{soc.motss} both from a server in Japan ! and a server in Norway, you could use the following as the group regexp: ! ! @example ! "^nntp+some.server.jp:soc.motss$\\|^nntp+some.server.no:soc.motss$" ! @end example ! ! This should work kinda smoothly---all articles from both groups should ! end up in this one, and there should be no duplicates. Threading (and ! the rest) will still work as usual, but there might be problems with the ! sequence of articles. Sorting on date might be an option here ! (@pxref{Selecting a Group}. ! ! One limitation, however---all groups that are included in a virtual ! group has to be alive (i.e., subscribed or unsubscribed). Killed or ! zombie groups can't be component groups for @code{nnvirtual} groups. ! ! @vindex nnvirtual-always-rescan ! If the @code{nnvirtual-always-rescan} is non-@code{nil}, ! @code{nnvirtual} will always scan groups for unread articles when ! entering a virtual group. If this variable is @code{nil} (which is the ! default) and you read articles in a component group after the virtual ! group has been activated, the read articles from the component group ! will show up when you enter the virtual group. You'll also see this ! effect if you have two virtual groups that contain the same component ! group. If that's the case, you should set this variable to @code{t}. ! Or you can just tap @code{M-g} on the virtual group every time before ! you enter it---it'll have much the same effect. ! ! ! @node Kibozed Groups ! @subsection Kibozed Groups ! @cindex nnkiboze ! @cindex kibozing ! ! @dfn{Kibozing} is defined by @sc{oed} as ``grepping through (parts of) ! the news feed''. @code{nnkiboze} is a backend that will do this for ! you. Oh joy! Now you can grind any @sc{nntp} server down to a halt ! with useless requests! Oh happiness! ! ! @kindex G k (Group) ! To create a kibozed group, use the @kbd{G k} command in the group ! buffer. ! ! The address field of the @code{nnkiboze} method is, as with ! @code{nnvirtual}, a regexp to match groups to be ``included'' in the ! @code{nnkiboze} group. There most similarities between @code{nnkiboze} ! and @code{nnvirtual} ends. ! ! In addition to this regexp detailing component groups, an @code{nnkiboze} group ! must have a score file to say what articles that are to be included in ! the group (@pxref{Scoring}). ! ! @kindex M-x nnkiboze-generate-groups ! @findex nnkiboze-generate-groups ! You must run @kbd{M-x nnkiboze-generate-groups} after creating the ! @code{nnkiboze} groups you want to have. This command will take time. Lots of ! time. Oodles and oodles of time. Gnus has to fetch the headers from ! all the articles in all the components groups and run them through the ! scoring process to determine if there are any articles in the groups ! that are to be part of the @code{nnkiboze} groups. ! ! Please limit the number of component groups by using restrictive ! regexps. Otherwise your sysadmin may become annoyed with you, and the ! @sc{nntp} site may throw you off and never let you back in again. ! Stranger things have happened. ! ! @code{nnkiboze} component groups do not have to be alive---they can be dead, ! and they can be foreign. No restrictions. ! ! @vindex nnkiboze-directory ! The generation of an @code{nnkiboze} group means writing two files in ! @code{nnkiboze-directory}, which is @file{~/News/} by default. One ! contains the @sc{nov} header lines for all the articles in the group, ! and the other is an additional @file{.newsrc} file to store information ! on what groups that have been searched through to find component ! articles. ! ! Articles that are marked as read in the @code{nnkiboze} group will have their ! @sc{nov} lines removed from the @sc{nov} file. ! ! ! @node Scoring ! @chapter Scoring ! @cindex scoring ! ! Other people use @dfn{kill files}, but we here at Gnus Towers like ! scoring better than killing, so we'd rather switch than fight. They do ! something completely different as well, so sit up straight and pay ! attention! ! ! @vindex gnus-summary-mark-below ! All articles have a default score (@code{gnus-summary-default-score}), ! which is 0 by default. This score may be raised or lowered either ! interactively or by score files. Articles that have a score lower than ! @code{gnus-summary-mark-below} are marked as read. ! ! Gnus will read any @dfn{score files} that apply to the current group ! before generating the summary buffer. ! ! There are several commands in the summary buffer that insert score ! entries based on the current article. You can, for instance, ask Gnus to ! lower or increase the score of all articles with a certain subject. ! ! There are two sorts of scoring entries: Permanent and temporary. ! Temporary score entries are self-expiring entries. Any entries that are ! temporary and have not been used for, say, a week, will be removed ! silently to help keep the sizes of the score files down. ! ! @menu ! * Summary Score Commands:: Adding score entries for the current group. ! * Group Score Commands:: General score commands. ! * Score Variables:: Customize your scoring. (My, what terminology). ! * Score File Format:: What a score file may contain. ! * Score File Editing:: You can edit score files by hand as well. ! * Adaptive Scoring:: Big Sister Gnus *knows* what you read. ! * Followups To Yourself:: Having Gnus notice when people answer you. ! * Scoring Tips:: How to score effectively. ! * Reverse Scoring:: That problem child of old is not problem. ! * Global Score Files:: Earth-spanning, ear-splitting score files. ! * Kill Files:: They are still here, but they can be ignored. ! * GroupLens:: Getting predictions on what you like to read. ! @end menu ! ! ! @node Summary Score Commands ! @section Summary Score Commands ! @cindex score commands ! ! The score commands that alter score entries do not actually modify real ! score files. That would be too inefficient. Gnus maintains a cache of ! previously loaded score files, one of which is considered the ! @dfn{current score file alist}. The score commands simply insert ! entries into this list, and upon group exit, this list is saved. ! ! The current score file is by default the group's local score file, even ! if no such score file actually exists. To insert score commands into ! some other score file (eg. @file{all.SCORE}), you must first make this ! score file the current one. ! ! General score commands that don't actually change the score file: ! ! @table @kbd ! ! @item V s ! @kindex V s (Summary) ! @findex gnus-summary-set-score ! Set the score of the current article (@code{gnus-summary-set-score}). ! ! @item V S ! @kindex V S (Summary) ! @findex gnus-summary-current-score ! Display the score of the current article ! (@code{gnus-summary-current-score}). ! ! @item V t ! @kindex V t (Summary) ! @findex gnus-score-find-trace ! Display all score rules that have been used on the current article ! (@code{gnus-score-find-trace}). ! ! @item V R ! @cindex V R (Summary) ! @findex gnus-summary-rescore ! Run the current summary through the scoring process ! (@code{gnus-summary-rescore}). This might be useful if you're playing ! around with your score files behind Gnus' back and want to see the ! effect you're having. ! ! @item V a ! @kindex V a (Summary) ! @findex gnus-summary-score-entry ! Add a new score entry, and allow specifying all elements ! (@code{gnus-summary-score-entry}). ! ! @item V c ! @kindex V c (Summary) ! @findex gnus-score-change-score-file ! Make a different score file the current ! (@code{gnus-score-change-score-file}). ! ! @item V e ! @kindex V e (Summary) ! @findex gnus-score-edit-current-scores ! Edit the current score file (@code{gnus-score-edit-current-scores}). ! You will be popped into a @code{gnus-score-mode} buffer (@pxref{Score ! File Editing}). ! ! @item V f ! @kindex V f (Summary) ! @findex gnus-score-edit-file ! Edit a score file and make this score file the current one ! (@code{gnus-score-edit-file}). ! ! @item V F ! @kindex V F (Summary) ! @findex gnus-score-flush-cache ! Flush the score cahe (@code{gnus-score-flush-cache}). This is useful ! after editing score files. ! ! @item V C ! @kindex V C (Summary) ! @findex gnus-score-customize ! Customize a score file in a visually pleasing manner ! (@code{gnus-score-customize}). ! ! @item I C-i ! @kindex I C-i (Summary) ! @findex gnus-summary-raise-score ! Increase the score of the current article ! (@code{gnus-summary-raise-score}). ! ! @item L C-l ! @kindex L C-l (Summary) ! @findex gnus-summary-lower-score ! Lower the score of the current article ! (@code{gnus-summary-lower-score}). ! @end table ! ! The rest of these commands modify the local score file. ! ! @table @kbd ! ! @item V m ! @kindex V m (Summary) ! @findex gnus-score-set-mark-below ! Prompt for a score, and mark all articles with a score below this as ! read (@code{gnus-score-set-mark-below}). ! ! @item V E ! @kindex V E (Summary) ! @findex gnus-score-set-expunge-below ! Expunge all articles with a score below the default score (or the ! numeric prefix) (@code{gnus-score-set-expunge-below}). ! @end table ! ! The keystrokes for actually making score entries follow a very regular ! pattern, so there's no need to list all the commands. (Hundreds of ! them.) ! ! @enumerate ! @item ! The first key is either @kbd{I} (upper case i) for increasing the score ! or @kbd{L} for lowering the score. ! @item ! The second key says what header you want to score on. The following ! keys are available: ! @table @kbd ! ! @item a ! Score on the author name. ! ! @item s ! Score on the subject line. ! ! @item x ! Score on the Xref line---i.e., the cross-posting line. ! ! @item t ! Score on thread---the References line. ! ! @item d ! Score on the date. ! ! @item l ! Score on the number of lines. ! ! @item i ! Score on the Message-ID. ! ! @item f ! Score on followups. ! ! @item b ! Score on the body. ! ! @item h ! Score on the head. ! @end table ! ! @item ! The third key is the match type. Which match types are legal depends on ! what headers you are scoring on. ! ! @table @code ! ! @item strings ! ! @table @kbd ! ! @item e ! Exact matching. ! ! @item s ! Substring matching. ! ! @item f ! Fuzzy matching. ! ! @item r ! Regexp matching ! @end table ! ! @item date ! @table @kbd ! ! @item b ! Before date. ! ! @item a ! At date. ! ! @item n ! This date. ! @end table ! ! @item number ! @table @kbd ! ! @item < ! Less than number. ! ! @item = ! Equal to number. ! ! @item > ! Greater than number. ! @end table ! @end table ! ! @item ! The fourth and final key says whether this is a temporary (i.e., expiring) ! score entry, or a permanent (i.e., non-expiring) score entry, or whether ! it is to be done immediately, without adding to the score file. ! @table @kbd ! ! @item t ! Temporary score entry. ! ! @item p ! Permanent score entry. ! ! @item i ! Immediately scoring. ! @end table ! ! @end enumerate ! ! So, let's say you want to increase the score on the current author with ! exact matching permanently: @kbd{I a e p}. If you want to lower the ! score based on the subject line, using substring matching, and make a ! temporary score entry: @kbd{L s s t}. Pretty easy. ! ! To make things a bit more complicated, there are shortcuts. If you use ! a capital letter on either the second or third keys, Gnus will use ! defaults for the remaining one or two keystrokes. The defaults are ! ``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s ! t}, and @kbd{I a R} is the same as @kbd{I a r t}. ! ! @vindex gnus-score-mimic-keymap ! The @code{gnus-score-mimic-keymap} says whether these commands will ! pretend they are keymaps or not. ! ! ! @node Group Score Commands ! @section Group Score Commands ! @cindex group score commands ! ! There aren't many of these as yet, I'm afraid. ! ! @table @kbd ! ! @item W f ! @kindex W f (Group) ! @findex gnus-score-flush-cache ! Gnus maintains a cache of score alists to avoid having to reload them ! all the time. This command will flush the cache ! (@code{gnus-score-flush-cache}). ! ! @end table ! ! ! @node Score Variables ! @section Score Variables ! @cindex score variables ! ! @table @code ! ! @item gnus-use-scoring ! @vindex gnus-use-scoring ! If @code{nil}, Gnus will not check for score files, and will not, in ! general, do any score-related work. This is @code{t} by default. ! ! @item gnus-kill-killed ! @vindex gnus-kill-killed ! If this variable is @code{nil}, Gnus will never apply score files to ! articles that have already been through the kill process. While this ! may save you lots of time, it also means that if you apply a kill file ! to a group, and then change the kill file and want to run it over you ! group again to kill more articles, it won't work. You have to set this ! variable to @code{t} to do that. (It is @code{t} by default.) ! ! @item gnus-kill-files-directory ! @vindex gnus-kill-files-directory ! All kill and score files will be stored in this directory, which is ! initialized from the @code{SAVEDIR} environment variable by default. ! This is @file{~/News/} by default. ! ! @item gnus-score-file-suffix ! @vindex gnus-score-file-suffix ! Suffix to add to the group name to arrive at the score file name ! (@samp{SCORE} by default.) ! ! @item gnus-score-uncacheable-files ! @vindex gnus-score-uncacheable-files ! @cindex score cache ! All score files are normally cached to avoid excessive re-loading of ! score files. However, if this might make you Emacs grow big and ! bloated, so this regexp can be used to weed out score files that are ! unlikely to be needed again. It would be a bad idea to deny caching of ! @file{all.SCORE}, while it might be a good idea to not cache ! @file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this ! variable is @samp{ADAPT$} by default, so no adaptive score files will ! be cached. ! ! @item gnus-save-score ! @vindex gnus-save-score ! If you have really complicated score files, and do lots of batch ! scoring, then you might set this variable to @code{t}. This will make ! Gnus save the scores into the @file{.newsrc.eld} file. ! ! @item gnus-score-interactive-default-score ! @vindex gnus-score-interactive-default-score ! Score used by all the interactive raise/lower commands to raise/lower ! score with. Default is 1000, which may seem excessive, but this is to ! ensure that the adaptive scoring scheme gets enough room to play with. ! We don't want the small changes from the adaptive scoring to overwrite ! manually entered data. ! ! @item gnus-summary-default-score ! @vindex gnus-summary-default-score ! Default score of an article, which is 0 by default. ! ! @item gnus-score-over-mark ! @vindex gnus-score-over-mark ! Mark (in the third column) used for articles with a score over the ! default. Default is @samp{+}. ! ! @item gnus-score-below-mark ! @vindex gnus-score-below-mark ! Mark (in the third column) used for articles with a score below the ! default. Default is @samp{-}. ! ! @item gnus-score-find-score-files-function ! @vindex gnus-score-find-score-files-function ! Function used to find score files for the current group. This function ! is called with the name of the group as the argument. ! ! Predefined functions available are: ! @table @code ! ! @item gnus-score-find-single ! @findex gnus-score-find-single ! Only apply the group's own score file. ! ! @item gnus-score-find-bnews ! @findex gnus-score-find-bnews ! Apply all score files that match, using bnews syntax. This is the ! default. For instance, if the current group is @samp{gnu.emacs.gnus}, ! @file{all.emacs.all.SCORE}, @file{not.alt.all.SCORE} and ! @file{gnu.all.SCORE} would all apply. In short, the instances of ! @samp{all} in the score file names are translated into @samp{.*}, and ! then a regexp match is done. ! ! This means that if you have some score entries that you want to apply to ! all groups, then you put those entries in the @file{all.SCORE} file. ! ! @item gnus-score-find-hierarchical ! @findex gnus-score-find-hierarchical ! Apply all score files from all the parent groups. This means that you ! can't have score files like @file{all.SCORE} or @file{all.emacs.SCORE}, ! but you can have @file{SCORE}, @file{comp.SCORE} and ! @file{comp.emacs.SCORE}. ! ! @end table ! This variable can also be a list of functions. In that case, all these ! functions will be called, and all the returned lists of score files will ! be applied. These functions can also return lists of score alists ! directly. In that case, the functions that return these non-file score ! alists should probably be placed before the ``real'' score file ! functions, to ensure that the last score file returned is the local ! score file. Phu. ! ! @item gnus-score-expiry-days ! @vindex gnus-score-expiry-days ! This variable says how many days should pass before an unused score file ! entry is expired. If this variable is @code{nil}, no score file entries ! are expired. It's 7 by default. ! ! @item gnus-update-score-entry-dates ! @vindex gnus-update-score-entry-dates ! If this variable is non-@code{nil}, matching score entries will have ! their dates updated. (This is how Gnus controls expiry---all ! non-matching entries will become too old while matching entries will ! stay fresh and young.) However, if you set this variable to @code{nil}, ! even matching entries will grow old and will have to face that oh-so ! grim reaper. ! ! @item gnus-score-after-write-file-function ! @vindex gnus-score-after-write-file-function ! Function called with the name of the score file just written. ! ! @end table ! ! ! @node Score File Format ! @section Score File Format ! @cindex score file format ! ! A score file is an @code{emacs-lisp} file that normally contains just a ! single form. Casual users are not expected to edit these files; ! everything can be changed from the summary buffer. ! ! Anyway, if you'd like to dig into it yourself, here's an example: ! ! @lisp ! (("from" ! ("Lars Ingebrigtsen" -10000) ! ("Per Abrahamsen") ! ("larsi\\|lmi" -50000 nil R)) ! ("subject" ! ("Ding is Badd" nil 728373)) ! ("xref" ! ("alt.politics" -1000 728372 s)) ! ("lines" ! (2 -100 nil <)) ! (mark 0) ! (expunge -1000) ! (mark-and-expunge -10) ! (read-only nil) ! (orphan -10) ! (adapt t) ! (files "/hom/larsi/News/gnu.SCORE") ! (exclude-files "all.SCORE") ! (local (gnus-newsgroup-auto-expire t) ! (gnus-summary-make-false-root 'empty)) ! (eval (ding))) ! @end lisp ! ! This example demonstrates absolutely everything about a score file. ! ! Even though this looks much like lisp code, nothing here is actually ! @code{eval}ed. The lisp reader is used to read this form, though, so it ! has to be legal syntactically, if not semantically. ! ! Six keys are supported by this alist: ! ! @table @code ! ! @item STRING ! If the key is a string, it is the name of the header to perform the ! match on. Scoring can only be performed on these eight headers: ! @code{From}, @code{Subject}, @code{References}, @code{Message-ID}, ! @code{Xref}, @code{Lines}, @code{Chars} and @code{Date}. In addition to ! these headers, there are three strings to tell Gnus to fetch the entire ! article and do the match on larger parts of the article: @code{Body} ! will perform the match on the body of the article, @code{Head} will ! perform the match on the head of the article, and @code{All} will ! perform the match on the entire article. Note that using any of these ! last three keys will slow down group entry @emph{considerably}. The ! final ``header'' you can score on is @code{Followup}. These score ! entries will result in new score entries being added for all follow-ups ! to articles that matches these score entries. ! ! Following this key is a arbitrary number of score entries, where each ! score entry has one to four elements. ! @enumerate ! ! @item ! The first element is the @dfn{match element}. On most headers this will ! be a string, but on the Lines and Chars headers, this must be an ! integer. ! ! @item ! If the second element is present, it should be a number---the @dfn{score ! element}. This number should be an integer in the neginf to posinf ! interval. This number is added to the score of the article if the match ! is successful. If this element is not present, the ! @code{gnus-score-interactive-default-score} number will be used ! instead. This is 1000 by default. ! ! @item ! If the third element is present, it should be a number---the @dfn{date ! element}. This date says when the last time this score entry matched, ! which provides a mechanism for expiring the score entries. It this ! element is not present, the score entry is permanent. The date is ! represented by the number of days since December 31, 1 ce. ! ! @item ! If the fourth element is present, it should be a symbol---the @dfn{type ! element}. This element specifies what function should be used to see ! whether this score entry matches the article. What match types that can ! be used depends on what header you wish to perform the match on. ! @table @dfn ! ! @item From, Subject, References, Xref, Message-ID ! For most header types, there are the @code{r} and @code{R} (regexp) as ! well as @code{s} and @code{S} (substring) types and @code{e} and ! @code{E} (exact match) types. If this element is not present, Gnus will ! assume that substring matching should be used. @code{R} and @code{S} ! differ from the other two in that the matches will be done in a ! case-sensitive manner. All these one-letter types are really just ! abbreviations for the @code{regexp}, @code{string} and @code{exact} ! types, which you can use instead, if you feel like. ! ! @item Lines, Chars ! These two headers use different match types: @code{<}, @code{>}, ! @code{=}, @code{>=} and @code{<=}. ! ! @item Date ! For the Date header we have three match types: @code{before}, @code{at} ! and @code{after}. I can't really imagine this ever being useful, but, ! like, it would feel kinda silly not to provide this function. Just in ! case. You never know. Better safe than sorry. Once burnt, twice shy. ! Don't judge a book by its cover. Never not have sex on a first date. ! ! @item Head, Body, All ! These three match keys use the same match types as the @code{From} (etc) ! header uses. ! ! @item Followup ! This match key will add a score entry on all articles that followup to ! some author. Uses the same match types as the @code{From} header uses. ! ! @item Thread ! This match key will add a score entry on all articles that are part of ! a thread. Uses the same match types as the @code{References} header ! uses. ! @end table ! @end enumerate ! ! @item mark ! The value of this entry should be a number. Any articles with a score ! lower than this number will be marked as read. ! ! @item expunge ! 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. ! ! @item mark-and-expunge ! 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. ! ! @item thread-mark-and-expunge ! 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. @code{gnus-thread-score-function} ! says how to compute the total score for a thread. ! ! @item files ! 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. ! ! @item exclude-files ! The clue of this entry should be any number of files. This files will ! not be loaded, even though they would normally be so, for some reason or ! other. ! ! @item eval ! The value of this entry will be @code{eval}el. This element will be ! ignored when handling global score files. ! ! @item read-only ! Read-only score files will not be updated or saved. Global score files ! should feature this atom (@pxref{Global Score Files}). ! ! @item orphan ! 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 @samp{comp.lang.c}. Most likely you ! will only follow a few of the threads, also want to see any new threads. ! ! You can do this with the following two score file entries: ! ! @example ! (orphan -500) ! (mark-and-expunge -100) ! @end example ! ! When you enter the group the first time, you will only see the new ! threads. You then raise the score of the threads that you find ! interesting (with @kbd{I T} or @kbd{I S}), and ignore (@kbd{C y}) the ! rest. Next time you enter the group, you will see new articles in the ! interesting threads, plus any new threads. ! ! I.e. -- the orphan score atom is for high-volume groups where there ! exist a few interesting threads which can't be found automatically by ! ordinary scoring rules. ! ! @item adapt ! This entry controls the adaptive scoring. If it is @code{t}, the ! default adaptive scoring rules will be used. If it is @code{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. If it isn't present, ! or is something other than @code{t} or @code{ignore}, the default ! adaptive scoring rules will be used. If you want to use adaptive ! scoring on most groups, you'd set @code{gnus-use-adaptive-scoring} to ! @code{t}, and insert an @code{(adapt ignore)} in the groups where you do ! not want adaptive scoring. If you only want adaptive scoring in a few ! groups, you'd set @code{gnus-use-adaptive-scoring} to @code{nil}, and ! insert @code{(adapt t)} in the score files of the groups where you want ! it. ! ! @item adapt-file ! All adaptive score entries will go to the file named by this entry. It ! will also be applied when entering the group. This atom might be handy ! if you want to adapt on several groups at once, using the same adaptive ! file for a number of groups. ! ! @item local ! @cindex local variables ! The value of this entry should be a list of @code{(VAR VALUE)} pairs. ! Each @var{var} will be made buffer-local to the current summary buffer, ! and set to the value specified. This is a convenient, if somewhat ! strange, way of setting variables in some groups if you don't like hooks ! much. ! @end table ! ! ! @node Score File Editing ! @section Score File Editing ! ! You normally enter all scoring commands from the summary buffer, but you ! might feel the urge to edit them by hand as well, so we've supplied you ! with a mode for that. ! ! It's simply a slightly customized @code{emacs-lisp} mode, with these ! additional commands: ! ! @table @kbd ! ! @item C-c C-c ! @kindex C-c C-c (Score) ! @findex gnus-score-edit-done ! Save the changes you have made and return to the summary buffer ! (@code{gnus-score-edit-done}). ! ! @item C-c C-d ! @kindex C-c C-d (Score) ! @findex gnus-score-edit-insert-date ! Insert the current date in numerical format ! (@code{gnus-score-edit-insert-date}). This is really the day number, if ! you were wondering. ! ! @item C-c C-p ! @kindex C-c C-p (Score) ! @findex gnus-score-pretty-print ! The adaptive score files are saved in an unformatted fashion. If you ! intend to read one of these files, you want to @dfn{pretty print} it ! first. This command (@code{gnus-score-pretty-print}) does that for ! you. ! ! @end table ! ! Type @kbd{M-x gnus-score-mode} to use this mode. ! ! @vindex gnus-score-mode-hook ! @code{gnus-score-menu-hook} is run in score mode buffers. ! ! In the summary buffer you can use commands like @kbd{V f} and @kbd{V ! e} to begin editing score files. ! ! ! @node Adaptive Scoring ! @section Adaptive Scoring ! @cindex adaptive scoring ! ! If all this scoring is getting you down, Gnus has a way of making it all ! happen automatically---as if by magic. Or rather, as if by artificial ! stupidity, to be precise. ! @vindex gnus-use-adaptive-scoring ! When you read an article, or mark an article as read, or kill an ! article, you leave marks behind. On exit from the group, Gnus can sniff ! these marks and add score elements depending on what marks it finds. ! You turn on this ability by setting @code{gnus-use-adaptive-scoring} to ! @code{t}. ! @vindex gnus-default-adaptive-score-alist ! To give you complete control over the scoring process, you can customize ! the @code{gnus-default-adaptive-score-alist} variable. For instance, it ! might look something like this: ! @lisp ! (defvar gnus-default-adaptive-score-alist ! '((gnus-unread-mark) ! (gnus-ticked-mark (from 4)) ! (gnus-dormant-mark (from 5)) ! (gnus-del-mark (from -4) (subject -1)) ! (gnus-read-mark (from 4) (subject 2)) ! (gnus-expirable-mark (from -1) (subject -1)) ! (gnus-killed-mark (from -1) (subject -3)) ! (gnus-kill-file-mark) ! (gnus-ancient-mark) ! (gnus-low-score-mark) ! (gnus-catchup-mark (from -1) (subject -1)))) ! @end lisp ! As you see, each element in this alist has a mark as a key (either a ! variable name or a ``real'' mark---a character). Following this key is ! a arbitrary number of header/score pairs. If there are no header/score ! pairs following the key, no adaptive scoring will be done on articles ! that have that key as the article mark. For instance, articles with ! @code{gnus-unread-mark} in the example above will not get adaptive score ! entries. ! Each article can have only one mark, so just a single of these rules ! will be applied to each article. ! To take @code{gnus-del-mark} as an example---this alist says that all ! articles that have that mark (i.e., are marked with @samp{D}) will have a ! score entry added to lower based on the @code{From} header by -4, and ! lowered by @code{Subject} by -1. Change this to fit your prejudices. ! If you have marked 10 articles with the same subject with ! @code{gnus-del-mark}, the rule for that mark will be applied ten times. ! That means that that subject will get a score of ten times -1, which ! should be, unless I'm much mistaken, -10. ! ! The headers you can score on are @code{from}, @code{subject}, ! @code{message-id}, @code{references}, @code{xref}, @code{lines}, ! @code{chars} and @code{date}. In addition, you can score on ! @code{followup}, which will create an adaptive score entry that matches ! on the @code{References} header using the @code{Message-ID} of the ! current article, thereby matching the following thread. ! ! You can also score on @code{thread}, which will try to score all ! articles that appear in a thread. @code{thread} matches uses a ! @code{Message-ID} to match on the @code{References} header of the ! article. If the match is made, the @code{Message-ID} of the article is ! added to the @code{thread} rule. (Think about it. I'd recommend two ! aspirins afterwards.) ! ! If you use this scheme, you should set the score file atom @code{mark} ! to something small---like -300, perhaps, to avoid having small random ! changes result in articles getting marked as read. ! After using adaptive scoring for a week or so, Gnus should start to ! become properly trained and enhance the authors you like best, and kill ! the authors you like least, without you having to say so explicitly. ! You can control what groups the adaptive scoring is to be performed on ! by using the score files (@pxref{Score File Format}). This will also ! let you use different rules in different groups. ! @vindex gnus-adaptive-file-suffix ! The adaptive score entries will be put into a file where the name is the ! group name with @code{gnus-adaptive-file-suffix} appended. The default ! is @samp{ADAPT}. ! @vindex gnus-score-exact-adapt-limit ! When doing adaptive scoring, substring or fuzzy matching would probably ! give you the best results in most cases. However, if the header one ! matches is short, the possibility for false positives is great, so if ! the length of the match is less than ! @code{gnus-score-exact-adapt-limit}, exact matching will be used. If ! this variable is @code{nil}, exact matching will always be used to avoid ! this problem. ! @node Followups To Yourself ! @section Followups To Yourself ! Gnus offers two commands for picking out the @code{Message-ID} header in ! the current buffer. Gnus will then add a score rule that scores using ! this @code{Message-ID} on the @code{References} header of other ! articles. This will, in effect, increase the score of all articles that ! respond to the article in the current buffer. Quite useful if you want ! to easily note when people answer what you've said. ! @table @code ! @item gnus-score-followup-article ! @findex gnus-score-followup-article ! This will add a score to articles that directly follow up your own ! article. ! ! @item gnus-score-followup-thread ! @findex gnus-score-followup-thread ! This will add a score to all articles that appear in a thread ``below'' ! your own article. ! @end table ! @vindex gnus-inews-article-hook ! These two functions are both primarily meant to be used in hooks like ! @code{gnus-inews-article-hook}. ! @node Scoring Tips ! @section Scoring Tips ! @cindex scoring tips ! @table @dfn ! @item Crossposts ! @cindex crossposts ! @cindex scoring crossposts ! If you want to lower the score of crossposts, the line to match on is ! the @code{Xref} header. ! @lisp ! ("xref" (" talk.politics.misc:" -1000)) ! @end lisp ! @item Multiple crossposts ! If you want to lower the score of articles that have been crossposted to ! more than, say, 3 groups: ! @lisp ! ("xref" ("[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+" -1000 nil r)) ! @end lisp ! @item Matching on the body ! This is generally not a very good idea---it takes a very long time. ! Gnus actually has to fetch each individual article from the server. But ! you might want to anyway, I guess. Even though there are three match ! keys (@code{Head}, @code{Body} and @code{All}), you should choose one ! and stick with it in each score file. If you use any two, each article ! will be fetched @emph{twice}. If you want to match a bit on the ! @code{Head} and a bit on the @code{Body}, just use @code{All} for all ! the matches. ! ! @item Marking as read ! You will probably want to mark articles that has a score below a certain ! number as read. This is most easily achieved by putting the following ! in your @file{all.SCORE} file: ! @lisp ! ((mark -100)) ! @end lisp ! You may also consider doing something similar with @code{expunge}. ! @item Negated character classes ! If you say stuff like @code{[^abcd]*}, you may get unexpected results. ! That will match newlines, which might lead to, well, The Unknown. Say ! @code{[^abcd\n]*} instead. ! @end table + @node Reverse Scoring + @section Reverse Scoring + @cindex reverse scoring ! If you want to keep just articles that have @samp{Sex with Emacs} in the ! subject header, and expunge all other articles, you could put something ! like this in your score file: ! @lisp ! (("subject" ! ("Sex with Emacs" 2)) ! (mark 1) ! (expunge 1)) ! @end lisp ! So, you raise all articles that match @samp{Sex with Emacs} and mark the ! rest as read, and expunge them to boot. ! @node Global Score Files ! @section Global Score Files ! @cindex global score files ! Sure, other newsreaders have ``global kill files''. These are usually ! nothing more than a single kill file that applies to all groups, stored ! in the user's home directory. Bah! Puny, weak newsreaders! ! What I'm talking about here are Global Score Files. Score files from ! all over the world, from users everywhere, uniting all nations in one ! big, happy score file union! Ange-score! New and untested! ! @vindex gnus-global-score-files ! All you have to do to use other people's score files is to set the ! @code{gnus-global-score-files} variable. One entry for each score file, ! or each score file directory. Gnus will decide by itself what score ! files are applicable to which group. ! Say you want to use all score files in the ! @file{/ftp@@ftp.some-where:/pub/score} directory and the single score ! file @file{/ftp@@ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE}: ! @lisp ! (setq gnus-global-score-files ! '("/ftp@@ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE" ! "/ftp@@ftp.some-where:/pub/score/")) ! @end lisp ! @findex gnus-score-search-global-directories ! Simple, eh? Directory names must end with a @samp{/}. These ! directories are typically scanned only once during each Gnus session. ! If you feel the need to manually re-scan the remote directories, you can ! use the @code{gnus-score-search-global-directories} command. ! Note that, at present, using this option will slow down group entry ! somewhat. (That is---a lot.) ! If you want to start maintaining score files for other people to use, ! just put your score file up for anonymous ftp and announce it to the ! world. Become a retro-moderator! Participate in the retro-moderator ! wars sure to ensue, where retro-moderators battle it out for the ! sympathy of the people, luring them to use their score files on false ! premises! Yay! The net is saved! ! Here are some tips for the would-be retro-moderator, off the top of my ! head: ! @itemize @bullet ! @item ! Articles that are heavily crossposted are probably junk. ! @item ! To lower a single inappropriate article, lower by @code{Message-ID}. ! @item ! Particularly brilliant authors can be raised on a permanent basis. ! @item ! Authors that repeatedly post off-charter for the group can safely be ! lowered out of existence. ! @item ! Set the @code{mark} and @code{expunge} atoms to obliterate the nastiest ! articles completely. ! @item ! Use expiring score entries to keep the size of the file down. You ! should probably have a long expiry period, though, as some sites keep ! old articles for a long time. ! @end itemize ! ... I wonder whether other newsreaders will support global score files ! in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue ! Wave, xrn and 1stReader are bound to implement scoring. Should we start ! holding our breath yet? ! @node Kill Files ! @section Kill Files ! @cindex kill files ! Gnus still supports those pesky old kill files. In fact, the kill file ! entries can now be expiring, which is something I wrote before Daniel ! Quinlan thought of doing score files, so I've left the code in there. ! In short, kill processing is a lot slower (and I do mean @emph{a lot}) ! than score processing, so it might be a good idea to rewrite your kill ! files into score files. ! Anyway, a kill file is a normal @code{emacs-lisp} file. You can put any ! forms into this file, which means that you can use kill files as some ! sort of primitive hook function to be run on group entry, even though ! that isn't a very good idea. ! XCNormal kill files look like this: ! @lisp ! (gnus-kill "From" "Lars Ingebrigtsen") ! (gnus-kill "Subject" "ding") ! (gnus-expunge "X") ! @end lisp ! This will mark every article written by me as read, and remove them from ! the summary buffer. Very useful, you'll agree. ! Other programs use a totally different kill file syntax. If Gnus ! encounters what looks like a @code{rn} kill file, it will take a stab at ! interpreting it. ! Two summary functions for editing a GNUS kill file: ! ! @table @kbd ! ! @item M-k ! @kindex M-k (Summary) ! @findex gnus-summary-edit-local-kill ! Edit this group's kill file (@code{gnus-summary-edit-local-kill}). ! ! @item M-K ! @kindex M-K (Summary) ! @findex gnus-summary-edit-global-kill ! Edit the general kill file (@code{gnus-summary-edit-global-kill}). @end table ! Two group mode functions for editing the kill files: ! @table @kbd ! @item M-k ! @kindex M-k (Group) ! @findex gnus-group-edit-local-kill ! Edit this group's kill file (@code{gnus-group-edit-local-kill}). ! @item M-K ! @kindex M-K (Group) ! @findex gnus-group-edit-global-kill ! Edit the general kill file (@code{gnus-group-edit-global-kill}). ! @end table ! Kill file variables: + @table @code + @item gnus-kill-file-name + @vindex gnus-kill-file-name + A kill file for the group @samp{soc.motss} is normally called + @file{soc.motss.KILL}. The suffix appended to the group name to get + this file name is detailed by the @code{gnus-kill-file-name} variable. + The ``global'' kill file (not in the score file sense of ``global'', of + course) is called just @file{KILL}. ! @vindex gnus-kill-save-kill-file ! @item gnus-kill-save-kill-file ! If this variable is non-@code{nil}, Gnus will save the ! kill file after processing, which is necessary if you use expiring ! kills. ! @item gnus-apply-kill-hook ! @vindex gnus-apply-kill-hook ! @findex gnus-apply-kill-file-unless-scored ! @findex gnus-apply-kill-file ! A hook called to apply kill files to a group. It is ! @code{(gnus-apply-kill-file)} by default. If you want to ignore the ! kill file if you have a score file for the same group, you can set this ! hook to @code{(gnus-apply-kill-file-unless-scored)}. If you don't want ! kill files to be processed, you should set this variable to @code{nil}. ! ! @item gnus-kill-file-mode-hook ! @vindex gnus-kill-file-mode-hook ! A hook called in kill-file mode buffers. ! @end table ! @node GroupLens ! @section GroupLens ! @cindex GroupLens ! ! GroupLens is a collaborative filtering system that helps you work ! together with other people to find the quality news articles out of the ! huge volume of news articles generated every day. ! ! To accomplish this the GroupLens system combines your opinions about ! articles you have already read with the opinions of others who have done ! likewise and gives you a personalized prediction for each unread news ! article. Think of GroupLens as a matchmaker. GroupLens watches how you ! rate articles, and finds other people that rate articles the same way. ! Once it has found for you some people you agree with it tells you, in ! the form of a prediction, what they thought of the article. You can use ! this prediction to help you decide whether or not you want to read the ! article. ! @menu ! * Using GroupLens:: How to make Gnus use GroupLens. ! * Rating Articles:: Letting GroupLens know how you rate articles. ! * Displaying Predictions:: Displaying predictions given by GroupLens. ! * GroupLens Variables:: Customizing GroupLens. ! @end menu ! @node Using GroupLens ! @subsection Using GroupLens ! To use GroupLens you must register a pseudonym with your local Better ! Bit Bureau (BBB). At the moment the only better bit in town is at ! @samp{http://www.cs.umn.edu/Research/GroupLens/bbb.html}. ! Once you have registered you'll need to set a couple of variables. ! @table @code ! @item gnus-use-grouplens ! @vindex gnus-use-grouplens ! Setting this variable to a non-@code{nil} value will make Gnus hook into ! all the relevant GroupLens functions. ! @item grouplens-pseudonym ! @vindex grouplens-pseudonym ! This variable should be set to the pseudonum you got when registering ! with the Better Bit Bureau. ! ! @item grouplens-newsgroups ! @vindex grouplens-newsgroups ! A list of groups that you want to get GroupLens predictions for. @end table ! Thats the minimum of what you need to get up and running with GroupLens. ! Once you've registered, GroupLens will start giving you scores for ! articles based on the average of what other people think. But, to get ! the real benefit of GroupLens you need to start rating articles ! yourself. Then the scores GroupLens gives you will be personalized for ! you, based on how the people you usually agree with have already rated. ! ! ! @node Rating Articles ! @subsection Rating Articles ! ! In GroupLens, an article is rated on a scale from 1 to 5, inclusive. ! Where 1 means something like this article is a waste of bandwidth and 5 ! means that the article was really good. The basic question to ask ! yourself is, "on a scale from 1 to 5 would I like to see more articles ! like this one?" ! ! There are four ways to enter a rating for an article in GroupLens. @table @kbd ! @item r ! @kindex r (GroupLens) ! @findex bbb-summary-rate-article ! This function will prompt you for a rating on a scale of one to five. ! @item k ! @kindex k (GroupLens) ! @findex grouplens-score-thread ! This function will prompt you for a rating, and rate all the articles in ! the thread. This is really useful for some of those long running giant ! threads in rec.humor. ! @end table ! The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be ! the score of the article you're reading. ! @table @kbd ! ! @item 1-5 n ! @kindex n (GroupLens) ! @findex grouplens-next-unread-article ! Rate the article and go to the next unread article. ! ! @item 1-5 , ! @kindex , (GroupLens) ! @findex grouplens-best-unread-article ! Rate the article and go to the next unread article with the highest score. @end table ! If you want to give the current article a score of 4 and then go to the ! next article, just type @kbd{4 n}. ! @node Displaying Predictions ! @subsection Displaying Predictions ! GroupLens makes a prediction for you about how much you will like a ! news article. The predictions from GroupLens are on a scale from 1 to ! 5, where 1 is the worst and 5 is the best. You can use the predictions ! from GroupLens in one of three ways controlled by the variable ! @code{gnus-grouplens-override-scoring}. ! @vindex gnus-grouplens-override-scoring ! There are three ways to display predictions in grouplens. You may ! choose to have the GroupLens scores contribute to, or override the ! regular gnus scoring mechanism. override is the default; however, some ! people prefer to see the Gnus scores plus the grouplens scores. To get ! the separate scoring behavior you need to set ! @code{gnus-grouplens-override-scoring} to @code{'separate}. To have the ! GroupLens predictions combined with the grouplens scores set it to ! @code{'override} and to combine the scores set ! @code{gnus-grouplens-override-scoring} to @code{'combine}. When you use ! the combine option you will also want to set the values for ! @code{grouplens-prediction-offset} and ! @code{grouplens-score-scale-factor}. ! @vindex grouplens-prediction-display ! In either case, GroupLens gives you a few choices for how you would like ! to see your predictions displayed. The display of predictions is ! controlled by the @code{grouplens-prediction-display} variable. ! The following are legal values for that variable. ! @table @code ! @item prediction-spot ! The higher the prediction, the further to the right an @samp{*} is ! displayed. ! @item confidence-interval ! A numeric confidence interval. ! @item prediction-bar ! The higher the prediction, the longer the bar. ! @item confidence-bar ! Numerical confidence. ! @item confidence-spot ! The spot gets bigger with more confidence. ! @item prediction-num ! Plain-old numeric value. ! ! @item confidence-plus-minus ! Prediction +/i confidence. @end table ! ! @node GroupLens Variables ! @subsection GroupLens Variables @table @code ! @item gnus-summary-grouplens-line-format ! The summary line format used in summary buffers that are GroupLens ! enhanced. It accepts the same specs as the normal summary line format ! (@pxref{Summary Buffer Lines}). The default is ! @samp{%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n}. ! @item grouplens-bbb-host ! Host running the bbbd server. The default is ! @samp{grouplens.cs.umn.edu}. ! @item grouplens-bbb-port ! Port of the host running the bbbd server. The default is 9000. ! @item grouplens-score-offset ! Offset the prediction by this value. In other words, subtract the ! prediction value by this number to arrive at the effective score. The ! default is 0. ! ! @item grouplens-score-scale-factor ! This variable allows the user to magnify the effect of GroupLens scores. ! The scale factor is applied after the offset. The default is 1. @end table ! @node Various ! @chapter Various ! @menu ! * Process/Prefix:: A convention used by many treatment commands. ! * Interactive:: Making Gnus ask you many questions. ! * Formatting Variables:: You can specify what buffers should look like. ! * Windows Configuration:: Configuring the Gnus buffer windows. ! * Compilation:: How to speed Gnus up. ! * Mode Lines:: Displaying information in the mode lines. ! * Highlighting and Menus:: Making buffers look all nice and cozy. ! * Buttons:: Get tendonitis in ten easy steps! ! * Daemons:: Gnus can do things behind your back. ! * NoCeM:: How to avoid spam and other fatty foods. ! * Picons:: How to display pictures of what your reading. ! * Various Various:: Things that are really various. ! @end menu ! @node Process/Prefix ! @section Process/Prefix ! @cindex process/prefix convention ! Many functions, among them functions for moving, decoding and saving ! articles, use what is known as the @dfn{Process/Prefix convention}. ! This is a method for figuring out what articles that the user wants the ! command to be performed on. ! It goes like this: ! If the numeric prefix is N, perform the operation on the next N ! articles, starting with the current one. If the numeric prefix is ! negative, perform the operation on the previous N articles, starting ! with the current one. ! @vindex transient-mark-mode ! If @code{transient-mark-mode} in non-@code{nil} and the region is ! active, all articles in the region will be worked upon. ! If there is no numeric prefix, but some articles are marked with the ! process mark, perform the operation on the articles that are marked with ! the process mark. ! If there is neither a numeric prefix nor any articles marked with the ! process mark, just perform the operation on the current article. ! Quite simple, really, but it needs to be made clear so that surprises ! are avoided. ! @vindex gnus-summary-goto-unread ! One thing that seems to shock & horrify lots of people is that, for ! instance, @kbd{3 d} does exactly the same as @kbd{d} @kbd{d} @kbd{d}. ! Since each @kbd{d} (which marks the current article as read) by default ! goes to the next unread article after marking, this means that @kbd{3 d} ! will mark the next three unread articles as read, no matter what the ! summary buffer looks like. Set @code{gnus-summary-goto-unread} to ! @code{nil} for a more straightforward action. ! @node Interactive ! @section Interactive ! @cindex interaction ! @table @code ! ! @item gnus-novice-user ! @vindex gnus-novice-user ! If this variable is non-@code{nil}, you are either a newcomer to the ! World of Usenet, or you are very cautious, which is a nice thing to be, ! really. You will be given questions of the type ``Are you sure you want ! to do this?'' before doing anything dangerous. This is @code{t} by ! default. ! ! @item gnus-expert-user ! @vindex gnus-expert-user ! If this variable is non-@code{nil}, you will never ever be asked any ! questions by Gnus. It will simply assume you know what you're doing, no ! matter how strange. + @item gnus-interactive-catchup + @vindex gnus-interactive-catchup + Require confirmation before catching up a group if non-@code{nil}. It + is @code{t} by default. + @item gnus-interactive-exit + @vindex gnus-interactive-exit + Require confirmation before exiting Gnus. This variable is @code{t} by + default. @end table ! @node Formatting Variables ! @section Formatting Variables ! @cindex formatting variables ! ! Throughout this manual you've probably noticed lots of variables that ! are called things like @code{gnus-group-line-format} and ! @code{gnus-summary-mode-line-format}. These control how Gnus is to ! output lines in the various buffers. There's quite a lot of them. ! Fortunately, they all use the same syntax, so there's not that much to ! be annoyed by. ! ! Here's an example format spec (from the group buffer): @samp{%M%S%5y: ! %(%g%)\n}. We see that it is indeed extremely ugly, and that there are ! lots of percentages everywhere. ! ! Each @samp{%} element will be replaced by some string or other when the ! buffer in question is generated. @samp{%5y} means ``insert the @samp{y} ! spec, and pad with spaces to get a 5-character field''. Just like a ! normal format spec, almost. ! ! You can also say @samp{%6,4y}, which means that the field will never be ! more than 6 characters wide and never less than 4 characters wide. ! ! There are also specs for highlighting, and these are shared by all the ! format variables. Text inside the @samp{%(} and @samp{%)} specifiers ! will get the special @code{mouse-face} property set, which means that it ! will be highlighted (with @code{gnus-mouse-face}) when you put the mouse ! pointer over it. ! ! Text inside the @samp{%[} and @samp{%]} specifiers will have their ! normal faces set using @code{gnus-face-0}, which is @code{bold} by ! default. If you say @samp{%1[} instead, you'll get @code{gnus-face-1} ! instead, and so on. Create as many faces as you wish. The same goes ! for the @code{mouse-face} specs---you can say @samp{%3(hello%)} to have ! @samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. ! ! Here's an alternative recipe for the group buffer: ! ! @lisp ! ;; Create three face types. ! (setq gnus-face-1 'bold) ! (setq gnus-face-3 'italic) ! ! ;; We want the article count to be in ! ;; a bold and green face. So we create ! ;; a new face called `my-green-bold'. ! (copy-face 'bold 'my-green-bold) ! ;; Set the color. ! (set-face-foreground 'my-green-bold "ForestGreen") ! (setq gnus-face-2 'my-green-bold) ! ! ;; Set the new & fancy format. ! (setq gnus-group-line-format ! "%M%S%3@{%5y%@}%2[:%] %(%1@{%g%@}%)\n") ! @end lisp ! ! I'm sure you'll be able to use this scheme to create totally unreadable ! and extremely vulgar displays. Have fun! ! ! Currently Gnus uses the following formatting variables: ! @code{gnus-group-line-format}, @code{gnus-summary-line-format}, ! @code{gnus-server-line-format}, @code{gnus-topic-line-format}, ! @code{gnus-group-mode-line-format}, ! @code{gnus-summary-mode-line-format}, ! @code{gnus-article-mode-line-format}, ! @code{gnus-server-mode-line-format}. ! ! Note that the @samp{%(} specs (and friends) do not make any sense on the ! mode-line variables. ! ! All these format variables can also be arbitrary elisp forms. In that ! case, they will be @code{eval}ed to insert the required lines. ! ! @kindex M-x gnus-update-format ! @findex gnus-update-format ! Gnus includes a command to help you while creating your own format ! specs. @kbd{M-x gnus-update-format} will @code{eval} the current form, ! update the spec in question and pop you to a buffer where you can ! examine the resulting lisp code to be run to generate the line. ! ! ! @node Windows Configuration ! @section Windows Configuration ! @cindex windows configuration ! ! No, there's nothing here about X, so be quiet. ! ! @vindex gnus-use-full-window ! If @code{gnus-use-full-window} non-@code{nil}, Gnus will delete all ! other windows and occupy the entire Emacs screen by itself. It is ! @code{t} by default. ! ! @vindex gnus-buffer-configuration ! @code{gnus-buffer-configuration} describes how much space each Gnus ! buffer should be given. Here's an excerpt of this variable: ! ! @lisp ! ((group (vertical 1.0 (group 1.0 point) ! (if gnus-carpal (group-carpal 4)))) ! (article (vertical 1.0 (summary 0.25 point) ! (article 1.0)))) ! @end lisp ! This is an alist. The @dfn{key} is a symbol that names some action or ! other. For instance, when displaying the group buffer, the window ! configuration function will use @code{group} as the key. A full list of ! possible names is listed below. ! The @dfn{value} (i. e., the @dfn{split}) says how much space each buffer ! should occupy. To take the @code{article} split as an example - ! @lisp ! (article (vertical 1.0 (summary 0.25 point) ! (article 1.0))) ! @end lisp ! This @dfn{split} says that the summary buffer should occupy 25% of upper ! half of the screen, and that it is placed over the article buffer. As ! you may have noticed, 100% + 25% is actually 125% (yup, I saw y'all ! reaching for that calculator there). However, the special number ! @code{1.0} is used to signal that this buffer should soak up all the ! rest of the space available after the rest of the buffers have taken ! whatever they need. There should be only one buffer with the @code{1.0} ! size spec per split. ! Point will be put in the buffer that has the optional third element ! @code{point}. ! Here's a more complicated example: ! @lisp ! (article (vertical 1.0 (group 4) ! (summary 0.25 point) ! (if gnus-carpal (summary-carpal 4)) ! (article 1.0))) ! @end lisp ! If the size spec is an integer instead of a floating point number, ! then that number will be used to say how many lines a buffer should ! occupy, not a percentage. ! If the @dfn{split} looks like something that can be @code{eval}ed (to be ! precise---if the @code{car} of the split is a function or a subr), this ! split will be @code{eval}ed. If the result is non-@code{nil}, it will ! be used as a split. This means that there will be three buffers if ! @code{gnus-carpal} is @code{nil}, and four buffers if @code{gnus-carpal} ! is non-@code{nil}. ! Not complicated enough for you? Well, try this on for size: ! @lisp ! (article (horizontal 1.0 ! (vertical 0.5 ! (group 1.0) ! (gnus-carpal 4)) ! (vertical 1.0 ! (summary 0.25 point) ! (summary-carpal 4) ! (article 1.0)))) ! @end lisp ! Whoops. Two buffers with the mystery 100% tag. And what's that ! @code{horizontal} thingie? ! If the first element in one of the split is @code{horizontal}, Gnus will ! split the window horizontally, giving you two windows side-by-side. ! Inside each of these strips you may carry on all you like in the normal ! fashion. The number following @code{horizontal} says what percentage of ! the screen is to be given to this strip. ! ! For each split, there @emph{must} be one element that has the 100% tag. ! The splitting is never accurate, and this buffer will eat any leftover ! lines from the splits. ! To be slightly more formal, here's a definition of what a legal split ! may look like: ! @example ! split = frame | horizontal | vertical | buffer | form ! frame = "(frame " size *split ")" ! horizontal = "(horizontal " size *split ")" ! vertical = "(vertical " size *split ")" ! buffer = "(" buffer-name " " size *[ "point" ] ")" ! size = number | frame-params ! buffer-name = group | article | summary ... ! @end example ! The limitations are that the @code{frame} split can only appear as the ! top-level split. @var{form} should be an Emacs Lisp form that should ! return a valid split. We see that each split is fully recursive, and ! may contain any number of @code{vertical} and @code{horizontal} splits. ! ! @vindex gnus-window-min-width ! @vindex gnus-window-min-height ! @cindex window height ! @cindex window width ! Finding the right sizes can be a bit complicated. No window may be less ! than @code{gnus-window-min-height} (default 2) characters high, and all ! windows must be at least @code{gnus-window-min-width} (default 1) ! characters wide. Gnus will try to enforce this before applying the ! splits. If you want to use the normal Emacs window width/height limit, ! you can just set these two variables to @code{nil}. ! ! If you're not familiar with Emacs terminology, @code{horizontal} and ! @code{vertical} splits may work the opposite way of what you'd expect. ! Windows inside a @code{horizontal} split are shown side-by-side, and ! windows within a @code{vertical} split are shown above each other. ! ! @findex gnus-configure-frame ! If you want to experiment with window placement, a good tip is to call ! @code{gnus-configure-frame} directly with a split. This is the function ! that does all the real work when splitting buffers. Below is a pretty ! nonsensical configuration with 5 windows; two for the group buffer and ! three for the article buffer. (I said it was nonsensical.) If you ! @code{eval} the statement below, you can get an idea of how that would ! look straight away, without going through the normal Gnus channels. ! Play with it until you're satisfied, and then use ! @code{gnus-add-configuration} to add your new creation to the buffer ! configuration list. ! ! @lisp ! (gnus-configure-frame ! '(horizontal 1.0 ! (vertical 10 ! (group 1.0) ! (article 0.3 point)) ! (vertical 1.0 ! (article 1.0) ! (horizontal 4 ! (group 1.0) ! (article 10))))) ! @end lisp ! ! You might want to have several frames as well. No prob---just use the ! @code{frame} split: ! ! @lisp ! (gnus-configure-frame ! '(frame 1.0 ! (vertical 1.0 ! (summary 0.25 point) ! (article 1.0)) ! (vertical ((height . 5) (width . 15) ! (user-position . t) ! (left . -1) (top . 1)) ! (picon 1.0)))) ! ! @end lisp ! ! This split will result in the familiar summary/article window ! configuration in the first (or ``main'') frame, while a small additional ! frame will be created where picons will be shown. As you can see, ! instead of the normal @code{1.0} top-level spec, each additional split ! should have a frame parameter alist as the size spec. ! @xref{Frame Parameters, , Frame Parameters, elisp, The GNU Emacs Lisp ! Reference Manual}. ! Here's a list of all possible keys for ! @code{gnus-buffer-configuration}: ! @code{group}, @code{summary}, @code{article}, @code{server}, ! @code{browse}, @code{group-mail}, @code{summary-mail}, ! @code{summary-reply}, @code{info}, @code{summary-faq}, ! @code{edit-group}, @code{edit-server}, @code{reply}, @code{reply-yank}, ! @code{followup}, @code{followup-yank}, @code{edit-score}. ! @findex gnus-add-configuration ! Since the @code{gnus-buffer-configuration} variable is so long and ! complicated, there's a function you can use to ease changing the config ! of a single setting: @code{gnus-add-configuration}. If, for instance, ! you want to change the @code{article} setting, you could say: ! @lisp ! (gnus-add-configuration ! '(article (vertical 1.0 ! (group 4) ! (summary .25 point) ! (article 1.0)))) ! @end lisp ! You'd typically stick these @code{gnus-add-configuration} calls in your ! @file{.gnus} file or in some startup hook -- they should be run after ! Gnus has been loaded. ! @node Compilation ! @section Compilation ! @cindex compilation ! @cindex byte-compilation ! @findex gnus-compile ! Remember all those line format specification variables? ! @code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so ! on. Now, Gnus will of course heed whatever these variables are, but, ! unfortunately, changing them will mean a quite significant slow-down. ! (The default values of these variables have byte-compiled functions ! associated with them, while the user-generated versions do not, of ! course.) ! To help with this, you can run @kbd{M-x gnus-compile} after you've ! fiddled around with the variables and feel that you're (kind of) ! satisfied. This will result in the new specs being byte-compiled, and ! you'll get top speed again. ! @node Mode Lines ! @section Mode Lines ! @cindex mode lines ! @vindex gnus-updated-mode-lines ! @code{gnus-updated-mode-lines} says what buffers should keep their mode ! lines updated. It is a list of symbols. Supported symbols include ! @code{group}, @code{article}, @code{summary}, @code{server}, ! @code{browse}, and @code{tree}. If the corresponding symbol is present, ! Gnus will keep that mode line updated with information that may be ! pertinent. If this variable is @code{nil}, screen refresh may be ! quicker. ! @cindex display-time ! @vindex gnus-mode-non-string-length ! By default, Gnus displays information on the current article in the mode ! lines of the summary and article buffers. The information Gnus wishes ! to display (eg. the subject of the article) is often longer than the ! mode lines, and therefore have to be cut off at some point. The ! @code{gnus-mode-non-string-length} variable says how long the other ! elements on the line is (i.e., the non-info part). If you put ! additional elements on the mode line (eg. a clock), you should modify ! this variable: ! @c Hook written by Francesco Potorti` ! @lisp ! (add-hook 'display-time-hook ! (lambda () (setq gnus-mode-non-string-length ! (+ 21 ! (if line-number-mode 5 0) ! (if column-number-mode 4 0) ! (length display-time-string))))) ! @end lisp ! If this variable is @code{nil} (which is the default), the mode line ! strings won't be chopped off, and they won't be padded either. ! @node Highlighting and Menus ! @section Highlighting and Menus ! @cindex visual ! @cindex highlighting ! @cindex menus ! @vindex gnus-visual ! The @code{gnus-visual} variable controls most of the prettifying Gnus ! aspects. If @code{nil}, Gnus won't attempt to create menus or use fancy ! colors or fonts. This will also inhibit loading the @file{gnus-vis.el} ! file. ! This variable can be a list of visual properties that are enabled. The ! following elements are legal, and are all included by default: ! @table @code ! @item group-highlight ! Do highlights in the group buffer. ! @item summary-highlight ! Do highlights in the summary buffer. ! @item article-highlight ! Do highlights in the article buffer. ! @item highlight ! Turn on highlighting in all buffers. ! @item group-menu ! Create menus in the group buffer. ! @item summary-menu ! Create menus in the summary buffers. ! @item article-menu ! Create menus in the article buffer. ! @item browse-menu ! Create menus in the browse buffer. ! @item server-menu ! Create menus in the server buffer. ! @item score-menu ! Create menus in the score buffers. ! @item menu ! Create menus in all buffers. @end table ! So if you only want highlighting in the article buffer and menus in all ! buffers, you could say something like: ! @lisp ! (setq gnus-visual '(article-highlight menu)) ! @end lisp ! If you want only highlighting and no menus whatsoever, you'd say: @lisp ! (setq gnus-visual '(highlight)) @end lisp ! If @code{gnus-visual} is @code{t}, highlighting and menus will be used ! in all Gnus buffers. ! Other general variables that influence the look of all buffers include: @table @code ! @item gnus-mouse-face ! @vindex gnus-mouse-face ! This is the face (i.e., font) used for mouse highlighting in Gnus. No ! mouse highlights will be done if @code{gnus-visual} is @code{nil}. ! @item gnus-display-type ! @vindex gnus-display-type ! This variable is symbol indicating the display type Emacs is running ! under. The symbol should be one of @code{color}, @code{grayscale} or ! @code{mono}. If Gnus guesses this display attribute wrongly, either set ! this variable in your @file{~/.emacs} or set the resource ! @code{Emacs.displayType} in your @file{~/.Xdefaults}. ! ! @item gnus-background-mode ! @vindex gnus-background-mode ! This is a symbol indicating the Emacs background brightness. The symbol ! should be one of @code{light} or @code{dark}. If Gnus guesses this ! frame attribute wrongly, either set this variable in your @file{~/.emacs} or ! set the resource @code{Emacs.backgroundMode} in your @file{~/.Xdefaults}. ! `gnus-display-type'. @end table ! There are hooks associated with the creation of all the different menus: ! ! @table @code ! ! @item gnus-article-menu-hook ! @vindex gnus-article-menu-hook ! Hook called after creating the article mode menu. ! ! @item gnus-group-menu-hook ! @vindex gnus-group-menu-hook ! Hook called after creating the group mode menu. ! ! @item gnus-summary-menu-hook ! @vindex gnus-summary-menu-hook ! Hook called after creating the summary mode menu. ! ! @item gnus-server-menu-hook ! @vindex gnus-server-menu-hook ! Hook called after creating the server mode menu. ! ! @item gnus-browse-menu-hook ! @vindex gnus-browse-menu-hook ! Hook called after creating the browse mode menu. ! ! @item gnus-score-menu-hook ! @vindex gnus-score-menu-hook ! Hook called after creating the score mode menu. ! @end table ! @node Buttons ! @section Buttons ! @cindex buttons ! @cindex mouse ! @cindex click ! ! Those new-fangled @dfn{mouse} contraptions is very popular with the ! young, hep kids who don't want to learn the proper way to do things ! these days. Why, I remember way back in the summer of '89, when I was ! using Emacs on a Tops 20 system. Three hundred users on one single ! machine, and every user was running Simula compilers. Bah! ! ! Right. ! ! @vindex gnus-carpal ! Well, you can make Gnus display bufferfuls of buttons you can click to ! do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple, ! really. Tell the chiropractor I sent you. ! ! ! @table @code ! ! @item gnus-carpal-mode-hook ! @vindex gnus-carpal-mode-hook ! Hook run in all carpal mode buffers. ! ! @item gnus-carpal-button-face ! @vindex gnus-carpal-button-face ! Face used on buttons. ! @item gnus-carpal-header-face ! @vindex gnus-carpal-header-face ! Face used on carpal buffer headers. ! @item gnus-carpal-group-buffer-buttons ! @vindex gnus-carpal-group-buffer-buttons ! Buttons in the group buffer. ! ! @item gnus-carpal-summary-buffer-buttons ! @vindex gnus-carpal-summary-buffer-buttons ! Buttons in the summary buffer. ! ! @item gnus-carpal-server-buffer-buttons ! @vindex gnus-carpal-server-buffer-buttons ! Buttons in the server buffer. ! ! @item gnus-carpal-browse-buffer-buttons ! @vindex gnus-carpal-browse-buffer-buttons ! Buttons in the browse buffer. @end table ! All the @code{buttons} variables are lists. The elements in these list ! is either a cons cell where the car contains a text to be displayed and ! the cdr contains a function symbol, or a simple string. ! @node Daemons ! @section Daemons ! @cindex demons ! @cindex daemons ! Gnus, being larger than any program ever written (allegedly), does lots ! of strange stuff that you may wish to have done while you're not ! present. For instance, you may want it to check for new mail once in a ! while. Or you may want it to close down all connections to all servers ! when you leave Emacs idle. And stuff like that. ! ! Gnus will let you do stuff like that by defining various ! @dfn{handlers}. Each handler consists of three elements: A ! @var{function}, a @var{time}, and an @var{idle} parameter. ! ! Here's an example of a handler that closes connections when Emacs has ! been idle for thirty minutes: @lisp ! (gnus-demon-close-connections nil 30) @end lisp ! Here's a handler that scans for PGP headers every hour when Emacs is ! idle: ! @lisp ! (gnus-demon-scan-pgp 60 t) ! @end lisp ! This @var{time} parameter and than @var{idle} parameter works together ! in a strange, but wonderful fashion. Basically, if @var{idle} is ! @code{nil}, then the function will be called every @var{time} minutes. ! If @var{idle} is @code{t}, then the function will be called after ! @var{time} minutes only if Emacs is idle. So if Emacs is never idle, ! the function will never be called. But once Emacs goes idle, the ! function will be called every @var{time} minutes. ! If @var{idle} is a number and @var{time} is a number, the function will ! be called every @var{time} minutes only when Emacs has been idle for ! @var{idle} minutes. ! If @var{idle} is a number and @var{time} is @code{nil}, the function ! will be called once every time Emacs has been idle for @var{idle} ! minutes. ! And if @var{time} is a string, it should look like @samp{07:31}, and ! the function will then be called once every day somewhere near that ! time. Modified by the @var{idle} parameter, of course. ! @vindex gnus-demon-timestep ! (When I say ``minute'' here, I really mean @code{gnus-demon-timestep} ! seconds. This is @code{60} by default. If you change that variable, ! all the timings in the handlers will be affected.) ! @vindex gnus-use-demon ! To set the whole thing in motion, though, you have to set ! @code{gnus-use-demon} to @code{t}. ! ! So, if you want to add a handler, you could put something like this in ! your @file{.gnus} file: ! ! @findex gnus-demon-add-handler @lisp ! (gnus-demon-add-handler 'gnus-demon-close-connections nil 30) @end lisp ! @findex gnus-demon-add-nocem ! @findex gnus-demon-add-scanmail ! @findex gnus-demon-add-disconnection ! Some ready-made functions to do this has been created: ! @code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection}, and ! @code{gnus-demon-add-scanmail}. Just put those functions in your ! @file{.gnus} if you want those abilities. ! ! @findex gnus-demon-init ! @findex gnus-demon-cancel ! @vindex gnus-demon-handlers ! If you add handlers to @code{gnus-demon-handlers} directly, you should ! run @code{gnus-demon-init} to make the changes take hold. To cancel all ! daemons, you can use the @code{gnus-demon-cancel} function. ! ! Note that adding daemons can be pretty naughty if you overdo it. Adding ! functions that scan all news and mail from all servers every two seconds ! is a sure-fire way of getting booted off any respectable system. So ! behave. ! ! ! @node NoCeM ! @section NoCeM ! @cindex nocem ! @cindex spam ! ! @dfn{Spamming} is posting the same article lots and lots of times. ! Spamming is bad. Spamming is evil. ! ! Spamming is usually canceled within a day or so by various anti-spamming ! agencies. These agencies usually also send out @dfn{NoCeM} messages. ! NoCeM is pronounced ``no see-'em'', and means what the name ! implies---these are messages that make the offending articles, like, go ! away. ! ! What use are these NoCeM messages if the articles are canceled anyway? ! Some sites do not honor cancel messages and some sites just honor cancels ! from a select few people. Then you may wish to make use of the NoCeM ! messages, which are distributed in the @samp{alt.nocem.misc} newsgroup. ! ! Gnus can read and parse the messages in this group automatically, and ! this will make spam disappear. ! ! There are some variables to customize, of course: ! ! @table @code ! @item gnus-use-nocem ! @vindex gnus-use-nocem ! Set this variable to @code{t} to set the ball rolling. It is @code{nil} ! by default. ! ! @item gnus-nocem-groups ! @vindex gnus-nocem-groups ! Gnus will look for NoCeM messages in the groups in this list. The ! default is @code{("alt.nocem.misc" "news.admin.net-abuse.announce")}. ! ! @item gnus-nocem-issuers ! @vindex gnus-nocem-issuers ! There are many people issuing NoCeM messages. This list says what ! people you want to listen to. The default is @code{("Automoose-1" ! "clewis@@ferret.ocunix.on.ca;" "jem@@xpat.com;" "red@@redpoll.mrfs.oh.us ! (Richard E. Depew)")}; fine, upstanding citizens all of them. ! ! Known despammers that you can put in this list include: ! ! @table @samp ! @item clewis@@ferret.ocunix.on.ca; ! @cindex Chris Lewis ! Chris Lewis---Major Canadian despammer who has probably canceled more ! usenet abuse than anybody else. ! ! @item Automoose-1 ! @cindex CancelMoose[tm] ! The CancelMoose[tm] on autopilot. The CancelMoose[tm] is reputed to be ! Norwegian, and was the person(s) who invented NoCeM. ! ! @item jem@@xpat.com; ! @cindex Jem ! Jem---Korean despammer who is getting very busy these days. ! ! @item red@@redpoll.mrfs.oh.us (Richard E. Depew) ! Richard E. Depew---lone American despammer. He mostly cancels binary ! postings to non-binary groups and removes spews (regurgitated articles). @end table ! You do not have to heed NoCeM messages from all these people---just the ! ones you want to listen to. ! @item gnus-nocem-directory ! @vindex gnus-nocem-directory ! This is where Gnus will store its NoCeM cache files. The default is ! @file{~/News/NoCeM/}. ! ! @item gnus-nocem-expiry-wait ! @vindex gnus-nocem-expiry-wait ! The number of days before removing old NoCeM entries from the cache. ! The default is 15. If you make it shorter Gnus will be faster, but you ! might then see old spam. ! ! @end table ! ! ! @node Picons ! @section Picons ! ! So... You want to slow down your news reader even more! This is a ! good way to do so. Its also a great way to impress people staring ! over your shoulder as you read news. ! ! @menu ! * Picon Basics:: What are picons and How do I get them. ! * Picon Requirements:: Don't go further if you aren't using XEmacs. ! * Easy Picons:: Displaying Picons -- the easy way. ! * Hard Picons:: The way you should do it. You'll learn something. ! * Picon Configuration:: Other variables you can trash/tweak/munge/play with. ! @end menu ! ! ! @node Picon Basics ! @subsection Picon Basics ! ! What are Picons? To quote directly from the Picons Web site ! (@samp{http://www.cs.indiana.edu/picons/ftp/index.html}): ! ! @quotation ! @dfn{Picons} is short for ``personal icons''. They're small, ! constrained images used to represent users and domains on the net, ! organized into databases so that the appropriate image for a given ! e-mail address can be found. Besides users and domains, there are picon ! databases for Usenet newsgroups and weather forecasts. The picons are ! in either monochrome @code{XBM} format or color @code{XPM} and ! @code{GIF} formats. ! @end quotation ! ! Please see the above mentioned web site for instructions on obtaining ! and installing the picons databases, or the following ftp site: ! @samp{http://www.cs.indiana.edu/picons/ftp/index.html}. ! ! @vindex gnus-picons-database ! Gnus expects picons to be installed into a location pointed to by ! @code{gnus-picons-database}. ! ! ! @node Picon Requirements ! @subsection Picon Requirements ! ! To use have Gnus display Picons for you, you must be running XEmacs ! 19.13 or greater since all other versions of Emacs aren't yet able to ! display images. ! ! Additionally, you must have @code{xpm} support compiled into XEmacs. ! ! @vindex gnus-picons-convert-x-face ! If you want to display faces from @code{X-Face} headers, you must have ! the @code{netpbm} utilities installed, or munge the ! @code{gnus-picons-convert-x-face} variable to use something else. ! ! ! @node Easy Picons ! @subsection Easy Picons ! ! To enable displaying picons, simply put the following line in your ! @file{~/.gnus} file and start Gnus. @lisp ! (setq gnus-use-picons t) ! (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) ! (add-hook 'gnus-summary-prepare-hook 'gnus-group-display-picons t) ! (add-hook 'gnus-article-display-hook 'gnus-picons-article-display-x-face) @end lisp ! @node Hard Picons ! @subsection Hard Picons ! Gnus can display picons for you as you enter and leave groups and ! articles. It knows how to interact with three sections of the picons ! database. Namely, it can display the picons newsgroup pictures, ! author's face picture(s), and the authors domain. To enable this ! feature, you need to first decide where to display them. ! @table @code ! @item gnus-picons-display-where ! @vindex gnus-picons-display-where ! Where the picon images should be displayed. It is @code{picons} by ! default (which by default maps to the buffer @samp{*Picons*}). Other ! valid places could be @code{article}, @code{summary}, or ! @samp{"*scratch*"} for all I care. Just make sure that you've made the ! buffer visible using the standard Gnus window configuration routines -- ! @xref{Windows Configuration}. ! @end table ! ! Note: If you set @code{gnus-use-picons} to @code{t}, it will set up your ! window configuration for you to include the @code{picons} buffer. ! ! Now that you've made that decision, you need to add the following ! functions to the appropriate hooks so these pictures will get ! displayed at the right time. ! ! @vindex gnus-article-display-hook ! @vindex gnus-picons-display-where ! @table @code ! @item gnus-article-display-picons ! @findex gnus-article-display-picons ! Looks up and display the picons for the author and the author's domain ! in the @code{gnus-picons-display-where} buffer. Should be added to ! the @code{gnus-article-display-hook}. ! ! @item gnus-group-display-picons ! @findex gnus-article-display-picons ! Displays picons representing the current group. This function should ! be added to the @code{gnus-summary-prepare-hook} or to the ! @code{gnus-article-display-hook} if @code{gnus-picons-display-where} ! is set to @code{article}. ! ! @item gnus-picons-article-display-x-face ! @findex gnus-article-display-picons ! Decodes and displays the X-Face header if present. This function ! should be added to @code{gnus-article-display-hook}. ! ! @end table ! ! Note: You must append them to the hook, so make sure to specify 't' ! to the append flag of @code{add-hook}: @lisp ! (add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) @end lisp ! @node Picon Configuration ! @subsection Picon Configuration ! ! The following variables offer further control over how things are ! done, where things are located, and other useless stuff you really ! don't need to worry about. ! ! @table @code ! @item gnus-picons-database ! @vindex gnus-picons-database ! The location of the picons database. Should point to a directory ! containing the @file{news}, @file{domains}, @file{users} (and so on) ! subdirectories. Defaults to @file{/usr/local/faces}. ! ! @item gnus-picons-news-directory ! @vindex gnus-picons-news-directory ! Sub-directory of the faces database containing the icons for ! newsgroups. ! ! @item gnus-picons-user-directories ! @vindex gnus-picons-user-directories ! List of subdirectories to search in @code{gnus-picons-database} for user ! faces. Defaults to @code{("local" "users" "usenix" "misc/MISC")}. ! ! @item gnus-picons-domain-directories ! @vindex gnus-picons-domain-directories ! List of subdirectories to search in @code{gnus-picons-database} for ! domain name faces. Defaults to @code{("domains")}. Some people may ! want to add @samp{unknown} to this list. ! ! @item gnus-picons-convert-x-face ! @vindex gnus-picons-convert-x-face ! The command to use to convert the @code{X-Face} header to an X bitmap ! (@code{xbm}). Defaults to @code{(format "@{ echo '/* Width=48, ! Height=48 */'; uncompface; @} | icontopbm | pbmtoxbm > %s" ! gnus-picons-x-face-file-name)} ! ! @item gnus-picons-x-face-file-name ! @vindex gnus-picons-x-face-file-name ! Names a temporary file to store the @code{X-Face} bitmap in. Defaults ! to @code{(format "/tmp/picon-xface.%s.xbm" (user-login-name))}. ! ! @item gnus-picons-buffer ! @vindex gnus-picons-buffer ! The name of the buffer that @code{picons} points to. Defaults to ! @samp{*Icon Buffer*}. ! ! @end table ! ! ! @node Various Various ! @section Various Various ! @cindex mode lines ! @cindex highlights ! ! @table @code ! ! @item gnus-verbose ! @vindex gnus-verbose ! This variable is an integer between zero and ten. The higher the value, ! the more messages will be displayed. If this variable is zero, Gnus ! will never flash any messages, if it is seven (which is the default), ! most important messages will be shown, and if it is ten, Gnus won't ever ! shut up, but will flash so many messages it will make your head swim. ! ! @item gnus-verbose-backends ! @vindex gnus-verbose-backends ! This variable works the same way as @code{gnus-verbose}, but it applies ! to the Gnus backends instead of Gnus proper. ! ! @item nnheader-max-head-length ! @vindex nnheader-max-head-length ! When the backends read straight heads of articles, they all try to read ! as little as possible. This variable (default @code{4096}) specifies ! the absolute max length the backends will try to read before giving up ! on finding a separator line between the head and the body. If this ! variable is @code{nil}, there is no upper read bound. If it is ! @code{t}, the backends won't try to read the articles piece by piece, ! but read the entire articles. This makes sense with some versions of ! @code{ange-ftp}. ! ! @item nnheader-file-name-translation-alist ! @vindex nnheader-file-name-translation-alist ! @cindex file names ! @cindex illegal characters in file names ! @cindex characters in file names ! This is an alist that says how to translate characters in file names. ! For instance, if @samp{:} is illegal as a file character in file names ! on your system (you OS/2 user you), you could say something like: ! ! @lisp ! (setq nnheader-file-name-translation-alist ! '((?: . ?_))) ! @end lisp ! ! In fact, this is the default value for this variable on OS/2 and MS ! Windows (phooey) systems. ! ! @item gnus-hidden-properties ! @vindex gnus-hidden-properties ! This is a list of properties to use to hide ``invisible'' text. It is ! @code{(invisible t intangible t)} by default on most systems, which ! makes invisible text invisible and intangible. ! ! @item gnus-parse-headers-hook ! @vindex gnus-parse-headers-hook ! A hook called before parsing headers. It can be used, for instance, to ! gather statistics on the headers fetched, or perhaps you'd like to prune ! some headers. I don't see why you'd want that, though. ! ! @end table ! ! ! @node The End ! @chapter The End ! ! Well, that's the manual---you can get on with your life now. Keep in ! touch. Say hello to your cats from me. ! ! My @strong{ghod}---I just can't stand goodbyes. Sniffle. ! ! Ol' Charles Reznikoff said it pretty well, so I leave the floor to him: ! ! @quotation ! @strong{Te Deum} ! @sp 1 ! Not because of victories @* ! I sing,@* ! having none,@* ! but for the common sunshine,@* ! the breeze,@* ! the largess of the spring. ! @sp 1 ! Not for victory@* ! but for the day's work done@* ! as well as I was able;@* ! not for a seat upon the dais@* ! but at the common table.@* ! @end quotation ! @node Appendices ! @chapter Appendices ! @menu ! * History:: How Gnus got where it is today. ! * Terminology:: We use really difficult, like, words here. ! * Customization:: Tailoring Gnus to your needs. ! * Troubleshooting:: What you might try if things do not work. ! * A Programmers Guide to Gnus:: Rilly, rilly technical stuff. ! * Emacs for Heathens:: A short introduction to Emacsian terms. ! * Frequently Asked Questions:: A question-and-answer session. ! @end menu ! @node History ! @section History ! @cindex history ! @sc{gnus} was written by Masanobu @sc{Umeda}. When autumn crept up in ! '94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus. ! If you want to investigate the person responsible for this outrage, you ! can point your (feh!) web browser to ! @file{http://www.ifi.uio.no/~larsi/}. This is also the primary ! distribution point for the new and spiffy versions of Gnus, and is known ! as The Site That Destroys Newsrcs And Drives People Mad. ! During the first extended alpha period of development, the new Gnus was ! called ``(ding) Gnus''. @dfn{(ding)}, is, of course, short for ! @dfn{ding is not Gnus}, which is a total and utter lie, but who cares? ! (Besides, the ``Gnus'' in this abbreviation should probably be ! pronounced ``news'' as @sc{Umeda} intended, which makes it a more ! appropriate name, don't you think?) ! ! In any case, after spending all that energy on coming up with a new and ! spunky name, we decided that the name was @emph{too} spunky, so we ! renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. ! ``@sc{gnus}''. New vs. old. ! The first ``proper'' release of Gnus 5 was done in November 1995 when it ! was included in the Emacs 19.30 distribution. ! In May 1996 the next Gnus generation (aka. ``September Gnus'') was ! released under the name ``Gnus 5.2''. ! @menu ! * Why?:: What's the point of Gnus? ! * Compatibility:: Just how compatible is Gnus with @sc{gnus}? ! * Conformity:: Gnus tries to conform to all standards. ! * Emacsen:: Gnus can be run on a few modern Emacsen. ! * Contributors:: Oodles of people. ! * New Features:: Pointers to some of the new stuff in Gnus. ! * Newest Features:: Features so new that they haven't been written yet. ! @end menu ! @node Why? ! @subsection Why? ! What's the point of Gnus? ! I want to provide a ``rad'', ``happening'', ``way cool'' and ``hep'' ! newsreader, that lets you do anything you can think of. That was my ! original motivation, but while working on Gnus, it has become clear to ! me that this generation of newsreaders really belong in the stone age. ! Newsreaders haven't developed much since the infancy of the net. If the ! volume continues to rise with the current rate of increase, all current ! newsreaders will be pretty much useless. How do you deal with ! newsgroups that have thousands of new articles each day? How do you ! keep track of millions of people who post? ! Gnus offers no real solutions to these questions, but I would very much ! like to see Gnus being used as a testing ground for new methods of ! reading and fetching news. Expanding on @sc{Umeda}-san's wise decision ! to separate the newsreader from the backends, Gnus now offers a simple ! interface for anybody who wants to write new backends for fetching mail ! and news from different sources. I have added hooks for customizations ! everywhere I could imagine useful. By doing so, I'm inviting every one ! of you to explore and invent. ! May Gnus never be complete. @kbd{C-u 100 M-x hail-emacs}. ! @node Compatibility ! @subsection Compatibility ! @cindex compatibility ! Gnus was designed to be fully compatible with @sc{gnus}. Almost all key ! bindings have been kept. More key bindings have been added, of course, ! but only in one or two obscure cases have old bindings been changed. ! Our motto is: ! @quotation ! @cartouche ! @center In a cloud bones of steel. ! @end cartouche ! @end quotation ! All commands have kept their names. Some internal functions have changed ! their names. ! The @code{gnus-uu} package has changed drastically. @pxref{Decoding ! Articles}. ! One major compatibility question is the presence of several summary ! buffers. All variables that are relevant while reading a group are ! buffer-local to the summary buffer they belong in. Although many ! important variables have their values copied into their global ! counterparts whenever a command is executed in the summary buffer, this ! change might lead to incorrect values being used unless you are careful. ! All code that relies on knowledge of @sc{gnus} internals will probably ! fail. To take two examples: Sorting @code{gnus-newsrc-alist} (or ! changing it in any way, as a matter of fact) is strictly verboten. Gnus ! maintains a hash table that points to the entries in this alist (which ! speeds up many functions), and changing the alist directly will lead to ! peculiar results. ! @cindex hilit19 ! @cindex highlighting ! Old hilit19 code does not work at all. In fact, you should probably ! remove all hilit code from all Gnus hooks ! (@code{gnus-group-prepare-hook} and @code{gnus-summary-prepare-hook}). ! Gnus provides various integrated functions for highlighting. These are ! faster and more accurate. To make life easier for everybody, Gnus will ! by default remove all hilit calls from all hilit hooks. Uncleanliness! ! Away! ! Packages like @code{expire-kill} will no longer work. As a matter of ! fact, you should probably remove all old @sc{gnus} packages (and other ! code) when you start using Gnus. More likely than not, Gnus already ! does what you have written code to make @sc{gnus} do. (Snicker.) ! Even though old methods of doing things are still supported, only the ! new methods are documented in this manual. If you detect a new method of ! doing something while reading this manual, that does not mean you have ! to stop doing it the old way. ! Gnus understands all @sc{gnus} startup files. ! @kindex M-x gnus-bug ! @findex gnus-bug ! @cindex reporting bugs ! @cindex bugs ! Overall, a casual user who hasn't written much code that depends on ! @sc{gnus} internals should suffer no problems. If problems occur, ! please let me know by issuing that magic command @kbd{M-x gnus-bug}. ! @node Conformity ! @subsection Conformity ! No rebels without a clue here, ma'am. We conform to all standards known ! to (wo)man. Except for those standards and/or conventions we disagree ! with, of course. ! @table @strong ! @item RFC 822 ! @cindex RFC 822 ! There are no known breaches of this standard. ! @item RFC 1036 ! @cindex RFC 1036 ! There are no known breaches of this standard, either. ! @item Usenet Seal of Approval ! @cindex Usenet Seal of Approval ! Gnus hasn't been formally through the Seal process, but I have read ! through the Seal text and I think Gnus would pass. ! @item Son-of-RFC 1036 ! @cindex Son-of-RFC 1036 ! We do have some breaches to this one. ! @table @emph ! @item MIME ! Gnus does no MIME handling, and this standard-to-be seems to think that ! MIME is the bees' knees, so we have major breakage here. ! @item X-Newsreader ! This is considered to be a ``vanity header'', while I consider it to be ! consumer information. After seeing so many badly formatted articles ! coming from @code{tin} and @code{Netscape} I know not to use either of ! those for posting articles. I would not have known that if it wasn't ! for the @code{X-Newsreader} header. ! @item References ! Gnus does line breaking on this header. I infer from RFC1036 that being ! conservative in what you output is not creating 5000-character lines, so ! it seems like a good idea to me. However, this standard-to-be says that ! whitespace in the @code{References} header is to be preserved, so... It ! doesn't matter one way or the other to Gnus, so if somebody tells me ! what The Way is, I'll change it. Or not. ! @end table ! @end table ! If you ever notice Gnus acting non-compliantly with regards to the texts ! mentioned above, don't hesitate to drop a note to Gnus Towers and let us ! know. ! @node Emacsen ! @subsection Emacsen ! @cindex Emacsen ! @cindex XEmacs ! @cindex Mule ! @cindex Emacs ! Gnus should work on : ! @itemize @bullet ! @item ! Emacs 19.30 and up. ! @item ! XEmacs 19.13 and up. ! @item ! Mule versions based on Emacs 19.30 and up. ! @end itemize ! Gnus will absolutely not work on any Emacsen older than that. Not ! reliably, at least. ! There are some vague differences between Gnus on the various platforms: ! @itemize @bullet ! @item ! The mouse-face on Gnus lines under Emacs and Mule is delimited to ! certain parts of the lines while they cover the entire line under ! XEmacs. ! @item ! The same with current-article marking---XEmacs puts an underline under ! the entire summary line while Emacs and Mule are nicer and kinder. ! @item ! XEmacs features more graphics---a logo and a toolbar. ! @item ! Citation highlighting us better under Emacs and Mule than under XEmacs. ! @item ! Emacs 19.26-19.28 have tangible hidden headers, which can be a bit ! confusing. ! @end itemize ! @node Contributors ! @subsection Contributors ! @cindex contributors ! The new Gnus version couldn't have been done without the help of all the ! people on the (ding) mailing list. Every day for over a year I have ! gotten billions of nice bug reports from them, filling me with joy, ! every single one of them. Smooches. The people on the list have been ! tried beyond endurance, what with my ``oh, that's a neat idea , yup, I'll release it right away no wait, that doesn't ! work at all , yup, I'll ship that one off right away no, wait, that absolutely does not work'' policy for releases. ! Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that ! ``worser''? ``much worser''? ``worsest''?) ! I would like to take this opportunity to thank the Academy for... oops, ! wrong show. ! @itemize @bullet ! @item Masanobu @sc{Umeda} ! The writer of the original @sc{gnus}. ! @item Per Abrahamsen ! Custom, scoring, highlighting and @sc{soup} code (as well as numerous ! other things). ! @item Luis Fernandes ! Design and graphics. ! @item Wes Hardaker ! @file{gnus-picon.el} and the manual section on @dfn{picons} ! (@pxref{Picons}). ! @item Brad Miller ! @file{gnus-gl.el} and the GroupLens manual section (@pxref{GroupLens}). ! @item Sudish Joseph ! Innumerable bug fixes. ! @item Ilja Weis ! @file{gnus-topic.el}. ! @item Steven L. Baur ! Lots and lots of bugs detections and fixes. ! @item Vladimir Alexiev ! The refcard and reference booklets. ! @item Felix Lee & JWZ ! I stole some pieces from the XGnus distribution by Felix Lee and JWZ. ! @item Scott Byer ! @file{nnfolder.el} enhancements & rewrite. ! @item Peter Mutsaers ! Orphan article scoring code. ! @item Ken Raeburn ! POP mail support. ! @item Hallvard B Furuseth ! Various bits and pieces, especially dealing with .newsrc files. ! @item Brian Edmonds ! @file{gnus-bbdb.el}. ! @item Ricardo Nassif and Mark Borges ! Proof-reading. ! @item Kevin Davidson ! Came up with the name @dfn{ding}, so blame him. ! @end itemize ! Peter Arius, Stainless Steel Rat, Ulrik Dickow, Jack Vinson, Daniel ! Quinlan, Frank D. Cringle, Geoffrey T. Dairiki, Fabrice Popineau and ! Andrew Eskilsson have all contributed code and suggestions. ! @node New Features ! @subsection New Features ! @cindex new features ! ! @itemize @bullet ! ! @item ! The look of all buffers can be changed by setting format-like variables ! (@pxref{Group Buffer Format} and @pxref{Summary Buffer Format}). ! ! @item ! Local spool and several @sc{nntp} servers can be used at once ! (@pxref{Select Methods}). ! @item ! You can combine groups into virtual groups (@pxref{Virtual Groups}). ! @item ! You can read a number of different mail formats (@pxref{Getting Mail}). ! All the mail backends implement a convenient mail expiry scheme ! (@pxref{Expiring Mail}). ! @item ! Gnus can use various strategies for gathering threads that have lost ! their roots (thereby gathering loose sub-threads into one thread) or it ! can go back and retrieve enough headers to build a complete thread ! (@pxref{Customizing Threading}). ! @item ! Killed groups can be displayed in the group buffer, and you can read ! them as well (@pxref{Listing Groups}). ! @item ! Gnus can do partial group updates---you do not have to retrieve the ! entire active file just to check for new articles in a few groups ! (@pxref{The Active File}). ! @item ! Gnus implements a sliding scale of subscribedness to groups ! (@pxref{Group Levels}). ! @item ! You can score articles according to any number of criteria ! (@pxref{Scoring}). You can even get Gnus to find out how to score ! articles for you (@pxref{Adaptive Scoring}). ! @item ! Gnus maintains a dribble buffer that is auto-saved the normal Emacs ! manner, so it should be difficult to lose much data on what you have ! read if your machine should go down (@pxref{Auto Save}). ! @item ! Gnus now has its own startup file (@file{.gnus}) to avoid cluttering up ! the @file{.emacs} file. ! @item ! You can set the process mark on both groups and articles and perform ! operations on all the marked items (@pxref{Process/Prefix}). ! @item ! You can grep through a subset of groups and create a group from the ! results (@pxref{Kibozed Groups}). ! @item ! You can list subsets of groups according to, well, anything ! (@pxref{Listing Groups}). ! @item ! You can browse foreign servers and subscribe to groups from those ! servers (@pxref{Browse Foreign Server}). ! @item ! Gnus can fetch articles asynchronously on a second connection to the ! server (@pxref{Asynchronous Fetching}). + @item + You can cache articles locally (@pxref{Article Caching}). ! @item ! The uudecode functions have been expanded and generalized ! (@pxref{Decoding Articles}). ! @item ! You can still post uuencoded articles, which was a little-known feature ! of @sc{gnus}' past (@pxref{Uuencoding and Posting}). ! @item ! Fetching parents (and other articles) now actually works without ! glitches (@pxref{Finding the Parent}). ! @item ! Gnus can fetch FAQs and group descriptions (@pxref{Group Information}). ! @item ! Digests (and other files) can be used as the basis for groups ! (@pxref{Document Groups}). ! @item ! Articles can be highlighted and customized (@pxref{Customizing ! Articles}). ! @item ! URLs and other external references can be buttonized (@pxref{Article ! Buttons}). ! @item ! You can do lots of strange stuff with the Gnus window & frame ! configuration (@pxref{Windows Configuration}). ! @item ! You can click on buttons instead of using the keyboard ! (@pxref{Buttons}). ! @item ! Gnus can use NoCeM files to weed out spam (@pxref{NoCeM}). ! @end itemize ! This is, of course, just a @emph{short} overview of the @emph{most} ! important new features. No, really. There are tons more. Yes, we have ! feeping creaturism in full effect, but nothing too gratuitous, I would ! hope. ! @node Newest Features ! @subsection Newest Features ! @cindex todo ! Also known as the @dfn{todo list}. Sure to be implemented before the ! next millennium. ! Be afraid. Be very afraid. ! @itemize @bullet ! @item ! Native @sc{mime} support is something that should be done. ! @item ! A better and simpler method for specifying mail composing methods. ! @item ! Allow posting through mail-to-news gateways. ! @item ! Really do unbinhexing. ! @end itemize ! And much, much, much more. There is more to come than has already been ! implemented. (But that's always true, isn't it?) ! @code{} is where the actual ! up-to-the-second todo list is located, so if you're really curious, you ! could point your Web browser over that-a-way. ! @node Terminology ! @section Terminology ! @cindex terminology ! @table @dfn ! @item news ! @cindex news ! This is what you are supposed to use this thing for---reading news. ! News is generally fetched from a nearby @sc{nntp} server, and is ! generally publicly available to everybody. If you post news, the entire ! world is likely to read just what you have written, and they'll all ! snigger mischievously. Behind your back. ! @item mail ! @cindex mail ! Everything that's delivered to you personally is mail. Some news/mail ! readers (like Gnus) blur the distinction between mail and news, but ! there is a difference. Mail is private. News is public. Mailing is ! not posting, and replying is not following up. ! @item reply ! @cindex reply ! Send a mail to the person who has written what you are reading. ! @item follow up ! @cindex follow up ! Post an article to the current newsgroup responding to the article you ! are reading. ! @item backend ! @cindex backend ! Gnus gets fed articles from a number of backends, both news and mail ! backends. Gnus does not handle the underlying media, so to speak---this ! is all done by the backends. ! @item native ! @cindex native ! Gnus will always use one method (and backend) as the @dfn{native}, or ! default, way of getting news. ! @item foreign ! @cindex foreign ! You can also have any number of foreign groups active at the same time. ! These are groups that use different backends for getting news. ! ! @item secondary ! @cindex secondary ! Secondary backends are somewhere half-way between being native and being ! foreign, but they mostly act like they are native. ! ! @item article ! @cindex article ! A nessage that has been posted as news. ! ! @item mail message ! @cindex mail message ! A message that has been mailed. ! ! @item message ! @cindex message ! A mail message or news article ! @item head ! @cindex head ! The top part of a message, where administrative information (etc.) is ! put. ! @item body ! @cindex body ! The rest of an article. Everything that is not in the head is in the ! body. + @item header + @cindex header + A line from the head of an article. ! @item headers ! @cindex headers ! A collection of such lines, or a collection of heads. Or even a ! collection of @sc{nov} lines. ! @item @sc{nov} ! @cindex nov ! When Gnus enters a group, it asks the backend for the headers of all ! unread articles in the group. Most servers support the News OverView ! format, which is more compact and much faster to read and parse than the ! normal @sc{head} format. ! @item level ! @cindex levels ! Each group is subscribed at some @dfn{level} or other (1-9). The ones ! that have a lower level are ``more'' subscribed than the groups with a ! higher level. In fact, groups on levels 1-5 are considered ! @dfn{subscribed}; 6-7 are @dfn{unsubscribed}; 8 are @dfn{zombies}; and 9 ! are @dfn{killed}. Commands for listing groups and scanning for new ! articles will all use the numeric prefix as @dfn{working level}. ! @item killed groups ! @cindex killed groups ! No information on killed groups is stored or updated, which makes killed ! groups much easier to handle than subscribed groups. ! @item zombie groups ! @cindex zombie groups ! Just like killed groups, only slightly less dead. ! @item active file ! @cindex active file ! The news server has to keep track of what articles it carries, and what ! groups exist. All this information in stored in the active file, which ! is rather large, as you might surmise. ! @item bogus groups ! @cindex bogus groups ! A group that exists in the @file{.newsrc} file, but isn't known to the ! server (i. e., it isn't in the active file), is a @emph{bogus group}. ! This means that the group probably doesn't exist (any more). ! @item server ! @cindex server ! A machine than one can connect to and get news (or mail) from. ! ! @item select method ! @cindex select method ! A structure that specifies the backend, the server and the virtual ! server parameters. ! ! @item virtual server ! @cindex virtual server ! A named select method. Since a select methods defines all there is to ! know about connecting to a (physical) server, taking the who things as a ! whole is a virtual server. @end table + @node Customization ! @section Customization @cindex general customization *************** for some quite common situations. *** 6867,6872 **** @end menu @node Slow/Expensive Connection ! @section Slow/Expensive @sc{nntp} Connection If you run Emacs on a machine locally, and get your news from a machine --- 11512,11518 ---- @end menu + @node Slow/Expensive Connection ! @subsection Slow/Expensive @sc{nntp} Connection If you run Emacs on a machine locally, and get your news from a machine *************** Gnus has to get from the @sc{nntp} serve *** 6875,6878 **** --- 11521,11525 ---- @table @code + @item gnus-read-active-file Set this to @code{nil}, which will inhibit Gnus from requesting the *************** also have to set @code{gnus-check-new-ne *** 6881,6884 **** --- 11528,11532 ---- @code{gnus-check-bogus-newsgroups} to @code{nil} to make sure that Gnus doesn't suddenly decide to fetch the active file anyway. + @item gnus-nov-is-evil This one has to be @code{nil}. If not, grabbing article headers from *************** support @sc{xover}; Gnus will detect thi *** 6887,6892 **** @end table @node Slow Terminal Connection ! @section Slow Terminal Connection Let's say you use your home computer for dialing up the system that --- 11535,11541 ---- @end table + @node Slow Terminal Connection ! @subsection Slow Terminal Connection Let's say you use your home computer for dialing up the system that *************** amount of data that is sent over the wir *** 6895,6906 **** @table @code @item gnus-auto-center-summary ! Set this to @code{nil} to inhibit Gnus from recentering the summary ! buffer all the time. @item gnus-visible-headers Cut down on the headers that are included in the articles to the ! minimum. You can, in fact, make do without them altogether - most of the useful data is in the summary buffer, anyway. Set this variable to ! @samp{"^NEVVVVER"} or @samp{"From:"}, or whatever you feel you need. @item gnus-article-display-hook Set this hook to all the available hiding commands: --- 11544,11560 ---- @table @code + @item gnus-auto-center-summary ! Set this to @code{nil} to inhibit Gnus from re-centering the summary ! buffer all the time. If it is @code{vertical}, do only vertical ! re-centering. If it is neither @code{nil} nor @code{vertical}, do both ! horizontal and vertical recentering. ! @item gnus-visible-headers Cut down on the headers that are included in the articles to the ! minimum. You can, in fact, make do without them altogether---most of the useful data is in the summary buffer, anyway. Set this variable to ! @samp{^NEVVVVER} or @samp{From:}, or whatever you feel you need. ! @item gnus-article-display-hook Set this hook to all the available hiding commands: *************** Set this hook to all the available hidin *** 6910,6913 **** --- 11564,11568 ---- gnus-article-hide-citation)) @end lisp + @item gnus-use-full-window By setting this to @code{nil}, you can make all the windows smaller. *************** While this doesn't really cut down much *** 6915,6921 **** --- 11570,11578 ---- have to see smaller portions of articles before deciding that you didn't want to read them anyway. + @item gnus-thread-hide-subtree If this is non-@code{nil}, all threads in the summary buffer will be hidden initially. + @item gnus-updated-mode-lines If this is @code{nil}, Gnus will not put information in the buffer mode *************** lines, which might save some time. *** 6923,6928 **** @end table @node Little Disk Space ! @section Little Disk Space The startup files can get rather large, so you may want to cut their --- 11580,11587 ---- @end table + @node Little Disk Space ! @subsection Little Disk Space ! @cindex disk space The startup files can get rather large, so you may want to cut their *************** sizes a bit if you are running out of sp *** 6930,6946 **** @table @code @item gnus-save-newsrc-file ! If this is @code{nil}, Gnus will never save @file{.newsrc} - it will only save @file{.newsrc.eld}. This means that you will not be able to ! use any other newsreaders than Gnus. @item gnus-save-killed-list If this is @code{nil}, Gnus will not save the list of dead groups. You should also set @code{gnus-check-new-newsgroups} to @code{ask-server} and @code{gnus-check-bogus-newsgroups} to @code{nil} if you set this ! variable to @code{nil}. @end table @node Slow Machine ! @section Slow Machine If you have a slow machine, or are just really impatient, there are a --- 11589,11611 ---- @table @code + @item gnus-save-newsrc-file ! If this is @code{nil}, Gnus will never save @file{.newsrc}---it will only save @file{.newsrc.eld}. This means that you will not be able to ! use any other newsreaders than Gnus. This variable is @code{t} by ! default. ! @item gnus-save-killed-list If this is @code{nil}, Gnus will not save the list of dead groups. You should also set @code{gnus-check-new-newsgroups} to @code{ask-server} and @code{gnus-check-bogus-newsgroups} to @code{nil} if you set this ! variable to @code{nil}. This variable is @code{t} by default. ! @end table + @node Slow Machine ! @subsection Slow Machine ! @cindex slow machine If you have a slow machine, or are just really impatient, there are a *************** Set @code{gnus-article-display-hook} to *** 6957,6965 **** processing a bit faster. @node Troubleshooting ! @chapter Troubleshooting @cindex troubleshooting ! Gnus works @emph{so} well straight out of the box - I can't imagine any problems, really. --- 11622,11631 ---- processing a bit faster. + @node Troubleshooting ! @section Troubleshooting @cindex troubleshooting ! Gnus works @emph{so} well straight out of the box---I can't imagine any problems, really. *************** Ahem. *** 6967,6976 **** --- 11633,11645 ---- @enumerate + @item Make sure your computer is switched on. + @item Make sure that you really load the current Gnus version. If you have been running @sc{gnus}, you need to exit Emacs and start it up again before Gnus will work. + @item Try doing an @kbd{M-x gnus-version}. If you get something that looks *************** like @samp{Gnus v5.46; nntp 4.0} you hav *** 6978,6987 **** on the other hand, you get something like @samp{NNTP 3.x} or @samp{nntp flee}, you have some old @file{.el} files lying around. Delete these. @item ! Read the help group (@kbd{M h} in the group buffer) for a FAQ and a how-to. @end enumerate ! If all else fails, report the problem as a bug, @cindex bugs --- 11647,11657 ---- on the other hand, you get something like @samp{NNTP 3.x} or @samp{nntp flee}, you have some old @file{.el} files lying around. Delete these. + @item ! Read the help group (@kbd{G h} in the group buffer) for a FAQ and a how-to. @end enumerate ! If all else fails, report the problem as a bug. @cindex bugs *************** If all else fails, report the problem as *** 6992,7035 **** If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug} command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send ! me the backtrace. I will fix bugs, but I can only fix them if you send me a precise description as to how to reproduce the bug. ! @c If you just need help, you are better off asking on ! @c @samp{gnu.emacs.gnus}. ! ! @node The End ! @chapter The End ! ! Well, that's the manual - you can get on with your life now. Keep in ! touch. Say hello to your cats from me. ! ! My @strong{ghod} - I just can't stand goodbyes. Sniffle. - Ol' Chuck Reznikoff said it pretty well, so I leave the floor to him: - - @quotation - @strong{Te Deum} - @sp 1 - Not because of victories @* - I sing,@* - having none,@* - but for the common sunshine,@* - the breeze,@* - the largess of the spring. - @sp 1 - Not for victory@* - but for the day's work done@* - as well as I was able;@* - not for a seat upon the dais@* - but at the common table.@* - @end quotation ! @node Appendix ! @chapter A Programmer's Guide to Gnus It is my hope that other people will figure out smart stuff that Gnus can do, and that other people will write those smart things as well. To facilitate that I thought it would be a good idea to describe the inner ! workings of Gnus. And some of the not-so-inner workings, while I'm at it. --- 11662,11702 ---- If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug} command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send ! me the backtrace. I will fix bugs, but I can only fix them if you send me a precise description as to how to reproduce the bug. ! You really can never be too detailed in a bug report. Always use the ! @kbd{M-x gnus-bug} command when you make bug reports, even if it creates ! a 10Kb mail each time you use it, and even if you have sent me your ! environment 500 times before. I don't care. I want the full info each ! time. ! ! It is also important to remember that I have no memory whatsoever. If ! you send a bug report, and I send you a reply, and then you send back ! just ``No, it's not! Moron!'', I will have no idea what you are ! insulting me about. Always over-explain everything. It's much easier ! for all of us---if I don't have all the information I need, I will just ! mail you and ask for more info, and everything takes more time. ! ! If the problem you're seeing is very visual, and you can't quite explain ! it, copy the Emacs window to a file (with @code{xwd}, for instance), put ! it somewhere it can be reached, and include the URL of the picture in ! the bug report.a ! ! If you just need help, you are better off asking on ! @samp{gnu.emacs.gnus}. I'm not very helpful. ! ! @cindex gnu.emacs.gnus ! @cindex ding mailing list ! You can also ask on the ding mailing list---@samp{ding@@ifi.uio.no}. ! Write to @samp{ding-request@@ifi.uio.no} to subscribe. ! @node A Programmers Guide to Gnus ! @section A Programmer's Guide to Gnus It is my hope that other people will figure out smart stuff that Gnus can do, and that other people will write those smart things as well. To facilitate that I thought it would be a good idea to describe the inner ! workings of Gnus. And some of the not-so-inner workings, while I'm at it. *************** and general method of operations. *** 7046,7065 **** * Ranges:: A handy format for storing mucho numbers. * Group Info:: The group info format. @end menu @node Backend Interface ! @section Backend Interface ! Gnus doesn't know anything about nntp, spools, mail or virtual groups. ! It only knows how to talk to @dfn{virtual servers}. A virtual server is ! a @dfn{backend} and some @dfn{backend variables}. As examples of the ! first, we have @code{nntp}, @code{nnspool} and @code{nnmbox}. As examples of the latter we have @code{nntp-port-number} and ! @code{nnmbox-directory}. ! When Gnus asks for information from a backend -- say @code{nntp} -- on something, it will normally include a virtual server name in the ! function parameters. (If not, the backend should use the "current" virtual server.) For instance, @code{nntp-request-list} takes a virtual server as its only (optional) parameter. If this virtual server hasn't --- 11713,11734 ---- * Ranges:: A handy format for storing mucho numbers. * Group Info:: The group info format. + * Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen. + * Various File Formats:: Formats of files that Gnus use. @end menu @node Backend Interface ! @subsection Backend Interface ! Gnus doesn't know anything about @sc{nntp}, spools, mail or virtual ! groups. It only knows how to talk to @dfn{virtual servers}. A virtual ! server is a @dfn{backend} and some @dfn{backend variables}. As examples ! of the first, we have @code{nntp}, @code{nnspool} and @code{nnmbox}. As examples of the latter we have @code{nntp-port-number} and ! @code{nnmbox-directory}. ! When Gnus asks for information from a backend---say @code{nntp}---on something, it will normally include a virtual server name in the ! function parameters. (If not, the backend should use the ``current'' virtual server.) For instance, @code{nntp-request-list} takes a virtual server as its only (optional) parameter. If this virtual server hasn't *************** name. Take this example: *** 7075,7080 **** @end lisp ! Here the virtual server name is @samp{"odd-one"} while the name of ! the physical server is @samp{"ifi.uio.no"}. The backends should be able to switch between several virtual servers. --- 11744,11749 ---- @end lisp ! Here the virtual server name is @samp{odd-one} while the name of ! the physical server is @samp{ifi.uio.no}. The backends should be able to switch between several virtual servers. *************** always check whether are present before *** 7087,7119 **** All these functions are expected to return data in the buffer ! @code{nntp-server-buffer} (@samp{" *nntpd*"}), which is somewhat unfortunately named, but we'll have to live with it. When I talk about ! "resulting data", I always refer to the data in that buffer. When I ! talk about "return value", I talk about the function value returned by the function call. Some backends could be said to be @dfn{server-forming} backends, and some might be said to not be. The latter are backends that generally ! only operate on one group at a time, and have no concept of "server" -- ! they have a group, and they deliver info on that group and nothing more. In the examples and definitions I will refer to the imaginary backend @code{nnchoke}. @menu * Required Backend Functions:: Functions that must be implemented. * Optional Backend Functions:: Functions that need not be implemented. @end menu @node Required Backend Functions ! @subsection Required Backend Functions @table @code ! @item (nnchoke-retrieve-headers ARTICLES &optional GROUP SERVER) @var{articles} is either a range of article numbers or a list of ! @code{Message-ID}s. Current backends do not fully support either - only sequences (lists) of article numbers, and most backends do not support retrieval of @code{Message-ID}s. But they should try for both. --- 11756,11792 ---- All these functions are expected to return data in the buffer ! @code{nntp-server-buffer} (@samp{ *nntpd*}), which is somewhat unfortunately named, but we'll have to live with it. When I talk about ! ``resulting data'', I always refer to the data in that buffer. When I ! talk about ``return value'', I talk about the function value returned by the function call. Some backends could be said to be @dfn{server-forming} backends, and some might be said to not be. The latter are backends that generally ! only operate on one group at a time, and have no concept of ``server'' ! -- they have a group, and they deliver info on that group and nothing ! more. In the examples and definitions I will refer to the imaginary backend @code{nnchoke}. + @cindex @code{nnchoke} + @menu * Required Backend Functions:: Functions that must be implemented. * Optional Backend Functions:: Functions that need not be implemented. + * Writing New Backends:: Extending old backends. @end menu @node Required Backend Functions ! @subsubsection Required Backend Functions @table @code ! @item (nnchoke-retrieve-headers ARTICLES &optional GROUP SERVER FETCH-OLD) @var{articles} is either a range of article numbers or a list of ! @code{Message-ID}s. Current backends do not fully support either---only sequences (lists) of article numbers, and most backends do not support retrieval of @code{Message-ID}s. But they should try for both. *************** This might later be expanded to @code{va *** 7124,7127 **** --- 11797,11808 ---- of HEADs and NOV lines, but this is currently not supported by Gnus. + If @var{fetch-old} is non-@code{nil} it says to try to fetch "extra + headers, in some meaning of the word. This is generally done by + fetching (at most) @var{fetch-old} extra headers less than the smallest + article number in @code{articles}, and fill in the gaps as well. The + presence of this parameter can be ignored if the backend finds it + cumbersome to follow the request. If this is non-@code{nil} and not a + number, do maximum fetches. + Here's an example HEAD: *************** field = *** 7166,7170 **** For a closer explanation what should be in those fields, ! @xref{Headers}. --- 11847,11851 ---- For a closer explanation what should be in those fields, ! @pxref{Headers}. *************** non-@code{nil} value. There should be n *** 7185,7189 **** Close connection to @var{server} and free all resources connected ! to it. There should be no data returned. --- 11866,11871 ---- Close connection to @var{server} and free all resources connected ! to it. Return @code{nil} if the server couldn't be closed for some ! reason. There should be no data returned. *************** There should be no data returned. *** 7194,7198 **** Close connection to all servers and free all resources that the backend have reserved. All buffers that have been created by that backend ! should be killed. (Not the @code{nntp-server-buffer}, though.) There should be no data returned. --- 11876,11881 ---- Close connection to all servers and free all resources that the backend have reserved. All buffers that have been created by that backend ! should be killed. (Not the @code{nntp-server-buffer}, though.) This ! function is generally only called when Gnus is shutting down. There should be no data returned. *************** There should be no data returned. *** 7201,7208 **** @item (nnchoke-server-opened &optional SERVER) ! This function should return whether @var{server} is opened, and that the ! connection to it is still alive. This function should under no ! circumstances attempt to reconnect to a server that is has lost ! connection to. There should be no data returned. --- 11884,11891 ---- @item (nnchoke-server-opened &optional SERVER) ! If @var{server} is the current virtual server, and the connection to the ! physical server is alive, then this function should return a ! non-@code{nil} vlue. This function should under no circumstances ! attempt to reconnect to a server that is has lost connection to. There should be no data returned. *************** another, and Gnus mainly request article *** 7229,7232 **** --- 11912,11922 ---- its article buffer. + If it is at all possible, this function should return a cons cell where + the car is the group name the article was fetched from, and the cdr is + the article number. This will enable Gnus to find out what the real + group and article numbers are when fetching articles by + @code{Message-ID}. If this isn't possible, @code{t} should be returned + on successful article retrievement. + @item (nnchoke-open-group GROUP &optional SERVER) *************** Here's an example of some result data an *** 7248,7257 **** @end example ! The first number is the status, which should be @samp{211}. Next is the total number of articles in the group, the lowest article number, the highest article number, and finally the group name. Note that the total number of articles may be less than one might think while just considering the highest and lowest article numbers, but some articles ! may have been cancelled. Gnus just discards the total-number, so whether one should take the bother to generate it properly (if that is a problem) is left as an exercise to the reader. --- 11938,11947 ---- @end example ! The first number is the status, which should be @code{211}. Next is the total number of articles in the group, the lowest article number, the highest article number, and finally the group name. Note that the total number of articles may be less than one might think while just considering the highest and lowest article numbers, but some articles ! may have been canceled. Gnus just discards the total-number, so whether one should take the bother to generate it properly (if that is a problem) is left as an exercise to the reader. *************** clear if the posting could not be comple *** 7310,7332 **** There should be no result data from this function. - - @item (nnchoke-request-post-buffer POST GROUP SUBJECT HEADER ARTICLE-BUFFER INFO FOLLOW-TO RESPECT-POSTER) - - This function should return a buffer suitable for composing an article - to be posted by @code{nnchoke-request-post}. If @var{post} is - non-@code{nil}, this is not a followup, but a totally new article. - @var{group} is the name of the group to be posted to. @var{subject} is - the subject of the message. @var{article-buffer} is the buffer being - followed up, if that is the case. @var{info} is the group info. - @var{follow-to} is the group that one is supposed to re-direct the - article to. If @var{respect-poster} is non-@code{nil}, the special - @samp{"poster"} value of a @code{Followup-To} header is to be respected. - - There should be no result data returned. - @end table @node Optional Backend Functions ! @subsection Optional Backend Functions @table @code --- 12000,12008 ---- There should be no result data from this function. @end table + @node Optional Backend Functions ! @subsubsection Optional Backend Functions @table @code *************** information (as is the case with virtual *** 7356,7360 **** may alter the info in any manner it sees fit, and should return the (altered) group info. This function may alter the group info ! destructively, so no copying is needed before boogying. There should be no result data from this function. --- 12032,12065 ---- may alter the info in any manner it sees fit, and should return the (altered) group info. This function may alter the group info ! destructively, so no copying is needed before boogeying. ! ! There should be no result data from this function. ! ! ! @item (nnchoke-request-type GROUP &optional ARTICLE) ! ! When the user issues commands for ``sending news'' (@kbd{F} in the ! summary buffer, for instance), Gnus has to know whether the article the ! user is following up is news or mail. This function should return ! @code{news} if @var{article} in @var{group} is news, @code{mail} if it ! is mail and @code{unknown} if the type can't be decided. (The ! @var{article} parameter is necessary in @code{nnvirtual} groups which ! might very well combine mail groups and news groups.) ! ! There should be no result data from this function. ! ! ! @item (nnchoke-request-update-mark GROUP ARTICLE MARK) ! ! If the user tries to set a mark that the backend doesn't like, this ! function may change the mark. Gnus will use whatever this function ! returns as the mark for @var{article} instead of the original ! @var{mark}. If the backend doesn't care, it must return the original ! @var{mark}, and not @code{nil} or any other type of garbage. ! ! The only use for this that I can see is what @code{nnvirtual} does with ! it---if a component group is auto-expirable, marking an article as read ! in the virtual group should result in the article being marked as ! expirable. There should be no result data from this function. *************** request that the backend check for incom *** 7367,7371 **** another. A mail backend will typically read the spool file or query the POP server when this function is invoked. The @var{group} doesn't have ! to be heeded -- if the backend decides that it is too much work just scanning for a single group, it may do a total scan of all groups. It would be nice, however, to keep things local if that's practical. --- 12072,12076 ---- another. A mail backend will typically read the spool file or query the POP server when this function is invoked. The @var{group} doesn't have ! to be heeded---if the backend decides that it is too much work just scanning for a single group, it may do a total scan of all groups. It would be nice, however, to keep things local if that's practical. *************** format. The data should be in the activ *** 7415,7419 **** ! @item (nnchoke-request-create-groups GROUP &optional SERVER) This function should create an empty group with name @var{group}. --- 12120,12124 ---- ! @item (nnchoke-request-create-group GROUP &optional SERVER) This function should create an empty group with name @var{group}. *************** This function should move @var{article} *** 7445,7452 **** This function should ready the article in question for moving by removing any header lines it has added to the article, and generally ! should "tidy up" the article. Then it should @code{eval} ! @var{accept-form} in the buffer where the "tidy" article is. This will ! do the actual copying. If this @code{eval} returns a non-@code{nil} ! value, the article should be removed. If @var{last} is @code{nil}, that means that there is a high likelihood --- 12150,12157 ---- This function should ready the article in question for moving by removing any header lines it has added to the article, and generally ! should ``tidy up'' the article. Then it should @code{eval} ! @var{accept-form} in the buffer where the ``tidy'' article is. This ! will do the actual copying. If this @code{eval} returns a ! non-@code{nil} value, the article should be removed. If @var{last} is @code{nil}, that means that there is a high likelihood *************** that there will be more requests issued *** 7454,7461 **** optimizations. There should be no data returned. ! @item (nnchoke-request-accept-article GROUP &optional LAST) This function takes the current buffer and inserts it into @var{group}. --- 12159,12169 ---- optimizations. + The function should return a cons where the car is the group name and + the cdr is the article number that the article was entered as. + There should be no data returned. ! @item (nnchoke-request-accept-article GROUP &optional SERVER LAST) This function takes the current buffer and inserts it into @var{group}. *************** If @var{last} in @code{nil}, that means *** 7463,7466 **** --- 12171,12177 ---- this function in short order. + The function should return a cons where the car is the group name and + the cdr is the article number that the article was entered as. + There should be no data returned. *************** This function should remove @var{article *** 7473,7484 **** There should be no data returned. @end table @node Score File Syntax ! @section Score File Syntax Score files are meant to be easily parsable, but yet extremely ! malleable. It was decided that something that had the same read syntax as an Emacs Lisp list would fit that spec. --- 12184,12382 ---- There should be no data returned. + + @item (nnchoke-request-delete-group GROUP FORCE &optional SERVER) + + This function should delete @var{group}. If @var{force}, it should + really delete all the articles in the group, and then delete the group + itself. (If there is such a thing as ``the group itself''.) + + There should be no data returned. + + + @item (nnchoke-request-rename-group GROUP NEW-NAME &optional SERVER) + + This function should rename @var{group} into @var{new-name}. All + articles that are in @var{group} should move to @var{new-name}. + + There should be no data returned. + + @end table + + + @node Writing New Backends + @subsubsection Writing New Backends + + The various backends share many similarities. @code{nnml} is just like + @code{nnspool}, but it allows you to edit the articles on the server. + @code{nnmh} is just like @code{nnml}, but it doesn't use an active file, + and it doesn't maintain overview databases. @code{nndir} is just like + @code{nnml}, but it has no concept of ``groups'', and it doesn't allow + editing articles. + + It would make sense if it were possible to ``inherit'' functions from + backends when writing new backends. And, indeed, you can do that if you + want to. (You don't have to if you don't want to, of course.) + + All the backends declare their public variables and functions by using a + package called @code{nnoo}. + + To inherit functions from other backends (and allow other backends to + inherit functions from the current backend), you should use the + following macros: + following. + + @table @code + + @item nnoo-declare + This macro declares the first parameter to be a child of the subsequent + parameters. For instance: + + @lisp + (nnoo-declare nndir + nnml nnmh) + @end lisp + + @code{nndir} has here declared that it intends to inherit functions from + both @code{nnml} and @code{nnmh}. + + @item defvoo + This macro is equivalent to @code{defvar}, but registers the variable as + a public server variable. Most state-oriented variables should be + declared with @code{defvoo} instead of @code{defvar}. + + In addition to the normal @code{defvar} parameters, it takes a list of + variables in the parent backends to map the variable to when executing + a function in those backends. + + @lisp + (defvoo nndir-directory nil + "Where nndir will look for groups." + nnml-current-directory nnmh-current-directory) + @end lisp + + This means that @code{nnml-current-directory} will be set to + @code{nndir-directory} when an @code{nnml} function is called on behalf + of @code{nndir}. (The same with @code{nnmh}.) + + @item nnoo-define-basics + This macro defines some common functions that almost all backends should + have. + + @example + (nnoo-define-basics nndir) + @end example + + @item deffoo + This macro is just like @code{defun} and takes the same parameters. In + addition to doing the normal @code{defun} things, it registers the + function as being public so that other backends can inherit it. + + @item nnoo-map-functions + This macro allows mapping of functions from the current backend to + functions from the parent backends. + + @example + (nnoo-map-functions nndir + (nnml-retrieve-headers 0 nndir-current-group 0 0) + (nnmh-request-article 0 nndir-current-group 0 0)) + @end example + + This means that when @code{nndir-retrieve-headers} is called, the first, + third, and fourth parameters will be passed on to + @code{nnml-retrieve-headers}, while the second parameter is set to the + value of @code{nndir-current-group}. + + @item nnoo-import + This macro allows importing functions from backends. It should be the + last thing in the source file, since it will only define functions that + haven't already been defined. + + @example + (nnoo-import nndir + (nnmh + nnmh-request-list + nnmh-request-newgroups) + (nnml)) + @end example + + This means that calls to @code{nndir-request-list} should just be passed + on to @code{nnmh-request-list}, while all public functions from + @code{nnml} that haven't been defined in @code{nndir} yet should be + defined now. + @end table + Below is a slightly shortened version of the @code{nndir} backend. + + @lisp + ;;; nndir.el --- single directory newsgroup access for Gnus + ;; Copyright (C) 1995,96 Free Software Foundation, Inc. + + ;;; Code: + + (require 'nnheader) + (require 'nnmh) + (require 'nnml) + (require 'nnoo) + (eval-when-compile (require 'cl)) + + (nnoo-declare nndir + nnml nnmh) + + (defvoo nndir-directory nil + "Where nndir will look for groups." + nnml-current-directory nnmh-current-directory) + + (defvoo nndir-nov-is-evil nil + "*Non-nil means that nndir will never retrieve NOV headers." + nnml-nov-is-evil) + + (defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) + (defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) + (defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) + + (defvoo nndir-status-string "" nil nnmh-status-string) + (defconst nndir-version "nndir 1.0") + + ;;; Interface functions. + + (nnoo-define-basics nndir) + + (deffoo nndir-open-server (server &optional defs) + (setq nndir-directory + (or (cadr (assq 'nndir-directory defs)) + server)) + (unless (assq 'nndir-directory defs) + (push `(nndir-directory ,server) defs)) + (push `(nndir-current-group + ,(file-name-nondirectory (directory-file-name nndir-directory))) + defs) + (push `(nndir-top-directory + ,(file-name-directory (directory-file-name nndir-directory))) + defs) + (nnoo-change-server 'nndir server defs)) + + (nnoo-map-functions nndir + (nnml-retrieve-headers 0 nndir-current-group 0 0) + (nnmh-request-article 0 nndir-current-group 0 0) + (nnmh-request-group nndir-current-group 0 0) + (nnmh-close-group nndir-current-group 0)) + + (nnoo-import nndir + (nnmh + nnmh-status-message + nnmh-request-list + nnmh-request-newgroups)) + + (provide 'nndir) + @end lisp + + @node Score File Syntax ! @subsection Score File Syntax Score files are meant to be easily parsable, but yet extremely ! mallable. It was decided that something that had the same read syntax as an Emacs Lisp list would fit that spec. *************** required-atom = mark / expunge / mark *** 7527,7531 **** optional-atom = adapt / local / eval mark = "mark" space nil-or-number ! nil-or-t = "nil" / expunge = "expunge" space nil-or-number mark-and-expunge = "mark-and-expunge" space nil-or-number --- 12425,12429 ---- optional-atom = adapt / local / eval mark = "mark" space nil-or-number ! nil-or-number = "nil" / expunge = "expunge" space nil-or-number mark-and-expunge = "mark-and-expunge" space nil-or-number *************** discarded. *** 7545,7549 **** As you can see, white space is needed, but the type and amount of white space is irrelevant. This means that formatting of the score file is ! left up to the programmer -- if it's simpler to just spew it all out on one looong line, then that's ok. --- 12443,12447 ---- As you can see, white space is needed, but the type and amount of white space is irrelevant. This means that formatting of the score file is ! left up to the programmer---if it's simpler to just spew it all out on one looong line, then that's ok. *************** The meaning of the various atoms are exp *** 7551,7556 **** manual. @node Headers ! @section Headers Gnus uses internally a format for storing article headers that --- 12449,12455 ---- manual. + @node Headers ! @subsection Headers Gnus uses internally a format for storing article headers that *************** almost suspect that the author looked at *** 7559,7574 **** just shamelessly @emph{stole} the entire thing, and one would be right. ! @dfn{Header} is a severly overloaded term. "Header" is used in RFC1036 ! to talk about lines in the head of an article (eg., @code{From}). It is ! used by many people as a synonym for "head" -- "the header and the ! body". (That should be avoided, in my opinion.) And Gnus uses a format ! internally that it calls "header", which is what I'm talking about ! here. This is a 9-element vector, basically, with each header (ouch) ! having one slot. These slots are, in order: @code{number}, @code{subject}, @code{from}, @code{date}, @code{id}, @code{references}, @code{chars}, @code{lines}, @code{xref}. There are macros for accessing and setting these slots -- ! they all have predicatable names beginning with @code{mail-header-} and @code{mail-header-set-}, respectively. --- 12458,12473 ---- just shamelessly @emph{stole} the entire thing, and one would be right. ! @dfn{Header} is a severely overloaded term. ``Header'' is used in ! RFC1036 to talk about lines in the head of an article (eg., ! @code{From}). It is used by many people as a synonym for ! ``head''---``the header and the body''. (That should be avoided, in my ! opinion.) And Gnus uses a format internally that it calls ``header'', ! which is what I'm talking about here. This is a 9-element vector, ! basically, with each header (ouch) having one slot. These slots are, in order: @code{number}, @code{subject}, @code{from}, @code{date}, @code{id}, @code{references}, @code{chars}, @code{lines}, @code{xref}. There are macros for accessing and setting these slots -- ! they all have predictable names beginning with @code{mail-header-} and @code{mail-header-set-}, respectively. *************** The @code{xref} slot is really a @code{m *** 7576,7581 **** be put in there. @node Ranges ! @section Ranges @sc{gnus} introduced a concept that I found so useful that I've started --- 12475,12481 ---- be put in there. + @node Ranges ! @subsection Ranges @sc{gnus} introduced a concept that I found so useful that I've started *************** using it a lot and have elaborated on it *** 7584,7588 **** The question is simple: If you have a large amount of objects that are identified by numbers (say, articles, to take a @emph{wild} example) ! that you want to callify as being "included", a normal sequence isn't very useful. (A 200,000 length sequence is a bit long-winded.) --- 12484,12488 ---- The question is simple: If you have a large amount of objects that are identified by numbers (say, articles, to take a @emph{wild} example) ! that you want to callify as being ``included'', a normal sequence isn't very useful. (A 200,000 length sequence is a bit long-winded.) *************** is slightly tricky: *** 7611,7615 **** @example ! ((1 . 6) 7 8 (10 . 12)) @end example --- 12511,12515 ---- @example ! ((1 . 5) 7 8 (10 . 12)) @end example *************** are equal. In fact, any non-descending *** 7626,7630 **** @end example ! is a perfectly valid range, although a pretty longwinded one. This is also legal: --- 12526,12530 ---- @end example ! is a perfectly valid range, although a pretty long-winded one. This is also legal: *************** sequences.) *** 7657,7661 **** @node Group Info ! @section Group Info Gnus stores all permanent info on groups in a @dfn{group info} list. --- 12557,12561 ---- @node Group Info ! @subsection Group Info Gnus stores all permanent info on groups in a @dfn{group info} list. *************** second is a more complex one: *** 7670,7674 **** ("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) ! ((tick (15 . 19)) (replied 3 6 (19 . 23))) (nnml "") (auto-expire (to-address "ding@@ifi.uio.no"))) --- 12570,12574 ---- ("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) ! ((tick (15 . 19)) (replied 3 6 (19 . 3))) (nnml "") (auto-expire (to-address "ding@@ifi.uio.no"))) *************** in pseudo-BNF. *** 7700,7703 **** --- 12600,12826 ---- + @node Emacs/XEmacs Code + @subsection Emacs/XEmacs Code + @cindex XEmacs + @cindex Emacsen + + While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the + platforms must be the primary one. I chose Emacs. Not because I don't + like XEmacs or Mule, but because it comes first alphabetically. + + This means that Gnus will byte-compile under Emacs with nary a warning, + while XEmacs will pump out gigabytes of warnings while byte-compiling. + As I use byte-compilation warnings to help me root out trivial errors in + Gnus, that's very useful. + + I've also consistently used Emacs function interfaces, but have used + Gnusey aliases for the functions. To take an example: Emacs defines a + @code{run-at-time} function while XEmacs defines a @code{start-itimer} + function. I then define a function called @code{gnus-run-at-time} that + takes the same parameters as the Emacs @code{run-at-time}. When running + Gnus under Emacs, the former function is just an alias for the latter. + However, when running under XEmacs, the former is an alias for the + following function: + + @lisp + (defun gnus-xmas-run-at-time (time repeat function &rest args) + (start-itimer + "gnus-run-at-time" + `(lambda () + (,function ,@@args)) + time repeat)) + @end lisp + + This sort of thing has been done for bunches of functions. Gnus does + not redefine any native Emacs functions while running under XEmacs -- it + does this @code{defalias} thing with Gnus equivalents instead. Cleaner + all over. + + Of course, I could have chosen XEmacs as my native platform and done + mapping functions the other way around. But I didn't. The performance + hit these indirections impose on Gnus under XEmacs should be slight. + + + @node Various File Formats + @subsection Various File Formats + + @menu + * Active File Format:: Information on articles and groups available. + * Newsgroups File Format:: Group descriptions. + @end menu + + + @node Active File Format + @subsubsection Active File Format + + The active file lists all groups that are available on the server in + question. It also lists the highest and lowest current article numbers + in each group. + + Here's an excerpt from a typical active file: + + @example + soc.motss 296030 293865 y + alt.binaries.pictures.fractals 3922 3913 n + comp.sources.unix 1605 1593 m + comp.binaries.ibm.pc 5097 5089 y + no.general 1000 900 y + @end example + + Here's a pseudo-BNF definition of this file: + + @example + active = *group-line + group-line = group space high-number space low-number space flag + group = + space = " " + high-number = + low-number = + flag = "y" / "n" / "m" / "j" / "x" / "=" group + @end example + + + @node Newsgroups File Format + @subsubsection Newsgroups File Format + + The newsgroups file lists groups along with their descriptions. Not all + groups on the server have to be listed, and not all groups in the file + have to exist on the server. The file is meant purely as information to + the user. + + The format is quite simple; a group name, a tab, and the description. + Here's the definition: + + @example + newsgroups = *line + line = group tab description + group = + tab = + description = + @end example + + + @node Emacs for Heathens + @section Emacs for Heathens + + Believe it or not, but some people who use Gnus haven't really used + Emacs much before they embarked on their journey on the Gnus Love Boat. + If you are one of those unfortunates whom ``@kbd{M-C-a}'', ``kill the + region'', and ``set @code{gnus-flargblossen} to an alist where the key + is a regexp that is used for matching on the group name'' are magical + phrases with little or no meaning, then this appendix is for you. If + you are already familiar with Emacs, just ignore this and go fondle your + cat instead. + + @menu + * Keystrokes:: Entering text and executing commands. + * Emacs Lisp:: The built-in Emacs programming language. + @end menu + + + @node Keystrokes + @subsection Keystrokes + + @itemize @bullet + @item + Q: What is an experienced Emacs user? + + @item + A: A person who wishes that the terminal had pedals. + @end itemize + + Yes, when you use Emacs, you are apt to use the control key, the shift + key and the meta key a lot. This is very annoying to some people + (notably @code{vi}le users), and the rest of us just love the hell out + of it. Just give up and submit. Emacs really does stand for + ``Escape-Meta-Alt-Control-Shift'', and not ``Editing Macros'', as you + may have heard from other disreputable sources (like the Emacs author). + + The shift key is normally located near your pinky fingers, and are + normally used to get capital letters and stuff. You probably use it all + the time. The control key is normally marked ``CTRL'' or something like + that. The meta key is, funnily enough, never marked as such on any + keyboards. The one I'm currently at has a key that's marked ``Alt'', + which is the meta key on this keyboard. It's usually located somewhere + to the left hand side of the keyboard, usually on the bottom row. + + Now, us Emacs people doesn't say ``press the meta-control-m key'', + because that's just too inconvenient. We say ``press the @kbd{M-C-m} + key''. @kbd{M-} is the prefix that means ``meta'' and ``C-'' is the + prefix that means ``control''. So ``press @kbd{C-k}'' means ``press + down the control key, and hold it down while you press @kbd{k}''. + ``Press @kbd{M-C-k}'' means ``press down and hold down the meta key and + the control key and then press @kbd{k}''. Simple, ay? + + This is somewhat complicated by the fact that not all keyboards have a + meta key. In that case you can use the ``escape'' key. Then @kbd{M-k} + means ``press escape, release escape, press @kbd{k}''. That's much more + work than if you have a meta key, so if that's the case, I respectfully + suggest you get a real keyboard with a meta key. You can't live without + it. + + + + @node Emacs Lisp + @subsection Emacs Lisp + + Emacs is the King of Editors because it's really a Lisp interpreter. + Each and every key you tap runs some Emacs Lisp code snippet, and since + Emacs Lisp is an interpreted language, that means that you can configure + any key to run any arbitrary code. You just, like, do it. + + Gnus is written in Emacs Lisp, and is run as a bunch of interpreted + functions. (These are byte-compiled for speed, but it's still + interpreted.) If you decide that you don't like the way Gnus does + certain things, it's trivial to have it do something a different way. + (Well, at least if you know how to write Lisp code.) However, that's + beyond the scope of this manual, so we are simply going to talk about + some common constructs that you normally use in your @file{.emacs} file + to customize Gnus. + + If you want to set the variable @code{gnus-florgbnize} to four (4), you + write the following: + + @lisp + (setq gnus-florgbnize 4) + @end lisp + + This function (really ``special form'') @code{setq} is the one that can + set a variable to some value. This is really all you need to know. Now + you can go and fill your @code{.emacs} file with lots of these to change + how Gnus works. + + If you have put that thing in your @code{.emacs} file, it will be read + and @code{eval}ed (which is lisp-ese for ``run'') the next time you + start Emacs. If you want to change the variable right away, simply say + @kbd{C-x C-e} after the closing parenthesis. That will @code{eval} the + previous ``form'', which here is a simple @code{setq} statement. + + Go ahead---just try it, if you're located at your Emacs. After you + @kbd{C-x C-e}, you will see @samp{4} appear in the echo area, which + is the return value of the form you @code{eval}ed. + + Some pitfalls: + + If the manual says ``set @code{gnus-read-active-file} to @code{some}'', + that means: + + @lisp + (setq gnus-read-active-file 'some) + @end lisp + + On the other hand, if the manual says ``set @code{gnus-nntp-server} to + @samp{nntp.ifi.uio.no}'', that means: + + @lisp + (setq gnus-nntp-server "nntp.ifi.uio.no") + @end lisp + + So be careful not to mix up strings (the latter) with symbols (the + former). The manual is unambiguous, but it can be confusing. + + + @include gnus-faq.texi + @node Index @chapter Index *************** in pseudo-BNF. *** 7712,7719 **** @bye - - @c Local Variables: - @c outline-regexp: "@chap\\|@\\(sub\\)*section\\|@appendix \\|@appendix\\(sub\\)*sec\\|\^L" @c End: -  --- 12835,12838 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/message.texi emacs-19.32/man/message.texi *** emacs-19.31/man/message.texi Wed Dec 31 19:00:00 1969 --- emacs-19.32/man/message.texi Wed Jun 26 17:49:43 1996 *************** *** 0 **** --- 1,1007 ---- + \input texinfo @c -*-texinfo-*- + + @setfilename ../info/message + @settitle Message Manual + @synindex fn cp + @synindex vr cp + @synindex pg cp + @iftex + @finalout + @end iftex + @setchapternewpage odd + + @ifinfo + + This file documents Messa, the Emacs message composition mode. + + Copyright (C) 1996 Free Software Foundation, Inc. + + Permission is granted to make and distribute verbatim copies of + this manual provided the copyright notice and this permission notice + are preserved on all copies. + + @ignore + Permission is granted to process this file through Tex and print the + results, provided the printed document carries copying permission + notice identical to this one except for the removal of this paragraph + (this paragraph not being relevant to the printed manual). + + @end ignore + Permission is granted to copy and distribute modified versions of this + manual under the conditions for verbatim copying, provided also that the + entire resulting derived work is distributed under the terms of a + permission notice identical to this one. + + Permission is granted to copy and distribute translations of this manual + into another language, under the above conditions for modified versions. + @end ifinfo + + @tex + + @titlepage + @title Message Manual + + @author by Lars Magne Ingebrigtsen + @page + + @vskip 0pt plus 1filll + Copyright @copyright{} 1996 Free Software Foundation, Inc. + + Permission is granted to make and distribute verbatim copies of + this manual provided the copyright notice and this permission notice + are preserved on all copies. + + Permission is granted to copy and distribute modified versions of this + manual under the conditions for verbatim copying, provided that the + entire resulting derived work is distributed under the terms of a + permission notice identical to this one. + + Permission is granted to copy and distribute translations of this manual + into another language, under the above conditions for modified versions. + + @end titlepage + @page + + @end tex + + @node Top + @top Message + + All message composition (both mail and news) takes place in Message mode + buffers. + + @menu + * Interface:: Setting up message buffers. + * Commands:: Commands you can execute in message mode buffers. + * Variables:: Customizing the message buffers. + * Index:: Variable, function and concept index. + * Key Index:: List of Message mode keys. + @end menu + + + @node Interface + @chapter Interface + + When a program (or a person) wants to respond to a message -- reply, + follow up, forward, cancel -- the program (or person) should just put + point in the buffer where the message is and call the required command. + @code{Message} will then pop up a new @code{message} mode buffer with + appropriate headers filled out, and the user can edit the message before + sending it. + + @menu + * New Mail Message:: Editing a brand new mail message. + * New News Message:: Editing a brand new news message. + * Reply:: Replying via mail. + * Wide Reply:: Responding to all people via mail. + * Followup:: Following up via news. + * Canceling News:: Canceling a news article. + * Superseding:: Superseding a message. + * Forwarding:: Forwarding a message via news or mail. + * Resending:: Resending a mail message. + * Bouncing:: Bouncing a mail message. + @end menu + + + @node New Mail Message + @section New Mail Message + + @findex message-mail + The @code{message-mail} command pops up a new message buffer. + + Two optional parameters are accepted: The first will be used as the + @code{To} header and the second as the @code{Subject} header. If these + aren't present, those two headers will be empty. + + + @node New News Message + @section New News Message + + @findex message-news + The @code{message-news} command pops up a new message buffer. + + This function accepts two optional parameters. The first will be used + as the @code{Newsgroups} header and the second as the @code{Subject} + header. If these aren't present, those two headers will be empty. + + + @node Reply + @section Reply + + @findex message-reply + The @code{message-reply} function pops up a message buffer that's a + reply to the message in the current buffer. + + @vindex message-reply-to-function + Message uses the normal methods to determine where replies are to go, + but you can change the behavior to suit your needs by fiddling with the + @code{message-reply-to-function} variable. + + If you want the replies to go to the @code{Sender} instead of the + @code{From}, you could do something like this: + + @lisp + (setq message-reply-to-function + (lambda () + (cond ((equal (mail-fetch-field "from") "somebody") + (mail-fetch-field "sender")) + (t + nil)))) + @end lisp + + This function will be called narrowed to the head of the article that is + being replied to. + + As you can see, this function should return a string if it has an + opinion as to what the To header should be. If it does not, it should + just return @code{nil}, and the normal methods for determining the To + header will be used. + + This function can also return a list. In that case, each list element + should be a cons, where the car should be the name of an header + (eg. @code{Cc}) and the cdr should be the header value + (eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into + the head of the outgoing mail. + + + @node Wide Reply + @section Wide Reply + + @findex message-wide-reply + The @code{message-wide-reply} pops up a message buffer that's a wide + reply to the message in the current buffer. + + @vindex message-wide-reply-to-function + Message uses the normal methods to determine where wide replies are to go, + but you can change the behavior to suit your needs by fiddling with the + @code{message-wide-reply-to-function}. It is used in the same way as + @code{message-reply-to-function} (@pxref{Reply}). + + @findex rmail-dont-reply-to-names + Addresses that matches the @code{rmail-dont-reply-to-names} regular + expression will be removed from the @code{Cc} header. + + + @node Followup + @section Followup + + @findex message-followup + The @code{message-followup} command pops up a message buffer that's a + followup to the message in the current buffer. + + @vindex message-followup-to-function + Message uses the normal methods to determine where followups are to go, + but you can change the behavior to suit your needs by fiddling with the + @code{message-followup-to-function}. It is used in the same way as + @code{message-reply-to-function} (@pxref{Reply}). + + @vindex message-use-followup-to + The @code{message-use-followup-to} variable says what to do about + @code{Followup-To} headers. If it is @code{use}, always use the value. + If it is @code{ask} (which is the default), ask whether to use the + value. If it is @code{t}, use the value unless it is @samp{poster}. If + it is @code{nil}, don't use the value. + + + @node Canceling News + @section Canceling News + + @findex message-cancel-news + The @code{message-cancel-news} command cancels the article in the + current buffer. + + + @node Superseding + @section Superseding + + @findex message-supersede + The @code{message-supersede} command pops up a message buffer that will + supersede the message in the current buffer. + + @vindex message-ignored-supersedes-headers + Headers matching the @code{message-ignored-supersedes-headers} are + removed before popping up the new message buffer. The default is + @samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:}. + + + + @node Forwarding + @section Forwarding + + @findex message-forward + The @code{message-forward} command pops up a message buffer to forward + the message in the current buffer. If given a prefix, forward using + news. + + @table @code + @item message-forward-start-separator + @vindex message-forward-start-separator + Delimiter inserted before forwarded messages. The default is + @samp{------- Start of forwarded message -------\n}. + + @vindex message-forward-end-separator + @item message-forward-end-separator + @vindex message-forward-end-separator + Delimiter inserted after forwarded messages. The default is + @samp{------- End of forwarded message -------\n}. + + @item message-signature-before-forwarded-message + @vindex message-signature-before-forwarded-message + If this variable is @code{t}, which it is by default, your personal + signature will be inserted before the forwarded message. If not, the + forwarded message will be inserted first in the new mail. + + @item message-included-forward-headers + @vindex message-included-forward-headers + Regexp matching header lines to be included in forwarded messages. + + @end table + + + @node Resending + @section Resending + + @findex message-resend + The @code{message-resend} command will prompt the user for an address + and resend the message in the current buffer to that address. + + @vindex message-ignored-resent-headers + Headers the match the @code{message-ignored-resent-headers} regexp will + be removed before sending the message. The default is + @samp{^Return-receipt}. + + + @node Bouncing + @section Bouncing + + @findex message-bounce + The @code{message-bounce} command will, if the current buffer contains a + bounced mail message, pop up a message buffer stripped of the bounce + information. + + @vindex message-ignored-bounced-headers + Headers that match the @code{message-ignored-bounced-headers} regexp + will be removed before popping up the buffer. The default is + @samp{^Received:}. + + + @node Commands + @chapter Commands + + @menu + * Header Commands:: Commands for moving to headers. + * Movement:: Moving around in message buffers. + * Insertion:: Inserting things into message buffers. + * Various Commands:: Various things. + * Sending:: Actually sending the message. + @end menu + + + @node Header Commands + @section Header Commands + + All these commands move to the header in question. If it doesn't exist, + it will be inserted. + + @table @kbd + + @item C-c ? + @kindex C-c ? + @findex message-goto-to + Describe the message mode. + + @item C-c C-f C-t + @kindex C-c C-f C-t + @findex message-goto-to + Go to the @code{To} header (@code{message-goto-to}). + + @item C-c C-f C-b + @kindex C-c C-f C-b + @findex message-goto-bcc + Go to the @code{Bcc} header (@code{message-goto-bcc}). + + @item C-c C-f C-f + @kindex C-c C-f C-f + @findex message-goto-fcc + Go to the @code{Fcc} header (@code{message-goto-fcc}). + + @item C-c C-f C-c + @kindex C-c C-f C-c + @findex message-goto-cc + Go to the @code{Cc} header (@code{message-goto-cc}). + + @item C-c C-f C-s + @kindex C-c C-f C-s + @findex message-goto-subject + Go to the @code{Subject} header (@code{message-goto-subject}). + + @item C-c C-f C-r + @kindex C-c C-f C-r + @findex message-goto-reply-to + Go to the @code{Reply-To} header (@code{message-goto-reply-to}). + + @item C-c C-f C-n + @kindex C-c C-f C-n + @findex message-goto-newsgroups + Go to the @code{Newsgroups} header (@code{message-goto-newsgroups}). + + @item C-c C-f C-d + @kindex C-c C-f C-d + @findex message-goto-distribution + Go to the @code{Distribution} header (@code{message-goto-distribution}). + + @item C-c C-f C-o + @kindex C-c C-f C-o + @findex message-goto-followup-to + Go to the @code{Followup-To} header (@code{message-goto-followup-to}). + + @item C-c C-f C-k + @kindex C-c C-f C-k + @findex message-goto-keywords + Go to the @code{Keywords} header (@code{message-goto-keywords}). + + @item C-c C-f C-u + @kindex C-c C-f C-u + @findex message-goto-summary + Go to the @code{Summary} header (@code{message-goto-summary}). + + @end table + + + @node Movement + @section Movement + + @table @kbd + @item C-c C-b + @kindex C-c C-b + @findex message-goto-body + Move to the beginning of the body of the message + (@code{message-goto-body}). + + @item C-c C-i + @kindex C-c C-i + @findex message-goto-signature + Move to the signature of the message (@code{message-goto-signature}). + + @end table + + + @node Insertion + @section Insertion + + @table @kbd + + @item C-c C-y + @kindex C-c C-y + @findex message-yank-original + Yank the message that's being replied to into the message buffer + (@code{message-yank-original}). + + @item C-c C-q + @kindex C-c C-q + @findex message-fill-yanked-message + Fill the yanked message (@code{message-fill-yanked-message}). + + @item C-c C-w + @kindex C-c C-w + @findex message-insert-signature + Insert a signature at the end of the buffer + (@code{message-insert-signature}). + + @end table + + @table @code + @item message-ignored-cited-headers + @vindex message-ignored-cited-headers + All headers that match this regexp will be removed from yanked + messages. The default is @samp{.}, which means that all headers will be + removed. + + @item message-citation-line-function + @vindex message-citation-line-function + Function called to insert the citation line. The default is + @code{message-insert-citation-line}. + + @item message-yank-prefix + @vindex message-yank-prefix + @cindex yanking + @cindex quoting + When you are replying to or following up an article, you normally want + to quote the person you are answering. Inserting quoted text is done by + @dfn{yanking}, and each quoted line you yank will have + @code{message-yank-prefix} prepended to it. The default is @samp{> }. + If it is @code{nil}, just indent the message. + + @item message-indentation-spaces + @vindex message-indentation-spaces + Number of spaces to indent yanked messages. + + @item message-cite-function + @vindex message-cite-function + @findex message-cite-original + @findex sc-cite-original + @cindex Supercite + Function for citing an original message. The default is + @code{message-cite-original}. You can also set it to + @code{sc-cite-original} to use Supercite. + + @item message-indent-citation-function + @vindex message-indent-citation-function + Function for modifying a citation just inserted in the mail buffer. + This can also be a list of functions. Each function can find the + citation between @code{(point)} and @code{(mark t)}. And each function + should leave point and mark around the citation text as modified. + + @item message-signature + @vindex message-signature + String to be inserted at the end of the message buffer. If @code{t} + (which is the default), the @code{message-signature-file} file will be + inserted instead. If a function, the result from the function will be + used instead. If a form, the result from the form will be used instead. + If this variable is @code{nil}, no signature will be inserted at all. + + @item message-signature-file + @vindex message-signature-file + File containing the signature to be inserted at the end of the buffer. + The default is @samp{~/.signature}. + + @end table + + Note that RFC1036 says that a signature should be preceded by the three + characters @samp{-- } on a line by themselves. This is to make it + easier for the recipient to automatically recognize and process the + signature. So don't remove those characters, even though you might feel + that they ruin you beautiful design, like, totally. + + Also note that no signature should be more than four lines long. + Including ASCII graphics is an efficient way to get everybody to believe + that you are silly and have nothing important to say. + + + + @node Various Commands + @section Various Commands + + @table @kbd + + @item C-c C-r + @kindex C-c C-r + @findex message-caesar-buffer-body + Caesar rotate (aka. rot13) the current message + (@code{message-caesar-buffer-body}). If narrowing is in effect, just + rotate the visible portion of the buffer. A numerical prefix says how + many places to rotate the text. The default is 13. + + @item C-c C-t + @kindex C-c C-t + @findex message-insert-to + Insert a @code{To} header that contains the @code{Reply-To} or + @code{From} header of the message you're following up + (@code{message-insert-to}). + + @item C-c C-n + @kindex C-c C-n + @findex message-insert-newsgroups + Insert a @code{Newsgroups} header that reflects the @code{Followup-To} + or @code{Newsgroups} header of the article you're replying to + (@code{message-insert-newsgroups}). + + @item C-c M-r + @kindex C-c M-r + @findex message-rename-buffer + Rename the buffer (@code{message-rename-buffer}). If given a prefix, + prompt for a new buffer name. + + @end table + + + @node Sending + @section Sending + + @table @kbd + @item C-c C-c + @kindex C-c C-c + @findex message-send-and-exit + Send the message and bury the current buffer + (@code{message-send-and-exit}). + + @item C-c C-s + @kindex C-c C-s + @findex message-send + Send the message (@code{message-send}). + + @item C-c C-d + @kindex C-c C-d + @findex message-dont-send + Bury the message buffer and exit (@code{message-dont-send}). + + @item C-c C-k + @kindex C-c C-k + @findex message-kill-buffer + Kill the message buffer and exit (@code{message-kill-buffer}). + + @end table + + + @node Variables + @chapter Variables + + @menu + * Message Headers:: General message header stuff. + * Mail Headers:: Customizing mail headers. + * Mail Variables:: Other mail variables. + * News Headers:: Customizing news headers. + * News Variables:: Other news variables. + * Various Message Variables:: Other message variables. + * Sending Variables:: Variables for sending. + * Message Buffers:: How Message names its buffers. + * Message Actions:: Actions to be performed when exiting. + @end menu + + + @node Message Headers + @section Message Headers + + Message is quite aggressive on the message generation front. It has + to be -- it's a combined news and mail agent. To be able to send + combined messages, it has to generate all headers itself to ensure that + mail and news copies of messages look sufficiently similar. + + @table @code + + @item message-generate-headers-first + @vindex message-generate-headers-first + If non-@code{nil}, generate all headers before starting to compose the + message. + + @item message-from-style + @vindex message-from-style + Specifies how @code{From} headers should look. There are four legal + values: + + @table @code + @item nil + Just the address -- @samp{king@@grassland.com}. + + @item parens + @samp{king@@grassland.com (Elvis Parsley)}. + + @item angles + @samp{Elvis Parsley }. + + @item default + Look like @code{angles} if that doesn't require quoting, and + @code{parens} if it does. If even @code{parens} requires quoting, use + @code{angles} anyway. + + @end table + + @item message-deletable-headers + @vindex message-deletable-headers + Headers in this list that were previously generated by Message will be + deleted before posting. Let's say you post an article. Then you decide + to post it again to some other group, you naughty boy, so you jump back + to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and + ship it off again. By default, this variable makes sure that the old + generated @code{Message-ID} is deleted, and a new one generated. If + this isn't done, the entire empire would probably crumble, anarchy would + prevail, and cats would start walking on two legs and rule the world. + Allegedly. + + @item message-default-headers + @vindex message-default-headers + This string is inserted at the end of the headers in all message + buffers. + + @end table + + + @node Mail Headers + @section Mail Headers + + @table @code + @item message-required-mail-headers + @vindex message-required-mail-headers + See @pxref{News Headers} for the syntax of this variable. It is + @code{(From Date Subject (optional . In-Reply-To) Message-ID Lines + (optional . X-Mailer))} by default. + + @item message-ignored-mail-headers + @vindex message-ignored-mail-headers + Regexp of headers to be removed before mailing. The default is + @samp{^Gcc:\\|^Fcc:}. + + @item message-default-mail-headers + @vindex message-default-mail-headers + This string is inserted at the end of the headers in all message + buffers that are initialized as mail. + + @end table + + + @node Mail Variables + @section Mail Variables + + @table @code + @item message-send-mail-function + @vindex message-send-mail-function + Function used to send the current buffer as mail. The default is + @code{message-send-mail-with-sendmail}. If you prefer using MH + instead, set this variable to @code{message-send-mail-with-mh}. + + @end table + + + @node News Headers + @section News Headers + + @vindex message-required-news-headers + @code{message-required-news-headers} a list of header symbols. These + headers will either be automatically generated, or, if that's + impossible, they will be prompted for. The following symbols are legal: + + @table @code + + @item From + @cindex From + @findex user-full-name + @findex user-mail-address + This required header will be filled out with the result of the + @code{message-make-from} function, which depends on the + @code{message-from-style}, @code{user-full-name}, + @code{user-mail-address} variables. + + @item Subject + @cindex Subject + This required header will be prompted for if not present already. + + @item Newsgroups + @cindex Newsgroups + This required header says which newsgroups the article is to be posted + to. If it isn't present already, it will be prompted for. + + @item Organization + @cindex organization + This optional header will be filled out depending on the + @code{message-user-organization} variable. + @code{message-user-organization-file} will be used if that variable is + @code{t}. + + @item Lines + @cindex Lines + This optional header will be computed by Message. + + @item Message-ID + @cindex Message-ID + @vindex mail-host-address + @findex system-name + @cindex Sun + This required header will be generated by Message. A unique ID will be + created based on date, time, user name and system name. Message will + use @code{mail-host-address} as the fully qualified domain name (FQDN) + of the machine if that variable is define. If not, it will use + @code{system-name}, which doesn't report a FQDN on some machines -- + notably Suns. + + @item X-Newsreader + @cindex X-Newsreader + This optional header will be filled out according to the + @code{message-newsreader} local variable. + + @item X-Mailer + This optional header will be filled out according to the + @code{message-mailer} local variable, unless there already is an + @code{X-Newsreader} header present. + + @item In-Reply-To + This optional header is filled out using the @code{Date} and @code{From} + header of the article being replied. + + @item Expires + @cindex Expires + This extremely optional header will be inserted according to the + @code{message-expires} variable. It is highly deprecated and shouldn't + be used unless you know what you're doing. + + @item Distribution + @cindex Distribution + This optional header is filled out according to the + @code{message-distribution-function} variable. It is a deprecated and + much misunderstood header. + + @item Path + @cindex path + This extremely optional header should probably not ever be used. + However, some @emph{very} old servers require that this header is + present. @code{message-user-path} further controls how this + @code{Path} header is to look. If is is @code{nil}, the the server name + as the leaf node. If is is a string, use the string. If it is neither + a string nor @code{nil}, use the user name only. However, it is highly + unlikely that you should need to fiddle with this variable at all. + @end table + + @findex yow + @cindex Mime-Version + In addition, you can enter conses into this list. The car of this cons + should be a symbol. This symbol's name is the name of the header, and + the cdr can either be a string to be entered verbatim as the value of + this header, or it can be a function to be called. This function should + return a string to be inserted. For instance, if you want to insert + @code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")} + into the list. If you want to insert a funny quote, you could enter + something like @code{(X-Yow . yow)} into the list. The function + @code{yow} will then be called without any arguments. + + If the list contains a cons where the car of the cons is + @code{optional}, the cdr of this cons will only be inserted if it is + non-@code{nil}. + + Other variables for customizing outgoing news articles: + + @table @code + + @item message-syntax-checks + @vindex message-syntax-checks + If non-@code{nil}, message will attempt to check the legality of the + headers, as well as some other stuff, before posting. You can control + the granularity of the check by adding or removing elements from this + list. Legal elements are: + + @table @code + @item subject-cmsg + Check the subject for commands. + @item sender + @cindex Sender + Insert a new @code{Sender} header if the @code{From} header looks odd. + @item multiple-headers + Check for the existence of multiple equal headers. + @item sendsys + @cindex sendsys + Check for the existence of version and sendsys commands. + @item message-id + Check whether the @code{Message-ID} looks ok. + @item from + Check whether the @code{From} header seems nice. + @item long-lines + @cindex long lines + Check for too long lines. + @item control-chars + Check for illegal characters. + @item size + Check for excessive size. + @item new-text + Check whether there is any new text in the messages. + @item signature + Check the length of the signature. + @item approved + @cindex approved + Check whether the article has an @code{Approved} header, which is + something only moderators should include. + @item empty + Check whether the article is empty. + @item empty-headers + Check whether any of the headers are empty. + @item existing-newsgroups + Check whether the newsgroups mentioned in the Newsgroups and + Followup-To headers exist. + @item valid-newsgroups + Check whether the @code{Newsgroups} and @code{Followup-To} headers + are valid syntactially. + @end table + + All these conditions are checked by default. + + @item message-ignored-news-headers + @vindex message-ignored-news-headers + Regexp of headers to be removed before posting. The default is + @samp{^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:}. + + @item message-default-news-headers + @vindex message-default-news-headers + This string is inserted at the end of the headers in all message + buffers that are initialized as news. + + @end table + + + @node News Variables + @section News Variables + + @table @code + @item message-send-news-function + @vindex message-send-news-function + Function used to send the current buffer as news. The default is + @code{message-send-news}. + + @item message-post-method + @vindex message-post-method + Method used for posting a prepared news message. + + @end table + + + @node Various Message Variables + @section Various Message Variables + + @table @code + @item message-signature-separator + @vindex message-signature-separator + Regexp matching the signature separator. It is @samp{^-- *$} by + default. + + @item mail-header-separator + @vindex mail-header-separator + String used to separate the headers from the body. It is @samp{--text + follows this line--} by default. + + @item message-directory + @vindex message-directory + Directory used by many mailey things. The default is @file{~/Mail/}. + + @item message-autosave-directory + @vindex message-autosave-directory + Directory where message buffers will be autosaved to. + + @item message-signature-setup-hook + @vindex message-signature-setup-hook + Hook run when initializing the message buffer. It is run after the + headers have been inserted but before the signature has been inserted. + + @item message-setup-hook + @vindex message-setup-hook + Hook run as the last thing when the message buffer has been initialized. + + @item message-header-setup-hook + @vindex message-header-setup-hook + Hook called narrowed to the headers after initializing the headers. + + @item message-send-hook + @vindex message-send-hook + Hook run before sending messages. + + @item message-sent-hook + @vindex message-sent-hook + Hook run after sending messages. + + @item message-mode-syntax-table + @vindex message-mode-syntax-table + Syntax table used in message mode buffers. + + @end table + + + + @node Sending Variables + @section Sending Variables + + @table @code + + @item message-fcc-handler-function + @vindex message-fcc-handler-function + A function called to save outgoing articles. This function will be + called with the name of the file to store the article in. The default + function is @code{rmail-output} which saves in Unix mailbox format. + + @item message-courtesy-message + @vindex message-courtesy-message + When sending combined messages, this string is inserted at the start of + the mailed copy. If this variable is @code{nil}, no such courtesy + message will be added. + + @end table + + + @node Message Buffers + @section Message Buffers + + Message will generate new buffers with unique buffer names when you + request a message buffer. When you send the message, the buffer isn't + normally killed off. It's name is changed and a certain number of old + message buffers are kept alive. + + @table @code + @item message-generate-new-buffers + @vindex message-generate-new-buffers + If non-@code{nil}, generate new buffers. The default is @code{t}. If + this is a function, call that function with three parameters: The type, + the to address and the group name. (Any of these may be @code{nil}.) + The function should return the new buffer name. + + @item message-max-buffers + @vindex message-max-buffers + This variable says how many old message buffers to keep. If there are + more message buffers than this, the oldest buffer will be killed. The + default is 10. If this variable is @code{nil}, no old message buffers + will ever be killed. + + @item message-send-rename-function + @vindex message-send-rename-function + After sending a message, the buffer is renamed from, for instance, + @samp{*reply to Lars*} to @samp{*sent reply to Lars*}. If you don't + like this, set this variable to a function that renames the buffer in a + manner you like. If you don't want to rename the buffer at all, you can + say: + + @lisp + (setq message-send-rename-function 'ignore) + @end lisp + + @item message-kill-buffer-on-exit + @findex message-kill-buffer-on-exit + If non-@code{nil}, kill the buffer immediately on exit. + + @end table + + + @node Message Actions + @section Message Actions + + When Message is being used from a news/mail reader, the reader is likely + to want to perform some task after the message has been sent. Perhaps + return to the previous window configuration or mark an article as + replied. + + @vindex message-kill-actions + @vindex message-postpone-actions + @vindex message-exit-actions + @vindex message-send-actions + The user may exit from the message buffer in various ways. The most + common is @kbd{C-c C-c}, which sends the message and exits. Other + possibilities are @kbd{C-c C-s} which just sends the message, @kbd{C-c + C-d} which postpones the message editing and buries the message buffer, + and @kbd{C-c C-k} which kills the message buffer. Each of these actions + have lists associated with them that contains actions to be executed: + @code{message-send-actions}, @code{message-exit-actions}, + @code{message-postpone-actions}, and @code{message-kill-actions}. + + Message provides a function to interface with these lists: + @code{message-add-action}. The first parameter is the action to be + added, and the rest of the arguments are which lists to add this action + to. Here's an example from Gnus: + + @lisp + (message-add-action + `(set-window-configuration ,(current-window-configuration)) + 'exit 'postpone 'kill) + @end lisp + + This restores the Gnus window configuration when the message buffer is + killed, postponed or exited. + + An @dfn{action} can be either a normal function; or a list where the + @code{car} is a function and the @code{cdr} is the list of arguments; or + a form to be @code{eval}ed. + + @node Index + @chapter Index + @printindex cp + + @node Key Index + @chapter Key Index + @printindex ky + + @summarycontents + @contents + @bye + + @c End: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/misc.texi emacs-19.32/man/misc.texi *** emacs-19.31/man/misc.texi Tue May 21 13:32:54 1996 --- emacs-19.32/man/misc.texi Mon Jul 15 18:31:07 1996 *************** diversions and amusements. *** 14,100 **** @end iftex ! @node GNUS, Shell, Calendar/Diary, Top ! @section GNUS ! @cindex @sc{gnus} @cindex reading netnews ! @sc{gnus} is an Emacs subsystem for reading and responding to netnews. You ! can use @sc{gnus} to browse through news groups, look at summaries of ! articles in specific group, and read articles of interest. You can ! respond to authors or write replies to all the readers of a news group. - This section introduces @sc{gnus} and describes several basic - features. @ifinfo ! @xref{Top, GNUS, GNUS, gnus}. @end ifinfo @iftex ! For more information, run @kbd{M-x info} and select the @sc{gnus} manual. @end iftex ! @findex gnus ! To start @sc{gnus}, type @kbd{M-x gnus @key{RET}}. @menu ! * Buffers of GNUS:: The Newsgroups, Summary and Article buffers. ! * GNUS Startup:: What you should know about starting GNUS. ! * Summary of GNUS:: A short description of the basic GNUS commands. @end menu ! @node Buffers of GNUS ! @subsection GNUS's Three Buffers ! ! @sc{gnus} creates and uses three Emacs buffers, each with its own ! particular purpose and its own major mode. ! The @dfn{Newsgroup buffer} contains a list of newsgroups. This is the ! first buffer that @sc{gnus} displays when it starts up. Normally the list ! contains only the newsgroups to which you subscribe (which are listed in ! your @file{.newsrc} file) and which contain unread articles. Use this ! buffer to select a specific newsgroup. ! ! The @dfn{Summary buffer} lists the articles in a single newsgroup, ! including their subjects, their numbers, and who posted them. @sc{gnus} ! creates a Summary buffer for a newsgroup when you select the group in ! the Newsgroup buffer. Use this buffer to select an article. ! ! The @dfn{Article buffer} displays the text of an article. You rarely ! need to select this buffer because you can scroll through it while ! remaining in the Summary buffer. ! @node GNUS Startup ! @subsection When GNUS Starts Up ! At startup, @sc{gnus} reads your @file{.newsrc} news initialization file and attempts to communicate with the local news server, which is a repository of news articles. The news server need not be the same computer you are logged in on. ! If you start @sc{gnus} and connect to the server, but do not see any ! newsgroups listed in the Newsgroup buffer, type @kbd{L} to get a listing ! of all the newsgroups. Then type @kbd{u} to unsubscribe from the ! newsgroups you don't want to read. (You can move point to a particular ! group using @kbd{n} and @kbd{p} or the usual Emacs commands.) ! ! The first time you start @sc{gnus}, it subscribes automatically to every ! newsgroup that exists. Subsequently, @sc{gnus} subscribes automatically ! to all newly created newsgroups. You can unsubscribe groups with ! @kbd{u}. You can inhibit automatic subscription by adding the following ! line to your @file{~/.newsrc} file: ! ! @example ! options -n !all !all.all ! @end example ! When you quit @sc{gnus} with @kbd{q}, it automatically records in your ! @file{.newsrc} initialization file the subscribed or unsubscribed status ! of all newsgroups, except for groups you have ``killed''. (You do not ! need to edit this file yourself, but you may.) When new newsgroups come ! into existence, @sc{gnus} subscribes to them automatically; if you don't ! want to read them, use @kbd{u} to unsubscribe from them. ! ! @node Summary of GNUS ! @subsection Summary of GNUS Commands Reading news is a two step process: --- 14,98 ---- @end iftex ! @node Gnus, Shell, Calendar/Diary, Top ! @section Gnus ! @cindex Gnus @cindex reading netnews ! Gnus is an Emacs package primarily designed for reading and posting ! Usenet news. It can also be used to read and respond to messages from a ! number of other sources -- mail, remote directories, digests, and so ! on. ! ! This section introduces Gnus and describes several basic features. @ifinfo ! @xref{Top, Gnus}. @end ifinfo @iftex ! For more information, run @kbd{M-x info} and select the Gnus manual. @end iftex ! @findex Gnus ! To start Gnus, type @kbd{M-x gnus @key{RET}}. @menu ! * Buffers of Gnus:: The group, summary and article buffers. ! * Gnus Startup:: What you should know about starting Gnus. ! * Summary of Gnus:: A short description of the basic Gnus commands. @end menu ! @node Buffers of Gnus ! @subsection Gnus Buffers ! As opposed to most normal Emacs packages, Gnus uses a number of ! different buffers to display information and to receive commands. The ! three buffers users spend most of their time in are the @dfn{group ! buffer}, the @dfn{summary buffer} and the @dfn{article buffer}. ! ! The @dfn{group buffer} contains a list of groups. This is the first ! buffer Gnus displays when it starts up. It normally displays only the ! groups to which you subscribe and that contain unread articles. Use ! this buffer to select a specific group. ! ! The @dfn{summary buffer} lists one line for each article in a single ! group. By default, the author, the subject and the line number are ! displayed for each article, but this is customizable, like most aspects ! of Gnus display. The summary buffer is created when you select a group ! in the group buffer, and is killed when you exit the group. Use this ! buffer to select an article. ! ! The @dfn{article buffer} displays the article. In normal Gnus usage, ! you don't select this buffer---all useful article-oriented commands work ! in the summary buffer. But you can select the article buffer, and ! execute all Gnus commands from that buffer, if you want to. ! @node Gnus Startup ! @subsection When Gnus Starts Up ! At startup, Gnus reads your @file{.newsrc} news initialization file and attempts to communicate with the local news server, which is a repository of news articles. The news server need not be the same computer you are logged in on. ! If you start Gnus and connect to the server, but do not see any ! newsgroups listed in the group buffer, type @kbd{L} or @kbd{A k} to get ! a listing of all the groups. Then type @kbd{u} to toggle ! subscription to groups. ! ! The first time you start Gnus, Gnus will subscribe you to a select few ! groups. All other groups start out as @dfn{killed groups} for you; you ! can list them with @kbd{A k}. All new groups that subsequently come to ! exist at the news server become @dfn{zombie groups} for you; type @kbd{A ! z} to list them. You can subscribe to a group shown in these lists ! using the @kbd{u} command. ! ! When you quit Gnus with @kbd{q}, it automatically records in your ! @file{.newsrc} and @file{.newsrc.eld} initialization files the ! subscribed or unsubscribed status of all groups. You should normally ! not edit these files manually, but you may if you know how. ! @node Summary of Gnus ! @subsection Summary of Gnus Commands Reading news is a two step process: *************** Reading news is a two step process: *** 102,177 **** @enumerate @item ! Choose a newsgroup in the Newsgroup buffer. @item ! Select articles from the Summary buffer. Each article selected is ! displayed in the Article buffer in a large window, below the Summary buffer in its small window. @end enumerate ! Each @sc{gnus} buffer has its own special commands, but commands that ! do the similar things have similar key bindings. Here are commands for the ! Newsgroup and Summary buffers: @table @kbd ! @kindex z @r{(GNUS Group mode)} ! @findex gnus-group-suspend ! @item z ! In the Newsgroup buffer, suspend @sc{gnus}. You can return to @sc{gnus} later by ! selecting the Newsgroup buffer and typing @kbd{g} to get newly arrived ! articles. ! ! @kindex q @r{(GNUS Group mode)} @findex gnus-group-exit @item q ! In the Newsgroup buffer, update your @file{.newsrc} initialization file ! and quit @sc{gnus}. ! In the Summary buffer, exit the current newsgroup and return to the ! Newsgroup buffer. Thus, typing @kbd{q} twice quits @sc{gnus}. ! @kindex L @r{(GNUS Group mode)} @findex gnus-group-list-all-groups @item L ! In the Newsgroup buffer, list all the newsgroups available on your news server (except those you have killed). This may be a long list! ! @kindex l @r{(GNUS Group mode)} @findex gnus-group-list-groups @item l ! In the Newsgroup buffer, list only the newsgroups to which you subscribe ! and which contain unread articles. ! @kindex u @r{(GNUS Group mode)} @findex gnus-group-unsubscribe-current-group ! @cindex subscribe newsgroups ! @cindex unsubscribe newsgroups @item u ! In the Newsgroup buffer, unsubscribe from (or subscribe to) the ! newsgroup listed in the line that point is on. When you quit @sc{gnus} ! by typing @kbd{q}, @sc{gnus} lists in your @file{.newsrc} file which ! groups you have subscribed to. The next time you start @sc{gnus}, you ! won't see this group initially, because @sc{gnus} normally displays only ! subscribed-to groups. ! @kindex C-k @r{(GNUS)} @findex gnus-group-kill-group @item C-k ! In the Newsgroup buffer, ``kill'' the current line's newsgroup---don't even list it in @file{.newsrc} from now on. This affects future ! @sc{gnus} sessions as well as the present session. ! When you quit @sc{gnus} by typing @kbd{q}, @sc{gnus} writes information in the file @file{.newsrc} describing all newsgroups except those you have ``killed.'' ! @kindex SPC @r{(GNUS)} @findex gnus-group-read-group @item @key{SPC} ! In the Newsgroup buffer, select the group on the line under the cursor and display the first unread article in that group. @need 1000 ! In the Summary buffer, @itemize @bullet --- 100,167 ---- @enumerate @item ! Choose a group in the group buffer. @item ! Select articles from the summary buffer. Each article selected is ! displayed in the article buffer in a large window, below the summary buffer in its small window. @end enumerate ! Each Gnus buffer has its own special commands, but commands that do ! the similar things have similar key bindings. Here are commands for the ! group and summary buffers: @table @kbd ! @kindex q @r{(Gnus Group mode)} @findex gnus-group-exit @item q ! In the group buffer, update your @file{.newsrc} initialization file ! and quit Gnus. ! In the summary buffer, exit the current group and return to the ! group buffer. Thus, typing @kbd{q} twice quits Gnus. ! @kindex L @r{(Gnus Group mode)} @findex gnus-group-list-all-groups @item L ! In the group buffer, list all the groups available on your news server (except those you have killed). This may be a long list! ! @kindex l @r{(Gnus Group mode)} @findex gnus-group-list-groups @item l ! In the group buffer, list only the groups to which you subscribe and ! which contain unread articles. ! @kindex u @r{(Gnus Group mode)} @findex gnus-group-unsubscribe-current-group ! @cindex subscribe groups ! @cindex unsubscribe groups @item u ! In the group buffer, unsubscribe from (or subscribe to) the group listed ! in the line that point is on. When you quit Gnus by typing @kbd{q}, ! Gnus lists in your @file{.newsrc} file which groups you have subscribed ! to. The next time you start Gnus, you won't see this group, ! because Gnus normally displays only subscribed-to groups. ! @kindex C-k @r{(Gnus)} @findex gnus-group-kill-group @item C-k ! In the group buffer, ``kill'' the current line's group---don't even list it in @file{.newsrc} from now on. This affects future ! Gnus sessions as well as the present session. ! When you quit Gnus by typing @kbd{q}, Gnus writes information in the file @file{.newsrc} describing all newsgroups except those you have ``killed.'' ! @kindex SPC @r{(Gnus)} @findex gnus-group-read-group @item @key{SPC} ! In the group buffer, select the group on the line under the cursor and display the first unread article in that group. @need 1000 ! In the summary buffer, @itemize @bullet *************** Select the next unread article if at the *** 188,262 **** Thus, you can move through all the articles by repeatedly typing @key{SPC}. ! @kindex DEL @r{(GNUS)} @item @key{DEL} ! In the Newsgroup Buffer, move point to the previous newsgroup containing unread articles. @findex gnus-summary-prev-page ! In the Summary buffer, scroll the text of the article backwards. ! @kindex n @r{(GNUS)} @findex gnus-group-next-unread-group @findex gnus-summary-next-unread-article @item n ! Move point to the next unread newsgroup, or select the next unread ! article. ! @kindex p @r{(GNUS)} @findex gnus-group-prev-unread-group @findex gnus-summary-prev-unread-article @item p ! Move point to the previous unread newsgroup, or select the previous unread article. ! @kindex C-n @r{(GNUS Group mode)} @findex gnus-group-next-group ! @kindex C-p @r{(GNUS Group mode)} @findex gnus-group-prev-group ! @kindex C-n @r{(GNUS Summary mode)} @findex gnus-summary-next-subject ! @kindex C-p @r{(GNUS Summary mode)} @findex gnus-summary-prev-subject @item C-n @itemx C-p Move point to the next or previous item, even if it is marked as read. ! This does not select the article or newsgroup on that line. ! @kindex s @r{(GNUS Summary mode)} @findex gnus-summary-isearch-article @item s ! In the Summary buffer, do an incremental search of the current text in ! the Article buffer, just as if you switched to the Article buffer and typed @kbd{C-s}. ! @kindex M-s @r{(GNUS Summary mode)} @findex gnus-summary-search-article-forward @item M-s @var{regexp} RET ! In the Summary buffer, search forward for articles containing a match for @var{regexp}. - @c kindex C-c C-s C-n @r{(GNUS Summary mode)} - @findex gnus-summary-sort-by-number - @c kindex C-c C-s C-s @r{(GNUS Summary mode)} - @findex gnus-summary-sort-by-subject - @c kindex C-c C-s C-d @r{(GNUS Summary mode)} - @findex gnus-summary-sort-by-date - @c kindex C-c C-s C-a @r{(GNUS Summary mode)} - @findex gnus-summary-sort-by-author - @item C-c C-s C-n - @itemx C-c C-s C-s - @itemx C-c C-s C-d - @itemx C-c C-s C-a - In the Summary buffer, sort the list of articles by number, subject, - date, or author. - - @kindex C-M-n @r{(GNUS Summary mode)} - @findex gnus-summary-next-same-subject - @kindex C-M-p @r{(GNUS Summary mode)} - @findex gnus-summary-prev-same-subject - @item C-M-n - @itemx C-M-p - In the Summary buffer, read the next or previous article with the same - subject as the current article. @end table --- 178,228 ---- Thus, you can move through all the articles by repeatedly typing @key{SPC}. ! @kindex DEL @r{(Gnus)} @item @key{DEL} ! In the group buffer, move point to the previous group containing unread articles. @findex gnus-summary-prev-page ! In the summary buffer, scroll the text of the article backwards. ! @kindex n @r{(Gnus)} @findex gnus-group-next-unread-group @findex gnus-summary-next-unread-article @item n ! Move point to the next unread group, or select the next unread article. ! @kindex p @r{(Gnus)} @findex gnus-group-prev-unread-group @findex gnus-summary-prev-unread-article @item p ! Move point to the previous unread group, or select the previous unread article. ! @kindex C-n @r{(Gnus Group mode)} @findex gnus-group-next-group ! @kindex C-p @r{(Gnus Group mode)} @findex gnus-group-prev-group ! @kindex C-n @r{(Gnus Summary mode)} @findex gnus-summary-next-subject ! @kindex C-p @r{(Gnus Summary mode)} @findex gnus-summary-prev-subject @item C-n @itemx C-p Move point to the next or previous item, even if it is marked as read. ! This does not select the article or group on that line. ! @kindex s @r{(Gnus Summary mode)} @findex gnus-summary-isearch-article @item s ! In the summary buffer, do an incremental search of the current text in ! the article buffer, just as if you switched to the article buffer and typed @kbd{C-s}. ! @kindex M-s @r{(Gnus Summary mode)} @findex gnus-summary-search-article-forward @item M-s @var{regexp} RET ! In the summary buffer, search forward for articles containing a match for @var{regexp}. @end table *************** subject as the current article. *** 266,270 **** @c Too many references to the name of the manual if done with xref in TeX! ! @sc{gnus} is powerful and customizable. Here are references to a few @ifinfo additional topics: --- 232,236 ---- @c Too many references to the name of the manual if done with xref in TeX! ! Gnus is powerful and customizable. Here are references to a few @ifinfo additional topics: *************** additional topics: *** 272,305 **** @end ifinfo @iftex ! additional topics in @cite{The GNUS Manual}: @itemize @bullet @item Follow discussions on specific topics.@* ! See section ``Thread-based Reading''. @item ! Read digests. See section ``Digest Articles'' @item Refer to and jump to the parent of the current article.@* ! See section ``Referencing Articles''. ! @item Refer to articles by using Message-IDs included in the messages.@* ! See section ``Article Commands''. @item ! Save articles. See section ``Saving Articles''. @item ! Create filters that preselect which articles you will see, according to ! regular expressions in the articles or their headers.@* ! See section ``Kill File''. @item Send an article to a newsgroup.@* ! See section ``Posting Articles''. @end itemize @end iftex --- 238,270 ---- @end ifinfo @iftex ! additional topics in @cite{The Gnus Manual}: @itemize @bullet @item Follow discussions on specific topics.@* ! See section ``Threading.'' @item ! Read digests. See section ``Document Groups.'' @item Refer to and jump to the parent of the current article.@* ! See section ``Finding the Parent.'' @item Refer to articles by using Message-IDs included in the messages.@* ! See section ``Article Keymap.'' @item ! Save articles. See section ``Saving Articles.'' @item ! Have Gnus score articles according to various criteria, like author ! name, subject, or string in the body of the articles.@* ! See section ``Scoring.'' @item Send an article to a newsgroup.@* ! See section ``Composing Messages.'' @end itemize @end iftex *************** See section ``Posting Articles''. *** 308,342 **** @item Follow discussions on specific topics.@* ! @xref{Thread-based Reading, , Reading Based on Conversation Threads, ! gnus, The GNUS Manual}. @item ! Read digests. @xref{Digest Articles, , , gnus, The GNUS Manual}. @item Refer to and jump to the parent of the current article.@* ! @xref{Referencing Articles, , , gnus, The GNUS Manual}. ! @item Refer to articles by using Message-IDs included in the messages.@* ! @xref{Article Commands, , , gnus, The GNUS Manual}. @item ! Save articles. @xref{Saving Articles, , , gnus, The GNUS Manual}. @item ! Create filters that preselect which articles you will see, according to ! regular expressions in the articles or their headers.@* ! @xref{Kill File, , , gnus, The GNUS Manual}. @item Send an article to a newsgroup.@* ! @xref{Posting Articles, , , gnus, The GNUS Manual}. @end itemize @end ifinfo @end ignore ! @node Shell, Emacs Server, GNUS, Top @section Running Shell Commands from Emacs @cindex subshell --- 273,306 ---- @item Follow discussions on specific topics.@* ! @xref{Threading, , Reading Based on Conversation Threads, ! gnus, The Gnus Manual}. @item ! Read digests. @xref{Document Groups, , , gnus, The Gnus Manual}. @item Refer to and jump to the parent of the current article.@* ! @xref{Finding the Parent, , , gnus, The Gnus Manual}. @item Refer to articles by using Message-IDs included in the messages.@* ! @xref{Article Keymap, , , gnus, The Gnus Manual}. @item ! Save articles. @xref{Saving Articles, , , gnus, The Gnus Manual}. @item ! Have Gnus score articles according to various criteria, like author ! name, subject, or string in the body of the articles.@* ! @xref{Scoring, , , gnus, The Gnus Manual}. @item Send an article to a newsgroup.@* ! @xref{Composing Messages, , , gnus, The Gnus Manual}. @end itemize @end ifinfo @end ignore ! @node Shell, Emacs Server, Gnus, Top @section Running Shell Commands from Emacs @cindex subshell *************** the previous Emacs session had. *** 1492,1498 **** @noindent @findex desktop-save ! Then, to enable state saving in a particular Emacs session, use the ! command @kbd{M-x desktop-save}. Once you have done this, the state of ! this Emacs session will be saved when you exit Emacs. In order for Emacs to recover the state from a previous session, you --- 1456,1465 ---- @noindent @findex desktop-save ! The first time you save the state of the Emacs session, you must do it ! manually, with the command @kbd{M-x desktop-save}. Once you have done ! that, exiting Emacs will save the state again--not only the present ! Emacs session, but also subsequent sessions. You can also save the ! state at any time, without exiting Emacs, by typing @kbd{M-x ! desktop-save} again. In order for Emacs to recover the state from a previous session, you diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/msdog.texi emacs-19.32/man/msdog.texi *** emacs-19.31/man/msdog.texi Sun May 19 18:49:30 1996 --- emacs-19.32/man/msdog.texi Sat Jul 6 21:40:27 1996 *************** text files and binary files does still a *** 28,32 **** * Printing and MS-DOS:: * Subprocesses on MS-DOS:: ! * Windows 95 Subprocesses:: @end menu --- 28,33 ---- * Printing and MS-DOS:: * Subprocesses on MS-DOS:: ! * Windows Subprocesses:: ! * System Menu on Windows:: @end menu *************** colors. Use the @code{list-colors-displ *** 94,101 **** what colors and faces are available and what they look like. ! Multiple frames (@pxref{Frames}) are not supported on MS-DOS. You ! have only a single frame which occupies the entire screen. When you run ! Emacs under MS-Windows 3.x, the single frame can take less than the full ! screen, but you still cannot have more than a single frame. @cindex frame size under MS-DOS --- 95,104 ---- what colors and faces are available and what they look like. ! @cindex frames on MS-DOS ! Multiple frames (@pxref{Frames}) are supported on MS-DOS, but they all ! overlap, so you only see a single frame at any given moment. That ! single visible frame occupies the entire screen. When you run Emacs ! under MS-Windows 3.x, the visible frame can take less than the full ! screen, but you still cannot see more than a single frame. @cindex frame size under MS-DOS *************** lines, depending on your hardware; the @ *** 106,122 **** to the default 80x25 screen size. ! By default, Emacs only knows how to set screen sizes of 80 columns ! by 25 or 43/50 rows. However, if your video adapter has special video modes that will switch the display to other sizes, you can have Emacs ! support those too. When you ask Emacs to switch the (single) frame to ! @var{n} rows by @var{m} cols dimensions, it checks if there is a ! variable called @code{screen-dimensions-@var{n}x@var{m}}, and if so, ! uses its value (which must be an integer) as the video mode to switch ! to. (Emacs switches to that video mode by calling the BIOS @code{Set ! Video Mode} function with the value of ! @code{screen-dimensions-@var{n}x@var{m}} in the @code{AL} register.) ! For example, suppose your adapter will switch to 66x80 dimensions when ! put into video mode 85. Then you can make Emacs support this screen ! size by putting the following into your @file{_emacs} file: @example --- 109,125 ---- to the default 80x25 screen size. ! By default, Emacs only knows how to set screen sizes of 80 columns by ! 25 or 43/50 rows. However, if your video adapter has special video modes that will switch the display to other sizes, you can have Emacs ! support those too. When you ask Emacs to switch the frame to @var{n} ! rows by @var{m} cols dimensions, it checks if there is a variable called ! @code{screen-dimensions-@var{n}x@var{m}}, and if so, uses its value ! (which must be an integer) as the video mode to switch to. (Emacs ! switches to that video mode by calling the BIOS @code{Set Video Mode} ! function with the value of @code{screen-dimensions-@var{n}x@var{m}} in ! the @code{AL} register.) For example, suppose your adapter will switch ! to 66x80 dimensions when put into video mode 85. Then you can make ! Emacs support this screen size by putting the following into your ! @file{_emacs} file: @example *************** VGA supports 44x80 dimensions and you de *** 140,143 **** --- 143,149 ---- @code{screen-dimensions-44x80}. + Changing frame dimensions on MS-DOS has the effect of changing all the + other frames to the new dimensions. + @node File Names on MS-DOS @section File Names on MS-DOS *************** the @code{dired-listing-switches} variab *** 361,400 **** @samp{-s}, @samp{-t}, and @samp{-u}. ! @node Windows 95 Subprocesses ! @section Windows 95 Subprocesses - Subprocesses, both synchronous and asynchronous, work fine on Windows 95 - as long as you run only 32-bit Windows applications in them. However, - when you run a DOS application in a subprocess, it doesn't completely - work; and if you run two DOS applications at the same time in two - subprocesses, the operating system can get badly confused. - - Since the command interpreter shells run as DOS applications, these - problems are significant. But there's nothing we can do about them; - only Microsoft can fix them. Windows 95 simply cannot cope when one - Windows process tries to run two separate DOS subprocesses. - - If you run just one DOS application subprocess, then the application is - likely to busy-wait when idle, which means that your machine will be - 100% busy as long as the application is running. However, aside from - the heavy load, the subprocess will work as expected---provided you - terminate it before you start any other DOS application as a subprocess. - - Emacs is unable to terminate or interrupt a DOS subprocess. The only - way you can terminate such a subprocess is by giving it a command that - tells its program to exit. - - If you run two DOS applications at the same time in two separate - subprocesses, even if one of them is asynchronous, you will probably - find that one of the subprocesses is hung. If the second subprocess is - asynchronous, then Emacs itself will be hung. Meanwhile, your machine - will be 100% busy. - - If you can go to the first subprocess (possible if Emacs is not hung), - and tell it to exit, that should clear up the problem. Otherwise you - will have to reboot. - - If you have to reboot in this situation, do not use the @code{Shutdown} - command on the @code{Start} menu; that usually hangs the system. - Instead, type @kbd{CTL-ALT-@key{DEL}} and then choose @code{Shutdown}. - That usually works, although it may take a few minutes to do its job. --- 367,428 ---- @samp{-s}, @samp{-t}, and @samp{-u}. ! @node Windows Subprocesses ! @section Subprocesses on Windows 95 and Windows NT ! ! Subprocesses, both synchronous and asynchronous, work fine on both ! Windows 95 and Windows NT as long as you run only 32-bit Windows ! applications. However, when you run a DOS application in a subprocess, ! you may encounter problems or be unable to run the application at all; ! and if you run two DOS applications at the same time in two ! subprocesses, you may have to reboot your system. ! ! Since the standard command interpreter (and most command line utilities) ! on Windows 95 are DOS applications, these problems are significant when ! using that system. But there's nothing we can do about them; only ! Microsoft can fix them. ! ! If you run just one DOS application subprocess, the subprocess should ! work as expected as long as it is ``well-behaved'' and does not perform ! direct screen access or other unusual actions. If you have a CPU ! monitor application, your machine will appear to be 100% busy even when ! the DOS application is idle, but this is only an artefact of the way CPU ! monitors measure processor load. ! ! You must terminate the DOS application before you start any other DOS ! application in a different subprocess. Emacs is unable to interrupt or ! terminate a DOS subprocess. The only way you can terminate such a ! subprocess is by giving it a command that tells its program to exit. ! ! If you attempt to run two DOS applications at the same time in separate ! subprocesses, the second one that is started will be suspended until the ! first one finishes, even if either or both of them are asynchronous. ! ! If you can go to the first subprocess, and tell it to exit, the second ! subprocess should continue normally. However, if the second subprocess ! is synchronous, Emacs itself will be hung until the first subprocess ! finishes. If it will not finish without user input, then you have no ! choice but to reboot if you are running on Windows 95. If you are ! running on Windows NT, you can use a process viewer application to kill ! the appropriate instance of ntvdm instead (this will terminate both DOS ! subprocesses). ! ! If you have to reboot Windows 95 in this situation, do not use the ! @code{Shutdown} command on the @code{Start} menu; that usually hangs the ! system. Instead, type @kbd{CTL-ALT-@key{DEL}} and then choose ! @code{Shutdown}. That usually works, although it may take a few minutes ! to do its job. ! ! @node System Menu on Windows ! @section Using the System Menu on Windows ! ! Emacs normally turns off the Windows feature that tapping the @key{ALT} ! key invokes the Windows menu. The reason is that the @key{ALT} also ! serves as @key{META} in Emacs. When using Emacs, users often press the ! @key{META} key temporarily and then change their minds; if this has the ! effect of bringing up the Windows menu, it alters the meaning of ! subsequent commands. Many users find this frustrating. ! ! @vindex win32-pass-alt-to-system ! You can reenable Windows's default handling of tapping the @key{ALT} key ! by setting @code{win32-pass-alt-to-system} to a non-@code{nil} value. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/programs.texi emacs-19.32/man/programs.texi *** emacs-19.31/man/programs.texi Fri May 17 17:19:59 1996 --- emacs-19.32/man/programs.texi Fri Jun 28 05:27:33 1996 *************** on the screen. *** 58,62 **** command. Tags remembers which file it is in. * Emerge:: A convenient way of merging two versions of a program. ! * C Mode:: Special commands of C mode (and C++ mode). * Fortran:: Fortran mode and its special features. * Asm Mode:: Asm mode and its special features. --- 58,62 ---- command. Tags remembers which file it is in. * Emerge:: A convenient way of merging two versions of a program. ! * C Mode:: Special commands of C, C++, Objective-C and Java modes. * Fortran:: Fortran mode and its special features. * Asm Mode:: Asm mode and its special features. *************** on the screen. *** 69,72 **** --- 69,74 ---- @cindex Scheme mode @cindex C++ mode + @cindex Objective-C mode + @cindex Java mode @cindex Perl mode @cindex Icon mode *************** on the screen. *** 75,80 **** @cindex Tcl mode Emacs also has major modes for the programming languages Lisp, Scheme ! (a variant of Lisp), Awk, C, C++, Fortran, Icon, Pascal, Perl and Tcl. ! There is also a major mode for makefiles, called Makefile mode. Ideally, a major mode should be implemented for each programming --- 77,83 ---- @cindex Tcl mode Emacs also has major modes for the programming languages Lisp, Scheme ! (a variant of Lisp), Awk, C, C++, Objective-C, Java, Fortran, Icon, ! Pascal, Perl and Tcl. There is also a major mode for makefiles, called ! Makefile mode. Ideally, a major mode should be implemented for each programming *************** global variable @code{c-syntactic-contex *** 663,668 **** describes the results. Each element in this list is a cons cell containing a syntactic symbol and (optionally) its corresponding buffer ! position. There may be more than one element; syntactic symbols have ! corresponding buffer positions. @node Indentation Calculation --- 666,671 ---- describes the results. Each element in this list is a cons cell containing a syntactic symbol and (optionally) its corresponding buffer ! position. There may be more than one element in a component list, and ! syntactic symbols need not always have corresponding buffer positions. @node Indentation Calculation *************** list. Remember that the list for this l *** 739,743 **** the offset for this symbol is 2. At this point the running total is 2 (0 + 2 = 2). It then goes to buffer position 43, which is the @samp{i} ! in @code{if} on line 3. This character is in the fourth column on that line, so adding this to the running total yields a total indentation of 4 spaces.@refill --- 742,746 ---- the offset for this symbol is 2. At this point the running total is 2 (0 + 2 = 2). It then goes to buffer position 43, which is the @samp{i} ! in @code{if} on line 3. This character is in the second column on that line, so adding this to the running total yields a total indentation of 4 spaces.@refill *************** style is @code{gnu}. *** 1029,1034 **** To choose the style you want, use the command @kbd{M-x c-set-style}. Specify a style name as an argument (case is not significant in C style ! names). The chosen style affects all buffers including those you will ! create later. @findex c-add-style --- 1032,1037 ---- To choose the style you want, use the command @kbd{M-x c-set-style}. Specify a style name as an argument (case is not significant in C style ! names). The chosen style only affects newly visited buffers, not those ! you are already editing. @findex c-add-style *************** recorded is called a @dfn{tag}. *** 1488,1492 **** * Find Tag:: Commands to find the definition of a specific tag. * Tags Search:: Using a tags table for searching and replacing. - * Tags Stepping:: Visiting files in a tags table, one by one. * List Tags:: Listing and finding tags defined in a file. @end menu --- 1491,1494 ---- *************** much like running a compilation; finding *** 1919,1939 **** @code{grep} matches works like finding the compilation errors. @xref{Compilation}. - - @node Tags Stepping - @subsection Stepping Through a Tags Table - @findex next-file - - If you wish to process all the files in the selected tags table, but - not in the specific ways that @kbd{M-x tags-search} and @kbd{M-x - tags-query-replace} do, you can use @kbd{M-x next-file} to visit the - files one by one. - - @table @kbd - @item C-u M-x next-file - Visit the first file in the tags table, and prepare to advance - sequentially by files. - @item M-x next-file - Visit the next file in the selected tags table. - @end table @node List Tags --- 1921,1924 ---- *************** commands. *** 2357,2362 **** @section C Mode ! This section describes special features available in C mode, C++ mode ! and Objective C mode. @menu --- 2342,2347 ---- @section C Mode ! This section describes special features available in C, C++, ! Objective-C and Java modes. @menu *************** past that place). *** 2433,2437 **** Move point backward to beginning of a C++ nomenclature section or word. With prefix argument @var{n}, move @var{n} times. If @var{n} is ! negative, move forward. @item M-x c-forward-into-nomenclature --- 2418,2424 ---- Move point backward to beginning of a C++ nomenclature section or word. With prefix argument @var{n}, move @var{n} times. If @var{n} is ! negative, move forward. C++ nomenclature means a symbol name in the ! style of NamingSymbolsWithMixedCaseAndNoUnderlines; each capital letter ! begins a section or word. @item M-x c-forward-into-nomenclature *************** With prefix argument @var{n}, move @var{ *** 2448,2452 **** the current line and may insert newlines. This feature is controlled by the variable @code{c-auto-newline}. The ``electric'' characters are ! @kbd{@{}, @kbd{@}}, @kbd{:}, @kbd{#}, @kbd{;}, @kbd{,}, @kbd{/} and @kbd{*}. --- 2435,2440 ---- the current line and may insert newlines. This feature is controlled by the variable @code{c-auto-newline}. The ``electric'' characters are ! @kbd{@{}, @kbd{@}}, @kbd{:}, @kbd{#}, @kbd{;}, @kbd{,}, @kbd{<}, ! @kbd{>}, @kbd{/} and @kbd{*}. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/rmail.texi emacs-19.32/man/rmail.texi *** emacs-19.31/man/rmail.texi Tue May 21 11:44:39 1996 --- emacs-19.32/man/rmail.texi Wed Jul 24 14:39:13 1996 *************** instead of storing the data in inbox fil *** 309,313 **** with POP if you compile it with the macro @code{MAIL_USE_POP} defined, and then install it setuid to @code{root}. It is safe to install ! @code{movemail} in this way. @cindex @code{MAILHOST} environment variable --- 309,314 ---- with POP if you compile it with the macro @code{MAIL_USE_POP} defined, and then install it setuid to @code{root}. It is safe to install ! @code{movemail} in this way. Note: @code{movemail} only works with POP3, ! not with older versions of POP. @cindex @code{MAILHOST} environment variable *************** opening a connection to the POP server. *** 319,323 **** variable specifies the machine to look for the server on. ! There are three reason for having separate Rmail files and inboxes. @enumerate --- 320,331 ---- variable specifies the machine to look for the server on. ! @vindex rmail-pop-password ! @vindex rmail-pop-password-required ! Accessing mail via POP may require a password. If the variable ! @code{rmail-pop-password} is non-@code{nil}, it specifies the password ! to use for POP. Alternatively, if @code{rmail-pop-password-required} is ! non-@code{nil}, then Rmail asks you for the password to use. ! ! There are two reasons for having separate Rmail files and inboxes. @enumerate *************** of them to Rmail's own format. *** 329,336 **** @item - The inbox file format usually doesn't provide a place for all the - information that Rmail records. - - @item It is very cumbersome to access an inbox file without danger of losing mail, because it is necessary to interlock with mail delivery. --- 337,340 ---- *************** the rest of Rmail, since only Rmail oper *** 341,344 **** --- 345,354 ---- @end enumerate + Rmail was written to use Babyl format as its internal format. Since + then, we have recognized that the usual inbox format on Unix and GNU + systems is adequate for the job, and we plan to change Rmail to use that + as its internal format. However, the Rmail file will still be separate + from the inbox file, even on systems where their format is the same. + When getting new mail, Rmail first copies the new mail from the inbox file to the Rmail file; then it saves the Rmail file; then it truncates *************** the reply command with a numeric argumen *** 657,664 **** sending the mail goes as usual (@pxref{Sending Mail}). You can edit the presupplied header fields if they are not right for you. You can also ! use the commands of Mail mode, including @kbd{C-c C-y} to yank in the ! message that you are replying to, and @kbd{C-c C-q} to fill what was ! thus yanked. You can also switch to the Rmail buffer, select a ! different message, switch back, and yank the new current message. @kindex M-m @r{(Rmail)} --- 667,674 ---- sending the mail goes as usual (@pxref{Sending Mail}). You can edit the presupplied header fields if they are not right for you. You can also ! use the commands of Mail mode (@pxref{Mail Mode}), including @kbd{C-c ! C-y} which yanks in the message that you are replying to. You can ! switch to the Rmail buffer, select a different message there, switch ! back, and yank the new current message. @kindex M-m @r{(Rmail)} diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/search.texi emacs-19.32/man/search.texi *** emacs-19.31/man/search.texi Wed May 15 10:44:08 1996 --- emacs-19.32/man/search.texi Mon Jul 15 16:19:09 1996 *************** match is recorded. *** 541,549 **** @item \` matches the empty string, provided it is at the beginning ! of the buffer. @item \' matches the empty string, provided it is at the end of ! the buffer. @item \= --- 541,549 ---- @item \` matches the empty string, provided it is at the beginning ! of the buffer or string being matched against. @item \' matches the empty string, provided it is at the end of ! the buffer or string being matched against. @item \= diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/sending.texi emacs-19.32/man/sending.texi *** emacs-19.31/man/sending.texi Tue May 21 11:44:41 1996 --- emacs-19.32/man/sending.texi Wed Jul 24 14:39:44 1996 *************** the end of the message to say more about *** 437,445 **** from the file @file{.signature} in your home directory. To insert your signature automatically, set the variable @code{mail-signature} ! non-@code{nil}; then starting a mail message automatically inserts the contents of your @file{.signature} file. If you want to omit your signature from a particular message, delete it from the buffer before you send the message. @kindex C-c C-y @r{(Mail mode)} @findex mail-yank-original --- 437,449 ---- from the file @file{.signature} in your home directory. To insert your signature automatically, set the variable @code{mail-signature} ! to @code{t}; then starting a mail message automatically inserts the contents of your @file{.signature} file. If you want to omit your signature from a particular message, delete it from the buffer before you send the message. + You can also set @code{mail-signature} to a string; then that string + is inserted automatically as your signature when you start editing a + message to send. + @kindex C-c C-y @r{(Mail mode)} @findex mail-yank-original *************** inserted lines, regardless of the value *** 467,471 **** (@code{mail-fill-yanked-message}) to fill the paragraphs of the yanked old message or messages. One use of @kbd{C-c C-q} fills all such ! paragraphs, each one individually. @xref{Filling}. @findex ispell-message --- 471,477 ---- (@code{mail-fill-yanked-message}) to fill the paragraphs of the yanked old message or messages. One use of @kbd{C-c C-q} fills all such ! paragraphs, each one individually. To fill a single paragraph of the ! quoted message, use @kbd{M-q}, after first setting the fill prefix ! appropriately to handle the indentation. @xref{Filling}. @findex ispell-message diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/texinfo.tex emacs-19.32/man/texinfo.tex *** emacs-19.31/man/texinfo.tex Sat May 25 20:21:23 1996 --- emacs-19.32/man/texinfo.tex Thu Aug 1 22:06:46 1996 *************** *** 36,40 **** % This automatically updates the version number based on RCS. \def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}} ! \deftexinfoversion$Revision: 2.172 $ \message{Loading texinfo package [Version \texinfoversion]:} --- 36,40 ---- % This automatically updates the version number based on RCS. \def\deftexinfoversion$#1: #2 ${\def\texinfoversion{#2}} ! \deftexinfoversion$Revision: 2.174 $ \message{Loading texinfo package [Version \texinfoversion]:} *************** where each line of input produces a line *** 627,630 **** --- 627,631 ---- % \def\ignoremorecommands{% + \let\defcodeindex = \relax \let\defcv = \relax \let\deffn = \relax *************** where each line of input produces a line *** 667,671 **** \let\clear = \relax \let\item = \relax - \let\message = \relax } --- 668,671 ---- *************** where each line of input produces a line *** 1191,1194 **** --- 1191,1195 ---- \let\file=\samp + \let\email=\samp \let\url=\samp % perhaps include a hypertex \special eventually diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/text.texi emacs-19.32/man/text.texi *** emacs-19.31/man/text.texi Wed May 15 10:58:05 1996 --- emacs-19.32/man/text.texi Sat Jun 29 16:36:16 1996 *************** choice (@pxref{Comments}). *** 428,437 **** Adaptive filling (see the following section) works for Auto Filling as ! well as for explicit fill commands. It will take a non-whitespace fill ! prefix automatically from the second line of a paragraph. In a mode ! where an indented line does not start a paragraph, it will take a ! whitespace fill prefix automatically from the first or second line. ! Non-whitespace fill prefixes can come automatically only from the second ! line, never from the first. Auto Fill mode does not refill entire paragraphs; it can break lines but --- 428,433 ---- Adaptive filling (see the following section) works for Auto Filling as ! well as for explicit fill commands. It takes a fill prefix ! automatically from the second or first line of a paragraph. Auto Fill mode does not refill entire paragraphs; it can break lines but *************** paragraph has just one line. You can tu *** 500,509 **** @code{adaptive-fill-mode} to @code{nil}. @vindex adaptive-fill-regexp The variable @code{adaptive-fill-regexp} determines what kinds of line beginnings can serve as a fill prefix: any characters at the start of ! the line which match this regular expression are used. However, ! whitespace can only be an automatic fill prefix in major modes where an ! indented line does not start a paragraph. @vindex adaptive-fill-function --- 496,517 ---- @code{adaptive-fill-mode} to @code{nil}. + Some major modes, including Text mode, treat whitespace at the + beginning of a line as a signal that this line starts a new paragraph. + It would be a mistake to copy text which implies the start of a + paragraph onto each line of the paragraph when filling it. Therefore, + adaptive filling does not accept a fill prefix from a line which is a + paragraph-starter. In particular, adaptive filling in Text mode does + not accept a fill prefix consisting of just whitespace. + + However, other modes including Indented Text mode (@pxref{Text Mode}) + do not consider whitespace as a signal to start a new paragraph. In + these modes, adaptive filling does accept a fill prefix consisting of + just whitespace, if the first or second line of a paragraph begins with + whitespace. + @vindex adaptive-fill-regexp The variable @code{adaptive-fill-regexp} determines what kinds of line beginnings can serve as a fill prefix: any characters at the start of ! the line which match this regular expression are used. @vindex adaptive-fill-function *************** local to the current buffer; until that *** 530,536 **** effect. The default is initially 70. @xref{Locals}. The easiest way to set @code{fill-column} is to use the command @kbd{C-x f} ! (@code{set-fill-column}). With no argument, it sets @code{fill-column} ! to the current horizontal position of point. With a numeric argument, ! it uses that as the new fill column. Emacs commands normally consider a period followed by two spaces or by --- 538,544 ---- effect. The default is initially 70. @xref{Locals}. The easiest way to set @code{fill-column} is to use the command @kbd{C-x f} ! (@code{set-fill-column}). With a numeric argument, it uses that as the ! new fill column. With just @kbd{C-u} as argument, it sets ! @code{fill-column} to the current horizontal position of point. Emacs commands normally consider a period followed by two spaces or by diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/trouble.texi emacs-19.32/man/trouble.texi *** emacs-19.31/man/trouble.texi Mon Mar 25 10:41:44 1996 --- emacs-19.32/man/trouble.texi Fri Jun 28 05:19:20 1996 *************** Boston, MA 02111-1307 USA *** 471,474 **** --- 471,482 ---- or ugly, or easy to fix, chances are we will want to. + @findex report-emacs-bug + A convenient way to send a bug report for Emacs is to use the command + @kbd{M-x report-emacs-bug}. This sets up a mail buffer (@pxref{Sending + Mail}) and automatically inserts @emph{some} of the essential + information. However, it cannot supply all the necessary information; + you should still read and follow the guidelines below, so you can enter + the other crucial information by hand before you send the message. + To enable maintainers to investigate a bug, your report should include all these things: diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/man/viper.texi emacs-19.32/man/viper.texi *** emacs-19.31/man/viper.texi Mon Feb 26 16:16:48 1996 --- emacs-19.32/man/viper.texi Fri Jun 21 22:55:59 1996 *************** *** 13,17 **** @title Viper Is a Package for Emacs Rebels @subtitle a Vi emulator for GNU Emacs 19 and XEmacs 19 ! @subtitle January 1996, Viper Version 2.85 @author Masahiko Sato (VIP 3.5) --- 13,17 ---- @title Viper Is a Package for Emacs Rebels @subtitle a Vi emulator for GNU Emacs 19 and XEmacs 19 ! @subtitle June 1996, Viper Version 2.90 @author Masahiko Sato (VIP 3.5) *************** *** 26,31 **** @noindent ! Copyright @copyright{} 1991 Aamod Sane @* ! Copyright @copyright{} 1994 Michael Kifer Permission is granted to make and distribute verbatim copies of --- 26,30 ---- @noindent ! Copyright @copyright{} 1995, 1996 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of *************** have to set it as a string inside double *** 1718,1725 **** @item vip-spell-function 'ispell-region Function used by the command @kbd{#c} to spell. ! @item ex-find-file-shell "csh" ! Shell used to interpret filenames. If you have problems with Csh, change ! to something else. Note that you have to set it as a string inside ! double quotes. @item ex-cycle-other-window t If @code{t}, @kbd{:n} and @kbd{:b} will cycle through files in another --- 1717,1735 ---- @item vip-spell-function 'ispell-region Function used by the command @kbd{#c} to spell. ! @item ex-nontrivial-find-file-function ! The value of this variable is the function used to find all files that ! match a wildcard. This is usually done when the user types @kbd{:e} and ! specifies a wildcard in the file name (or if the file name contains unusual ! symbols (e.g., a space). Viper provides two functions for this: one for ! Unix-like systems (@code{vip-ex-nontrivial-find-file-unix}) and one for ! DOS, W95, and NT (@code{vip-ex-nontrivial-find-file-ms}). If the default ! function doesn't quite do what you expect or if you prefer to use ``fancy'' ! shells, you may have to write your own version of this function and make it ! into the value of @code{ex-nontrivial-find-file-function}. Use ! @code{vip-ex-nontrivial-find-file-unix} and ! @code{vip-ex-nontrivial-find-file-ms} as examples. ! @vindex @code{ex-nontrivial-find-file-function}. ! @findex @code{vip-ex-nontrivial-find-file-ms} ! @findex @code{vip-ex-nontrivial-find-file-unix} @item ex-cycle-other-window t If @code{t}, @kbd{:n} and @kbd{:b} will cycle through files in another *************** can include a line like this in your @fi *** 1865,1869 **** @vindex @code{vip-custom-file-name} @vindex @code{vip-spell-function} - @vindex @code{ex-find-file-shell} @vindex @code{ex-cycle-other-window} @vindex @code{ex-cycle-through-non-files} --- 1875,1878 ---- *************** jjm@@hplb.hpl.hp.com (Jean-Jacques Morea *** 2884,2888 **** Launchbury), rxga@@ulysses.att.com, jamesm@@bga.com (D.J. Miller II), ascott@@fws214.intel.com (Andy Scott), toma@@convex.convex.com, ! gvr@@cs.brown.edu, dave@@hellgate.utah.edu, cook@@biostat.wisc.edu (Tom Cook), lindstro@@biostat.wisc.edu (Mary Lindstrom), edmonds@@edmonds.home.cs.ubc.ca (Brian Edmonds), mveiga@@dit.upm.es --- 2893,2897 ---- Launchbury), rxga@@ulysses.att.com, jamesm@@bga.com (D.J. Miller II), ascott@@fws214.intel.com (Andy Scott), toma@@convex.convex.com, ! dave@@hellgate.utah.edu, cook@@biostat.wisc.edu (Tom Cook), lindstro@@biostat.wisc.edu (Mary Lindstrom), edmonds@@edmonds.home.cs.ubc.ca (Brian Edmonds), mveiga@@dit.upm.es *************** csdayton@@midway.uchicago.edu (Soren Day *** 2900,2907 **** pradyut@@cs.uchicago.edu (Pradyut Shah), vrenjak@@sun1.racal.com (Milan Vrenjak), ! georger@@microcrafts.com (George V. Reilly), whicken@@dragon.parasoft.com (Wendell Hicken), terra@@diku.dk (Morten Welinder), ! James Kanze (kanze@@gabi-soft.fr) @end example --- 2909,2920 ---- pradyut@@cs.uchicago.edu (Pradyut Shah), vrenjak@@sun1.racal.com (Milan Vrenjak), ! gvr@@halcyon.com (George V. Reilly), whicken@@dragon.parasoft.com (Wendell Hicken), terra@@diku.dk (Morten Welinder), ! kanze@@gabi-soft.fr (James Kanze), ! hatazaki@@bach.convex.com (Takao Hatazaki), ! sawdey@@lcse.umn.edu (Aaron Sawdey), ! jobrien@@hchp.org (John O'Brien), ! mrb@@Eng.Sun.COM (Martin Buchholz) @end example diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/msdos/ChangeLog emacs-19.32/msdos/ChangeLog *** emacs-19.31/msdos/ChangeLog Sat May 25 15:32:24 1996 --- emacs-19.32/msdos/ChangeLog Thu Aug 1 01:11:38 1996 *************** *** 1,2 **** --- 1,15 ---- + Sat Jul 27 00:14:21 1996 Richard Stallman + + * Version 19.32 released. + + Wed Jul 24 11:04:24 1996 Eli Zaretskii + + * mainmake.v2 (TAGS): Make sure bin/etags.exe is current. Make + the rules always generate TAGS. + + Sun Jun 9 13:21:51 1996 Eli Zaretskii + + * sed2.inp: Don't undef MULTI_FRAME. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/msdos/mainmake.v2 emacs-19.32/msdos/mainmake.v2 *** emacs-19.31/msdos/mainmake.v2 Mon Apr 15 14:46:19 1996 --- emacs-19.32/msdos/mainmake.v2 Wed Jul 24 12:18:53 1996 *************** install: all *** 71,75 **** FRC: ! TAGS tags: lib-src cd lisp ../bin/etags [a-zA-Z]*.el term/[a-zA-Z]*.el --- 71,78 ---- FRC: ! TAGS tags: lib-src FRC ! cd lib-src ! if exist etags.exe mv -f etags.exe ../bin ! cd .. cd lisp ../bin/etags [a-zA-Z]*.el term/[a-zA-Z]*.el diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/msdos/sed2.inp emacs-19.32/msdos/sed2.inp *** emacs-19.31/msdos/sed2.inp Fri Apr 12 11:41:25 1996 --- emacs-19.32/msdos/sed2.inp Mon Jun 10 17:22:20 1996 *************** *** 42,46 **** / HAVE_TIMEVAL/a\ #endif /* not __DJGPP__ > 1 */ - /^#define MULTI_FRAME *$/s/define/undef/ s/^#define USER_FULL_NAME .*$/#define USER_FULL_NAME (getenv ("NAME"))/ s/^#undef STACK_DIRECTION *$/#define STACK_DIRECTION -1/ --- 42,45 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/nt/ChangeLog emacs-19.32/nt/ChangeLog *** emacs-19.31/nt/ChangeLog Sat May 25 15:32:39 1996 --- emacs-19.32/nt/ChangeLog Thu Aug 1 01:11:25 1996 *************** *** 1,2 **** --- 1,19 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + Tue Jul 16 19:22:57 1996 Andrew Innes + + * makefile.nt (clean): Use OBJDIR macro. + + Mon Jun 3 11:40:33 1996 Kim F. Storm + + * runemacs.c (CHOOSE_NEWEST_EXE): New parameter macro. + Not defined by default. + (WinMain): Add conditional testing CHOOSE_NEWEST_EXE. + (WinMain): Convert backslashes to slashes in env var values. + + * addpm.c (env_vars): Use slashes, not backslashes. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/nt/addpm.c emacs-19.32/nt/addpm.c *** emacs-19.31/nt/addpm.c Wed May 8 13:49:55 1996 --- emacs-19.32/nt/addpm.c Mon Jun 3 11:40:08 1996 *************** env_vars[] = *** 55,65 **** { {"emacs_dir", NULL}, ! {"EMACSLOADPATH", "%emacs_dir%\\lisp"}, {"SHELL", "%COMSPEC%"}, ! {"EMACSDATA", "%emacs_dir%\\etc"}, ! {"EMACSPATH", "%emacs_dir%\\bin"}, ! {"EMACSLOCKDIR", "%emacs_dir%\\lock"}, ! {"INFOPATH", "%emacs_dir%\\info"}, ! {"EMACSDOC", "%emacs_dir%\\etc"}, {"TERM", "cmd"} }; --- 55,65 ---- { {"emacs_dir", NULL}, ! {"EMACSLOADPATH", "%emacs_dir%/lisp"}, {"SHELL", "%COMSPEC%"}, ! {"EMACSDATA", "%emacs_dir%/etc"}, ! {"EMACSPATH", "%emacs_dir%/bin"}, ! {"EMACSLOCKDIR", "%emacs_dir%/lock"}, ! {"INFOPATH", "%emacs_dir%/info"}, ! {"EMACSDOC", "%emacs_dir%/etc"}, {"TERM", "cmd"} }; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/nt/makefile.nt emacs-19.32/nt/makefile.nt *** emacs-19.31/nt/makefile.nt Fri May 3 14:15:42 1996 --- emacs-19.32/nt/makefile.nt Tue Jul 16 19:19:28 1996 *************** CLEAN_CMD = $(MAKE) -f makefile.nt clean *** 143,147 **** clean:; - $(DEL) *~ *.pdb - $(DEL_TREE) deleted ! - $(DEL_TREE) obj - $(DEL_TREE) ..\bin - $(DEL) ..\etc\DOC ..\etc\DOC-X --- 143,147 ---- clean:; - $(DEL) *~ *.pdb - $(DEL_TREE) deleted ! - $(DEL_TREE) $(OBJDIR) - $(DEL_TREE) ..\bin - $(DEL) ..\etc\DOC ..\etc\DOC-X diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/nt/runemacs.c emacs-19.32/nt/runemacs.c *** emacs-19.31/nt/runemacs.c Fri May 3 12:34:26 1996 --- emacs-19.32/nt/runemacs.c Mon Jun 3 11:44:27 1996 *************** *** 6,9 **** --- 6,24 ---- console window lying around. */ + /* + You may want to define this if you want to be able to install updated + emacs binaries even when other users are using the current version. + The problem with some file servers (notably Novell) is that an open + file cannot be overwritten, deleted, or even renamed. So if someone + is running emacs.exe already, you cannot install a newer version. + By defining CHOOSE_NEWEST_EXE, you can name your new emacs.exe + something else which matches "emacs*.exe", and runemacs will + automatically select the newest emacs executeable in the bin directory. + (So you'll probably be able to delete the old version some hours/days + later). + */ + + /* #define CHOOSE_NEWEST_EXE */ + #define WIN32 *************** WinMain (HINSTANCE hSelf, HINSTANCE hPre *** 21,26 **** int wait_for_child = FALSE; DWORD ret_code = 0; ! char * new_cmdline; ! char * p; char modname[MAX_PATH]; --- 36,41 ---- int wait_for_child = FALSE; DWORD ret_code = 0; ! char *new_cmdline; ! char *p; char modname[MAX_PATH]; *************** WinMain (HINSTANCE hSelf, HINSTANCE hPre *** 33,53 **** new_cmdline = alloca (MAX_PATH + strlen (cmdline) + 1); strcpy (new_cmdline, modname); - strcat (new_cmdline, "\\emacs.exe "); ! /* append original arguments if any; first look for -wait as first ! argument, and apply that ourselves */ ! if (strncmp (cmdline, "-wait", 5) == 0) { ! wait_for_child = TRUE; ! cmdline += 5; } strcat (new_cmdline, cmdline); ! /* set emacs_dir variable if runemacs was in "%emacs_dir%\bin" */ if ((p = strrchr (modname, '\\')) && stricmp (p, "\\bin") == 0) ! { ! *p = 0; ! SetEnvironmentVariable ("emacs_dir", modname); ! } memset (&start, 0, sizeof (start)); --- 48,103 ---- new_cmdline = alloca (MAX_PATH + strlen (cmdline) + 1); strcpy (new_cmdline, modname); ! #ifdef CHOOSE_NEWEST_EXE { ! /* Silly hack to allow new versions to be installed on ! server even when current version is in use. */ ! ! char * best_name = alloca (MAX_PATH + 1); ! FILETIME best_time = {0,0}; ! WIN32_FIND_DATA wfd; ! HANDLE fh; ! p = new_cmdline + strlen (new_cmdline); ! strcpy (p, "\\emacs*.exe"); ! fh = FindFirstFile (new_cmdline, &wfd); ! if (fh == INVALID_HANDLE_VALUE) ! goto error; ! do ! { ! if (wfd.ftLastWriteTime.dwHighDateTime > best_time.dwHighDateTime ! || (wfd.ftLastWriteTime.dwHighDateTime == best_time.dwHighDateTime ! && wfd.ftLastWriteTime.dwLowDateTime > best_time.dwLowDateTime)) ! { ! best_time = wfd.ftLastWriteTime; ! strcpy (best_name, wfd.cFileName); ! } ! } ! while (FindNextFile (fh, &wfd)); ! FindClose (fh); ! *p++ = '\\'; ! strcpy (p, best_name); ! strcat (p, " "); } + #else + strcat (new_cmdline, "\\emacs.exe"); + #endif + + /* Append original arguments if any; first look for -wait as first + argument, and apply that ourselves. */ + if (strncmp (cmdline, "-wait", 5) == 0) + { + wait_for_child = TRUE; + cmdline += 5; + } strcat (new_cmdline, cmdline); ! /* Set emacs_dir variable if runemacs was in "%emacs_dir%\bin". */ if ((p = strrchr (modname, '\\')) && stricmp (p, "\\bin") == 0) ! { ! *p = 0; ! for (p = modname; *p; p++) ! if (*p == '\\') *p = '/'; ! SetEnvironmentVariable ("emacs_dir", modname); ! } memset (&start, 0, sizeof (start)); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/oldXMenu/AddSel.c emacs-19.32/oldXMenu/AddSel.c *** emacs-19.31/oldXMenu/AddSel.c Mon Nov 13 00:15:39 1995 --- emacs-19.32/oldXMenu/AddSel.c Wed Jun 12 13:41:17 1996 *************** XMenuAddSelection(display, menu, p_num, *** 63,68 **** * Fill the XMSelect structure. */ ! select->type = SELECTION; ! select->active = active; select->serial = -1; select->label = label; --- 63,77 ---- * Fill the XMSelect structure. */ ! if (!strcmp (label, "--") || !strcmp (label, "---")) ! { ! select->type = SEPARATOR; ! select->active = 0; ! } ! else ! { ! select->type = SELECTION; ! select->active = active; ! } ! select->serial = -1; select->label = label; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/oldXMenu/ChangeLog emacs-19.32/oldXMenu/ChangeLog *** emacs-19.31/oldXMenu/ChangeLog Sat May 25 15:32:51 1996 --- emacs-19.32/oldXMenu/ChangeLog Wed Jul 31 15:10:45 1996 *************** *** 1,2 **** --- 1,14 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + Wed Jun 12 13:35:36 1996 Richard Stallman + + * Internal.c (_XMRefreshSelection): Check for type SEPARATOR. + * InsSel.c (XMenuInsertSelection): Use SEPARATOR if nec. + * AddSel.c (XMenuAddSelection): Use SEPARATOR if nec. + + * XMenu.h: New alternative SEPARATOR. + Sat May 25 15:30:10 1996 Karl Heuer diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/oldXMenu/InsSel.c emacs-19.32/oldXMenu/InsSel.c *** emacs-19.31/oldXMenu/InsSel.c Thu Jan 4 15:55:46 1996 --- emacs-19.32/oldXMenu/InsSel.c Wed Jun 12 13:41:09 1996 *************** XMenuInsertSelection(menu, p_num, s_num, *** 74,78 **** * Fill the XMSelect structure. */ ! select->type = SELECTION; select->active = active; select->serial = -1; --- 74,88 ---- * Fill the XMSelect structure. */ ! if (!strcmp (label, "--") || !strcmp (label, "---")) ! { ! select->type = SEPARATOR; ! select->active = 0; ! } ! else ! { ! select->type = SELECTION; ! select->active = active; ! } ! select->active = active; select->serial = -1; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/oldXMenu/Internal.c emacs-19.32/oldXMenu/Internal.c *** emacs-19.31/oldXMenu/Internal.c Thu Jan 4 15:55:48 1996 --- emacs-19.32/oldXMenu/Internal.c Thu Jun 13 17:06:02 1996 *************** _XMRefreshSelection(display, menu, selec *** 934,938 **** register int bdr_width = menu->s_bdr_width; ! if (select->activated) { if (menu->menu_mode == INVERT) { XFillRectangle(display, --- 934,947 ---- register int bdr_width = menu->s_bdr_width; ! if (select->type == SEPARATOR) { ! XDrawLine(display, ! select->parent_p->window, ! menu->normal_select_GC, ! select->window_x, ! select->window_y + height / 2, ! select->window_x + width, ! select->window_y + height / 2); ! } ! else if (select->activated) { if (menu->menu_mode == INVERT) { XFillRectangle(display, diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/oldXMenu/XMenu.h emacs-19.32/oldXMenu/XMenu.h *** emacs-19.31/oldXMenu/XMenu.h Thu Jan 4 15:55:51 1996 --- emacs-19.32/oldXMenu/XMenu.h Wed Jun 12 13:38:22 1996 *************** extern char *_XMErrorList[]; *** 68,72 **** * An XMSelect is a menu selection object with a label and a data pointer. */ ! typedef enum _xmwintype {PANE, SELECTION, PL_HEADER, SL_HEADER} XMWType; typedef struct _xmwindow { --- 68,72 ---- * An XMSelect is a menu selection object with a label and a data pointer. */ ! typedef enum _xmwintype {PANE, SELECTION, PL_HEADER, SL_HEADER, SEPARATOR} XMWType; typedef struct _xmwindow { diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/.gdbinit emacs-19.32/src/.gdbinit *** emacs-19.31/src/.gdbinit Wed Nov 15 11:56:44 1995 --- emacs-19.32/src/.gdbinit Fri Jun 28 03:47:55 1996 *************** *** 4,7 **** --- 4,10 ---- set main + # Find lwlib source files too. + dir ../lwlib + # This should be EMACS_INT, but in some cases that is a macro. # long ought to work in all cases right now. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/ChangeLog emacs-19.32/src/ChangeLog *** emacs-19.31/src/ChangeLog Sat May 25 19:40:28 1996 --- emacs-19.32/src/ChangeLog Thu Aug 1 01:09:22 1996 *************** *** 1,2 **** --- 1,750 ---- + Wed Jul 31 13:52:46 1996 Richard Stallman + + * Version 19.32 released. + + * s/hpux10.h (C_SWITCH_X_SYSTEM, LD_SWITCH_X_DEFAULT): + Override to add /usr/contrib directories. + + Wed Jul 31 12:51:52 1996 Richard Stallman + + * xterm.c (XTread_socket): Delete the code to pass menu bar keys + to the toolkit alone. + (XTread_socket): Don't fail to pass button events to toolkit. + + Mon Jul 29 18:35:59 1996 Richard Stallman + + * xterm.c (XTread_socket): Pass keys in menu bar to toolkit alone + only for Motif. + + * xdisp.c (prepare_menu_bars): Conditionalize previous change. + + Sat Jul 27 00:14:21 1996 Richard Stallman + + * filelock.c (lock_file_owner_name): Always initialize the_pw. + + * xterm.c (XTread_socket): Fixing previous change: + Clear last_mouse_press_frame on non-menu-bar ButtonPress. + Always use last_mouse_press_frame as frame for ButtonRelease. + But ignore the event if frame's output_data.x is null. + Save the ButtonRelease only if USE_MOTIF. + (last_mouse_press_frame): This is now a Lisp object. + (syms_of_xterm): Initialize and staticpro it. + + * xmenu.c (pending_menu_activation): Don't initialize. Not static. + (set_frame_menubar): If no saved_menu_event yet, set deep_p. + Don't clear pending_menu_activation here. + + * xmenu.c (Fx_popup_dialog): Don't fail to initialize WINDOW. + + * xdisp.c (prepare_menu_bars): Clear pending_menu_activation. + + * print.c: When printing into a buffer, generate all the text + first, then insert it all at once. + (print_buffer): New variable. + (print_buffer_size, print_buffer_pos): New variables. + (PRINTPREPARE): Allocate print_buffer. + (PRINTFINISH): Free print_buffer after inserting its contents. + (printchar, strout): Output into print_buffer. + (print_string): If printcharfun is nil, use strout. + + Fri Jul 26 16:42:26 1996 Marcus Daniels + + * xmenu.c (pending_menu_activation): New variable. + (x_activate_menubar): Don't call set_frame_menubar for + ButtonRelease events. Instead, set pending_menu_activation. + (set_frame_menubar): If pending_menu_activation, set deep_p. + + * xterm.c (last_mouse_press_frame): New variable. + (XTread_socket): Store a saved_button_event for ButtonRelease. + + Thu Jul 25 04:49:51 1996 Marcus Daniels + + * xmenu.c (set_frame_menubar): Use -1 for call_data + in the deep_p = 0 case. + + Wed Jul 24 21:40:29 1996 Geoff Voelker + + * ntinevt.c (win32_read_socket): Never block reading from input queue. + + Wed Jul 24 00:20:58 1996 Marcus Daniels + + * editfns.c (Fencode_time): Assign to tm.tm_gmtoff for NEXTSTEP, + since timezone environment variable is ignored. + + Tue Jul 23 14:29:12 1996 Richard Stallman + + * buffer.c (buffer_permanent_local_flags): New variable. + (init_buffer_once): Initialize it. + (reset_buffer_local_variables): New argument PERMANENT_TOO. + Callers changed. Now declared static. + + * s/irix6-0.h [__GNUC__] (C_DEBUG_SWITCH): Define as -g3. + + * m/mips.h, m/iris4.h, m/iris5d.h (LIBS_MACHINE) [__GNUC__ and ABIN32]: + Define as empty. + + Tue Jul 23 02:59:43 1996 Paul Eggert + + * editfns.c (Fdecode_time, difftm): Work even if tm_year represents + negative years; this is possible with 64-bit time_t values. + + Sat Jul 20 02:59:43 1996 Karl Heuer + + * fileio.c (check_writable): Use euidaccess, not eaccess. + + Sat Jul 20 00:43:14 1996 Erik Naggum + + * intervals.c (balance_intervals_internal): Recurse directly. + + Fri Jul 19 15:47:06 1996 Eli Zaretskii + + * unexec.c (copy_text_and_data) [DJGPP >= 2]: Switch off two bits + in `_crt0_startup_flags' so they don't go into the dumped Emacs. + Restore the value of `_crt0_startup_flags' after .text and .data + were dumped. + + Fri Jul 19 15:37:36 1996 Karl Heuer + + * s/irix5-0.h (_BSD_SIGNALS): Define. + * s/irix6-0.h (SA_RESTART): Add #undef. + + Tue Jul 16 19:21:25 1996 Andrew Innes + + * w32term.c (w32_read_socket): Need to erase background + immediately before repainting exposed region. + + * makefile.nt (DOC, clean): Use OBJDIR macro. + + Tue Jul 16 18:43:10 1996 Karl Heuer + + * xfns.c (Fx_create_frame): Do xlwmenu hack only if USE_LUCID. + + * m/alpha.h, unexelf.c: Undo Jul 15 changes. + * config.in, data.c, keyboard.c, process.c: Undo Jul 15 changes. + * cm.h, sysdep.c, terminfo.c: Undo Jul 15 and Jul 16 changes. + + Tue Jul 16 04:58:21 1996 Karl Heuer + + * cm.h, terminfo.c, sysdep.c: Test HAVE_TERMIOS rather than the + automatically-generated HAVE_TERMIOS_H, in case is + present but unusable. + + Tue Jul 16 01:45:28 1996 Richard Stallman + + * fns.c (Fy_or_n_p): Pass 3rd arg to Flookup_key. + + * s/hpux10.h (LIBS_TERMCAP): New definition. + + Mon Jul 15 19:53:14 1996 Karl Heuer + + * window.c (struct save_window_data, struct saved_window): First + placeholder member is EMACS_INT, not int. + + * print.c (print): Fix args in strout calls. + + * xterm.h (struct x_output): Member saved_button_event replaced by + saved_menu_event. + * xmenu.c (x_activate_menubar): Allow any event, not just ButtonPress. + * xterm.c (SET_SAVED_MENU_EVENT): New macro. + (SET_SAVED_BUTTON_EVENT, SET_SAVED_KEY_EVENT): New macros. + (XTread_socket): Defer key events as well as button presses. + + * frame.c (Qmouse_leave_buffer_hook): Delete redundant definition. + (syms_of_frame_1): Delete the duplicate assignment and staticpro. + * lisp.h (Qmouse_leave_buffer_hook, Qfont): Declare here. + * floatfns.c (Qarith_error): Delete redundant definition. + * xfns.c (Qfont): Delete redundant definition. + (syms_of_xfns): Delete the duplicate assignment and staticpro. + * w32fns.c (Qfont): Delete redundant definition. + (syms_of_win32fns): Delete the duplicate assignment and staticpro. + * xfns.c (xlwmenu_default_font): Declare, but don't define. + * xselect.c (last_event_timestamp): Declare, but don't define. + + Mon Jul 15 17:30:15 1996 David Mosberger-Tang + + * m/alpha.h (TEXT_START, DATA_START, DATA_SEG_BITS, UNEXEC, DATA_END): + Omit these definitions if ELF. + (LINUX_SBRK_BUG): Omit this if using a recent GNU library. + [__ELF__] (C_SWITCH_MACHINE): Define. + (NO_TERMIO): Define this unconditionally. + (COFF): Omit this if ELF. + * config.in (HAVE_TERMIOS_H): Add #undef. + * cm.h [HAVE_TERMIOS_H]: Declare ospeed as speed_t. + * sysdep.c [HAVE_TERMIOS_H]: Likewise. + * dispnew.c: Don't delare ospeed; cm.h already did it. + * terminfo.c: Use . + [HAVE_TERMIOS_H]: Declare ospeed as speed_t. + [USG]: Include . + * data.c (arith_error): Don't reinstall sig handler if POSIX_SIGNALS. + * keyboard.c (input_available_signal, interrupt_signal): Likewise. + * process.c (create_process_1, sigchld_handler): Likewise. + * unexelf.c: Add 64-bit ELF and Alpha/ELF support. + + Sat Jul 13 20:05:47 1996 Richard Stallman + + * search.c (Fmatch_data): If no matching done yet, return Qnil. + + Sat Jul 13 20:03:19 1996 Paul Eggert + + * vmstime.c (sys_gmtime): Don't assume year < 2000. + + Sat Jul 13 13:46:51 1996 Karl Heuer + + * process.c (wait_reading_process_input) [hpux]: Workaround for + annoying messages. + + Fri Jul 12 21:02:21 1996 Richard Stallman + + * indent.c (Fvertical_motion): Doc fix. + + Thu Jul 11 20:25:00 1996 Andrew Innes + + * w32fns.c (win32_wnd_proc): Handle WM_ERASEBKGND and + WM_PALETTECHANGED messages inline (as they should be). + + * w32term.c (w32_read_socket): Remove unused WM_ERASEBKGND code. + No need to erase background now on (delayed) WM_PAINT. Move + WM_PALETTECHANGED processing to raw input thread. + + Thu Jul 11 20:05:05 1996 Richard Stallman + + * keyboard.c (menu_bar_item): Skip menu-bar equiv keys data + to get just the keymap. + + * s/irix5-0.h [__GNUC__] (C_DEBUG_SWITCH): New definition. + + Thu Jul 11 19:40:48 1996 David Mosberger-Tang + + * mem-limits.h (lim_data): Make this an unsigned long. + + Thu Jul 11 19:32:50 1996 Bill Mann + + * s/usg5-4-3.h: New file. + + Thu Jul 11 19:22:46 1996 Marcus Daniels + + * xterm.c (XTread_socket): Add #ifdef for previous change. + + Thu Jul 11 19:15:16 1996 Richard Stallman + + * buffer.c (syms_of_buffer): Doc fix. + + Mon Jul 8 00:31:57 1996 Roland McGrath + + * mem-limits.h [_LIBC]: Use weak_extern instead of weak_symbol for + __data_start. + + Sun Jul 7 19:51:11 1996 Michael I. Bushnell, p/BSG + + * s/gnu.h: Enable use of ncurses library cleanly. + + Sun Jul 7 18:55:30 1996 Karl Heuer + + * xterm.c: Undo previous change. + (XTread_socket): Better way to avoid sending toolkit-specific + events to Emacs. + + Sun Jul 7 18:45:37 1996 Richard Stallman + + * xmenu.c (popup_get_selection): For a ButtonRelease on the proper + display, don't queue it, and always deactivate the menu. + + Sun Jul 7 18:40:06 1996 Eli Zaretskii + + * msdos.c (IT_menu_display): Display control characters as ^X. + (XMenuAddPane, XMenuAddSelection): Adjust menu width for control + characters (displayed as ^X). + + * dired.c (file_name_completion): Set `stat' flags to avoid + computing expensive fields in struct stat (makes filename + completion much faster). + + * fileio.c (Fcopy_file): Use st_ino under DJGPP v2 and later to + prevent copying file into itself. + (check_executable): DJGPP v2 `stat' doesn't need to be augmented + in case of executable files. + (Ffile_modes): Use `stat' results as is in DJGPP v2 and later. + + Thu Jul 4 15:54:33 1996 Eli Zaretskii + + * msdos.c (dostounix_filename): On caseless filesystems, downcase + the filename. + (unixtodos_filename): Downcase the drive letter. + (init_environment): Downcase the pathnames in the environment only + when running on caseless filesystems. + + Wed Jul 03 14:02:26 1996 Andrew Innes + + * nt.c (normalize_filename): Always lower-case drive letters, even + on systems that preserve case in filenames. + + * fileio.c (DRIVE_LETTER) [WINDOWSNT]: Lower-case drive letters. + + Fri Jul 05 13:03:57 1996 Andrew Innes + + * w32term.c (x_set_mouse_pixel_position): Adjust coords by frame + position. + (x_set_mouse_position): Call x_set_mouse_pixel_position. + + Fri Jul 05 13:03:57 1996 Andrew Innes + + * nt.c (sys_rename): Do not delete newname if only changing case. + On Windows 95, use our version of mktemp (not the MSVC version) + and give the temp name a long extension to ensure the final rename + works as expected. + + Wed Jul 3 15:04:11 1996 Eli Zaretskii + + * callproc.c (Fcall_process) [MSDOS]: Initialize fd[0]; unlink + `tempfile' in case of errors. + (Fcall_process): When fd_error is negative, + don't close fd[0] if it's same as filefd. + + Wed Jul 3 11:36:51 1996 Eli Zaretskii + + * callproc.c (Fcall_process) [MSDOS]: Make the `tempfile' + parameter passed to `report_file_error' be a Lisp string. + (Fcall_process): If stderr is redirected to NULL_DEVICE, make + `report_file_error' print the name of device. Make the arguments + a cons cell. + + Sat Jul 6 09:27:26 1996 Richard Stallman + + * indent.c (Fvertical_motion): Doc fix. + + Wed Jul 3 01:10:23 1996 Marcus Daniels + + * xterm.c (XTread_socket): Use lw_tookit_related_event_p to + avoid sending toolkit-specific events to Emacs. + + Mon Jul 1 10:54:44 1996 Richard Stallman + + * m/alpha.h (HAVE_X11R4, HAVE_X11R5): Definitions deleted + since xterm.h and config.h should take care of them. + + * xselect.c (x_clear_frame_selections): Don't call + redisplay_preserve_echo_area here. + + Sun Jun 30 14:57:35 1996 Richard Stallman + + * systty.h: Delete spurious period from last change. + + Mon Jul 1 15:32:28 1996 Eli Zaretskii + + * fileio.c (DRIVE_LETTER) [MSDOS]: Lower-case drive letters. + + * msdos.c (msdos_downcase_filename): Always lower-case drive + letters, even on systems that preserve case in filenames. + + Sat Jun 29 01:04:17 1996 Richard Stallman + + * s/sol2-5.h (LIB_MOTIF): Fix typo. + + * emacs.c (main): Add `GNU Emacs' to the response to --version. + + * xfns.c (Fx_create_frame): Gcpro parms, parent, and name. + + * systty.h (GETPGRP_NO_ARG): Always define it, if __GNU_LIBRARY__. + + Fri Jun 28 02:30:47 1996 Richard Stallman + + * frame.c (make_frame_without_minibuffer): GCPRO the frame f. + + * config.in (AMPERSAND_FULL_NAME): Defined by default. + + * s/sol2-5.h (LIB_MOTIF): New definition. + + * emacs.c (standard_args): Delete `-rn' option. + + * .gdbinit: Add `dir ../lwlib'. + + * print.c (print): Obey Vprint_length for vectors, bitvectors. + + * fileio.c (check_executable): Use euidaccess, not eaccess. + + * config.in (HAVE_EUIDACCESS): This replaces HAVE_EACCESS. + + * xterm.h: Don't define HAVE_X11R5 here. + + * config.in (HAVE_X11R5): Add #undef. + + * unexhp9k800.c (unexec): Cast result of sbrk. + (run_time_remap): Cat arg to brk. + + Thu Jun 27 04:16:11 1996 Richard Stallman + + * xterm.c (x_connection_closed): Call clear_waiting_for_input. + + * keyboard.c (modify_event_symbol): Add properly to *symbol_table. + + Wed Jun 26 00:42:19 1996 Richard Stallman + + * xterm.c (x_connection_closed): Add newline when printing error + message on stderr. + (XTread_socket, Xatom_wm_save_yourself clause): + Don't call XSetCommand if f is 0. + (x_error_quitter): Delete newline from sprintf string. + + * xdisp.c (redisplay_internal): Use last_had_star to decide + whether to update the mode line to update the star. + (update_menu_bar): Likewise. + Also, don't set w->update_mode_line for frames that use + set_frame_menubar. + (redisplay_internal, mark_window_display_accurate): + Set last_had_star. + + * window.h (struct window): New field, last_had_star. + + Tue Jun 25 17:32:01 1996 Richard Stallman + + * xterm.c (x_connection_signal): Just return after calling `signal'. + (X_CONNECTION_LOCK_FLAG): Definition deleted. + (x_connection_signal_dpyinfo): Variable deleted. + (x_connection_signal_1): Function deleted. + (x_connection_close_if_hung): Function deleted. + + * indent.c (Fmove_to_column): Go after invis chars at the goal column. + + Mon Jun 24 20:22:39 1996 Richard Stallman + + * xterm.c (x_connection_closed): If waiting_for_input, + call quit_throw_to_read_char. + + Mon Jun 24 15:08:24 1996 Paul Eggert + + * unexelf.c (unexec): Round up section header offset to bss alignment + before deciding whether it's after the bss section. + + Sun Jun 23 15:20:20 1996 Richard Stallman + + * xfns.c (x_real_positions): Don't call x_uncatch_errors twice. + + * indent.c (current_column_1): Add declaration. + + Sat Jun 22 02:54:08 1996 Richard Stallman + + * indent.c: Make current-column, move-to-column and current-indentation + handle invisible chars (both text properties and overlays). + (skip_invisible): New function. + (Fmove_to_column): Use skip_invisible. Get rid of `retry' label. + (compute_motion): Use skip_invisible. + (current_column_1): New function. + (current_column): Use current_column_1 if might have invisible text. + + * data.c (Fdefalias): Doc fix. + + * s/gnu-linux.h (LD_SWITCH_SYSTEM): Just one definition. + Don't use prefix-args here because Makefile.in + does that when necessary. + + Fri Jun 21 02:23:38 1996 Richard Stallman + + * s/sco5.h: New file. + + * s/gnu-linux.h: Renamed from lignux.h. + (SYSTEM_TYPE): Changed to gnu/linux. + + * callproc.c (Fcall_process): Fix previous change. + + * xterm.c (x_iconify_frame): If frame is invisible, + explicitly mark it as iconified. + + * keyboard.c (kbd_buffer_get_event): Don't call x_activate_menubar + for a deleted frame. + + Wed Jun 19 17:15:32 1996 Richard Stallman + + * s/sol2-4.h (LD_SWITCH_SYSTEM): Use no space after -L and -R. + + Tue Jun 18 21:24:13 1996 Nico Francois + + * w32fns.c (Vwin32_alt_is_meta): New variable. + (win32_get_modifiers): Map Alt to alt_modifier if required. + (syms_of_win32fns): DEFVAR new variable. + + * ntinevt.c (Vwin32_alt_is_meta): Declared. + (win32_kbd_mods_to_emacs): Map Alt to alt_modifier if required. + + Sun Jun 16 14:59:20 1996 Richard Stallman + + * callproc.c (Fcall_process): Handle t or nil as STDERR_FILE. + + * s/hpux10.h (HPUX10): New macro. + + Fri Jun 14 14:34:05 1996 Andrew Innes + + * w32fns.c (win32_wnd_proc): No need to forward WM_ERASEBKGND to + main thread. + + * w32term.c (w32_read_socket): Erase update rect on WM_PAINT, so + no need to process WM_ERASEBKGND. + + Thu Jun 13 12:40:47 1996 Richard Stallman + + * xmenu.c (Qmenu_alias): New variable. + (syms_of_xmenu): Initialize it. + (menu_item_equiv_key): Check this property on the definition. + + * fileio.c (Fexpand_file_name): When simplifying /foo/.., + keep the initial slash. + + * s/hpux10.h (LIBS_SYSTEM): Two new definitions (and #undef first). + + Wed Jun 12 17:46:49 1996 Richard Stallman + + * emacs.c (main): For SIGHUP, use sigblock and sigunblock, + not sigblockx and sigunblockx. + + * buffer.c (Fkill_buffer): Doc fix. + + Wed Jun 12 14:26:40 1996 Andrew Innes + + * ntproc.c (restrict_dos_process): Variable deleted. + (sys_spawnve): Restrict DOS processes on NT as well. + + * nt.c: Delete restrict_dos_process. + + Wed Jun 12 14:26:40 1996 Andrew Innes + + * nt.c (restrict_dos_process): Renamed from can_run_dos_process. + (init_ntproc): Refer to restrict_dos_process. + + * ntproc.c (restrict_dos_process): Renamed from can_run_dos_process. + (sys_spawnve): Refer to restrict_dos_process. + + Wed Jun 12 11:49:34 1996 Richard Stallman + + * syssignal.h (sigunblockx): Use sigunblock. + + Tue Jun 11 15:47:01 1996 Richard Stallman + + * process.c (wait_reading_process_input): Move the O_NONBLOCK and + O_NDELAY conditionals out of the EWOULDBLOCK conditional. + + Mon Jun 10 16:28:50 1996 Richard Stallman + + * keymap.c (Fset_keymap_parent): Return early if KEYMAP already has + the proper parent. + + * s/lignux.h [__ELF__] (LD_SWITCH_SYSTEM): Define it. + + * frame.c (Fmake_terminal_frame): Test MSDOS, not __MSDOS__. + + * xdisp.c (redisplay_internal): Use FRAME_WINDOW_P. + (decode_mode_spec): Likewise. + + * minibuf.c (choose_minibuf_frame): Eliminate + MSDOS-non-MULTI_FRAME conditional. + + * dispnew.c (change_frame_size, remake_frame_glyphs): + Use FRAME_WINDOW_P. + + * msdos.c (check_x): Fix error message. + + Sun Jun 9 12:14:57 1996 Eli Zaretskii + + * xfaces.c (init_frame_faces): Build faces for an MSDOS frame + like for X frame. + (Fmake_face_internal): Call `ensure_face_ready' for MSDOS frames. + (Fset_face_attribute_internal): Support face attributes for MSDOS + frames. + + * xdisp.c (redisplay_internal): Use `Vterminal_frame' and other + termcap frame code on MSDOS as well. + (display_text_line) [HAVE_FACES]: Support faces on MSDOS. + (decode_mode_spec): Return frame name on MSDOS like for termcap + frames. + + * window.c (Fset_window_configuration) [HAVE_WINDOW_SYSTEM]: Call + `x_set_menu_bar_lines' on MSDOS as well. + + * msdos.h (check_x): Macro definition deleted. + (DisplayWidth): Use `selected_frame'. + (DisplayHeight): Use `selected_frame'. + (x_mouse_leave): Remove; it's not used. + + * msdos.c (x_set_menu_bar_lines): New function, copied from xfns.c. + (IT_set_frame_parameters): Use selected_frame instead of + the_only_frame. + (internal_terminal_init): Use selected_frame instead of the_only_frame. + (check_x): New function, replacing macro in msdos.h. + (XMenuActivate): Use selected_frame instead of + the_only_frame. Don't let the title for the "Buffers" popup + include a number when it is split into several menus. + + * minibuf.c (choose_minibuf_frame): Support multiple frames on MSDOS. + + * frame.h (FRAME_MSDOS_P): A new macro for MSDOS frames. + + * frame.c (Qpc): New variable. + (syms_of_frame_1): Define and staticpro it. + (Fframep): Support MSDOS frames. + (make_terminal_frame, Fmake_terminal_frame): Support MSDOS frames. + (Fset_mouse_position, Fset_mouse_pixel_position): Support MSDOS frames. + (Fframe_parameters, Fmodify_frame_parameters): Support MSDOS frames. + + * dosfns.c (Fset_mouse_position): Remove the DOS-specific + definition (it's defined on `frame.c'). + (syms_of_dosfns): Remove defsubr of `Fset_mouse_position'. + + * dispnew.c (Fredraw_frame, remake_frame_glyphs) + (direct_output_for_insert, change_frame_size): Support MSDOS frames. + + Mon Jun 10 14:01:16 1996 Richard Stallman + + * keymap.c (fix_submap_inheritance): If parent_entry is not a keymap, + use nil instead. + + * alloc.c (mark_object): Do set ARRAY_MARK_FLAG for bool-vectors. + + Mon Jun 10 14:56:38 1996 Andrew Innes + + * w32fns.c (x_to_win32_font): Allow any quality fonts. + + Sun Jun 9 16:12:36 1996 Richard Stallman + + * keyboard.c (read_char): Use unsigned to compare against + the size of Vkeyboard_translate_table. + Check size for char-table too. + + * s/freebsd.h (DONT_REOPEN_PTY): New definition. + + * process.c (create_process): Add DONT_OPEN_PTY conditional. + + Fri Jun 07 15:56:21 1996 Andrew Innes + + * nt.c (init_environment): Read PRELOAD_WINSOCK from registry if + not set in environment. + + (winsock_inuse) [HAVE_SOCKETS]: New variable. + (have_winsock) [HAVE_SOCKETS]: Obsolete variable removed. + + (term_winsock) [HAVE_SOCKETS]: Only unload winsock library if there + are no active sockets still open, and if the cleanup function + succeeds. Return TRUE if winsock is unloaded. + + (init_winsock) [HAVE_SOCKETS]: Load winsock if not already loaded, + and return TRUE if winsock support is available. Unload winsock + immediately if new parameter load_now is false. Check that + WSAStartup supports the winsock version we requested. + + (set_errno, check_errno, sys_socket, sys_bind, sys_connect, + sys_htons, sys_ntohs, sys_inet_addr, sys_gethostname, + sys_gethostbyname, sys_getservbyname, sys_close, sys_read, + sys_write) [HAVE_SOCKETS]: Check winsock_lib instead of + have_winsock to determine if winsock support is available. + + (sys_socket, sys_close) [HAVE_SOCKETS]: Count sockets in use. + + (init_ntproc) [HAVE_SOCKETS]: Only load winsock library on startup + if PRELOAD_WINSOCK is set in environment (or registry). + + * ntproc.c (Fwin32_has_winsock, + Fwin32_unload_winsock) [HAVE_SOCKETS]: New functions. + (syms_of_ntproc) [HAVE_SOCKETS]: defsubr them. + + * process.c (Fopen_network_stream) [WINDOWSNT]: Ensure Windows + socket library is loaded if available. + + Fri Jun 7 13:09:13 1996 Marcus Daniels + + * xterm.c (XTread_socket): Use XtAppNextEvent when using + toolkit configurations. + + Fri Jun 07 15:56:21 1996 Andrew Innes + + * nt.c (sys_mktemp): Complete rewrite. + + Fri Jun 07 15:56:21 1996 Andrew Innes + + * ntproc.c (sys_kill): Don't try to terminate a DOS process. + + Thu Jun 06 13:35:47 1996 Andrew Innes + + * fileio.c (Ffile_name_directory) [WINDOWSNT]: Remove previous + change, which was incorrect and isn't strictly required. + + Thu Jun 6 19:15:34 1996 Eli Zaretskii + + * xfaces.c (Fset_face_attribute_internal) [MSDOS]: Don't mask + bright color bit in background colors. + + * msdos.c (bright_bg): New function, enables bright background colors. + (dos_set_window_size): Move code to `bright_bg'. + (IT_set_terminal_modes): Enable bright background colors. + (IT_set_frame_parameters): Don't mask bright color bit in + background colors. Record colors on `termscript' file. + (internal_terminal_init): Enable bright background colors. Fix + default colors setting from $EMACSCOLORS. + + Fri Jun 7 00:46:12 1996 Geoff Voelker + + * w32fns.c (sync_modifiers): New function. + (w32_wnd_proc): Synchronize modifiers on each key down. + + Thu Jun 6 18:46:08 1996 Andrew Innes + + * nt.c (init_winsock): Dynamically link to SetHandleInformation. + (sys_socket): If possible, use SetHandleInformation to make socket + handle non-inheritable to avoid a bug in NT. + + Wed Jun 5 18:29:06 1996 Richard Stallman + + * keymap.c (Fkeymap_parent, Fset_keymap_parent): New functions. + (fix_submap_inheritance): New function. + (access_keymap): Use fix_submap_inheritance. + + Wed Jun 5 03:25:19 1996 Paul Eggert + + * editfns.c: (set_time_zone_rule): + Work around localtime cache bug in SunOS 4.1.3_U1 and SunOS 4.1.4. + + Tue Jun 4 10:57:59 1996 Geoff Voelker + + * w32term.c (w32_read_socket): If the dead key was produced using + AltGr and has a valid AltGr scan code, it's a valid key and + should not be discarded. + + Mon Jun 03 13:35:00 1996 Kim Storm + + * ntproc.c (Vwin32_downcase_file_names): New variable. + (syms_of_win32fns): DEFVAR it. + + * fileio.c (DRIVE_LETTER): [DOS_NT] New macro. + (expand_file_name): Apply DRIVE_LETTER macro to drive names. + + * nt.c (normalize_filename): New function. + (dostounix_filename, unixtodos_filename): Use it. + (readdir): Convert upper case file names to lower case + if win32-downcase-file-names is non-nil. + + Fri May 31 19:50:08 1996 Andrew Innes + + * fileio.c (Fexpand_file_name) [WINDOWSNT]: Don't strip trailing / + when newdir is just "//". + (Ffile_name_directory) [WINDOWSNT]: Return Qnil if filename is a + partial UNC name such as "//foo". + + Fri May 31 15:04:34 1996 Richard Stallman + + * xmenu.c (single_submenu): Handle non-keymap lists like symbols. + + * w32fns.c (reset_modifiers): Only clear a modifier if the + modifier key has been detected to have been released since + Emacs lost focus. + (win32_wnd_proc): Have Windows translate VK_NUMLOCK and + VK_SCROLL key downs; don't reset the modifier state when + Emacs loses focus. + + Thu May 30 19:09:36 1996 Richard Stallman + + * buffer.c (Fpop_to_buffer): Doc fix. + + * window.c (Fdisplay_buffer): Doc fix. + + Mon May 27 20:53:06 1996 Karl Heuer + + * s/sol2.h (LIBS_SYSTEM): Define this. + Sat May 25 15:30:10 1996 Karl Heuer *************** Fri May 24 15:06:04 1996 Andrew Innes *** 23,27 **** Add new handling code for WM_VSCROLL and WM_MOUSEMOVE events. Only filter WM_MOUSEMOVE events when a button is held down. ! Always pass on message to DefWindowProc after calling TranslateMessage. Reset keyboard modifiers when losing focus. --- 771,775 ---- Add new handling code for WM_VSCROLL and WM_MOUSEMOVE events. Only filter WM_MOUSEMOVE events when a button is held down. ! Always pass on message to DefWindowProc after calling TranslateMessage. Reset keyboard modifiers when losing focus. *************** Fri May 03 16:31:54 1996 Andrew Innes *** 252,256 **** scroll_bar_up_arrow, scroll_bar_down_arrow. (win32_scroll_bar_click): New enum constant. ! Fri May 3 14:30:22 1996 Andrw Innes --- 1000,1004 ---- scroll_bar_up_arrow, scroll_bar_down_arrow. (win32_scroll_bar_click): New enum constant. ! Fri May 3 14:30:22 1996 Andrw Innes *************** Fri May 3 14:30:22 1996 Andrw Innes ! * process.c (wait_reading_process_input, both definitions): If wait_for_cell, don't call timer_check, and use detect_input_pending instead of detect_input_pending_run_timers. ! * frame.c (Fframe_parameters, both definitions): Get sizes from FRAME_NEW_HEIGHT, FRAME_NEW_WIDTH if they are nonzero. --- 1449,1457 ---- Sun Apr 21 03:42:37 1996 Richard Stallman ! * process.c (wait_reading_process_input, both definitions): If wait_for_cell, don't call timer_check, and use detect_input_pending instead of detect_input_pending_run_timers. ! * frame.c (Fframe_parameters, both definitions): Get sizes from FRAME_NEW_HEIGHT, FRAME_NEW_WIDTH if they are nonzero. *************** Wed Apr 17 23:38:46 1996 Richard Stallm *** 731,735 **** * xterm.h (CHECK_X_FRAME): Macro deleted. ! Tue Apr 16 18:29:34 1996 Richard Stallman --- 1479,1483 ---- * xterm.h (CHECK_X_FRAME): Macro deleted. ! Tue Apr 16 18:29:34 1996 Richard Stallman *************** Sat Apr 13 00:36:55 1996 Richard Stallm *** 775,781 **** * process.c (wait_reading_process_input, both definitions): Use plain detect_input_pending just before the select call. ! (wait_reading_process_input) [subprocesses]: Get rid of the loop around the detect_input_pending call. ! * editfns.c (Fcompare_buffer_substrings): Fix dumb bug handling buffer name as second arg. --- 1523,1529 ---- * process.c (wait_reading_process_input, both definitions): Use plain detect_input_pending just before the select call. ! (wait_reading_process_input) [subprocesses]: Get rid of the loop around the detect_input_pending call. ! * editfns.c (Fcompare_buffer_substrings): Fix dumb bug handling buffer name as second arg. *************** Fri Apr 12 11:27:30 1996 Richard Stallm *** 788,792 **** * emacs.c (main) [MSDOS]: Always call tzset, not init__gettimeofday. ! * editfns.c (Fformat_time_string): Doc fix. Thu Apr 11 23:25:43 1996 Richard Stallman --- 1536,1540 ---- * emacs.c (main) [MSDOS]: Always call tzset, not init__gettimeofday. ! * editfns.c (Fformat_time_string): Doc fix. Thu Apr 11 23:25:43 1996 Richard Stallman *************** Thu Apr 11 13:48:08 1996 Eli Zaretskii *** 816,820 **** * emacs.c (main) [DJGPP v2]: Make standard streams use binary mode. Call `tzset' instead of `init_gettimeofday'. ! * fileio.c [MSDOS]: If DJGPP version 2, include fcntl.h and string.h. --- 1564,1568 ---- * emacs.c (main) [DJGPP v2]: Make standard streams use binary mode. Call `tzset' instead of `init_gettimeofday'. ! * fileio.c [MSDOS]: If DJGPP version 2, include fcntl.h and string.h. *************** Sat Mar 16 17:34:41 1996 Geoff Voelker *** 1036,1040 **** Handle the three new keys on Windows keyboards. Reset internal keyboard modifier state upon window focus. ! * w32term.h (VK_NUMPAD_*, VK_LWIN, VK_RWIN, VK_APPS): Define virtual keys for the numpad functions and the three --- 1784,1788 ---- Handle the three new keys on Windows keyboards. Reset internal keyboard modifier state upon window focus. ! * w32term.h (VK_NUMPAD_*, VK_LWIN, VK_RWIN, VK_APPS): Define virtual keys for the numpad functions and the three *************** Sun Mar 10 09:37:51 1996 Richard Stallm *** 1067,1071 **** * s/linux.h (TERMINFO): Don't define this. ! * process.c [!subprocesses] (wait_reading_process_input): Port the timer changes from the other wait_reading_process_input. --- 1815,1819 ---- * s/linux.h (TERMINFO): Don't define this. ! * process.c [!subprocesses] (wait_reading_process_input): Port the timer changes from the other wait_reading_process_input. *************** Sun Feb 25 02:17:28 1996 Richard Stallm *** 1227,1231 **** (read_minibuf_unwind): Likewise. Also, clearing the buffer is now the last thing we do. ! * keyboard.c (command_loop_1): Explicitly clear the echo area with message2; don't just clear echo_area_glyphs. --- 1975,1979 ---- (read_minibuf_unwind): Likewise. Also, clearing the buffer is now the last thing we do. ! * keyboard.c (command_loop_1): Explicitly clear the echo area with message2; don't just clear echo_area_glyphs. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/alloc.c emacs-19.32/src/alloc.c *** emacs-19.31/src/alloc.c Tue Apr 9 18:07:54 1996 --- emacs-19.32/src/alloc.c Mon Jun 10 14:01:01 1996 *************** mark_object (argptr) *** 1823,1827 **** #endif /* MULTI_FRAME */ else if (GC_BOOL_VECTOR_P (obj)) ! ; else { --- 1823,1833 ---- #endif /* MULTI_FRAME */ else if (GC_BOOL_VECTOR_P (obj)) ! { ! register struct Lisp_Vector *ptr = XVECTOR (obj); ! ! if (ptr->size & ARRAY_MARK_FLAG) ! break; /* Already marked */ ! ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */ ! } else { diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/alloca.c emacs-19.32/src/alloca.c *** emacs-19.31/src/alloca.c Tue Mar 19 20:08:07 1996 --- emacs-19.32/src/alloca.c Wed Jul 3 19:09:32 1996 *************** alloca (size) *** 181,185 **** /* Reclaim garbage, defined as all alloca'd storage that ! was allocated from deeper in the stack than currently. */ { --- 181,185 ---- /* Reclaim garbage, defined as all alloca'd storage that ! was allocated from deeper in the stack than currently. */ { *************** struct stk_trailer *** 351,355 **** #ifdef CRAY2 /* Determine a "stack measure" for an arbitrary ADDRESS. ! I doubt that "lint" will like this much. */ static long --- 351,355 ---- #ifdef CRAY2 /* Determine a "stack measure" for an arbitrary ADDRESS. ! I doubt that "lint" will like this much. */ static long diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/buffer.c emacs-19.32/src/buffer.c *** emacs-19.31/src/buffer.c Wed May 1 17:02:05 1996 --- emacs-19.32/src/buffer.c Fri Jul 26 12:08:11 1996 *************** static Lisp_Object Vbuffer_local_symbols *** 100,103 **** --- 100,107 ---- struct buffer buffer_local_types; + /* Flags indicating which built-in buffer-local variables + are permanent locals. */ + static int buffer_permanent_local_flags; + Lisp_Object Fset_buffer (); void set_buffer_internal (); *************** void set_buffer_internal_1 (); *** 105,108 **** --- 109,113 ---- static void call_overlay_mod_hooks (); static void swap_out_buffer_local_variables (); + static void reset_buffer_local_variables (); /* Alist of all buffer names vs the buffers. */ *************** The value is never nil.") *** 336,340 **** reset_buffer (b); ! reset_buffer_local_variables (b); /* Put this in the alist of all live buffers. */ --- 341,345 ---- reset_buffer (b); ! reset_buffer_local_variables (b, 1); /* Put this in the alist of all live buffers. */ *************** NAME should be a string which is not the *** 400,404 **** reset_buffer (b); ! reset_buffer_local_variables (b); /* Put this in the alist of all live buffers. */ --- 405,409 ---- reset_buffer (b); ! reset_buffer_local_variables (b, 1); /* Put this in the alist of all live buffers. */ *************** reset_buffer (b) *** 475,484 **** Don't use this on a buffer that has already been in use; it does not treat permanent locals consistently. ! Instead, use Fkill_all_local_variables. */ ! reset_buffer_local_variables (b) register struct buffer *b; { register int offset; /* Reset the major mode to Fundamental, together with all the --- 480,502 ---- Don't use this on a buffer that has already been in use; it does not treat permanent locals consistently. ! Instead, use Fkill_all_local_variables. ! ! If PERMANENT_TOO is 1, then we reset permanent built-in ! buffer-local variables. If PERMANENT_TOO is 0, ! we preserve those. */ ! static void ! reset_buffer_local_variables (b, permanent_too) register struct buffer *b; + int permanent_too; { register int offset; + int dont_reset; + + /* Decide which built-in local variables to reset. */ + if (permanent_too) + dont_reset = 0; + else + dont_reset = buffer_permanent_local_flags; /* Reset the major mode to Fundamental, together with all the *************** reset_buffer_local_variables (b) *** 503,508 **** b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; - b->buffer_file_type = Qnil; b->invisibility_spec = Qt; #if 0 --- 521,528 ---- b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; b->invisibility_spec = Qt; + #ifndef DOS_NT + b->buffer_file_type = Qnil; + #endif #if 0 *************** reset_buffer_local_variables (b) *** 511,517 **** #endif /* 0 */ ! /* Reset all per-buffer variables to their defaults. */ b->local_var_alist = Qnil; ! b->local_var_flags = 0; /* For each slot that has a default value, --- 531,537 ---- #endif /* 0 */ ! /* Reset all (or most) per-buffer variables to their defaults. */ b->local_var_alist = Qnil; ! b->local_var_flags &= dont_reset; /* For each slot that has a default value, *************** reset_buffer_local_variables (b) *** 523,529 **** { int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)); ! if (flag > 0 || flag == -2) ! *(Lisp_Object *)(offset + (char *)b) = ! *(Lisp_Object *)(offset + (char *)&buffer_defaults); } } --- 543,552 ---- { int flag = XINT (*(Lisp_Object *)(offset + (char *)&buffer_local_flags)); ! if ((flag > 0 ! /* Don't reset a permanent local. */ ! && ! (dont_reset & flag)) ! || flag == -2) ! *(Lisp_Object *)(offset + (char *)b) ! = *(Lisp_Object *)(offset + (char *)&buffer_defaults); } } *************** before the buffer is actually killed. T *** 922,926 **** when the hook functions are called.\n\n\ Any processes that have this buffer as the `process-buffer' are killed\n\ ! with `delete-process'.") (buffer) Lisp_Object buffer; --- 945,949 ---- when the hook functions are called.\n\n\ Any processes that have this buffer as the `process-buffer' are killed\n\ ! with SIGHUP.") (buffer) Lisp_Object buffer; *************** with `delete-process'.") *** 1091,1095 **** This gets rid of them for certain. */ swap_out_buffer_local_variables (b); ! reset_buffer_local_variables (b); b->name = Qnil; --- 1114,1118 ---- This gets rid of them for certain. */ swap_out_buffer_local_variables (b); ! reset_buffer_local_variables (b, 1); b->name = Qnil; *************** If BUFFER is nil, then some other buffer *** 1225,1229 **** If `pop-up-windows' is non-nil, windows can be split to do this.\n\ If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\ ! window even if BUFFER is already visible in the selected window.") (buffer, other_window) Lisp_Object buffer, other_window; --- 1248,1254 ---- If `pop-up-windows' is non-nil, windows can be split to do this.\n\ If optional second arg OTHER-WINDOW is non-nil, insist on finding another\n\ ! window even if BUFFER is already visible in the selected window.\n\ ! This uses the function `display-buffer' as a subroutine; see the documentation\n\ ! of `display-buffer' for additional customization information.") (buffer, other_window) Lisp_Object buffer, other_window; *************** the normal hook `change-major-mode-hook' *** 1552,1556 **** /* Actually eliminate all local bindings of this buffer. */ ! reset_buffer_local_variables (current_buffer); /* Redisplay mode lines; we are changing major mode. */ --- 1577,1581 ---- /* Actually eliminate all local bindings of this buffer. */ ! reset_buffer_local_variables (current_buffer, 0); /* Redisplay mode lines; we are changing major mode. */ *************** init_buffer_once () *** 3314,3323 **** register Lisp_Object tem; /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); ! reset_buffer_local_variables (&buffer_defaults); reset_buffer (&buffer_local_symbols); ! reset_buffer_local_variables (&buffer_local_symbols); /* Prevent GC from getting confused. */ buffer_defaults.text = &buffer_defaults.own_text; --- 3339,3350 ---- register Lisp_Object tem; + buffer_permanent_local_flags = 0; + /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); ! reset_buffer_local_variables (&buffer_defaults, 1); reset_buffer (&buffer_local_symbols); ! reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ buffer_defaults.text = &buffer_defaults.own_text; *************** init_buffer_once () *** 3405,3413 **** XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000); XSETFASTINT (buffer_local_flags.display_table, 0x2000); - XSETFASTINT (buffer_local_flags.syntax_table, 0x8000); - XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000); #ifdef DOS_NT XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000); #endif Vbuffer_alist = Qnil; --- 3432,3442 ---- XSETFASTINT (buffer_local_flags.abbrev_table, 0x1000); XSETFASTINT (buffer_local_flags.display_table, 0x2000); #ifdef DOS_NT XSETFASTINT (buffer_local_flags.buffer_file_type, 0x4000); + /* Make this one a permanent local. */ + buffer_permanent_local_flags |= 0x4000; #endif + XSETFASTINT (buffer_local_flags.syntax_table, 0x8000); + XSETFASTINT (buffer_local_flags.cache_long_line_scans, 0x10000); Vbuffer_alist = Qnil; *************** Each buffer has its own value of this va *** 3685,3692 **** Qnil, "Function called (if non-nil) to perform auto-fill.\n\ ! It is called after self-inserting a space at a column beyond `fill-column'.\n\ Each buffer has its own value of this variable.\n\ ! NOTE: This variable is not an ordinary hook;\n\ ! It may not be a list of functions."); DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer->filename, --- 3714,3721 ---- Qnil, "Function called (if non-nil) to perform auto-fill.\n\ ! It is called after self-inserting a space or newline.\n\ Each buffer has its own value of this variable.\n\ ! NOTE: This variable is not a hook;\n\ ! its value may not be a list of functions."); DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer->filename, diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/callproc.c emacs-19.32/src/callproc.c *** emacs-19.31/src/callproc.c Wed May 15 10:31:48 1996 --- emacs-19.32/src/callproc.c Sat Jul 6 15:49:32 1996 *************** If you quit, the process is killed with *** 246,251 **** { if (CONSP (XCONS (buffer)->cdr)) ! error_file = Fexpand_file_name (XCONS (XCONS (buffer)->cdr)->car, ! Qnil); buffer = XCONS (buffer)->car; } --- 246,259 ---- { if (CONSP (XCONS (buffer)->cdr)) ! { ! Lisp_Object stderr_file; ! stderr_file = XCONS (XCONS (buffer)->cdr)->car; ! ! if (NILP (stderr_file) || EQ (Qt, stderr_file)) ! error_file = stderr_file; ! else ! error_file = Fexpand_file_name (stderr_file, Qnil); ! } ! buffer = XCONS (buffer)->car; } *************** If you quit, the process is killed with *** 343,350 **** { close (filefd); ! report_file_error ("Opening process output file", Fcons (tempfile, Qnil)); } fd[1] = outfilefd; ! #endif if (INTEGERP (buffer)) --- 351,360 ---- { close (filefd); ! report_file_error ("Opening process output file", ! Fcons (build_string (tempfile), Qnil)); } + fd[0] = filefd; fd[1] = outfilefd; ! #endif /* MSDOS */ if (INTEGERP (buffer)) *************** If you quit, the process is killed with *** 397,404 **** { close (filefd); ! close (fd[0]); if (fd1 >= 0) close (fd1); ! report_file_error ("Cannot open", error_file); } #ifdef MSDOS /* MW, July 1993 */ --- 407,421 ---- { close (filefd); ! if (fd[0] != filefd) ! close (fd[0]); if (fd1 >= 0) close (fd1); ! #ifdef MSDOS ! unlink (tempfile); ! #endif ! report_file_error ("Cannot redirect stderr", ! Fcons ((NILP (error_file) ! ? build_string (NULL_DEVICE) : error_file), ! Qnil)); } #ifdef MSDOS /* MW, July 1993 */ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/config.in emacs-19.32/src/config.in *** emacs-19.31/src/config.in Mon Apr 8 09:44:55 1996 --- emacs-19.32/src/config.in Sat Jul 20 14:05:18 1996 *************** GNU General Public License for more deta *** 15,20 **** 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ --- 15,21 ---- 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. */ *************** the Free Software Foundation, 675 Mass A *** 64,67 **** --- 65,71 ---- #undef HAVE_X11R6 + /* Define if we have the X11R5 or newer version of Xlib. */ + #undef HAVE_X11R5 + /* Define if netdb.h declares h_errno. */ #undef HAVE_H_ERRNO *************** the Free Software Foundation, 675 Mass A *** 95,99 **** /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ ! #undef AMPERSAND_FULL_NAME /* Things set by --with options in the configure script. */ --- 99,104 ---- /* Define AMPERSAND_FULL_NAME if you use the convention that & in the full name stands for the login id. */ ! /* Turned on June 1996 supposing nobody will mind it. */ ! #define AMPERSAND_FULL_NAME /* Things set by --with options in the configure script. */ *************** the Free Software Foundation, 675 Mass A *** 170,174 **** #undef HAVE_SELECT #undef HAVE_MKTIME ! #undef HAVE_EACCESS #undef HAVE_GETPAGESIZE #undef HAVE_TZSET --- 175,179 ---- #undef HAVE_SELECT #undef HAVE_MKTIME ! #undef HAVE_EUIDACCESS #undef HAVE_GETPAGESIZE #undef HAVE_TZSET diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/data.c emacs-19.32/src/data.c *** emacs-19.31/src/data.c Tue Apr 9 18:08:19 1996 --- emacs-19.32/src/data.c Tue Jul 16 18:18:22 1996 *************** DEFUN ("fset", Ffset, Sfset, 2, 2, 0, *** 652,656 **** DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, ! "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.\n\ Associates the function with the current load file, if any.") (symbol, newdef) --- 652,656 ---- DEFUN ("defalias", Fdefalias, Sdefalias, 2, 2, 0, ! "Set SYMBOL's function definition to NEWDEF, and return NEWDEF.\n\ Associates the function with the current load file, if any.") (symbol, newdef) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/dired.c emacs-19.32/src/dired.c *** emacs-19.31/src/dired.c Thu May 9 19:21:45 1996 --- emacs-19.32/src/dired.c Sun Jul 7 18:32:14 1996 *************** file_name_completion (file, dirname, all *** 296,299 **** --- 296,312 ---- struct gcpro gcpro1, gcpro2, gcpro3; + #ifdef MSDOS + #if __DJGPP__ > 1 + /* Some fields of struct stat are *very* expensive to compute on MS-DOS, + but aren't required here. Avoid computing the following fields: + st_inode, st_size and st_nlink for directories, and the execute bits + in st_mode for non-directory files with non-standard extensions. */ + + unsigned short save_djstat_flags = _djstat_flags; + + _djstat_flags = _STAT_INODE | _STAT_EXEC_MAGIC | _STAT_DIRSIZE; + #endif + #endif + #ifdef VMS extern DIRENTRY * readdirver (); *************** file_name_completion (file, dirname, all *** 496,499 **** --- 509,518 ---- UNGCPRO; bestmatch = unbind_to (count, bestmatch); + + #ifdef MSDOS + #if __DJGPP__ > 1 + _djstat_flags = save_djstat_flags; + #endif + #endif if (all_flag || NILP (bestmatch)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/dispnew.c emacs-19.32/src/dispnew.c *** emacs-19.31/src/dispnew.c Wed May 22 21:33:05 1996 --- emacs-19.32/src/dispnew.c Mon Jul 15 16:53:44 1996 *************** FILE *termscript; /* Stdio stream being *** 168,173 **** struct cm Wcm; /* Structure for info on cursor positioning */ - extern short ospeed; /* Output speed (from sg_ospeed) */ - int delayed_size_change; /* 1 means SIGWINCH happened when not safe. */ --- 168,171 ---- *************** DEFUN ("redraw-frame", Fredraw_frame, Sr *** 184,188 **** f = XFRAME (frame); update_begin (f); ! /* set_terminal_modes (); */ clear_frame (); clear_frame_records (f); --- 182,187 ---- f = XFRAME (frame); update_begin (f); ! if (FRAME_MSDOS_P (f)) ! set_terminal_modes (); clear_frame (); clear_frame_records (f); *************** remake_frame_glyphs (frame) *** 400,404 **** FRAME_DESIRED_GLYPHS (frame) = make_frame_glyphs (frame, 0); FRAME_TEMP_GLYPHS (frame) = make_frame_glyphs (frame, 1); ! if (! FRAME_TERMCAP_P (frame) || frame == selected_frame) SET_FRAME_GARBAGED (frame); } --- 399,403 ---- FRAME_DESIRED_GLYPHS (frame) = make_frame_glyphs (frame, 0); FRAME_TEMP_GLYPHS (frame) = make_frame_glyphs (frame, 1); ! if (FRAME_WINDOW_P (frame) || frame == selected_frame) SET_FRAME_GARBAGED (frame); } *************** direct_output_for_insert (g) *** 1118,1122 **** int dummy; ! if (FRAME_WINDOW_P (frame)) face = compute_char_face (frame, w, point - 1, -1, -1, &dummy, point, 0); #endif --- 1117,1121 ---- int dummy; ! if (FRAME_WINDOW_P (frame) || FRAME_MSDOS_P (frame)) face = compute_char_face (frame, w, point - 1, -1, -1, &dummy, point, 0); #endif *************** change_frame_size (f, newheight, newwidt *** 2104,2113 **** { Lisp_Object tail, frame; ! if (FRAME_TERMCAP_P (f)) { ! /* When using termcap, all frames use the same screen, ! so a change in size affects all termcap frames. */ FOR_EACH_FRAME (tail, frame) ! if (FRAME_TERMCAP_P (XFRAME (frame))) change_frame_size_1 (XFRAME (frame), newheight, newwidth, pretend, delay); --- 2103,2112 ---- { Lisp_Object tail, frame; ! if (! FRAME_WINDOW_P (f)) { ! /* When using termcap, or on MS-DOS, all frames use ! the same screen, so a change in size affects all frames. */ FOR_EACH_FRAME (tail, frame) ! if (! FRAME_WINDOW_P (XFRAME (frame))) change_frame_size_1 (XFRAME (frame), newheight, newwidth, pretend, delay); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/dosfns.c emacs-19.32/src/dosfns.c *** emacs-19.31/src/dosfns.c Sun May 12 21:24:55 1996 --- emacs-19.32/src/dosfns.c Mon Jun 10 16:23:01 1996 *************** Report whether a mouse is present.") *** 166,180 **** } - DEFUN ("set-mouse-position", Fset_mouse_position, Sset_mouse_position, 3, 3, 0, - "Move the mouse pointer to the center of character cell (X,Y) in FRAME.\n\ - WARNING: If you use this under X windows,\n\ - you should call `unfocus-frame' afterwards.") - (frame, x, y) - Lisp_Object frame, x, y; - { - mouse_moveto (XINT (x), XINT (y)); - return Qnil; - } - /* Function to translate colour names to integers. See lisp/term/pc-win.el for its definition. */ --- 166,169 ---- *************** syms_of_dosfns () *** 334,339 **** #ifndef HAVE_X_WINDOWS defsubr (&Smsdos_mouse_p); - defsubr (&Sset_mouse_position); - Qmsdos_color_translate = intern ("msdos-color-translate"); staticpro (&Qmsdos_color_translate); --- 323,326 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/editfns.c emacs-19.32/src/editfns.c *** emacs-19.31/src/editfns.c Wed May 15 17:54:59 1996 --- emacs-19.32/src/editfns.c Wed Jul 24 00:12:11 1996 *************** ZONE is an integer indicating the number *** 694,698 **** XSETFASTINT (list_args[3], decoded_time->tm_mday); XSETFASTINT (list_args[4], decoded_time->tm_mon + 1); ! XSETFASTINT (list_args[5], decoded_time->tm_year + 1900); XSETFASTINT (list_args[6], decoded_time->tm_wday); list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; --- 694,698 ---- XSETFASTINT (list_args[3], decoded_time->tm_mday); XSETFASTINT (list_args[4], decoded_time->tm_mon + 1); ! XSETINT (list_args[5], decoded_time->tm_year + 1900); XSETFASTINT (list_args[6], decoded_time->tm_wday); list_args[7] = (decoded_time->tm_isdst)? Qt : Qnil; *************** If you want them to stand for years in t *** 766,769 **** --- 766,773 ---- abszone / (60*60), (abszone/60) % 60, abszone % 60); tzstring = tzbuf; + #ifdef _NEXT_SOURCE + /* On NEXTSTEP, timezone environment var is ignored. */ + tm.tm_gmtoff = -abszone; + #endif } else *************** difftm (a, b) *** 829,832 **** --- 833,839 ---- int ay = a->tm_year + (TM_YEAR_ORIGIN - 1); int by = b->tm_year + (TM_YEAR_ORIGIN - 1); + /* Divide years by 100, rounding towards minus infinity. */ + int ac = ay / 100 - (ay % 100 < 0); + int bc = by / 100 - (by % 100 < 0); /* Some compilers can't handle this as a single return statement. */ long days = ( *************** difftm (a, b) *** 835,840 **** /* + intervening leap days */ + ((ay >> 2) - (by >> 2)) ! - (ay/100 - by/100) ! + ((ay/100 >> 2) - (by/100 >> 2)) /* + difference in years * 365 */ + (long)(ay-by) * 365 --- 842,847 ---- /* + intervening leap days */ + ((ay >> 2) - (by >> 2)) ! - (ac - bc) ! + ((ac >> 2) - (bc >> 2)) /* + difference in years * 365 */ + (long)(ay-by) * 365 *************** set_time_zone_rule (tzstring) *** 940,943 **** --- 947,951 ---- char **from, **to, **newenv; + /* Make the ENVIRON vector longer with room for TZSTRING. */ for (from = environ; *from; from++) continue; *************** set_time_zone_rule (tzstring) *** 945,948 **** --- 953,958 ---- newenv = to = (char **) xmalloc (envptrs * sizeof (char *) + (tzstring ? strlen (tzstring) + 4 : 0)); + + /* Add TZSTRING to the end of environ, as a value for TZ. */ if (tzstring) { *************** set_time_zone_rule (tzstring) *** 953,956 **** --- 963,969 ---- } + /* Copy the old environ vector elements into NEWENV, + but don't copy the TZ variable. + So we have only one definition of TZ, which came from TZSTRING. */ for (from = environ; *from; from++) if (strncmp (*from, "TZ=", 3) != 0) *************** set_time_zone_rule (tzstring) *** 960,964 **** --- 973,1019 ---- environ = newenv; + /* If we do have a TZSTRING, NEWENV points to the vector slot where + the TZ variable is stored. If we do not have a TZSTRING, + TO points to the vector slot which has the terminating null. */ + #ifdef LOCALTIME_CACHE + { + /* In SunOS 4.1.3_U1 and 4.1.4, if TZ has a value like + "US/Pacific" that loads a tz file, then changes to a value like + "XXX0" that does not load a tz file, and then changes back to + its original value, the last change is (incorrectly) ignored. + Also, if TZ changes twice in succession to values that do + not load a tz file, tzset can dump core (see Sun bug#1225179). + The following code works around these bugs. */ + + /* These two values are known to load tz files in buggy implementations. + Their values shouldn't matter in non-buggy implementations. */ + char *tz1 = "TZ=GMT0"; + char *tz2 = "TZ=GMT1"; + + if (tzstring) + { + /* Temporarily set TZ to a value that loads a tz file + and that differs from tzstring. */ + char *tz = *newenv; + *newenv = strcmp (tzstring, tz1 + 3) == 0 ? tz2 : tz1; + tzset (); + *newenv = tz; + } + else + { + /* The implied tzstring is unknown, so temporarily set TZ to + two different values that each load a tz file. */ + *to = tz1; + to[1] = 0; + tzset (); + *to = tz2; + tzset (); + *to = 0; + } + + /* Now TZ has the desired value, and tzset can be invoked safely. */ + } + tzset (); #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/emacs.c emacs-19.32/src/emacs.c *** emacs-19.31/src/emacs.c Fri May 10 16:30:15 1996 --- emacs-19.32/src/emacs.c Sat Jun 29 19:04:48 1996 *************** main (argc, argv, envp) *** 448,452 **** else { ! printf ("%s\n", XSTRING (tem)->data); exit (0); } --- 448,452 ---- else { ! printf ("GNU Emacs %s\n", XSTRING (tem)->data); exit (0); } *************** Usage: %s [-t term] [--terminal term] [ *** 676,680 **** ) { ! sigblockx (SIGHUP); /* In --batch mode, don't catch SIGHUP if already ignored. That makes nohup work. */ --- 676,680 ---- ) { ! sigblock (sigmask (SIGHUP)); /* In --batch mode, don't catch SIGHUP if already ignored. That makes nohup work. */ *************** Usage: %s [-t term] [--terminal term] [ *** 682,686 **** || signal (SIGHUP, SIG_IGN) != SIG_IGN) signal (SIGHUP, fatal_error_signal); ! sigunblockx (SIGHUP); } --- 682,686 ---- || signal (SIGHUP, SIG_IGN) != SIG_IGN) signal (SIGHUP, fatal_error_signal); ! sigunblock (sigmask (SIGHUP)); } *************** struct standard_args standard_args[] = *** 1055,1059 **** { "-title", 0, 10, 1 }, { "-name", "--name", 10, 1 }, - { "-rn", 0, 10, 1 }, { "-xrm", "--xrm", 10, 1 }, { "-r", "--reverse-video", 5, 0 }, --- 1055,1058 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/fileio.c emacs-19.32/src/fileio.c *** emacs-19.31/src/fileio.c Wed May 1 19:23:17 1996 --- emacs-19.32/src/fileio.c Sat Jul 20 03:00:27 1996 *************** extern char *strerror (); *** 107,110 **** --- 107,114 ---- #define IS_DRIVE(x) isalpha (x) #endif + /* Need to lower-case the drive letter, or else expanded + filenames will sometimes compare inequal, because + `expand-file-name' doesn't always down-case the drive letter. */ + #define DRIVE_LETTER(x) (tolower (x)) #endif *************** See also the function `substitute-in-fil *** 1060,1064 **** { name = make_string (nm - 2, p - nm + 2); ! XSTRING (name)->data[0] = drive; XSTRING (name)->data[1] = ':'; } --- 1064,1068 ---- { name = make_string (nm - 2, p - nm + 2); ! XSTRING (name)->data[0] = DRIVE_LETTER (drive); XSTRING (name)->data[1] = ':'; } *************** See also the function `substitute-in-fil *** 1154,1158 **** /* Either nm starts with /, or drive isn't mounted. */ newdir = alloca (4); ! newdir[0] = drive; newdir[1] = ':'; newdir[2] = '/'; --- 1158,1162 ---- /* Either nm starts with /, or drive isn't mounted. */ newdir = alloca (4); ! newdir[0] = DRIVE_LETTER (drive); newdir[1] = ':'; newdir[2] = '/'; *************** See also the function `substitute-in-fil *** 1253,1259 **** if (newdir) { ! /* Get rid of any slash at the end of newdir. */ length = strlen (newdir); ! if (IS_DIRECTORY_SEP (newdir[length - 1])) { unsigned char *temp = (unsigned char *) alloca (length); --- 1257,1268 ---- if (newdir) { ! /* Get rid of any slash at the end of newdir, unless newdir is ! just // (an incomplete UNC name). */ length = strlen (newdir); ! if (IS_DIRECTORY_SEP (newdir[length - 1]) ! #ifdef WINDOWSNT ! && !(length == 2 && IS_DIRECTORY_SEP (newdir[0])) ! #endif ! ) { unsigned char *temp = (unsigned char *) alloca (length); *************** See also the function `substitute-in-fil *** 1379,1382 **** --- 1388,1393 ---- while (o != target && (--o) && !IS_DIRECTORY_SEP (*o)) ; + if (o == target && IS_ANY_SEP (*o)) + ++o; p += 3; } *************** See also the function `substitute-in-fil *** 1397,1401 **** if (!drive) abort (); target -= 2; ! target[0] = drive; target[1] = ':'; } --- 1408,1412 ---- if (!drive) abort (); target -= 2; ! target[0] = DRIVE_LETTER (drive); target[1] = ':'; } *************** A prefix arg makes KEEP-TIME non-nil.") *** 2068,2072 **** input_file_statable_p = (fstat (ifd, &st) >= 0); ! #ifndef MSDOS if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) --- 2079,2083 ---- input_file_statable_p = (fstat (ifd, &st) >= 0); ! #if !defined (MSDOS) || __DJGPP__ > 1 if (out_st.st_mode != 0 && st.st_dev == out_st.st_dev && st.st_ino == out_st.st_ino) *************** check_executable (filename) *** 2524,2528 **** if (stat (filename, &st) < 0) return 0; ! #ifdef WINDOWSNT return ((st.st_mode & S_IEXEC) != 0); #else --- 2535,2539 ---- if (stat (filename, &st) < 0) return 0; ! #if defined (WINDOWSNT) || (defined (MSDOS) && __DJGPP__ > 1) return ((st.st_mode & S_IEXEC) != 0); #else *************** check_executable (filename) *** 2535,2540 **** #endif /* not WINDOWSNT */ #else /* not DOS_NT */ ! #ifdef HAVE_EACCESS ! return (eaccess (filename, 1) >= 0); #else /* Access isn't quite right because it uses the real uid --- 2546,2551 ---- #endif /* not WINDOWSNT */ #else /* not DOS_NT */ ! #ifdef HAVE_EUIDACCESS ! return (euidaccess (filename, 1) >= 0); #else /* Access isn't quite right because it uses the real uid *************** check_writable (filename) *** 2558,2563 **** return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR); #else /* not MSDOS */ ! #ifdef HAVE_EACCESS ! return (eaccess (filename, 2) >= 0); #else /* Access isn't quite right because it uses the real uid --- 2569,2574 ---- return (st.st_mode & S_IWRITE || (st.st_mode & S_IFMT) == S_IFDIR); #else /* not MSDOS */ ! #ifdef HAVE_EUIDACCESS ! return (euidaccess (filename, 2) >= 0); #else /* Access isn't quite right because it uses the real uid *************** DEFUN ("file-modes", Ffile_modes, Sfile_ *** 2830,2837 **** if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; ! #ifdef MSDOS if (check_executable (XSTRING (absname)->data)) st.st_mode |= S_IEXEC; ! #endif /* MSDOS */ return make_number (st.st_mode & 07777); --- 2841,2848 ---- if (stat (XSTRING (absname)->data, &st) < 0) return Qnil; ! #if defined (MSDOS) && __DJGPP__ < 2 if (check_executable (XSTRING (absname)->data)) st.st_mode |= S_IEXEC; ! #endif /* MSDOS && __DJGPP__ < 2 */ return make_number (st.st_mode & 07777); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/filelock.c emacs-19.32/src/filelock.c *** emacs-19.31/src/filelock.c Tue Apr 9 18:03:32 1996 --- emacs-19.32/src/filelock.c Mon Jul 29 00:21:03 1996 *************** lock_file_owner_name (lfname) *** 167,170 **** --- 167,173 ---- if (lstat (lfname, &s) == 0) the_pw = getpwuid (s.st_uid); + else + the_pw = 0; + return (the_pw == 0 ? Qnil : build_string (the_pw->pw_name)); } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/floatfns.c emacs-19.32/src/floatfns.c *** emacs-19.31/src/floatfns.c Tue Apr 9 18:10:02 1996 --- emacs-19.32/src/floatfns.c Mon Jul 15 19:53:09 1996 *************** Boston, MA 02111-1307, USA. */ *** 51,56 **** #include "syssignal.h" - Lisp_Object Qarith_error; - #ifdef LISP_FLOAT_TYPE --- 51,54 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/fns.c emacs-19.32/src/fns.c *** emacs-19.31/src/fns.c Tue Apr 9 18:10:23 1996 --- emacs-19.32/src/fns.c Tue Jul 16 02:18:52 1996 *************** Also accepts Space to mean yes, or Delet *** 1600,1604 **** key = Fmake_vector (make_number (1), obj); ! def = Flookup_key (map, key); answer_string = Fsingle_key_description (obj); --- 1600,1604 ---- key = Fmake_vector (make_number (1), obj); ! def = Flookup_key (map, key, Qt); answer_string = Fsingle_key_description (obj); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/frame.c emacs-19.32/src/frame.c *** emacs-19.31/src/frame.c Sun Apr 21 03:42:40 1996 --- emacs-19.32/src/frame.c Mon Jul 15 20:01:26 1996 *************** Lisp_Object Qwidth; *** 79,82 **** --- 79,83 ---- Lisp_Object Qx; Lisp_Object Qwin32; + Lisp_Object Qpc; Lisp_Object Qvisible; Lisp_Object Qbuffer_predicate; *************** Lisp_Object Vterminal_frame; *** 86,91 **** Lisp_Object Vdefault_frame_alist; - Lisp_Object Qmouse_leave_buffer_hook; - static void syms_of_frame_1 () --- 87,90 ---- *************** syms_of_frame_1 () *** 118,121 **** --- 117,122 ---- Qwin32 = intern ("win32"); staticpro (&Qwin32); + Qpc = intern ("pc"); + staticpro (&Qpc); Qvisible = intern ("visible"); staticpro (&Qvisible); *************** syms_of_frame_1 () *** 125,131 **** staticpro (&Qtitle); - Qmouse_leave_buffer_hook = intern ("mouse-leave-buffer-hook"); - staticpro (&Qmouse_leave_buffer_hook); - DEFVAR_LISP ("default-frame-alist", &Vdefault_frame_alist, "Alist of default values for frame creation.\n\ --- 126,129 ---- *************** See also `frame-live-p'.") *** 230,234 **** case output_win32: return Qwin32; ! /* The `pc' case is in the Fframep below. */ default: abort (); --- 228,233 ---- case output_win32: return Qwin32; ! case output_msdos_raw: ! return Qpc; default: abort (); *************** make_frame_without_minibuffer (mini_wind *** 380,383 **** --- 379,383 ---- { register struct frame *f; + struct gcpro gcpro1; if (!NILP (mini_window)) *************** make_frame_without_minibuffer (mini_wind *** 399,406 **** || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) { /* If there's no minibuffer frame to use, create one. */ ! kb->Vdefault_minibuffer_frame ! = call1 (intern ("make-initial-minibuffer-frame"), display); } mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; } --- 399,412 ---- || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) { + Lisp_Object frame_dummy; + + XSETFRAME (frame_dummy, f); + GCPRO1 (frame_dummy); /* If there's no minibuffer frame to use, create one. */ ! kb->Vdefault_minibuffer_frame = ! call1 (intern ("make-initial-minibuffer-frame"), display); ! UNGCPRO; } + mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; } *************** make_terminal_frame () *** 499,503 **** --- 505,515 ---- f->visible = 1; /* FRAME_SET_VISIBLE wd set frame_garbaged. */ f->async_visible = 1; /* Don't let visible be cleared later. */ + #ifdef MSDOS + f->output_data.x = &the_only_x_display; + f->output_method = output_msdos_raw; + init_frame_faces (f); + #else /* not MSDOS */ f->output_data.nothing = 1; /* Nonzero means frame isn't deleted. */ + #endif return f; } *************** Note that changing the size of one termi *** 516,521 **** --- 528,538 ---- Lisp_Object frame; + #ifdef MSDOS + if (selected_frame->output_method != output_msdos_raw) + abort (); + #else if (selected_frame->output_method != output_termcap) error ("Not using an ASCII terminal now; cannot make a new ASCII frame"); + #endif f = make_terminal_frame (); *************** before calling this function on it, like *** 1327,1330 **** --- 1344,1355 ---- /* Warping the mouse will cause enternotify and focus events. */ x_set_mouse_position (XFRAME (frame), x, y); + #else + #if defined (MSDOS) && defined (HAVE_MOUSE) + if (FRAME_MSDOS_P (XFRAME (frame))) + { + Fselect_frame (frame, Qnil); + mouse_moveto (XINT (x), XINT (y)); + } + #endif #endif *************** before calling this function on it, like *** 1351,1354 **** --- 1376,1387 ---- /* Warping the mouse will cause enternotify and focus events. */ x_set_mouse_pixel_position (XFRAME (frame), x, y); + #else + #if defined (MSDOS) && defined (HAVE_MOUSE) + if (FRAME_MSDOS_P (XFRAME (frame))) + { + Fselect_frame (frame, Qnil); + mouse_moveto (XINT (x), XINT (y)); + } + #endif #endif *************** If FRAME is omitted, return information *** 1714,1717 **** --- 1747,1766 ---- alist = Fcopy_alist (f->param_alist); + #ifdef MSDOS + if (FRAME_MSDOS_P (f)) + { + static char *colornames[16] = + { + "black", "blue", "green", "cyan", "red", "magenta", "brown", + "lightgray", "darkgray", "lightblue", "lightgreen", "lightcyan", + "lightred", "lightmagenta", "yellow", "white" + }; + store_in_alist (&alist, intern ("foreground-color"), + build_string (colornames[FRAME_FOREGROUND_PIXEL (f)])); + store_in_alist (&alist, intern ("background-color"), + build_string (colornames[FRAME_BACKGROUND_PIXEL (f)])); + } + store_in_alist (&alist, intern ("font"), build_string ("default")); + #endif store_in_alist (&alist, Qname, f->name); height = (FRAME_NEW_HEIGHT (f) ? FRAME_NEW_HEIGHT (f) : FRAME_HEIGHT (f)); *************** The meaningful PARMs depend on the kind *** 1765,1768 **** --- 1814,1822 ---- if (FRAME_WINDOW_P (f)) x_set_frame_parameters (f, alist); + else + #endif + #ifdef MSDOS + if (FRAME_MSDOS_P (f)) + IT_set_frame_parameters (f, alist); else #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/frame.h emacs-19.32/src/frame.h *** emacs-19.31/src/frame.h Fri Apr 26 22:09:25 1996 --- emacs-19.32/src/frame.h Mon Jun 10 16:23:18 1996 *************** typedef struct frame *FRAME_PTR; *** 312,315 **** --- 312,316 ---- #define FRAME_X_P(f) ((f)->output_method == output_x_window) #define FRAME_WIN32_P(f) ((f)->output_method == output_win32) + #define FRAME_MSDOS_P(f) ((f)->output_method == output_msdos_raw) /* FRAME_WINDOW_P tests whether the frame is a window, and is *************** extern FRAME_PTR last_nonminibuf_frame; *** 470,473 **** --- 471,475 ---- #define FRAME_LIVE_P(f) 1 + #define FRAME_MSDOS_P(f) 0 #ifdef MSDOS /* The following definitions could also be used in the non-MSDOS case, diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/getloadavg.c emacs-19.32/src/getloadavg.c *** emacs-19.31/src/getloadavg.c Wed May 22 17:47:27 1996 --- emacs-19.32/src/getloadavg.c Mon May 27 20:16:34 1996 *************** extern int errno; *** 142,146 **** #endif ! #if defined(sun) && defined(SVR4) #define SUNOS_5 #endif --- 142,146 ---- #endif ! #if (defined(sun) && defined(SVR4)) || defined (SOLARIS2) #define SUNOS_5 #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/gmalloc.c emacs-19.32/src/gmalloc.c *** emacs-19.31/src/gmalloc.c Sat May 25 20:19:49 1996 --- emacs-19.32/src/gmalloc.c Thu Aug 1 22:04:54 1996 *************** Cambridge, MA 02139, USA. *** 37,40 **** --- 37,54 ---- #endif + #if defined (__cplusplus) || (defined (__STDC__) && __STDC__) + #undef __P + #define __P(args) args + #undef __ptr_t + #define __ptr_t void * + #else /* Not C++ or ANSI C. */ + #undef __P + #define __P(args) () + #undef const + #define const + #undef __ptr_t + #define __ptr_t char * + #endif /* C++ or ANSI C. */ + #if defined(_LIBC) || defined(STDC_HEADERS) || defined(USG) #include *************** extern "C" *** 68,85 **** #endif - #if defined (__cplusplus) || (defined (__STDC__) && __STDC__) - #undef __P - #define __P(args) args - #undef __ptr_t - #define __ptr_t void * - #else /* Not C++ or ANSI C. */ - #undef __P - #define __P(args) () - #undef const - #define const - #undef __ptr_t - #define __ptr_t char * - #endif /* C++ or ANSI C. */ - #if defined (__STDC__) && __STDC__ #include --- 82,85 ---- *************** align (size) *** 408,412 **** /* Get SIZE bytes, if we can get them starting at END. Return the address of the space we got. ! If we cannot get space at END, fail and return -1. */ static __ptr_t get_contiguous_space __P ((__malloc_ptrdiff_t, __ptr_t)); static __ptr_t --- 408,412 ---- /* Get SIZE bytes, if we can get them starting at END. Return the address of the space we got. ! If we cannot get space at END, fail and return 0. */ static __ptr_t get_contiguous_space __P ((__malloc_ptrdiff_t, __ptr_t)); static __ptr_t diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/indent.c emacs-19.32/src/indent.c *** emacs-19.31/src/indent.c Tue May 21 20:32:39 1996 --- emacs-19.32/src/indent.c Fri Jul 12 21:02:17 1996 *************** int last_known_column_point; *** 51,54 **** --- 51,56 ---- int last_known_column_modified; + static int current_column_1 (); + /* Get the display table to use for the current buffer. */ *************** width_run_cache_on_off () *** 169,172 **** --- 171,250 ---- + /* Skip some invisible characters starting from POS. + This includes characters invisible because of text properties + and characters invisible because of overlays. + + If position POS is followed by invisible characters, + skip some of them and return the position after them. + Otherwise return POS itself. + + Set *NEXT_BOUNDARY_P to the next position at which + it will be necessary to call this function again. + + Don't scan past TO, and don't set *NEXT_BOUNDARY_P + to a value greater than TO. + + If WINDOW is non-nil, and this buffer is displayed in WINDOW, + take account of overlays that apply only in WINDOW. + + We don't necessarily skip all the invisible characters after POS + because that could take a long time. We skip a reasonable number + which can be skipped quickly. If there might be more invisible + characters immediately following, then *NEXT_BOUNDARY_P + will equal the return value. */ + + static int + skip_invisible (pos, next_boundary_p, to, window) + int pos; + int *next_boundary_p; + int to; + Lisp_Object window; + { + Lisp_Object prop, position, end, overlay_limit, proplimit; + Lisp_Object buffer; + + XSETFASTINT (position, pos); + XSETBUFFER (buffer, current_buffer); + + /* Give faster response for overlay lookup near POS. */ + recenter_overlay_lists (current_buffer, pos); + + /* We must not advance farther than the next overlay change. + The overlay change might change the invisible property; + or there might be overlay strings to be displayed there. */ + overlay_limit = Fnext_overlay_change (position); + /* As for text properties, this gives a lower bound + for where the invisible text property could change. */ + proplimit = Fnext_property_change (position, buffer, Qt); + if (XFASTINT (overlay_limit) < XFASTINT (proplimit)) + proplimit = overlay_limit; + /* PROPLIMIT is now a lower bound for the next change + in invisible status. If that is plenty far away, + use that lower bound. */ + if (XFASTINT (proplimit) > pos + 100 || XFASTINT (proplimit) >= to) + *next_boundary_p = XFASTINT (proplimit); + /* Otherwise, scan for the next `invisible' property change. */ + else + { + /* Don't scan terribly far. */ + XSETFASTINT (proplimit, min (pos + 100, to)); + /* No matter what. don't go past next overlay change. */ + if (XFASTINT (overlay_limit) < XFASTINT (proplimit)) + proplimit = overlay_limit; + end = Fnext_single_property_change (position, Qinvisible, + buffer, proplimit); + *next_boundary_p = XFASTINT (end); + } + /* if the `invisible' property is set, we can skip to + the next property change */ + if (!NILP (window) && EQ (XWINDOW (window)->buffer, buffer)) + prop = Fget_char_property (position, Qinvisible, window); + else + prop = Fget_char_property (position, Qinvisible, buffer); + if (TEXT_PROP_MEANS_INVISIBLE (prop)) + return *next_boundary_p; + return pos; + } + DEFUN ("current-column", Fcurrent_column, Scurrent_column, 0, 0, 0, "Return the horizontal position of point. Beginning of line is column 0.\n\ *************** current_column () *** 210,213 **** --- 288,301 ---- return last_known_column; + /* If the buffer has overlays or text properties, + use a more general algorithm. */ + if (BUF_INTERVALS (current_buffer) + || !NILP (current_buffer->overlays_before) + || !NILP (current_buffer->overlays_after)) + return current_column_1 (point); + + /* Scan backwards from point to the previous newline, + counting width. Tab characters are the only complicated case. */ + /* Make a pointer for decrementing through the chars before point. */ ptr = &FETCH_CHAR (point - 1) + 1; *************** current_column () *** 275,278 **** --- 363,435 ---- } + /* Return the column number of position POS + by scanning forward from the beginning of the line. + This function handles characters that are invisible + due to text properties or overlays. */ + + static int + current_column_1 (pos) + int pos; + { + register int tab_width = XINT (current_buffer->tab_width); + register int ctl_arrow = !NILP (current_buffer->ctl_arrow); + register struct Lisp_Char_Table *dp = buffer_display_table (); + + /* Start the scan at the beginning of this line with column number 0. */ + register int col = 0; + int scan = find_next_newline (pos, -1); + int next_boundary = scan; + + if (tab_width <= 0 || tab_width > 1000) tab_width = 8; + + /* Scan forward to the target position. */ + while (scan < pos) + { + int c; + + /* Occasionally we may need to skip invisible text. */ + while (scan == next_boundary) + { + /* This updates NEXT_BOUNDARY to the next place + where we might need to skip more invisible text. */ + scan = skip_invisible (scan, &next_boundary, pos, Qnil); + if (scan >= pos) + goto endloop; + } + + c = FETCH_CHAR (scan); + if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) + { + col += XVECTOR (DISP_CHAR_VECTOR (dp, c))->size; + scan++; + continue; + } + if (c == '\n') + break; + if (c == '\r' && EQ (current_buffer->selective_display, Qt)) + break; + scan++; + if (c == '\t') + { + int prev_col = col; + col += tab_width; + col = col / tab_width * tab_width; + } + else if (ctl_arrow && (c < 040 || c == 0177)) + col += 2; + else if (c < 040 || c >= 0177) + col += 4; + else + col++; + } + endloop: + + last_known_column = col; + last_known_column_point = point; + last_known_column_modified = MODIFF; + + return col; + } + /* Return the width in columns of the part of STRING from BEG to END. If BEG is nil, that stands for the beginning of STRING. *************** position_indentation (pos) *** 422,439 **** register unsigned char *p; register unsigned char *stop; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - stop = &FETCH_CHAR (BUFFER_CEILING_OF (pos)) + 1; p = &FETCH_CHAR (pos); while (1) { while (p == stop) { if (pos == ZV) return column; ! pos += p - &FETCH_CHAR (pos); p = &FETCH_CHAR (pos); - stop = &FETCH_CHAR (BUFFER_CEILING_OF (pos)) + 1; } switch (*p++) --- 579,621 ---- register unsigned char *p; register unsigned char *stop; + unsigned char *start; + int next_boundary = pos; + int ceiling = pos; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; p = &FETCH_CHAR (pos); + /* STOP records the value of P at which we will need + to think about the gap, or about invisible text, + or about the end of the buffer. */ + stop = p; + /* START records the starting value of P. */ + start = p; while (1) { while (p == stop) { + int stop_pos; + + /* If we have updated P, set POS to match. + The first time we enter the loop, POS is already right. */ + if (p != start) + pos = PTR_CHAR_POS (p); + /* Consider the various reasons STOP might have been set here. */ if (pos == ZV) return column; ! if (pos == next_boundary) ! pos = skip_invisible (pos, &next_boundary, ZV, Qnil); ! if (pos >= ceiling) ! ceiling = BUFFER_CEILING_OF (pos) + 1; ! /* Compute the next place we need to stop and think, ! and set STOP accordingly. */ ! stop_pos = min (ceiling, next_boundary); ! /* The -1 and +1 arrange to point at the first byte of gap ! (if STOP_POS is the position of the gap) ! rather than at the data after the gap. */ ! ! stop = &FETCH_CHAR (stop_pos - 1) + 1; p = &FETCH_CHAR (pos); } switch (*p++) *************** indented_beyond_p (pos, column) *** 462,466 **** return (position_indentation (pos) >= column); } - DEFUN ("move-to-column", Fmove_to_column, Smove_to_column, 1, 2, "p", --- 644,647 ---- *************** The return value is the current column." *** 494,504 **** int c; if (tab_width <= 0 || tab_width > 1000) tab_width = 8; CHECK_NATNUM (column, 0); goal = XINT (column); - retry: pos = point; end = ZV; /* If we're starting past the desired column, --- 675,687 ---- int c; + int next_boundary; + if (tab_width <= 0 || tab_width > 1000) tab_width = 8; CHECK_NATNUM (column, 0); goal = XINT (column); pos = point; end = ZV; + next_boundary = pos; /* If we're starting past the desired column, *************** The return value is the current column." *** 506,515 **** if (col > goal) { pos = find_next_newline (pos, -1); col = 0; } ! while (col < goal && pos < end) { c = FETCH_CHAR (pos); if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) --- 689,712 ---- if (col > goal) { + end = pos; pos = find_next_newline (pos, -1); col = 0; } ! while (pos < end) { + while (pos == next_boundary) + { + pos = skip_invisible (pos, &next_boundary, end, Qnil); + if (pos >= end) + goto endloop; + } + + /* Test reaching the goal column. We do this after skipping + invisible characters, so that we put point before the + character on which the cursor will appear. */ + if (col >= goal) + break; + c = FETCH_CHAR (pos); if (dp != 0 && VECTORP (DISP_CHAR_VECTOR (dp, c))) *************** The return value is the current column." *** 537,540 **** --- 734,738 ---- col++; } + endloop: SET_PT (pos); *************** The return value is the current column." *** 566,570 **** return val; } - /* compute_motion: compute buffer posn given screen posn and vice versa */ --- 764,767 ---- *************** compute_motion (from, fromvpos, fromhpos *** 714,760 **** break; ! { ! Lisp_Object prop, position, end, limit, proplimit; ! ! XSETFASTINT (position, pos); ! ! /* Give faster response for overlay lookup near POS. */ ! recenter_overlay_lists (current_buffer, pos); ! ! /* We must not advance farther than the next overlay change. ! The overlay change might change the invisible property; ! or there might be overlay strings to be displayed there. */ ! limit = Fnext_overlay_change (position); ! /* As for text properties, this gives a lower bound ! for where the invisible text property could change. */ ! proplimit = Fnext_property_change (position, buffer, Qt); ! if (XFASTINT (limit) < XFASTINT (proplimit)) ! proplimit = limit; ! /* PROPLIMIT is now a lower bound for the next change ! in invisible status. If that is plenty far away, ! use that lower bound. */ ! if (XFASTINT (proplimit) > pos + 100 || XFASTINT (proplimit) >= to) ! next_boundary = XFASTINT (proplimit); ! /* Otherwise, scan for the next `invisible' property change. */ ! else ! { ! /* Don't scan terribly far. */ ! XSETFASTINT (proplimit, min (pos + 100, to)); ! /* No matter what. don't go past next overlay change. */ ! if (XFASTINT (limit) < XFASTINT (proplimit)) ! proplimit = limit; ! end = Fnext_single_property_change (position, Qinvisible, ! buffer, proplimit); ! next_boundary = XFASTINT (end); ! } ! /* if the `invisible' property is set, we can skip to ! the next property change */ ! if (EQ (win->buffer, buffer)) ! prop = Fget_char_property (position, Qinvisible, window); ! else ! prop = Fget_char_property (position, Qinvisible, buffer); ! if (TEXT_PROP_MEANS_INVISIBLE (prop)) ! pos = next_boundary; ! } } --- 911,919 ---- break; ! /* Advance POS past invisible characters ! (but not necessarily all that there are here), ! and store in next_boundary the next position where ! we need to call skip_invisible. */ ! pos = skip_invisible (pos, &next_boundary, to, window); } *************** vmotion (from, vtarget, w) *** 1220,1236 **** DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0, ! "Move to start of screen line LINES lines down.\n\ ! If LINES is negative, this is moving up.\n\ \n\ The optional second argument WINDOW specifies the window to use for\n\ parameters such as width, horizontal scrolling, and so on.\n\ ! the default is the selected window.\n\ ! It does not matter what buffer is displayed in WINDOW.\n\ ! `vertical-motion' always uses the current buffer.\n\ \n\ ! Sets point to position found; this may be start of line\n\ ! or just the start of a continuation line.\n\ ! Returns number of lines moved; may be closer to zero than LINES\n\ ! if beginning or end of buffer was reached.") (lines, window) Lisp_Object lines, window; --- 1379,1402 ---- DEFUN ("vertical-motion", Fvertical_motion, Svertical_motion, 1, 2, 0, ! "Move point to start of the screen line LINES lines down.\n\ ! If LINES is negative, this means moving up.\n\ ! \n\ ! This function is an ordinary cursor motion function\n\ ! which calculates the new position based on how text would be displayed.\n\ ! The new position may be the start of a line,\n\ ! or just the start of a continuation line.\n\ ! The function returns number of screen lines moved over;\n\ ! that usually equals LINES, but may be closer to zero\n\ ! if beginning or end of buffer was reached.\n\ \n\ The optional second argument WINDOW specifies the window to use for\n\ parameters such as width, horizontal scrolling, and so on.\n\ ! The default is to use the selected window's parameters.\n\ \n\ ! `vertical-motion' always uses the current buffer,\n\ ! regardless of which buffer is displayed in WINDOW.\n\ ! This is consistent with other cursor motion functions\n\ ! and makes it possible to use `vertical-motion' in any buffer,\n\ ! whether or not it is currently displayed in some window.") (lines, window) Lisp_Object lines, window; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/intervals.c emacs-19.32/src/intervals.c *** emacs-19.31/src/intervals.c Thu Apr 25 23:00:45 1996 --- emacs-19.32/src/intervals.c Sat Jul 20 00:44:09 1996 *************** balance_intervals_internal (tree) *** 432,438 **** /* Balance within each side. */ if (tree->left) ! balance_intervals (tree->left); if (tree->right) ! balance_intervals (tree->right); return balance_an_interval (tree); } --- 432,438 ---- /* Balance within each side. */ if (tree->left) ! balance_intervals_internal (tree->left); if (tree->right) ! balance_intervals_internal (tree->right); return balance_an_interval (tree); } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/keyboard.c emacs-19.32/src/keyboard.c *** emacs-19.31/src/keyboard.c Thu May 23 15:20:25 1996 --- emacs-19.32/src/keyboard.c Tue Jul 16 18:22:12 1996 *************** read_char (commandflag, nmaps, maps, pre *** 2097,2105 **** if (STRINGP (Vkeyboard_translate_table) ! && XSTRING (Vkeyboard_translate_table)->size > XFASTINT (c)) XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]); else if ((VECTORP (Vkeyboard_translate_table) ! && XVECTOR (Vkeyboard_translate_table)->size > XFASTINT (c)) ! || CHAR_TABLE_P (Vkeyboard_translate_table)) { Lisp_Object d; --- 2097,2106 ---- if (STRINGP (Vkeyboard_translate_table) ! && XSTRING (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c)) XSETINT (c, XSTRING (Vkeyboard_translate_table)->data[XFASTINT (c)]); else if ((VECTORP (Vkeyboard_translate_table) ! && XVECTOR (Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c)) ! || (CHAR_TABLE_P (Vkeyboard_translate_table) ! && CHAR_TABLE_ORDINARY_SLOTS > (unsigned) XFASTINT (c))) { Lisp_Object d; *************** kbd_buffer_get_event (kbp, used_mouse_me *** 2697,2701 **** kbd_fetch_ptr = event + 1; input_pending = readable_events (0); ! x_activate_menubar (XFRAME (event->frame_or_window)); } #endif --- 2698,2703 ---- kbd_fetch_ptr = event + 1; input_pending = readable_events (0); ! if (FRAME_LIVE_P (XFRAME (event->frame_or_window))) ! x_activate_menubar (XFRAME (event->frame_or_window)); } #endif *************** modify_event_symbol (symbol_num, modifie *** 4484,4488 **** if (CONSP (*symbol_table)) ! *symbol_table = Fcons (value, *symbol_table); else XVECTOR (*symbol_table)->contents[symbol_num] = value; --- 4486,4490 ---- if (CONSP (*symbol_table)) ! *symbol_table = Fcons (Fcons (symbol_int, value), *symbol_table); else XVECTOR (*symbol_table)->contents[symbol_num] = value; *************** menu_bar_item (key, item_string, def) *** 5221,5224 **** --- 5223,5230 ---- Lisp_Object enabled; int i; + + /* Skip menu-bar equiv keys data. */ + if (CONSP (def) && CONSP (XCONS (def)->car)) + def = XCONS (def)->cdr; if (EQ (def, Qundefined)) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/keymap.c emacs-19.32/src/keymap.c *** emacs-19.31/src/keymap.c Tue Apr 9 18:02:05 1996 --- emacs-19.32/src/keymap.c Mon Jun 10 22:58:19 1996 *************** get_keymap (object) *** 259,264 **** --- 259,397 ---- return get_keymap_1 (object, 1, 0); } + + /* Return the parent map of the keymap MAP, or nil if it has none. + We assume that MAP is a valid keymap. */ + + DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0, + "Return the parent keymap of KEYMAP.") + (keymap) + Lisp_Object keymap; + { + Lisp_Object list; + + keymap = get_keymap_1 (keymap, 1, 1); + + /* Skip past the initial element `keymap'. */ + list = XCONS (keymap)->cdr; + for (; CONSP (list); list = XCONS (list)->cdr) + { + /* See if there is another `keymap'. */ + if (EQ (Qkeymap, XCONS (list)->car)) + return list; + } + + return Qnil; + } + + /* Set the parent keymap of MAP to PARENT. */ + + DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0, + "Modify KEYMAP to set its parent map to PARENT.\n\ + PARENT should be nil or another keymap.") + (keymap, parent) + Lisp_Object keymap, parent; + { + Lisp_Object list, prev; + int i; + + keymap = get_keymap_1 (keymap, 1, 1); + if (!NILP (parent)) + parent = get_keymap_1 (parent, 1, 1); + + /* Skip past the initial element `keymap'. */ + prev = keymap; + while (1) + { + list = XCONS (prev)->cdr; + /* If there is a parent keymap here, replace it. + If we came to the end, add the parent in PREV. */ + if (! CONSP (list) || EQ (Qkeymap, XCONS (list)->car)) + { + /* If we already have the right parent, return now + so that we avoid the loops below. */ + if (EQ (XCONS (prev)->cdr, parent)) + return parent; + + XCONS (prev)->cdr = parent; + break; + } + prev = list; + } + /* Scan through for submaps, and set their parents too. */ + for (list = XCONS (keymap)->cdr; CONSP (list); list = XCONS (list)->cdr) + { + /* Stop the scan when we come to the parent. */ + if (EQ (XCONS (list)->car, Qkeymap)) + break; + + /* If this element holds a prefix map, deal with it. */ + if (CONSP (XCONS (list)->car) + && CONSP (XCONS (XCONS (list)->car)->cdr)) + fix_submap_inheritance (keymap, XCONS (XCONS (list)->car)->car, + XCONS (XCONS (list)->car)->cdr); + + if (VECTORP (XCONS (list)->car)) + for (i = 0; i < XVECTOR (XCONS (list)->car)->size; i++) + if (CONSP (XVECTOR (XCONS (list)->car)->contents[i])) + fix_submap_inheritance (keymap, make_number (i), + XVECTOR (XCONS (list)->car)->contents[i]); + } + + return parent; + } + + /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition. + if EVENT is also a prefix in MAP's parent, + make sure that SUBMAP inherits that definition as its own parent. */ + + fix_submap_inheritance (map, event, submap) + Lisp_Object map, event, submap; + { + Lisp_Object map_parent, parent_entry; + + /* SUBMAP is a cons that we found as a key binding. + Discard the other things found in a menu key binding. */ + + if (CONSP (submap) + && STRINGP (XCONS (submap)->car)) + { + submap = XCONS (submap)->cdr; + /* Also remove a menu help string, if any, + following the menu item name. */ + if (CONSP (submap) && STRINGP (XCONS (submap)->car)) + submap = XCONS (submap)->cdr; + /* Also remove the sublist that caches key equivalences, if any. */ + if (CONSP (submap) + && CONSP (XCONS (submap)->car)) + { + Lisp_Object carcar; + carcar = XCONS (XCONS (submap)->car)->car; + if (NILP (carcar) || VECTORP (carcar)) + submap = XCONS (submap)->cdr; + } + } + + /* If it isn't a keymap now, there's no work to do. */ + if (! CONSP (submap) + || ! EQ (XCONS (submap)->car, Qkeymap)) + return; + + map_parent = Fkeymap_parent (map); + if (! NILP (map_parent)) + parent_entry = access_keymap (map_parent, event, 0, 0); + else + parent_entry = Qnil; + + /* If MAP's parent has something other than a keymap, + our own submap shadows it completely, so use nil as SUBMAP's parent. */ + if (! (CONSP (parent_entry) && EQ (XCONS (parent_entry)->car, Qkeymap))) + parent_entry = Qnil; + + if (! EQ (parent_entry, submap)) + Fset_keymap_parent (submap, parent_entry); + } + /* Look up IDX in MAP. IDX may be any sort of event. Note that this does only one level of lookup; IDX must be a single *************** access_keymap (map, idx, t_ok, noinherit *** 321,324 **** --- 454,459 ---- if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); return val; } *************** access_keymap (map, idx, t_ok, noinherit *** 333,336 **** --- 468,473 ---- if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap)) return Qnil; + if (CONSP (val)) + fix_submap_inheritance (map, idx, val); return val; } *************** define_as_prefix (keymap, c) *** 760,763 **** --- 897,914 ---- inherit the other prefix definition. */ inherit = access_keymap (keymap, c, 0, 0); + #if 0 + /* This code is needed to do the right thing in the following case: + keymap A inherits from B, + you define KEY as a prefix in A, + then later you define KEY as a prefix in B. + We want the old prefix definition in A to inherit from that in B. + It is hard to do that retroactively, so this code + creates the prefix in B right away. + + But it turns out that this code causes problems immediately + when the prefix in A is defined: it causes B to define KEY + as a prefix with no subcommands. + + So I took out this code. */ if (NILP (inherit)) { *************** define_as_prefix (keymap, c) *** 774,777 **** --- 925,929 ---- inherit = define_as_prefix (tail, c); } + #endif cmd = nconc2 (cmd, inherit); *************** and applies even for keys that have ordi *** 2649,2652 **** --- 2801,2806 ---- defsubr (&Skeymapp); + defsubr (&Skeymap_parent); + defsubr (&Sset_keymap_parent); defsubr (&Smake_keymap); defsubr (&Smake_sparse_keymap); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/lisp.h emacs-19.32/src/lisp.h *** emacs-19.31/src/lisp.h Fri Apr 26 15:51:38 1996 --- emacs-19.32/src/lisp.h Tue Jul 16 01:06:22 1996 *************** extern Lisp_Object Fread_no_blanks_input *** 1648,1652 **** extern Lisp_Object Qminus, Qplus, Vcurrent_prefix_arg; extern Lisp_Object Vcommand_history; ! extern Lisp_Object Qcall_interactively; extern Lisp_Object Fcall_interactively (); extern Lisp_Object Fprefix_numeric_value (); --- 1648,1652 ---- extern Lisp_Object Qminus, Qplus, Vcurrent_prefix_arg; extern Lisp_Object Vcommand_history; ! extern Lisp_Object Qcall_interactively, Qmouse_leave_buffer_hook; extern Lisp_Object Fcall_interactively (); extern Lisp_Object Fprefix_numeric_value (); *************** extern Lisp_Object truncate_undo_list () *** 1771,1775 **** /* defined in textprop.c */ extern Lisp_Object Qmodification_hooks; ! extern Lisp_Object Qrear_nonsticky; extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; extern Lisp_Object Fnext_property_change (); --- 1771,1775 ---- /* defined in textprop.c */ extern Lisp_Object Qmodification_hooks; ! extern Lisp_Object Qrear_nonsticky, Qfont; extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks; extern Lisp_Object Fnext_property_change (); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/m/alpha.h emacs-19.32/src/m/alpha.h *** emacs-19.31/src/m/alpha.h Mon Jan 15 04:15:02 1996 --- emacs-19.32/src/m/alpha.h Tue Jul 16 18:26:43 1996 *************** NOTE-END *** 140,147 **** - #define HAVE_X11R4 - #define HAVE_X11R5 - - /* Describe layout of the address space in an executing process. */ --- 140,143 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/m/iris4d.h emacs-19.32/src/m/iris4d.h *** emacs-19.31/src/m/iris4d.h Tue Jan 23 11:59:08 1996 --- emacs-19.32/src/m/iris4d.h Tue Jul 23 14:28:12 1996 *************** Boston, MA 02111-1307, USA. */ *** 132,136 **** --- 132,140 ---- #undef LIBS_MACHINE /* -lsun in case using Yellow Pages for passwords. */ + #if defined(__GNUC__) && defined(_ABIN32) + #define LIBS_MACHINE + #else #define LIBS_MACHINE -lmld + #endif #define LIBS_DEBUG diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/m/iris5d.h emacs-19.32/src/m/iris5d.h *** emacs-19.31/src/m/iris5d.h Tue Jan 23 12:01:41 1996 --- emacs-19.32/src/m/iris5d.h Tue Jul 23 14:30:19 1996 *************** *** 1,3 **** ! /* machine description file for Iris-4D machines. Use with s-iris3-6.h Copyright (C) 1987 Free Software Foundation, Inc. --- 1,3 ---- ! /* machine description file for Iris-5D machines. Use with s-iris3-6.h Copyright (C) 1987 Free Software Foundation, Inc. *************** Boston, MA 02111-1307, USA. */ *** 131,135 **** --- 131,140 ---- #undef LIBS_MACHINE /* -lsun in case using Yellow Pages for passwords. */ + #if defined(__GNUC__) && defined(_ABIN32) + #define LIBS_MACHINE -lsun + #else #define LIBS_MACHINE -lsun -lmld + #endif + #define LIBS_DEBUG diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/m/mips.h emacs-19.32/src/m/mips.h *** emacs-19.31/src/m/mips.h Mon Jan 15 04:15:02 1996 --- emacs-19.32/src/m/mips.h Tue Jul 23 14:28:10 1996 *************** NOTE-END */ *** 143,147 **** --- 143,152 ---- #else /* not BSD */ + #if defined(__GNUC__) && defined(_ABIN32) + #define LIBS_MACHINE + #else #define LIBS_MACHINE -lmld + #endif + #define LD_SWITCH_MACHINE -D 800000 -g3 #define START_FILES pre-crt0.o /usr/lib/crt1.o diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/makefile.nt emacs-19.32/src/makefile.nt *** emacs-19.31/src/makefile.nt Wed May 15 10:41:24 1996 --- emacs-19.32/src/makefile.nt Sat Jul 20 14:06:12 1996 *************** *** 17,22 **** # # 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ # --- 17,23 ---- # # 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. # *************** paths.h: ..\nt\paths.h *** 161,165 **** # Make sure we have the DOC file in the right place. # ! DOC = obj\etc\DOC-X $(DOC):; cd ..\lib-src - $(DEL) DOC-X --- 162,166 ---- # Make sure we have the DOC file in the right place. # ! DOC = $(OBJDIR)\etc\DOC-X $(DOC):; cd ..\lib-src - $(DEL) DOC-X *************** install: all *** 232,236 **** clean:; - $(DEL) *~ *.pdb config.h paths.h - $(DEL_TREE) deleted ! - $(DEL_TREE) obj # --- 233,237 ---- clean:; - $(DEL) *~ *.pdb config.h paths.h - $(DEL_TREE) deleted ! - $(DEL_TREE) $(OBJDIR) # diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/mem-limits.h emacs-19.32/src/mem-limits.h *** emacs-19.31/src/mem-limits.h Mon Jan 15 04:06:29 1996 --- emacs-19.32/src/mem-limits.h Thu Jul 11 19:40:08 1996 *************** *** 1,4 **** /* Includes for memory limit warnings. ! Copyright (C) 1990, 1993, 1994, 1995 Free Software Foundation, Inc. This file is part of GNU Emacs. --- 1,4 ---- /* Includes for memory limit warnings. ! Copyright (C) 1990, 1993, 1994, 1995, 1996 Free Software Foundation, Inc. This file is part of GNU Emacs. *************** Boston, MA 02111-1307, USA. */ *** 32,36 **** /* Old Linux startup code won't define __data_start. */ ! extern int etext, __data_start; weak_symbol (__data_start) #define start_of_data() (&__data_start ?: &etext) --- 32,36 ---- /* Old Linux startup code won't define __data_start. */ ! extern int etext, __data_start; weak_extern (__data_start) #define start_of_data() (&__data_start ?: &etext) *************** static POINTER data_space_start; *** 103,107 **** /* Number of bytes of writable memory we can expect to be able to get */ ! static unsigned int lim_data; #ifdef NO_LIM_DATA --- 103,107 ---- /* Number of bytes of writable memory we can expect to be able to get */ ! static unsigned long lim_data; #ifdef NO_LIM_DATA diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/minibuf.c emacs-19.32/src/minibuf.c *** emacs-19.31/src/minibuf.c Tue Apr 9 21:51:04 1996 --- emacs-19.32/src/minibuf.c Mon Jun 10 17:03:57 1996 *************** choose_minibuf_frame () *** 114,120 **** && !EQ (minibuf_window, selected_frame->minibuffer_window)) { - #if defined(MSDOS) && !defined(HAVE_X_WINDOWS) - selected_frame->minibuffer_window = minibuf_window; - #else /* I don't think that any frames may validly have a null minibuffer window anymore. */ --- 114,117 ---- *************** choose_minibuf_frame () *** 125,129 **** XWINDOW (minibuf_window)->buffer); minibuf_window = selected_frame->minibuffer_window; - #endif } } --- 122,125 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/msdos.c emacs-19.32/src/msdos.c *** emacs-19.31/src/msdos.c Sun May 12 13:45:14 1996 --- emacs-19.32/src/msdos.c Sun Jul 7 18:39:45 1996 *************** ScreenVisualBell (void) *** 366,369 **** --- 366,380 ---- #ifndef HAVE_X_WINDOWS + /* Enable bright background colors. */ + static void + bright_bg (void) + { + union REGS regs; + + regs.h.bl = 0; + regs.x.ax = 0x1003; + int86 (0x10, ®s, ®s); + } + /* Set the screen dimensions so that it can show no less than ROWS x COLS frame. */ *************** dos_set_window_size (rows, cols) *** 402,408 **** regs.x.ax = video_mode_value; int86 (0x10, ®s, ®s); - regs.h.bl = 0; - regs.x.ax = 0x1003; - int86 (0x10, ®s, ®s); if (have_mouse) --- 413,416 ---- *************** dos_set_window_size (rows, cols) *** 495,498 **** --- 503,509 ---- *rows = ScreenRows (); *cols = ScreenCols (); + + /* Enable bright background colors. */ + bright_bg (); } *************** IT_update_end () *** 667,671 **** } ! /* This was more or less copied from xterm.c */ static void --- 678,685 ---- } ! /* This was more or less copied from xterm.c ! ! Nowadays, the corresponding function under X is `x_set_menu_bar_lines_1' ! on xfns.c */ static void *************** IT_set_menu_bar_lines (window, n) *** 692,695 **** --- 706,735 ---- } + /* This was copied from xfns.c */ + + void + x_set_menu_bar_lines (f, value, oldval) + struct frame *f; + Lisp_Object value, oldval; + { + int nlines; + int olines = FRAME_MENU_BAR_LINES (f); + + /* Right now, menu bars don't work properly in minibuf-only frames; + most of the commands try to apply themselves to the minibuffer + frame itslef, and get an error because you can't switch buffers + in or split the minibuffer window. */ + if (FRAME_MINIBUF_ONLY_P (f)) + return; + + if (INTEGERP (value)) + nlines = XINT (value); + else + nlines = 0; + + FRAME_MENU_BAR_LINES (f) = nlines; + IT_set_menu_bar_lines (f->root_window, nlines - olines); + } + /* IT_set_terminal_modes is called when emacs is started, resumed, and whenever the screen is redrawn! */ *************** IT_set_terminal_modes (void) *** 727,730 **** --- 767,772 ---- fprintf (termscript, "\n", screen_size_X, screen_size_Y); + + bright_bg (); } *************** IT_set_terminal_window (void) *** 801,806 **** void ! IT_set_frame_parameters (frame, alist) ! FRAME_PTR frame; Lisp_Object alist; { --- 843,848 ---- void ! IT_set_frame_parameters (f, alist) ! FRAME_PTR f; Lisp_Object alist; { *************** IT_set_frame_parameters (frame, alist) *** 808,812 **** int redraw; extern unsigned long load_color (); - FRAME_PTR f = (FRAME_PTR) &the_only_frame; redraw = 0; --- 850,853 ---- *************** IT_set_frame_parameters (frame, alist) *** 827,830 **** --- 868,873 ---- FRAME_FOREGROUND_PIXEL (f) = new_color; redraw = 1; + if (termscript) + fprintf (termscript, "\n", new_color); } } *************** IT_set_frame_parameters (frame, alist) *** 834,853 **** if (new_color != ~0) { ! FRAME_BACKGROUND_PIXEL (f) = new_color & ~8; redraw = 1; } } else if (EQ (prop, intern ("menu-bar-lines"))) ! { ! int new; ! int old = FRAME_MENU_BAR_LINES (the_only_frame); ! ! if (INTEGERP (val)) ! new = XINT (val); ! else ! new = 0; ! FRAME_MENU_BAR_LINES (f) = new; ! IT_set_menu_bar_lines (the_only_frame.root_window, new - old); ! } } --- 877,888 ---- if (new_color != ~0) { ! FRAME_BACKGROUND_PIXEL (f) = new_color; redraw = 1; + if (termscript) + fprintf (termscript, "\n", new_color); } } else if (EQ (prop, intern ("menu-bar-lines"))) ! x_set_menu_bar_lines (f, val, 0); } *************** IT_set_frame_parameters (frame, alist) *** 855,859 **** { recompute_basic_faces (f); ! Fredraw_frame (Fselected_frame ()); } } --- 890,895 ---- { recompute_basic_faces (f); ! if (f == selected_frame) ! redraw_frame (f); } } *************** internal_terminal_init () *** 884,888 **** if (!internal_terminal || inhibit_window_system) { ! the_only_frame.output_method = output_termcap; return; } --- 920,924 ---- if (!internal_terminal || inhibit_window_system) { ! selected_frame->output_method = output_termcap; return; } *************** internal_terminal_init () *** 894,914 **** the_only_x_display.background_pixel = 7; /* White */ the_only_x_display.foreground_pixel = 0; /* Black */ colors = getenv ("EMACSCOLORS"); if (colors && strlen (colors) >= 2) { ! /* Foreground colrs use 4 bits, background only 3. */ ! if (isxdigit (colors[0]) && !isdigit (colors[0])) ! colors[0] += 10 - (isupper (colors[0]) ? 'A' : 'a'); if (colors[0] >= 0 && colors[0] < 16) the_only_x_display.foreground_pixel = colors[0]; ! if (colors[1] >= 0 && colors[1] < 8) the_only_x_display.background_pixel = colors[1]; } the_only_x_display.line_height = 1; - the_only_frame.output_data.x = &the_only_x_display; - the_only_frame.output_method = output_msdos_raw; the_only_x_display.font = (XFontStruct *)1; /* must *not* be zero */ ! init_frame_faces ((FRAME_PTR) &the_only_frame); ring_bell_hook = IT_ring_bell; --- 930,955 ---- the_only_x_display.background_pixel = 7; /* White */ the_only_x_display.foreground_pixel = 0; /* Black */ + bright_bg (); colors = getenv ("EMACSCOLORS"); if (colors && strlen (colors) >= 2) { ! /* The colors use 4 bits each (we enable bright background). */ ! if (isdigit (colors[0])) ! colors[0] -= '0'; ! else if (isxdigit (colors[0])) ! colors[0] -= (isupper (colors[0]) ? 'A' : 'a') - 10; if (colors[0] >= 0 && colors[0] < 16) the_only_x_display.foreground_pixel = colors[0]; ! if (isdigit (colors[1])) ! colors[1] -= '0'; ! else if (isxdigit (colors[1])) ! colors[1] -= (isupper (colors[1]) ? 'A' : 'a') - 10; ! if (colors[1] >= 0 && colors[1] < 16) the_only_x_display.background_pixel = colors[1]; } the_only_x_display.line_height = 1; the_only_x_display.font = (XFontStruct *)1; /* must *not* be zero */ ! init_frame_faces (selected_frame); ring_bell_hook = IT_ring_bell; *************** dos_get_saved_screen (screen, rows, cols *** 944,947 **** --- 985,1001 ---- #endif } + + #ifndef HAVE_X_WINDOWS + + /* We are not X, but we can emulate it well enough for our needs... */ + void + check_x (void) + { + if (! FRAME_MSDOS_P (selected_frame)) + error ("Not running under a windows system"); + } + + #endif + /* ----------------------- Keyboard control ---------------------- *************** IT_menu_display (XMenu *menu, int y, int *** 1801,1805 **** *p++ = FAST_MAKE_GLYPH (' ', face); for (j = 0, q = menu->text[i]; *q; j++) ! *p++ = FAST_MAKE_GLYPH (*q++, face); for (; j < width; j++) *p++ = FAST_MAKE_GLYPH (' ', face); --- 1855,1869 ---- *p++ = FAST_MAKE_GLYPH (' ', face); for (j = 0, q = menu->text[i]; *q; j++) ! { ! if (*q > 26) ! *p++ = FAST_MAKE_GLYPH (*q++, face); ! else /* make '^x' */ ! { ! *p++ = FAST_MAKE_GLYPH ('^', face); ! j++; ! *p++ = FAST_MAKE_GLYPH (*q++ + 64, face); ! } ! } ! for (; j < width; j++) *p++ = FAST_MAKE_GLYPH (' ', face); *************** XMenuAddPane (Display *foo, XMenu *menu, *** 1838,1841 **** --- 1902,1906 ---- { int len; + char *p; if (!enable) *************** XMenuAddPane (Display *foo, XMenu *menu, *** 1847,1852 **** menu->panenumber[menu->count] = ++menu->panecount; menu->count++; ! if ((len = strlen (txt)) > menu->width) menu->width = len; return menu->panecount; } --- 1912,1925 ---- menu->panenumber[menu->count] = ++menu->panecount; menu->count++; ! ! /* Adjust length for possible control characters (which will ! be written as ^x). */ ! for (len = strlen (txt), p = txt; *p; p++) ! if (*p < 27) ! len++; ! ! if (len > menu->width) menu->width = len; + return menu->panecount; } *************** XMenuAddSelection (Display *bar, XMenu * *** 1859,1862 **** --- 1932,1936 ---- { int len; + char *p; if (pane) *************** XMenuAddSelection (Display *bar, XMenu * *** 1868,1873 **** menu->panenumber[menu->count] = enable; menu->count++; ! if ((len = strlen (txt)) > menu->width) menu->width = len; return XM_SUCCESS; } --- 1942,1955 ---- menu->panenumber[menu->count] = enable; menu->count++; ! ! /* Adjust length for possible control characters (which will ! be written as ^x). */ ! for (len = strlen (txt), p = txt; *p; p++) ! if (*p < 27) ! len++; ! ! if (len > menu->width) menu->width = len; + return XM_SUCCESS; } *************** XMenuActivate (Display *foo, XMenu *menu *** 1907,1910 **** --- 1989,1993 ---- int leave, result, onepane; int title_faces[4]; /* face to display the menu title */ + int buffers_num_deleted = 0; /* Just in case we got here without a mouse present... */ *************** XMenuActivate (Display *foo, XMenu *menu *** 1915,1933 **** screensize = screen_size * 2; faces[0] ! = compute_glyph_face (&the_only_frame, face_name_id_number ! (&the_only_frame, intern ("msdos-menu-passive-face")), 0); faces[1] ! = compute_glyph_face (&the_only_frame, face_name_id_number ! (&the_only_frame, intern ("msdos-menu-active-face")), 0); selectface ! = face_name_id_number (&the_only_frame, intern ("msdos-menu-select-face")); ! faces[2] = compute_glyph_face (&the_only_frame, selectface, faces[0]); ! faces[3] = compute_glyph_face (&the_only_frame, selectface, faces[1]); /* Make sure the menu title is always displayed with --- 1998,2016 ---- screensize = screen_size * 2; faces[0] ! = compute_glyph_face (selected_frame, face_name_id_number ! (selected_frame, intern ("msdos-menu-passive-face")), 0); faces[1] ! = compute_glyph_face (selected_frame, face_name_id_number ! (selected_frame, intern ("msdos-menu-active-face")), 0); selectface ! = face_name_id_number (selected_frame, intern ("msdos-menu-select-face")); ! faces[2] = compute_glyph_face (selected_frame, selectface, faces[0]); ! faces[3] = compute_glyph_face (selected_frame, selectface, faces[1]); /* Make sure the menu title is always displayed with *************** XMenuActivate (Display *foo, XMenu *menu *** 1937,1940 **** --- 2020,2035 ---- statecount = 1; + + /* Don't let the title for the "Buffers" popup menu include a + digit (which is ugly). + + This is a terrible kludge, but I think the "Buffers" case is + the only one where the title includes a number, so it doesn't + seem to be necessary to make this more general. */ + if (strncmp (menu->text[0], "Buffers 1", 9) == 0) + { + menu->text[0][7] = '\0'; + buffers_num_deleted = 1; + } state[0].menu = menu; mouse_off (); *************** XMenuActivate (Display *foo, XMenu *menu *** 1942,1945 **** --- 2037,2042 ---- IT_menu_display (menu, y0 - 1, x0 - 1, title_faces); /* display menu title */ + if (buffers_num_deleted) + menu->text[0][7] = ' '; if ((onepane = menu->count == 1 && menu->submenu[0])) { *************** x_pixel_height (struct frame *f) *** 2062,2065 **** --- 2159,2164 ---- /* ----------------------- DOS / UNIX conversion --------------------- */ + void msdos_downcase_filename (unsigned char *); + /* Destructively turn backslashes into slashes. */ *************** dostounix_filename (p) *** 2068,2071 **** --- 2167,2172 ---- register char *p; { + msdos_downcase_filename (p); + while (*p) { *************** unixtodos_filename (p) *** 2082,2085 **** --- 2183,2192 ---- register char *p; { + if (p[1] == ':' && *p >= 'A' && *p <= 'Z') + { + *p += 'a' - 'A'; + p += 2; + } + while (*p) { *************** unixtodos_filename (p) *** 2091,2095 **** /* Get the default directory for a given drive. 0=def, 1=A, 2=B, ... */ - void msdos_downcase_filename (unsigned char *); int --- 2198,2201 ---- *************** msdos_downcase_filename (p) *** 2237,2240 **** --- 2343,2357 ---- register unsigned char *p; { + /* Always lower-case drive letters a-z, even if the filesystem + preserves case in filenames. + This is so MSDOS filenames could be compared by string comparison + functions that are case-sensitive. Even case-preserving filesystems + do not distinguish case in drive letters. */ + if (p[1] == ':' && *p >= 'A' && *p <= 'Z') + { + *p += 'a' - 'A'; + p += 2; + } + /* Under LFN we expect to get pathnames in their true case. */ if (NILP (Fmsdos_long_file_names ())) *************** init_environment (argc, argv, skip_args) *** 2297,2301 **** root = alloca (MAXPATHLEN + 20); _fixpath (argv[0], root); ! strlwr (root); len = strlen (root); while (len > 0 && root[len] != '/' && root[len] != ':') --- 2414,2418 ---- root = alloca (MAXPATHLEN + 20); _fixpath (argv[0], root); ! msdos_downcase_filename (root); len = strlen (root); while (len > 0 && root[len] != '/' && root[len] != ':') *************** init_environment (argc, argv, skip_args) *** 2331,2335 **** t = alloca (strlen (s) + 1); strcpy (t, s); - strlwr (t); dostounix_filename (t); setenv ("SHELL", t, 0); --- 2448,2451 ---- *************** init_environment (argc, argv, skip_args) *** 2342,2346 **** not normally mentioned. Now it is. */ strcat (strcpy (t, ".;"), s); - strlwr (t); dostounix_filename (t); /* Not a single file name, but this should work. */ setenv ("PATH", t, 1); --- 2458,2461 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/msdos.h emacs-19.32/src/msdos.h *** emacs-19.31/src/msdos.h Tue Apr 9 23:38:18 1996 --- emacs-19.32/src/msdos.h Mon Jun 10 16:23:43 1996 *************** extern Display *x_current_display; *** 95,107 **** #define load_pixmap(p1,p2,p3,p4) (0) #define XGetGeometry(p1,p2,p3,p4,p5,p6,p7,p8,p9) ! #define DisplayWidth(p1,p2) (the_only_frame.width) ! #define DisplayHeight(p1,p2) (the_only_frame.height) #define XMenuSetAEQ (void) #define XMenuSetFreeze (void) #define XMenuRecompute (void) #define FONT_WIDTH(foo) 1 - /* Function `getcbrk' is the most harmless I can think of right now... */ - #define check_x if (FRAME_TERMCAP_P (bar)) error ("Not running under a windows system."); else getcbrk - #define x_mouse_leave getcbrk #define XM_FAILURE -1 #define XM_SUCCESS 1 --- 95,104 ---- #define load_pixmap(p1,p2,p3,p4) (0) #define XGetGeometry(p1,p2,p3,p4,p5,p6,p7,p8,p9) ! #define DisplayWidth(p1,p2) (selected_frame->width) ! #define DisplayHeight(p1,p2) (selected_frame->height) #define XMenuSetAEQ (void) #define XMenuSetFreeze (void) #define XMenuRecompute (void) #define FONT_WIDTH(foo) 1 #define XM_FAILURE -1 #define XM_SUCCESS 1 diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/nt.c emacs-19.32/src/nt.c *** emacs-19.31/src/nt.c Tue May 21 13:37:37 1996 --- emacs-19.32/src/nt.c Sat Jul 6 21:42:57 1996 *************** static int dir_is_fat; *** 123,126 **** --- 123,128 ---- static char dir_pathname[MAXPATHLEN+1]; + extern Lisp_Object Vwin32_downcase_file_names; + DIR * opendir (char *filename) *************** readdir (DIR *dirp) *** 198,201 **** --- 200,212 ---- if (dir_is_fat) _strlwr (dir_static.d_name); + else if (!NILP (Vwin32_downcase_file_names)) + { + register char *p; + for (p = dir_static.d_name; *p; p++) + if (*p >= 'a' && *p <= 'z') + break; + if (!*p) + _strlwr (dir_static.d_name); + } return &dir_static; *************** srandom (int seed) *** 379,382 **** --- 390,454 ---- } + /* Normalize filename by converting all path separators to + the specified separator. Also conditionally convert upper + case path name components to lower case. */ + + static void + normalize_filename (fp, path_sep) + register char *fp; + char path_sep; + { + char sep; + char *elem; + + /* Always lower-case drive letters a-z, even if the filesystem + preserves case in filenames. + This is so filenames can be compared by string comparison + functions that are case-sensitive. Even case-preserving filesystems + do not distinguish case in drive letters. */ + if (fp[1] == ':' && *fp >= 'A' && *fp <= 'Z') + { + *fp += 'a' - 'A'; + fp += 2; + } + + if (NILP (Vwin32_downcase_file_names)) + { + while (*fp) + { + if (*fp == '/' || *fp == '\\') + *fp = path_sep; + fp++; + } + return; + } + + sep = path_sep; /* convert to this path separator */ + elem = fp; /* start of current path element */ + + do { + if (*fp >= 'a' && *fp <= 'z') + elem = 0; /* don't convert this element */ + + if (*fp == 0 || *fp == ':') + { + sep = *fp; /* restore current separator (or 0) */ + *fp = '/'; /* after conversion of this element */ + } + + if (*fp == '/' || *fp == '\\') + { + if (elem && elem != fp) + { + *fp = 0; /* temporary end of string */ + _strlwr (elem); /* while we convert to lower case */ + } + *fp = sep; /* convert (or restore) path separator */ + elem = fp + 1; /* next element starts after separator */ + sep = path_sep; + } + } while (*fp++); + } + /* Destructively turn backslashes into slashes. */ void *************** dostounix_filename (p) *** 384,393 **** register char *p; { ! while (*p) ! { ! if (*p == '\\') ! *p = '/'; ! p++; ! } } --- 456,460 ---- register char *p; { ! normalize_filename (p, '/'); } *************** unixtodos_filename (p) *** 397,406 **** register char *p; { ! while (*p) ! { ! if (*p == '/') ! *p = '\\'; ! p++; ! } } --- 464,468 ---- register char *p; { ! normalize_filename (p, '\\'); } *************** init_environment () *** 534,537 **** --- 596,600 ---- { "HOME", + "PRELOAD_WINSOCK", "emacs_dir", "EMACSLOADPATH", *************** sys_mkdir (const char * path) *** 938,945 **** } char * sys_mktemp (char * template) { ! return (char *) map_win32_filename ((const char *) _mktemp (template), NULL); } --- 1001,1052 ---- } + /* Because of long name mapping issues, we need to implement this + ourselves. Also, MSVC's _mktemp returns NULL when it can't generate + a unique name, instead of setting the input template to an empty + string. + + Standard algorithm seems to be use pid or tid with a letter on the + front (in place of the 6 X's) and cycle through the letters to find a + unique name. We extend that to allow any reasonable character as the + first of the 6 X's. */ char * sys_mktemp (char * template) { ! char * p; ! int i; ! unsigned uid = GetCurrentThreadId (); ! static char first_char[] = "abcdefghijklmnopqrstuvwyz0123456789!%-_@#"; ! ! if (template == NULL) ! return NULL; ! p = template + strlen (template); ! i = 5; ! /* replace up to the last 5 X's with uid in decimal */ ! while (--p >= template && p[0] == 'X' && --i >= 0) ! { ! p[0] = '0' + uid % 10; ! uid /= 10; ! } ! ! if (i < 0 && p[0] == 'X') ! { ! i = 0; ! do ! { ! int save_errno = errno; ! p[0] = first_char[i]; ! if (sys_access (template, 0) < 0) ! { ! errno = save_errno; ! return template; ! } ! } ! while (++i < sizeof (first_char)); ! } ! ! /* Template is badly formed or else we can't generate a unique name, ! so return empty string */ ! template[0] = 0; ! return template; } *************** sys_rename (const char * oldname, const *** 955,963 **** { char temp[MAX_PATH]; /* MoveFile on Win95 doesn't correctly change the short file name ! alias when oldname has a three char extension and newname has the ! same first three chars in its extension. To avoid problems, on ! Win95 we rename to a temporary name first. */ strcpy (temp, map_win32_filename (oldname, NULL)); --- 1062,1079 ---- { char temp[MAX_PATH]; + DWORD attr; /* MoveFile on Win95 doesn't correctly change the short file name ! alias in a number of circumstances (it is not easy to predict when ! just by looking at oldname and newname, unfortunately). In these ! cases, renaming through a temporary name avoids the problem. ! ! A second problem on Win95 is that renaming through a temp name when ! newname is uppercase fails (the final long name ends up in ! lowercase, although the short alias might be uppercase) UNLESS the ! long temp name is not 8.3. ! ! So, on Win95 we always rename through a temp name, and we make sure ! the temp name has a long extension to ensure correct renaming. */ strcpy (temp, map_win32_filename (oldname, NULL)); *************** sys_rename (const char * oldname, const *** 967,971 **** char * p; - unixtodos_filename (temp); if (p = strrchr (temp, '\\')) p++; --- 1083,1086 ---- *************** sys_rename (const char * oldname, const *** 973,977 **** p = temp; strcpy (p, "__XXXXXX"); ! _mktemp (temp); if (rename (map_win32_filename (oldname, NULL), temp) < 0) return -1; --- 1088,1095 ---- p = temp; strcpy (p, "__XXXXXX"); ! sys_mktemp (temp); ! /* Force temp name to require a manufactured 8.3 alias - this ! seems to make the second rename work properly. */ ! strcat (temp, ".long"); if (rename (map_win32_filename (oldname, NULL), temp) < 0) return -1; *************** sys_rename (const char * oldname, const *** 979,985 **** /* Emulate Unix behaviour - newname is deleted if it already exists ! (at least if it is a file; don't do this for directories). */ newname = map_win32_filename (newname, NULL); ! if (GetFileAttributes (newname) != -1) { _chmod (newname, 0666); --- 1097,1107 ---- /* Emulate Unix behaviour - newname is deleted if it already exists ! (at least if it is a file; don't do this for directories). ! However, don't do this if we are just changing the case of the file ! name - we will end up deleting the file we are trying to rename! */ newname = map_win32_filename (newname, NULL); ! if (stricmp (newname, temp) != 0 ! && (attr = GetFileAttributes (newname)) != -1 ! && (attr & FILE_ATTRIBUTE_DIRECTORY) == 0) { _chmod (newname, 0666); *************** int (PASCAL *pfn_gethostname) (char * na *** 1288,1310 **** struct hostent * (PASCAL *pfn_gethostbyname) (const char * name); struct servent * (PASCAL *pfn_getservbyname) (const char * name, const char * proto); ! static int have_winsock; ! static HANDLE winsock_lib; ! static void term_winsock (void) { ! if (have_winsock) { ! pfn_WSACleanup (); ! FreeLibrary (winsock_lib); } } ! static void ! init_winsock () { WSADATA winsockData; winsock_lib = LoadLibrary ("wsock32.dll"); --- 1410,1455 ---- struct hostent * (PASCAL *pfn_gethostbyname) (const char * name); struct servent * (PASCAL *pfn_getservbyname) (const char * name, const char * proto); + + /* SetHandleInformation is only needed to make sockets non-inheritable. */ + BOOL (WINAPI *pfn_SetHandleInformation) (HANDLE object, DWORD mask, DWORD flags); + #ifndef HANDLE_FLAG_INHERIT + #define HANDLE_FLAG_INHERIT 1 + #endif ! HANDLE winsock_lib; ! static int winsock_inuse; ! BOOL term_winsock (void) { ! if (winsock_lib != NULL && winsock_inuse == 0) { ! /* Not sure what would cause WSAENETDOWN, or even if it can happen ! after WSAStartup returns successfully, but it seems reasonable ! to allow unloading winsock anyway in that case. */ ! if (pfn_WSACleanup () == 0 || ! pfn_WSAGetLastError () == WSAENETDOWN) ! { ! if (FreeLibrary (winsock_lib)) ! winsock_lib = NULL; ! return TRUE; ! } } + return FALSE; } ! BOOL ! init_winsock (int load_now) { WSADATA winsockData; + if (winsock_lib != NULL) + return TRUE; + + pfn_SetHandleInformation = NULL; + pfn_SetHandleInformation + = (void *) GetProcAddress (GetModuleHandle ("kernel32.dll"), + "SetHandleInformation"); + winsock_lib = LoadLibrary ("wsock32.dll"); *************** init_winsock () *** 1336,1350 **** LOAD_PROC( WSACleanup ); /* specify version 1.1 of winsock */ if (pfn_WSAStartup (0x101, &winsockData) == 0) { ! have_winsock = TRUE; ! return; } fail: FreeLibrary (winsock_lib); } ! have_winsock = FALSE; } --- 1481,1514 ---- LOAD_PROC( WSACleanup ); + #undef LOAD_PROC + /* specify version 1.1 of winsock */ if (pfn_WSAStartup (0x101, &winsockData) == 0) { ! if (winsockData.wVersion != 0x101) ! goto fail; ! ! if (!load_now) ! { ! /* Report that winsock exists and is usable, but leave ! socket functions disabled. I am assuming that calling ! WSAStartup does not require any network interaction, ! and in particular does not cause or require a dial-up ! connection to be established. */ ! ! pfn_WSACleanup (); ! FreeLibrary (winsock_lib); ! winsock_lib = NULL; ! } ! winsock_inuse = 0; ! return TRUE; } fail: FreeLibrary (winsock_lib); + winsock_lib = NULL; } ! ! return FALSE; } *************** int h_errno = 0; *** 1357,1361 **** static void set_errno () { ! if (!have_winsock) h_errno = EINVAL; else --- 1521,1525 ---- static void set_errno () { ! if (winsock_lib == NULL) h_errno = EINVAL; else *************** static void set_errno () *** 1378,1382 **** static void check_errno () { ! if (h_errno == 0 && have_winsock) pfn_WSASetLastError (0); } --- 1542,1546 ---- static void check_errno () { ! if (h_errno == 0 && winsock_lib != NULL) pfn_WSASetLastError (0); } *************** sys_socket(int af, int type, int protoco *** 1401,1405 **** child_process * cp; ! if (!have_winsock) { h_errno = ENETDOWN; --- 1565,1569 ---- child_process * cp; ! if (winsock_lib == NULL) { h_errno = ENETDOWN; *************** sys_socket(int af, int type, int protoco *** 1438,1451 **** parent = GetCurrentProcess (); ! DuplicateHandle (parent, ! (HANDLE) s, ! parent, ! &new_s, ! 0, ! FALSE, ! DUPLICATE_SAME_ACCESS); ! pfn_closesocket (s); ! fd_info[fd].hnd = new_s; ! s = (SOCKET) new_s; } #endif --- 1602,1626 ---- parent = GetCurrentProcess (); ! /* Apparently there is a bug in NT 3.51 with some service ! packs, which prevents using DuplicateHandle to make a ! socket handle non-inheritable (causes WSACleanup to ! hang). The work-around is to use SetHandleInformation ! instead if it is available and implemented. */ ! if (!pfn_SetHandleInformation ! || !pfn_SetHandleInformation ((HANDLE) s, ! HANDLE_FLAG_INHERIT, ! HANDLE_FLAG_INHERIT)) ! { ! DuplicateHandle (parent, ! (HANDLE) s, ! parent, ! &new_s, ! 0, ! FALSE, ! DUPLICATE_SAME_ACCESS); ! pfn_closesocket (s); ! s = (SOCKET) new_s; ! } ! fd_info[fd].hnd = (HANDLE) s; } #endif *************** sys_socket(int af, int type, int protoco *** 1470,1473 **** --- 1645,1649 ---- /* success! */ + winsock_inuse++; /* count open sockets */ return fd; } *************** int *** 1488,1492 **** sys_bind (int s, const struct sockaddr * addr, int namelen) { ! if (!have_winsock) { h_errno = ENOTSOCK; --- 1664,1668 ---- sys_bind (int s, const struct sockaddr * addr, int namelen) { ! if (winsock_lib == NULL) { h_errno = ENOTSOCK; *************** int *** 1510,1514 **** sys_connect (int s, const struct sockaddr * name, int namelen) { ! if (!have_winsock) { h_errno = ENOTSOCK; --- 1686,1690 ---- sys_connect (int s, const struct sockaddr * name, int namelen) { ! if (winsock_lib == NULL) { h_errno = ENOTSOCK; *************** u_short *** 1531,1535 **** sys_htons (u_short hostshort) { ! return (have_winsock) ? pfn_htons (hostshort) : hostshort; } --- 1707,1711 ---- sys_htons (u_short hostshort) { ! return (winsock_lib != NULL) ? pfn_htons (hostshort) : hostshort; } *************** u_short *** 1538,1542 **** sys_ntohs (u_short netshort) { ! return (have_winsock) ? pfn_ntohs (netshort) : netshort; } --- 1714,1718 ---- sys_ntohs (u_short netshort) { ! return (winsock_lib != NULL) ? pfn_ntohs (netshort) : netshort; } *************** unsigned long *** 1545,1549 **** sys_inet_addr (const char * cp) { ! return (have_winsock) ? pfn_inet_addr (cp) : INADDR_NONE; } --- 1721,1725 ---- sys_inet_addr (const char * cp) { ! return (winsock_lib != NULL) ? pfn_inet_addr (cp) : INADDR_NONE; } *************** int *** 1552,1556 **** sys_gethostname (char * name, int namelen) { ! if (have_winsock) return pfn_gethostname (name, namelen); --- 1728,1732 ---- sys_gethostname (char * name, int namelen) { ! if (winsock_lib != NULL) return pfn_gethostname (name, namelen); *************** sys_gethostbyname(const char * name) *** 1567,1571 **** struct hostent * host; ! if (!have_winsock) { h_errno = ENETDOWN; --- 1743,1747 ---- struct hostent * host; ! if (winsock_lib == NULL) { h_errno = ENETDOWN; *************** sys_getservbyname(const char * name, con *** 1585,1589 **** struct servent * serv; ! if (!have_winsock) { h_errno = ENETDOWN; --- 1761,1765 ---- struct servent * serv; ! if (winsock_lib == NULL) { h_errno = ENETDOWN; *************** sys_close (int fd) *** 1634,1644 **** if (i == MAXDESC) { ! #if defined (HAVE_SOCKETS) && !defined (SOCK_REPLACE_HANDLE) if (fd_info[fd].flags & FILE_SOCKET) { ! if (!have_winsock) abort (); pfn_shutdown (SOCK_HANDLE (fd), 2); rc = pfn_closesocket (SOCK_HANDLE (fd)); } #endif --- 1810,1823 ---- if (i == MAXDESC) { ! #ifdef HAVE_SOCKETS if (fd_info[fd].flags & FILE_SOCKET) { ! #ifndef SOCK_REPLACE_HANDLE ! if (winsock_lib == NULL) abort (); pfn_shutdown (SOCK_HANDLE (fd), 2); rc = pfn_closesocket (SOCK_HANDLE (fd)); + #endif + winsock_inuse--; /* count open sockets */ } #endif *************** sys_read (int fd, char * buffer, unsigne *** 1893,1897 **** else /* FILE_SOCKET */ { ! if (!have_winsock) abort (); /* do the equivalent of a non-blocking read */ --- 2072,2076 ---- else /* FILE_SOCKET */ { ! if (winsock_lib == NULL) abort (); /* do the equivalent of a non-blocking read */ *************** sys_write (int fd, const void * buffer, *** 1953,1957 **** if (fd_info[fd].flags & FILE_SOCKET) { ! if (!have_winsock) abort (); nchars = pfn_send (SOCK_HANDLE (fd), buffer, count, 0); if (nchars == SOCKET_ERROR) --- 2132,2136 ---- if (fd_info[fd].flags & FILE_SOCKET) { ! if (winsock_lib == NULL) abort (); nchars = pfn_send (SOCK_HANDLE (fd), buffer, count, 0); if (nchars == SOCKET_ERROR) *************** term_ntproc () *** 1979,1983 **** } - extern BOOL can_run_dos_process; extern BOOL dos_process_running; --- 2158,2161 ---- *************** init_ntproc () *** 1986,1991 **** { #ifdef HAVE_SOCKETS ! /* initialise the socket interface if available */ ! init_winsock (); #endif --- 2164,2180 ---- { #ifdef HAVE_SOCKETS ! /* Initialise the socket interface now if available and requested by ! the user by defining PRELOAD_WINSOCK; otherwise loading will be ! delayed until open-network-stream is called (win32-has-winsock can ! also be used to dynamically load or reload winsock). ! ! Conveniently, init_environment is called before us, so ! PRELOAD_WINSOCK can be set in the registry. */ ! ! /* Always initialize this correctly. */ ! winsock_lib = NULL; ! ! if (getenv ("PRELOAD_WINSOCK") != NULL) ! init_winsock (TRUE); #endif *************** init_ntproc () *** 2049,2054 **** } ! /* Only allow Emacs to run DOS programs on Win95. */ ! can_run_dos_process = (GetVersion () & 0x80000000); dos_process_running = FALSE; --- 2238,2253 ---- } ! /* Restrict Emacs to running only one DOS program at a time (with any ! number of Win32 programs). This is to prevent the user from ! running into problems with DOS programs being run in the same VDM ! under both Windows 95 and Windows NT. ! ! Note that it is possible for Emacs to run DOS programs in separate ! VDMs, but unfortunately the pipe implementation on Windows 95 then ! fails to report when the DOS process exits (which is supposed to ! break the pipe). Until this bug is fixed, or we can devise a ! work-around, we must try to avoid letting the user start more than ! one DOS program if possible. */ ! dos_process_running = FALSE; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/ntinevt.c emacs-19.32/src/ntinevt.c *** emacs-19.31/src/ntinevt.c Fri May 3 14:30:40 1996 --- emacs-19.32/src/ntinevt.c Thu Jul 25 03:13:20 1996 *************** extern void reinvoke_input_signal (void) *** 48,51 **** --- 48,54 ---- extern int change_frame_size (FRAME_PTR, int, int, int, int); + /* from w32fns.c */ + extern Lisp_Object Vwin32_alt_is_meta; + /* Event queue */ #define EVENT_QUEUE_SIZE 50 *************** win32_kbd_mods_to_emacs (DWORD mods) *** 104,108 **** if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED)) ! retval = meta_modifier; if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED)) --- 107,111 ---- if (mods & (RIGHT_ALT_PRESSED | LEFT_ALT_PRESSED)) ! retval = ((NILP (Vwin32_alt_is_meta)) ? alt_modifier : meta_modifier); if (mods & (RIGHT_CTRL_PRESSED | LEFT_CTRL_PRESSED)) *************** win32_read_socket (int sd, struct input_ *** 522,526 **** for (;;) { ! nev = fill_queue (waitp != 0); if (nev <= 0) { --- 525,529 ---- for (;;) { ! nev = fill_queue (0); if (nev <= 0) { diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/ntproc.c emacs-19.32/src/ntproc.c *** emacs-19.31/src/ntproc.c Fri May 17 17:39:24 1996 --- emacs-19.32/src/ntproc.c Wed Jun 12 14:18:59 1996 *************** Lisp_Object Vwin32_quote_process_args; *** 58,64 **** Lisp_Object Vwin32_pipe_read_delay; ! /* Keep track of whether we have already started a DOS program, and ! whether we can run them in the first place. */ ! BOOL can_run_dos_process; BOOL dos_process_running; --- 58,66 ---- Lisp_Object Vwin32_pipe_read_delay; ! /* Control conversion of upper case file names to lower case. ! nil means no, t means yes. */ ! Lisp_Object Vwin32_downcase_file_names; ! ! /* Keep track of whether we have already started a DOS program. */ BOOL dos_process_running; *************** reap_subprocess (child_process *cp) *** 381,385 **** /* If this was a DOS process, indicate that it is now safe to ! start a new one. */ if (cp->is_dos_process) dos_process_running = FALSE; --- 383,387 ---- /* If this was a DOS process, indicate that it is now safe to ! start a new one. */ if (cp->is_dos_process) dos_process_running = FALSE; *************** sys_spawnve (int mode, char *cmdname, ch *** 619,625 **** allowed to start it. */ is_dos_binary = win32_is_dos_binary (cmdname); ! if (is_dos_binary && (!can_run_dos_process || dos_process_running)) { ! errno = (can_run_dos_process) ? EAGAIN : EINVAL; return -1; } --- 621,627 ---- allowed to start it. */ is_dos_binary = win32_is_dos_binary (cmdname); ! if (is_dos_binary && dos_process_running) { ! errno = EAGAIN; return -1; } *************** sys_kill (int pid, int sig) *** 1052,1058 **** { /* Kill the process. On Win32 this doesn't kill child processes ! so it doesn't work very well for shells which is why it's ! not used in every case. */ ! if (!TerminateProcess (proc_hand, 0xff)) { DebPrint (("sys_kill.TerminateProcess returned %d " --- 1054,1062 ---- { /* Kill the process. On Win32 this doesn't kill child processes ! so it doesn't work very well for shells which is why it's not ! used in every case. Also, don't try to terminate DOS processes ! (on Win95), because this will hang Emacs. */ ! if (!(cp && cp->is_dos_process) ! && !TerminateProcess (proc_hand, 0xff)) { DebPrint (("sys_kill.TerminateProcess returned %d " *************** reset_standard_handles (int in, int out, *** 1153,1159 **** --- 1157,1236 ---- } + #ifdef HAVE_SOCKETS + + /* To avoid problems with winsock implementations that work over dial-up + connections causing or requiring a connection to exist while Emacs is + running, Emacs no longer automatically loads winsock on startup if it + is present. Instead, it will be loaded when open-network-stream is + first called. + + To allow full control over when winsock is loaded, we provide these + two functions to dynamically load and unload winsock. This allows + dial-up users to only be connected when they actually need to use + socket services. */ + + /* From nt.c */ + extern HANDLE winsock_lib; + extern BOOL term_winsock (void); + extern BOOL init_winsock (int load_now); + + extern Lisp_Object Vsystem_name; + + DEFUN ("win32-has-winsock", Fwin32_has_winsock, Swin32_has_winsock, 0, 1, 0, + "Test for presence of the Windows socket library `winsock'.\n\ + Returns non-nil if winsock support is present, nil otherwise.\n\ + \n\ + If the optional argument LOAD-NOW is non-nil, the winsock library is\n\ + also loaded immediately if not already loaded. If winsock is loaded,\n\ + the winsock local hostname is returned (since this may be different from\n\ + the value of `system-name' and should supplant it), otherwise t is\n\ + returned to indicate winsock support is present.") + (load_now) + Lisp_Object load_now; + { + int have_winsock; + + have_winsock = init_winsock (!NILP (load_now)); + if (have_winsock) + { + if (winsock_lib != NULL) + { + /* Return new value for system-name. The best way to do this + is to call init_system_name, saving and restoring the + original value to avoid side-effects. */ + Lisp_Object orig_hostname = Vsystem_name; + Lisp_Object hostname; + + init_system_name (); + hostname = Vsystem_name; + Vsystem_name = orig_hostname; + return hostname; + } + return Qt; + } + return Qnil; + } + + DEFUN ("win32-unload-winsock", Fwin32_unload_winsock, Swin32_unload_winsock, + 0, 0, 0, + "Unload the Windows socket library `winsock' if loaded.\n\ + This is provided to allow dial-up socket connections to be disconnected\n\ + when no longer needed. Returns nil without unloading winsock if any\n\ + socket connections still exist.") + () + { + return term_winsock () ? Qt : Qnil; + } + + #endif /* HAVE_SOCKETS */ + syms_of_ntproc () { + #ifdef HAVE_SOCKETS + defsubr (&Swin32_has_winsock); + defsubr (&Swin32_unload_winsock); + #endif + DEFVAR_LISP ("win32-quote-process-args", &Vwin32_quote_process_args, "Non-nil enables quoting of process arguments to ensure correct parsing.\n\ *************** of time slices to wait (effectively boos *** 1178,1181 **** --- 1255,1263 ---- process temporarily). A value of zero disables waiting entirely."); Vwin32_pipe_read_delay = 50; + + DEFVAR_LISP ("win32-downcase-file-names", &Vwin32_downcase_file_names, + "Non-nil means convert all-upper case file names to lower case.\n\ + This applies when performing completions and file name expansion."); + Vwin32_downcase_file_names = Qnil; } /* end of ntproc.c */ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/print.c emacs-19.32/src/print.c *** emacs-19.31/src/print.c Tue May 21 13:23:37 1996 --- emacs-19.32/src/print.c Sat Jul 27 20:03:09 1996 *************** int print_depth; *** 51,54 **** --- 51,63 ---- Lisp_Object being_printed[PRINT_CIRCLE]; + /* When printing into a buffer, first we put the text in this + block, then insert it all at once. */ + char *print_buffer; + + /* Size allocated in print_buffer. */ + int print_buffer_size; + /* Size used in print_buffer. */ + int print_buffer_pos; + /* Maximum length of list to print in full; noninteger means effectively infinity */ *************** glyph_to_str_cpy (glyphs, str) *** 159,165 **** SET_PT (marker_position (printcharfun)); \ start_point = point; \ ! printcharfun = Qnil;} #define PRINTFINISH \ if (MARKERP (original)) \ Fset_marker (original, make_number (point), Qnil); \ --- 168,185 ---- SET_PT (marker_position (printcharfun)); \ start_point = point; \ ! printcharfun = Qnil;} \ ! if (NILP (printcharfun)) \ ! { \ ! print_buffer_pos = 0; \ ! print_buffer_size = 1000; \ ! print_buffer = (char *) xmalloc (print_buffer_size); \ ! } \ ! else \ ! print_buffer = 0; #define PRINTFINISH \ + if (NILP (printcharfun)) \ + insert (print_buffer, print_buffer_pos); \ + if (print_buffer) free (print_buffer); \ if (MARKERP (original)) \ Fset_marker (original, make_number (point), Qnil); \ *************** printchar (ch, fun) *** 190,194 **** { QUIT; ! insert (&ch, 1); return; } --- 210,217 ---- { QUIT; ! if (print_buffer_pos == print_buffer_size) ! print_buffer = (char *) xrealloc (print_buffer, ! print_buffer_size *= 2); ! print_buffer[print_buffer_pos++] = ch; return; } *************** strout (ptr, size, printcharfun) *** 240,247 **** if (EQ (printcharfun, Qnil)) { ! insert (ptr, size >= 0 ? size : strlen (ptr)); #ifdef MAX_PRINT_CHARS if (max_print) ! print_chars += size >= 0 ? size : strlen(ptr); #endif /* MAX_PRINT_CHARS */ return; --- 263,281 ---- if (EQ (printcharfun, Qnil)) { ! if (size < 0) ! size = strlen (ptr); ! ! if (print_buffer_pos + size > print_buffer_size) ! { ! print_buffer_size = print_buffer_size * 2 + size; ! print_buffer = (char *) xrealloc (print_buffer, ! print_buffer_size); ! } ! bcopy (ptr, print_buffer + print_buffer_pos, size); ! print_buffer_pos += size; ! #ifdef MAX_PRINT_CHARS if (max_print) ! print_chars += size; #endif /* MAX_PRINT_CHARS */ return; *************** print_string (string, printcharfun) *** 302,316 **** Lisp_Object printcharfun; { ! if (EQ (printcharfun, Qt)) ! /* strout is safe for output to a frame (echo area). */ strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun); - else if (EQ (printcharfun, Qnil)) - { - #ifdef MAX_PRINT_CHARS - if (max_print) - print_chars += XSTRING (string)->size; - #endif /* MAX_PRINT_CHARS */ - insert_from_string (string, 0, XSTRING (string)->size, 1); - } else { --- 336,342 ---- Lisp_Object printcharfun; { ! if (EQ (printcharfun, Qt) || NILP (printcharfun)) ! /* strout is safe for output to a frame (echo area) or to print_buffer. */ strout (XSTRING (string)->data, XSTRING (string)->size, printcharfun); else { *************** print (obj, printcharfun, escapeflag) *** 1027,1030 **** --- 1053,1062 ---- strout (buf, -1, printcharfun); PRINTCHAR ('\"'); + + /* Don't print more characters than the specified maximum. */ + if (INTEGERP (Vprint_length) + && XINT (Vprint_length) < size_in_chars) + size_in_chars = XINT (Vprint_length); + for (i = 0; i < size_in_chars; i++) { *************** print (obj, printcharfun, escapeflag) *** 1125,1128 **** --- 1157,1166 ---- register int i; register Lisp_Object tem; + + /* Don't print more elements than the specified maximum. */ + if (INTEGERP (Vprint_length) + && XINT (Vprint_length) < size) + size = XINT (Vprint_length); + for (i = 0; i < size; i++) { *************** print (obj, printcharfun, escapeflag) *** 1188,1192 **** case Lisp_Misc_Objfwd: ! strout (buf, "#objvar, printcharfun, escapeflag); PRINTCHAR ('>'); --- 1226,1230 ---- case Lisp_Misc_Objfwd: ! strout ("#objvar, printcharfun, escapeflag); PRINTCHAR ('>'); *************** print (obj, printcharfun, escapeflag) *** 1194,1198 **** case Lisp_Misc_Buffer_Objfwd: ! strout (buf, "#offset), --- 1232,1236 ---- case Lisp_Misc_Buffer_Objfwd: ! strout ("#offset), *************** print (obj, printcharfun, escapeflag) *** 1202,1206 **** case Lisp_Misc_Kboard_Objfwd: ! strout (buf, "#offset), --- 1240,1244 ---- case Lisp_Misc_Kboard_Objfwd: ! strout ("#offset), diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/process.c emacs-19.32/src/process.c *** emacs-19.31/src/process.c Fri Apr 26 15:52:00 1996 --- emacs-19.32/src/process.c Tue Jul 16 18:32:38 1996 *************** create_process (process, new_argv, curre *** 1437,1441 **** #endif /* TIOCNOTTY */ ! #if !defined (RTU) && !defined (UNIPLUS) /*** There is a suggestion that this ought to be a conditional on TIOCSPGRP. */ --- 1437,1441 ---- #endif /* TIOCNOTTY */ ! #if !defined (RTU) && !defined (UNIPLUS) && !defined (DONT_REOPEN_PTY) /*** There is a suggestion that this ought to be a conditional on TIOCSPGRP. */ *************** create_process (process, new_argv, curre *** 1466,1470 **** #endif } ! #endif /* not UNIPLUS and not RTU */ #ifdef SETUP_SLAVE_PTY if (pty_flag) --- 1466,1471 ---- #endif } ! #endif /* not UNIPLUS and not RTU and not DONT_REOPEN_PTY */ ! #ifdef SETUP_SLAVE_PTY if (pty_flag) *************** Fourth arg SERVICE is name of the servic *** 1635,1638 **** --- 1636,1644 ---- int count = specpdl_ptr - specpdl; + #ifdef WINDOWSNT + /* Ensure socket support is loaded if available. */ + init_winsock (TRUE); + #endif + GCPRO4 (name, buffer, host, service); CHECK_STRING (name, 0); *************** wait_reading_process_input (time_limit, *** 2032,2035 **** --- 2038,2049 ---- EMACS_ADD_TIME (end_time, end_time, timeout); } + #ifdef hpux + /* AlainF 5-Jul-1996 + HP-UX 10.10 seem to have problems with signals coming in + Causes "poll: interrupted system call" messages when Emacs is run + in an X window + Turn off periodic alarms (in case they are in use) */ + stop_polling (); + #endif while (1) *************** wait_reading_process_input (time_limit, *** 2325,2329 **** else if (nread == -1 && errno == EWOULDBLOCK) ; ! #else #ifdef O_NONBLOCK else if (nread == -1 && errno == EAGAIN) --- 2339,2345 ---- else if (nread == -1 && errno == EWOULDBLOCK) ; ! #endif ! /* ISC 4.1 defines both EWOULDBLOCK and O_NONBLOCK, ! and Emacs uses O_NONBLOCK, so what we get is EAGAIN. */ #ifdef O_NONBLOCK else if (nread == -1 && errno == EAGAIN) *************** wait_reading_process_input (time_limit, *** 2341,2345 **** #endif /* O_NDELAY */ #endif /* O_NONBLOCK */ - #endif /* EWOULDBLOCK */ #ifdef HAVE_PTYS /* On some OSs with ptys, when the process on one end of --- 2357,2360 ---- *************** wait_reading_process_input (time_limit, *** 2385,2389 **** QUIT; } ! return got_some_input; } --- 2400,2412 ---- QUIT; } ! #ifdef hpux ! /* AlainF 5-Jul-1996 ! HP-UX 10.10 seems to have problems with signals coming in ! Causes "poll: interrupted system call" messages when Emacs is run ! in an X window ! Turn periodic alarms back on */ ! start_polling(); ! #endif ! return got_some_input; } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/regex.c emacs-19.32/src/regex.c *** emacs-19.31/src/regex.c Fri May 24 14:33:51 1996 --- emacs-19.32/src/regex.c Tue Jul 9 05:10:23 1996 *************** static const char *re_error_msgid[] = *** 1009,1013 **** change it ourselves. */ #if defined (MATCH_MAY_ALLOCATE) ! int re_max_failures = 20000; #else int re_max_failures = 2000; --- 1009,1015 ---- change it ourselves. */ #if defined (MATCH_MAY_ALLOCATE) ! /* 4400 was enough to cause a crash on Alpha OSF/1, ! whose default stack limit is 2mb. */ ! int re_max_failures = 4000; #else int re_max_failures = 2000; *************** static struct re_pattern_buffer re_comp_ *** 5187,5190 **** --- 5189,5198 ---- char * + #ifdef _LIBC + /* Make these definitions weak in libc, so POSIX programs can redefine + these names if they don't use our functions, and still use + regcomp/regexec below without link errors. */ + weak_function + #endif re_comp (s) const char *s; *************** re_comp (s) *** 5228,5231 **** --- 5236,5242 ---- int + #ifdef _LIBC + weak_function + #endif re_exec (s) const char *s; *************** re_exec (s) *** 5235,5247 **** 0 <= re_search (&re_comp_buf, s, len, 0, len, (struct re_registers *) 0); } - - #ifdef _LIBC - /* Make these definitions weak in libc, so POSIX programs can redefine - these names if they don't use our functions, and still use - regcomp/regexec below without link errors. */ - weak_symbol (re_comp) - weak_symbol (re_exec) - #endif - #endif /* _REGEX_RE_COMP */ --- 5246,5249 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/bsdos2-1.h emacs-19.32/src/s/bsdos2-1.h *** emacs-19.31/src/s/bsdos2-1.h Wed Dec 31 19:00:00 1969 --- emacs-19.32/src/s/bsdos2-1.h Sun Jul 7 18:24:05 1996 *************** *** 0 **** --- 1,6 ---- + /* s/ file for BSDI BSD/OS 2.1 system. */ + + #include "bsdos2.h" + + #undef LIB_X11_LIB + #define LIB_X11_LIB -L/usr/X11/lib -lX11 -lipc diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/bsdos2.h emacs-19.32/src/s/bsdos2.h *** emacs-19.31/src/s/bsdos2.h Sat May 6 17:52:59 1995 --- emacs-19.32/src/s/bsdos2.h Sun Jul 7 18:25:12 1996 *************** *** 1,3 **** ! /* s/ file for BSDI BSD/OS 2.x system. */ #include "bsd386.h" --- 1,3 ---- ! /* s/ file for BSDI BSD/OS 2.0 system. */ #include "bsd386.h" diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/freebsd.h emacs-19.32/src/s/freebsd.h *** emacs-19.31/src/s/freebsd.h Sun Feb 4 16:33:48 1996 --- emacs-19.32/src/s/freebsd.h Sun Jun 9 16:14:32 1996 *************** *** 93,94 **** --- 93,99 ---- and exits -- enami tsugutomo . */ #define vfork fork + + /* Don't close pty in process.c to make it as controlling terminal. + It is already a controlling terminal of subprocess, because we did + ioctl TIOCSCTTY. */ + #define DONT_REOPEN_PTY diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/gnu-linux.h emacs-19.32/src/s/gnu-linux.h *** emacs-19.31/src/s/gnu-linux.h Thu Apr 11 13:35:48 1996 --- emacs-19.32/src/s/gnu-linux.h Mon Jul 15 22:17:05 1996 *************** *** 1,4 **** ! /* This file is the configuration file for Lignux systems ! (that is, Linux-based GNU operating systems.) Copyright (C) 1985, 1986, 1992, 1994, 1996 Free Software Foundation, Inc. --- 1,3 ---- ! /* This file is the configuration file for Linux-based GNU systems Copyright (C) 1985, 1986, 1992, 1994, 1996 Free Software Foundation, Inc. *************** Boston, MA 02111-1307, USA. */ *** 37,41 **** It sets the Lisp variable system-type. */ ! #define SYSTEM_TYPE "lignux" /* All the best software is free. */ /* Check the version number of Linux--if it is at least 1.2.0, --- 36,40 ---- It sets the Lisp variable system-type. */ ! #define SYSTEM_TYPE "gnu/linux" /* All the best software is free. */ /* Check the version number of Linux--if it is at least 1.2.0, *************** Boston, MA 02111-1307, USA. */ *** 92,98 **** /usr/spool/mail/$USER.lock. */ ! /* Both are used in Linux by different mail programs. I assume that most ! people are using newer mailers that have heard of flock. Change this ! if you need to. */ #define MAIL_USE_FLOCK --- 91,97 ---- /usr/spool/mail/$USER.lock. */ ! /* On GNU/Linux systems, both methods are used by various mail ! programs. I assume that most people are using newer mailers that ! have heard of flock. Change this if you need to. */ #define MAIL_USE_FLOCK *************** Boston, MA 02111-1307, USA. */ *** 152,156 **** #ifndef __ELF__ ! /* Linux has crt0.o in a non-standard place */ #define START_FILES pre-crt0.o /usr/lib/crt0.o #else --- 151,155 ---- #ifndef __ELF__ ! /* GNU/Linux usually has crt0.o in a non-standard place */ #define START_FILES pre-crt0.o /usr/lib/crt0.o #else *************** Boston, MA 02111-1307, USA. */ *** 158,162 **** #endif ! /* As of version 1.1.51, Linux does not actually implement SIGIO. */ /* Here we assume that signal.h is already included. */ #ifdef emacs --- 157,169 ---- #endif ! #ifdef __ELF__ ! /* Here is how to find X Windows. LD_SWITCH_X_SITE_AUX gives an -R option ! says where to find X windows at run time. */ ! ! #define LD_SWITCH_SYSTEM LD_SWITCH_X_SITE_AUX ! #endif /* __ELF__ */ ! ! /* As of version 1.1.51, Linux did not actually implement SIGIO. ! But it works in newer versions. */ /* Here we assume that signal.h is already included. */ #ifdef emacs diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/gnu.h emacs-19.32/src/s/gnu.h *** emacs-19.31/src/s/gnu.h Mon Apr 8 19:01:12 1996 --- emacs-19.32/src/s/gnu.h Sun Jul 7 19:50:28 1996 *************** Boston, MA 02111-1307, USA. */ *** 43,46 **** --- 43,52 ---- #define TAB3 OXTABS + /* Tell Emacs that we are a terminfo based system; disable the use + of local termcap. (GNU uses ncurses.) */ + #ifdef HAVE_LIBNCURSES + #define TERMINFO + #define LIBS_TERMCAP -lncurses + #endif #define SYSV_SYSTEM_DIR diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/hpux10.h emacs-19.32/src/s/hpux10.h *** emacs-19.31/src/s/hpux10.h Tue Nov 21 17:28:38 1995 --- emacs-19.32/src/s/hpux10.h Wed Jul 31 16:45:40 1996 *************** *** 1,4 **** --- 1,6 ---- #include "hpux9shr.h" + #define HPUX10 + /* We have to go this route, rather than hpux9's approach of renaming the functions via macros. The system's stdlib.h has fully prototyped *************** *** 11,12 **** --- 13,34 ---- #define HPUX10 #define FORCE_ALLOCA_H + + #ifdef LIBS_SYSTEM + #undef LIBS_SYSTEM + #endif + #ifdef HPUX_NET + #define LIBS_SYSTEM -ln -l:libdld.sl + #else + #define LIBS_SYSTEM -l:libdld.sl + #endif + + /* Make sure we get select from libc rather than from libcurses + because libcurses on HPUX 10.10 has a broken version of select. */ + #define LIBS_TERMCAP -lc -lcurses + + #undef C_SWITCH_X_SYSTEM + #undef LD_SWITCH_X_DEFAULT + /* However, HPUX 10 puts Xaw and Xmu in a strange place + (if you install them at all). So search that place. */ + #define C_SWITCH_X_SYSTEM -I/usr/include/X11R5 -I/usr/include/Motif1.2 -I/usr/contrib/X11R5/include + #define LD_SWITCH_X_DEFAULT -L/usr/lib/X11R5 -L/usr/lib/Motif1.2 -L/usr/contrib/X11R5/lib diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/irix5-0.h emacs-19.32/src/s/irix5-0.h *** emacs-19.31/src/s/irix5-0.h Tue Jan 23 12:02:51 1996 --- emacs-19.32/src/s/irix5-0.h Fri Jul 19 15:40:59 1996 *************** *** 3,6 **** --- 3,9 ---- #define IRIX5 + /* We want BSD style signals. */ + #define _BSD_SIGNALS + #define SETPGRP_RELEASES_CTTY *************** char *_getpty(); *** 113,115 **** --- 116,124 ---- #ifndef __GNUC__ #define C_SWITCH_SYSTEM -cckr + #endif + + /* -g does not work on Irix, and since gcc warns if you use it, + turn off the warning. */ + #ifdef __GNUC__ + #define C_DEBUG_SWITCH #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/irix6-0.h emacs-19.32/src/s/irix6-0.h *** emacs-19.31/src/s/irix6-0.h Thu Dec 21 01:04:19 1995 --- emacs-19.32/src/s/irix6-0.h Tue Jul 23 23:38:26 1996 *************** *** 15,16 **** --- 15,25 ---- #undef C_SWITCH_SYSTEM #endif + + /* The only supported configuration of GCC under IRIX6.x produces + n32 MIPS ABI binaries and also supports -g. */ + #ifdef __GNUC__ + #undef C_DEBUG_SWITCH + #define C_DEBUG_SWITCH -g + #endif + + #undef SA_RESTART Only in emacs-19.31/src/s: lignux.h diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/sco5.h emacs-19.32/src/s/sco5.h *** emacs-19.31/src/s/sco5.h Wed Dec 31 19:00:00 1969 --- emacs-19.32/src/s/sco5.h Sat Jul 20 14:02:19 1996 *************** *** 0 **** --- 1,168 ---- + /* System description file for SCO 3.2v5. + Copyright (C) 1996 Free Software Foundation, Inc. + + This file is part of GNU Emacs. + + GNU Emacs is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2, or (at your option) + any later version. + + GNU Emacs is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with GNU Emacs; see the file COPYING. If not, write to the + Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307, USA. */ + + /* Contributed by Mark Diekhans . */ + + /* SCO is sort of like SVR3. */ + #include "usg5-3.h" + #define SCO_R5 + + #if 0 /* Turned off rather than make the Lisp code check for this. -- rms. + I am assuming that (at least most of) the tests for usg-unix-v + do the right thing for sco3.2v4 also. Things that *might* be wrong + as a result of turning off these lines include the values of + ange-ftp-remote-shell-file-name (now remsh) + dired-chown-program (now just chown) + lpr-command (now lp) + nntp-buggy-select (now t) + rmail-spool-directory (now /usr/mail?) + and the actions of the function print-region-1. */ + + /* SYSTEM_TYPE should indicate the kind of system you are using. */ + #undef SYSTEM_TYPE + #define SYSTEM_TYPE "SCO 3.2v4" + #endif + + /* SCO supports job control. */ + #undef NOMULTIPLEJOBS + + /* SCO has termios. */ + #define HAVE_TERMIOS + + /* SCO has ptys with unusual names. */ + #define HAVE_PTYS + + #define PTY_ITERATION \ + for (i = 0; ; i++) + #define PTY_NAME_SPRINTF \ + sprintf (pty_name, "/dev/ptyp%d", i); + #define PTY_TTY_NAME_SPRINTF \ + sprintf (pty_name, "/dev/ttyp%d", i); + + /* Sockets are an option on SCO. If you have X, you have them. + They also exist if you have TCP, but we don't know how to test + for that. */ + #ifdef HAVE_X_WINDOWS + #define HAVE_SOCKETS + #endif + + #ifndef __GNUC__ + #define LINKER ld + #endif + + /* This is safe since we already assumed HAVE_SOCKET + if using X windows. */ + #undef LIBX11_SYSTEM + #define LIBX11_SYSTEM -lpt -lnls -lnsl_s -lc_s -lsocket + + #undef LIB_X11_LIB + #define LIB_X11_LIB -lX11 + + #ifdef HAVE_INET_SOCKETS /* This comes from autoconf. */ + #define HAVE_SOCKETS + #endif + + #ifdef HAVE_SOCKETS + #define LIBS_SYSTEM -lsocket -lPW + #endif + + #ifndef HAVE_GETTIMEOFDAY + #define HAVE_GETTIMEOFDAY + #endif + + /* This enables configure to tell that we have alloca. */ + #ifndef LIBS_SYSTEM + #define LIBS_SYSTEM -lPW + #endif + + #ifdef HAVE_X11R5 + /* configure can't get this right linking fails unless -lsocket is used. */ + #undef HAVE_XSCREENNUMBEROFSCREEN + #define HAVE_XSCREENNUMBEROFSCREEN + #endif + + /* We don't have -loldX, and we don't need it. */ + #define LIB_XMENU_LIB + + /* SCO does have TIOCGWINSZ. */ + #undef BROKEN_TIOCGWINSZ + #define NEED_PTEM_H + + /* We need to link with crt1.o and crtn.o. */ + #define START_FILES pre-crt0.o /lib/crt1.o + #define LIB_STANDARD -lc /lib/crtn.o + + /* Send signals to subprocesses by "typing" signal chars at them. */ + #define SIGNALS_VIA_CHARACTERS + + /* Specify program for etc/fakemail to run. Define SMAIL if you are + using smail, don't for MMDF. */ + + #ifdef SMAIL + #define MAIL_PROGRAM_NAME "/bin/smail -q0" + #else + #define MAIL_PROGRAM_NAME "/usr/lib/mail/execmail" + #endif + + /* miano@acosta.enet.dec.com says these are needed. */ + #define bcopy(b1,b2,len) memmove (b2, b1, len) + #define bzero(b,len) memset (b, 0, len) + #define bcmp(b1,b2,len) memcmp (b1, b2, len) + + /* Tell process_send_signal to use VSUSP instead of VSWTCH. */ + #define PREFER_VSUSP + + /* wjs@wang.com (William Smith) says this is needed on 3.2.4.2. */ + #define POSIX_SIGNALS + + /* wjs@wiis.wang.com says SCO 3.2 v4.2 "has sockets", + but only for network connections. + It doesn't have the kind of sockets that emacsclient.c + and emacsserver.c would use. */ + #define NO_SOCKETS_IN_FILE_SYSTEM + + #ifndef PENDING_OUTPUT_COUNT + #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base) + #endif + + #ifndef HAVE_VFORK + #define HAVE_VFORK + #endif + + /* Use ELF and get real shared libraries */ + + #undef COFF + #define ELF + + #define UNEXEC unexelf.o + + #define C_SWITCH_SYSTEM -belf + #define LD_SWITCH_SYSTEM -belf + + /* SCO has a working alloca in libPW */ + #define HAVE_ALLOCA + + /* Don't disable static function, as SCO's header files have some.*/ + #undef static + + #undef START_FILES + #define START_FILES pre-crt0.o /usr/ccs/lib/crt1.o /usr/ccs/lib/values-Xt.o + #undef LIB_STANDARD + #define LIB_STANDARD -lc /usr/ccs/lib/crtn.o diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/sol2-4.h emacs-19.32/src/s/sol2-4.h *** emacs-19.31/src/s/sol2-4.h Wed May 1 15:12:28 1996 --- emacs-19.32/src/s/sol2-4.h Wed Jun 19 17:15:06 1996 *************** *** 14,24 **** #undef LD_SWITCH_SYSTEM #ifndef __GNUC__ ! #define LD_SWITCH_SYSTEM -L /usr/ccs/lib LD_SWITCH_X_SITE_AUX -R /usr/dt/lib -L /usr/dt/lib #else /* GCC */ /* We use ./prefix-args because we don't know whether LD_SWITCH_X_SITE_AUX has anything in it. It can be empty. This works ok in src. Luckily lib-src does not use LD_SWITCH_SYSTEM. */ ! #define LD_SWITCH_SYSTEM -L /usr/ccs/lib \ ! `./prefix-args -Xlinker LD_SWITCH_X_SITE_AUX` -R /usr/dt/lib -L /usr/dt/lib #endif /* GCC */ --- 14,24 ---- #undef LD_SWITCH_SYSTEM #ifndef __GNUC__ ! #define LD_SWITCH_SYSTEM -L/usr/ccs/lib LD_SWITCH_X_SITE_AUX -R/usr/dt/lib -L/usr/dt/lib #else /* GCC */ /* We use ./prefix-args because we don't know whether LD_SWITCH_X_SITE_AUX has anything in it. It can be empty. This works ok in src. Luckily lib-src does not use LD_SWITCH_SYSTEM. */ ! #define LD_SWITCH_SYSTEM -L/usr/ccs/lib \ ! `./prefix-args -Xlinker LD_SWITCH_X_SITE_AUX` -R/usr/dt/lib -L/usr/dt/lib #endif /* GCC */ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/sol2-5.h emacs-19.32/src/s/sol2-5.h *** emacs-19.31/src/s/sol2-5.h Wed Apr 24 15:44:34 1996 --- emacs-19.32/src/s/sol2-5.h Sat Jun 29 20:22:10 1996 *************** *** 3,6 **** --- 3,11 ---- #include "sol2-4.h" + /* -lgen is needed for the regex and regcmp functions + which are used by Motif. In the future we can try changing + regex.c to provide them in Emacs, but this is safer for now. */ + #define LIB_MOTIF -lXm -lgen + #if 0 /* A recent patch in unexelf.c should eliminate the need for this. */ /* Don't use the shared libraries for -lXt and -lXaw, diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/sol2.h emacs-19.32/src/s/sol2.h *** emacs-19.31/src/s/sol2.h Wed May 1 15:12:44 1996 --- emacs-19.32/src/s/sol2.h Tue May 28 11:54:15 1996 *************** *** 24,26 **** --- 24,28 ---- #endif /* GCC */ + #undef LIBS_SYSTEM + #define LIBS_SYSTEM -lsocket -lnsl -lelf -lkvm #define HAVE_VFORK diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/s/usg5-4-3.h emacs-19.32/src/s/usg5-4-3.h *** emacs-19.31/src/s/usg5-4-3.h Wed Dec 31 19:00:00 1969 --- emacs-19.32/src/s/usg5-4-3.h Thu Jul 11 19:29:46 1996 *************** *** 0 **** --- 1,8 ---- + /* s/ file for System V release 4.3. */ + + #include "usg5-4-2.h" + + /* Bill_Mann@PraxisInt.com: without this switch emacs generates this error + on start up for an i486-ncr-sysv4.3 (running the X toolkit): + _XipOpenIM() Unable to find Atom _XIM_INPUTMETHOD */ + #define X11R5_INHIBIT_I18N diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/search.c emacs-19.32/src/search.c *** emacs-19.31/src/search.c Tue Apr 9 18:06:37 1996 --- emacs-19.32/src/search.c Sat Jul 13 20:05:29 1996 *************** Use `store-match-data' to reinstate the *** 1840,1844 **** if (NILP (last_thing_searched)) ! error ("match-data called before any match found"); data = (Lisp_Object *) alloca ((2 * search_regs.num_regs) --- 1840,1844 ---- if (NILP (last_thing_searched)) ! return Qnil; data = (Lisp_Object *) alloca ((2 * search_regs.num_regs) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/syssignal.h emacs-19.32/src/syssignal.h *** emacs-19.31/src/syssignal.h Fri Apr 26 15:52:02 1996 --- emacs-19.32/src/syssignal.h Wed Jun 12 13:56:38 1996 *************** sigset_t sys_sigsetmask (/*sigset_t new_ *** 123,129 **** #define sigholdx(sig) sigsetmask (sigmask (sig)) #define sigblockx(sig) sigblock (sigmask (sig)) ! #define sigunblockx(sig) sigblock (SIGEMPTYMASK) #define sigpausex(sig) sigpause (0) ! #endif /* BSD4_1 */ #ifdef BSD4_1 --- 123,129 ---- #define sigholdx(sig) sigsetmask (sigmask (sig)) #define sigblockx(sig) sigblock (sigmask (sig)) ! #define sigunblockx(sig) sigunblock (sigmask (sig)) #define sigpausex(sig) sigpause (0) ! #endif /* not BSD4_1 */ #ifdef BSD4_1 *************** sigset_t sys_sigsetmask (/*sigset_t new_ *** 133,137 **** #define sigunblockx(sig) sigrelse (sig) #define sigpausex(sig) sigpause (sig) ! #endif /* ! defined (BSD4_1) */ /* On bsd, [man says] kill does not accept a negative number to kill a pgrp. --- 133,137 ---- #define sigunblockx(sig) sigrelse (sig) #define sigpausex(sig) sigpause (sig) ! #endif /* BSD4_1 */ /* On bsd, [man says] kill does not accept a negative number to kill a pgrp. diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/systty.h emacs-19.32/src/systty.h *** emacs-19.31/src/systty.h Tue May 21 10:43:11 1996 --- emacs-19.32/src/systty.h Tue Jul 2 12:12:22 1996 *************** static struct sensemode { *** 293,298 **** #endif ! /* EMACS_GETPGRP (arg) returns the process group of the terminal. */ #if defined (USG) && !defined (GETPGRP_NEEDS_ARG) # if !defined (GETPGRP_NO_ARG) --- 293,302 ---- #endif ! /* EMACS_GETPGRP (arg) returns the process group of the process. */ + #ifdef __GNU_LIBRARY__ + /* GNU libc by default defines getpgrp with no args on all systems. */ + #define GETPGRP_NO_ARG + #else /* not __GNU_LIBRARY__ */ #if defined (USG) && !defined (GETPGRP_NEEDS_ARG) # if !defined (GETPGRP_NO_ARG) *************** static struct sensemode { *** 300,303 **** --- 304,308 ---- # endif #endif + #endif /* not __GNU_LIBRARY__ */ #if defined (GETPGRP_NO_ARG) diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/unexec.c emacs-19.32/src/unexec.c *** emacs-19.31/src/unexec.c Wed Apr 10 00:15:07 1996 --- emacs-19.32/src/unexec.c Fri Jul 19 15:46:02 1996 *************** int need_coff_header = 1; *** 179,182 **** --- 179,184 ---- #if __DJGPP__ > 1 #include /* for O_RDONLY, O_RDWR */ + #include /* for _crt0_startup_flags and its bits */ + static int save_djgpp_startup_flags; #endif #include *************** copy_text_and_data (new, a_out) *** 885,888 **** --- 887,895 ---- where our exception hooks are registered. */ __djgpp_exception_toggle (); + + /* Switch off startup flags that might have been set at runtime + and which might change the way that dumped Emacs works. */ + save_djgpp_startup_flags = _crt0_startup_flags; + _crt0_startup_flags &= ~(_CRT0_FLAG_NO_LFN | _CRT0_FLAG_NEARPTR); #endif #endif *************** copy_text_and_data (new, a_out) *** 906,909 **** --- 913,919 ---- /* Restore our exception hooks. */ __djgpp_exception_toggle (); + + /* Restore the startup flags. */ + _crt0_startup_flags = save_djgpp_startup_flags; #endif #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/unexelf.c emacs-19.32/src/unexelf.c *** emacs-19.31/src/unexelf.c Thu Apr 25 14:00:17 1996 --- emacs-19.32/src/unexelf.c Tue Jul 16 18:39:03 1996 *************** unexec (new_name, old_name, data_start, *** 768,772 **** NEW_SECTION_H (nn).sh_offset += new_data2_size; #else ! if (NEW_SECTION_H (nn).sh_offset >= new_data2_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; #endif --- 768,774 ---- NEW_SECTION_H (nn).sh_offset += new_data2_size; #else ! if (round_up (NEW_SECTION_H (nn).sh_offset, ! OLD_SECTION_H (old_bss_index).sh_addralign) ! >= new_data2_offset) NEW_SECTION_H (nn).sh_offset += new_data2_size; #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/unexhp9k800.c emacs-19.32/src/unexhp9k800.c *** emacs-19.31/src/unexhp9k800.c Sat May 28 17:46:32 1994 --- emacs-19.32/src/unexhp9k800.c Fri Jun 28 02:31:07 1996 *************** run_time_remap (ignored) *** 61,65 **** char *ignored; { ! brk (brk_on_dump); } --- 61,65 ---- char *ignored; { ! brk ((char *) brk_on_dump); } *************** unexec (new_name, old_name, new_end_of_t *** 101,105 **** read_header (old, &hdr, &auxhdr); ! brk_on_dump = sbrk (0); /* Decide how large the new and old data areas are */ --- 101,105 ---- read_header (old, &hdr, &auxhdr); ! brk_on_dump = (long) sbrk (0); /* Decide how large the new and old data areas are */ *************** unexec (new_name, old_name, new_end_of_t *** 107,111 **** /* I suspect these two statements are separate to avoid a compiler bug in hpux version 8. */ ! i = sbrk (0); new_size = i - auxhdr.exec_dmem; --- 107,111 ---- /* I suspect these two statements are separate to avoid a compiler bug in hpux version 8. */ ! i = (long) sbrk (0); new_size = i - auxhdr.exec_dmem; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/vmstime.c emacs-19.32/src/vmstime.c *** emacs-19.31/src/vmstime.c Mon Jan 15 04:06:29 1996 --- emacs-19.32/src/vmstime.c Sat Jul 13 20:02:49 1996 *************** struct tm *sys_gmtime(time_t *clock) *** 358,362 **** gmt.tm_mday = tmp_vectime.day; gmt.tm_mon = tmp_vectime.month - 1; ! gmt.tm_year = tmp_vectime.year % 100; tmp_operation = LIB$K_DAY_OF_WEEK; --- 358,362 ---- gmt.tm_mday = tmp_vectime.day; gmt.tm_mon = tmp_vectime.month - 1; ! gmt.tm_year = tmp_vectime.year - 1900; tmp_operation = LIB$K_DAY_OF_WEEK; diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/w32fns.c emacs-19.32/src/w32fns.c *** emacs-19.31/src/w32fns.c Sat May 25 19:19:20 1996 --- emacs-19.32/src/w32fns.c Tue Jul 16 01:10:12 1996 *************** *** 1,4 **** /* Functions for the Win32 window system. ! Copyright (C) 1989, 1992, 1993, 1994, 1995 Free Software Foundation. This file is part of GNU Emacs. --- 1,4 ---- /* Functions for the Win32 window system. ! Copyright (C) 1989, 92, 93, 94, 95, 1996 Free Software Foundation, Inc. This file is part of GNU Emacs. *************** Lisp_Object Vwin32_color_map; *** 50,53 **** --- 50,57 ---- Lisp_Object Vwin32_pass_alt_to_system; + /* Non nil if alt key is translated to meta_modifier, nil if it is translated + to alt_modifier. */ + Lisp_Object Vwin32_alt_is_meta; + /* Non nil if left window, right window, and application key events are passed on to Windows. */ *************** Lisp_Object Qbox; *** 131,135 **** Lisp_Object Qcursor_color; Lisp_Object Qcursor_type; - Lisp_Object Qfont; Lisp_Object Qforeground_color; Lisp_Object Qgeometry; --- 135,138 ---- *************** win32_get_modifiers () *** 2651,2655 **** return (((GetKeyState (VK_SHIFT)&0x8000) ? shift_modifier : 0) | ((GetKeyState (VK_CONTROL)&0x8000) ? ctrl_modifier : 0) | ! ((GetKeyState (VK_MENU)&0x8000) ? meta_modifier : 0)); } --- 2654,2659 ---- return (((GetKeyState (VK_SHIFT)&0x8000) ? shift_modifier : 0) | ((GetKeyState (VK_CONTROL)&0x8000) ? ctrl_modifier : 0) | ! ((GetKeyState (VK_MENU)&0x8000) ? ! ((NILP (Vwin32_alt_is_meta)) ? alt_modifier : meta_modifier) : 0)); } *************** static void *** 2756,2762 **** reset_modifiers () { if (!modifiers_recorded) return; ! bzero (modifiers, sizeof (modifiers)); } --- 2760,2802 ---- reset_modifiers () { + SHORT ctrl, alt; + if (!modifiers_recorded) return; ! ! ctrl = GetAsyncKeyState (VK_CONTROL); ! alt = GetAsyncKeyState (VK_MENU); ! ! if (ctrl == 0 || alt == 0) ! /* Emacs doesn't have keyboard focus. Do nothing. */ ! return; ! ! if (!(ctrl & 0x08000)) ! /* Clear any recorded control modifier state. */ ! modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0; ! ! if (!(alt & 0x08000)) ! /* Clear any recorded alt modifier state. */ ! modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0; ! ! /* Otherwise, leave the modifier state as it was when Emacs lost ! keyboard focus. */ ! } ! ! /* Synchronize modifier state with what is reported with the current ! keystroke. Even if we cannot distinguish between left and right ! modifier keys, we know that, if no modifiers are set, then neither ! the left or right modifier should be set. */ ! static void ! sync_modifiers () ! { ! if (!modifiers_recorded) ! return; ! ! if (!(GetKeyState (VK_CONTROL) & 0x8000)) ! modifiers[EMACS_RCONTROL] = modifiers[EMACS_LCONTROL] = 0; ! ! if (!(GetKeyState (VK_MENU) & 0x8000)) ! modifiers[EMACS_RMENU] = modifiers[EMACS_LMENU] = 0; } *************** win32_wnd_proc (hwnd, msg, wParam, lPara *** 2892,2902 **** int windows_translate; switch (msg) { case WM_ERASEBKGND: ! enter_crit (); ! GetUpdateRect (hwnd, &wmsg.rect, FALSE); ! leave_crit (); ! my_post_msg (&wmsg, hwnd, msg, wParam, lParam); return 1; case WM_PALETTECHANGED: --- 2932,2960 ---- int windows_translate; + /* Note that it is okay to call x_window_to_frame, even though we are + not running in the main lisp thread, because frame deletion + requires the lisp thread to synchronize with this thread. Thus, if + a frame struct is returned, it can be used without concern that the + lisp thread might make it disappear while we are using it. + + NB. Walking the frame list in this thread is safe (as long as + writes of Lisp_Object slots are atomic, which they are on Windows). + Although delete-frame can destructively modify the frame list while + we are walking it, a garbage collection cannot occur until after + delete-frame has synchronized with this thread. + + It is also safe to use functions that make GDI calls, such as + win32_clear_rect, because these functions must obtain a DC handle + from the frame struct using get_frame_dc which is thread-aware. */ + switch (msg) { case WM_ERASEBKGND: ! f = x_window_to_frame (dpyinfo, hwnd); ! if (f) ! { ! GetUpdateRect (hwnd, &wmsg.rect, FALSE); ! win32_clear_rect (f, NULL, &wmsg.rect); ! } return 1; case WM_PALETTECHANGED: *************** win32_wnd_proc (hwnd, msg, wParam, lPara *** 2904,2909 **** if ((HWND)wParam != hwnd) { ! /* simply notify main thread it may need to update frames */ ! my_post_msg (&wmsg, hwnd, msg, wParam, lParam); } return 0; --- 2962,2970 ---- if ((HWND)wParam != hwnd) { ! f = x_window_to_frame (dpyinfo, hwnd); ! if (f) ! /* get_frame_dc will realize our palette and force all ! frames to be redrawn if needed. */ ! release_frame_dc (f, get_frame_dc (f)); } return 0; *************** win32_wnd_proc (hwnd, msg, wParam, lPara *** 2930,2933 **** --- 2991,2997 ---- case WM_KEYDOWN: case WM_SYSKEYDOWN: + /* Synchronize modifiers with current keystroke. */ + sync_modifiers (); + record_keydown (wParam, lParam); *************** win32_wnd_proc (hwnd, msg, wParam, lPara *** 2951,2954 **** --- 3015,3020 ---- case VK_CAPITAL: case VK_SHIFT: + case VK_NUMLOCK: + case VK_SCROLL: windows_translate = 1; break; *************** win32_wnd_proc (hwnd, msg, wParam, lPara *** 3186,3192 **** goto dflt; - case WM_KILLFOCUS: case WM_SETFOCUS: reset_modifiers (); case WM_MOVE: case WM_SIZE: --- 3252,3258 ---- goto dflt; case WM_SETFOCUS: reset_modifiers (); + case WM_KILLFOCUS: case WM_MOVE: case WM_SIZE: *************** x_to_win32_font (lpxstr, lplogfont) *** 3948,3952 **** memset (lplogfont, 0, sizeof (*lplogfont)); ! #if 0 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS; lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS; --- 4014,4018 ---- memset (lplogfont, 0, sizeof (*lplogfont)); ! #if 1 lplogfont->lfOutPrecision = OUT_DEFAULT_PRECIS; lplogfont->lfClipPrecision = CLIP_DEFAULT_PRECIS; *************** syms_of_win32fns () *** 4892,4897 **** Qcursor_type = intern ("cursor-type"); staticpro (&Qcursor_type); - Qfont = intern ("font"); - staticpro (&Qfont); Qforeground_color = intern ("foreground-color"); staticpro (&Qforeground_color); --- 4958,4961 ---- *************** When non-nil, for example, alt pressed a *** 4956,4959 **** --- 5020,5028 ---- open the System menu. When nil, Emacs silently swallows alt key events."); Vwin32_pass_alt_to_system = Qnil; + + DEFVAR_LISP ("win32-alt-is-meta", &Vwin32_alt_is_meta, + "Non-nil if the alt key is to be considered the same as the meta key.\n\ + When nil, Emacs will translate the alt key to the Alt modifier, and not Meta."); + Vwin32_alt_is_meta = Qt; DEFVAR_LISP ("win32-pass-optional-keys-to-system", diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/w32term.c emacs-19.32/src/w32term.c *** emacs-19.31/src/w32term.c Sat May 25 13:44:39 1996 --- emacs-19.32/src/w32term.c Sat Jul 20 14:04:01 1996 *************** GNU General Public License for more deta *** 15,20 **** 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, 675 Mass Ave, Cambridge, MA 02139, USA. */ /* Added by Kevin Gallo */ --- 15,21 ---- 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. */ /* Added by Kevin Gallo */ *************** w32_read_socket (sd, bufp, numchars, wai *** 2395,2405 **** switch (msg.msg.message) { - case WM_ERASEBKGND: - f = x_window_to_frame (dpyinfo, msg.msg.hwnd); - if (f) - { - win32_clear_rect (f, NULL, &msg.rect); - } - break; case WM_PAINT: { --- 2396,2399 ---- *************** w32_read_socket (sd, bufp, numchars, wai *** 2416,2419 **** --- 2410,2415 ---- else { + /* Erase background again for safety. */ + win32_clear_rect (f, NULL, &msg.rect); dumprectangle (f, msg.rect.left, *************** w32_read_socket (sd, bufp, numchars, wai *** 2421,2435 **** msg.rect.right-msg.rect.left+1, msg.rect.bottom-msg.rect.top+1); - } } } - - break; - case WM_PALETTECHANGED: - f = x_window_to_frame (dpyinfo, msg.msg.hwnd); - if (f) - /* Realize palette - will force update if needed. */ - release_frame_dc (f, get_frame_dc (f)); break; case WM_KEYDOWN: --- 2417,2423 ---- *************** w32_read_socket (sd, bufp, numchars, wai *** 2481,2486 **** } ! /* Throw dead keys away. */ ! if (is_dead_key (msg.msg.wParam)) break; --- 2469,2478 ---- } ! /* Throw dead keys away. However, be sure not to ! throw away the dead key if it was produced using ! AltGr and there is a valid AltGr scan code for ! this key. */ ! if (is_dead_key (msg.msg.wParam) ! && !((VkKeyScan ((char) bufp->code) & 0xff00) == 0x600)) break; *************** x_set_window_size (f, change_gravity, co *** 3309,3312 **** --- 3301,3319 ---- void + x_set_mouse_pixel_position (f, pix_x, pix_y) + struct frame *f; + int pix_x, pix_y; + { + BLOCK_INPUT; + + pix_x += f->output_data.win32->left_pos; + pix_y += f->output_data.win32->top_pos; + + SetCursorPos (pix_x, pix_y); + + UNBLOCK_INPUT; + } + + void x_set_mouse_position (f, x, y) struct frame *f; *************** x_set_mouse_position (f, x, y) *** 3324,3346 **** if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f); ! BLOCK_INPUT; ! ! SetCursorPos (pix_x, pix_y); ! ! UNBLOCK_INPUT; ! } ! ! /* Move the mouse to position pixel PIX_X, PIX_Y relative to frame F. */ ! ! void ! x_set_mouse_pixel_position (f, pix_x, pix_y) ! struct frame *f; ! int pix_x, pix_y; ! { ! BLOCK_INPUT; ! ! SetCursorPos (pix_x, pix_y); ! ! UNBLOCK_INPUT; } --- 3331,3335 ---- if (pix_y > PIXEL_HEIGHT (f)) pix_y = PIXEL_HEIGHT (f); ! x_set_mouse_pixel_position (f, pix_x, pix_y); } diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/window.c emacs-19.32/src/window.c *** emacs-19.31/src/window.c Tue Apr 9 17:59:53 1996 --- emacs-19.32/src/window.c Thu Aug 1 01:08:37 1996 *************** unless the window is the selected window *** 2000,2004 **** argument NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).\n\ If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.\n\ ! Returns the window displaying BUFFER.") (buffer, not_this_window) register Lisp_Object buffer, not_this_window; --- 2000,2008 ---- argument NOT-THIS-WINDOW is non-nil (interactively, with prefix arg).\n\ If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER.\n\ ! Returns the window displaying BUFFER.\n\ ! \n\ ! The variables `special-display-buffer-names', `special-display-regexps',\n\ ! `same-window-buffer-names', and `same-window-regexps' customize how certain\n\ ! buffer names are handled.") (buffer, not_this_window) register Lisp_Object buffer, not_this_window; *************** negative means relative to bottom of win *** 2988,2992 **** struct save_window_data { ! int size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; Lisp_Object frame_width, frame_height, frame_menu_bar_lines; --- 2992,2996 ---- struct save_window_data { ! EMACS_INT size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; Lisp_Object frame_width, frame_height, frame_menu_bar_lines; *************** struct saved_window *** 3008,3012 **** { /* these first two must agree with struct Lisp_Vector in lisp.h */ ! int size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; --- 3012,3016 ---- { /* these first two must agree with struct Lisp_Vector in lisp.h */ ! EMACS_INT size_from_Lisp_Vector_struct; struct Lisp_Vector *next_from_Lisp_Vector_struct; *************** by `current-window-configuration' (which *** 3083,3087 **** || XFASTINT (data->frame_width) != previous_frame_width) change_frame_size (f, data->frame_height, data->frame_width, 0, 0); ! #ifdef HAVE_WINDOW_SYSTEM if (XFASTINT (data->frame_menu_bar_lines) != previous_frame_menu_bar_lines) --- 3087,3091 ---- || XFASTINT (data->frame_width) != previous_frame_width) change_frame_size (f, data->frame_height, data->frame_width, 0, 0); ! #if defined (HAVE_WINDOW_SYSTEM) || (defined (MSDOS) && defined (MULTI_FRAME)) if (XFASTINT (data->frame_menu_bar_lines) != previous_frame_menu_bar_lines) *************** by `current-window-configuration' (which *** 3221,3225 **** when the frame's old selected window has been deleted. */ #ifdef MULTI_FRAME ! if (f != selected_frame && ! FRAME_TERMCAP_P (f)) do_switch_frame (WINDOW_FRAME (XWINDOW (data->root_window)), Qnil, 0); --- 3225,3229 ---- when the frame's old selected window has been deleted. */ #ifdef MULTI_FRAME ! if (f != selected_frame && FRAME_WINDOW_P (f)) do_switch_frame (WINDOW_FRAME (XWINDOW (data->root_window)), Qnil, 0); *************** by `current-window-configuration' (which *** 3232,3236 **** change_frame_size (f, previous_frame_height, previous_frame_width, 0, 0); ! #ifdef HAVE_WINDOW_SYSTEM if (previous_frame_menu_bar_lines != FRAME_MENU_BAR_LINES (f)) x_set_menu_bar_lines (f, previous_frame_menu_bar_lines, 0); --- 3236,3240 ---- change_frame_size (f, previous_frame_height, previous_frame_width, 0, 0); ! #if defined (HAVE_WINDOW_SYSTEM) || (defined (MSDOS) && defined (MULTI_FRAME)) if (previous_frame_menu_bar_lines != FRAME_MENU_BAR_LINES (f)) x_set_menu_bar_lines (f, previous_frame_menu_bar_lines, 0); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/window.h emacs-19.32/src/window.h *** emacs-19.31/src/window.h Mon Jan 15 04:06:29 1996 --- emacs-19.32/src/window.h Wed Jun 26 00:20:00 1996 *************** struct window *** 125,128 **** --- 125,131 ---- /* Value of point at that time */ Lisp_Object last_point; + /* Non-nil if the buffer was "modified" when the window + was last updated. */ + Lisp_Object last_had_star; /* This window's vertical scroll bar. This field is only for use by the window-system-dependent code which implements the diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xdisp.c emacs-19.32/src/xdisp.c *** emacs-19.31/src/xdisp.c Fri May 17 17:11:25 1996 --- emacs-19.32/src/xdisp.c Thu Aug 1 17:38:03 1996 *************** Boston, MA 02111-1307, USA. */ *** 40,43 **** --- 40,44 ---- #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) extern void set_frame_menubar (); + extern int pending_menu_activation; #endif *************** prepare_menu_bars () *** 778,781 **** --- 779,788 ---- else update_menu_bar (selected_frame, 1); + + /* Motif needs this. See comment in xmenu.c. + Turn it off when pending_menu_activation is not defined. */ + #ifdef USE_X_TOOLKIT + pending_menu_activation = 0; + #endif } *************** redisplay_internal (preserve_echo_area) *** 839,843 **** #ifdef MULTI_FRAME ! if (FRAME_TERMCAP_P (selected_frame) && previous_terminal_frame != selected_frame) { --- 846,850 ---- #ifdef MULTI_FRAME ! if (! FRAME_WINDOW_P (selected_frame) && previous_terminal_frame != selected_frame) { *************** redisplay_internal (preserve_echo_area) *** 882,888 **** update_mode_lines++; ! /* Detect case that we need to write a star in the mode line. */ ! if (XFASTINT (w->last_modified) < MODIFF ! && XFASTINT (w->last_modified) <= SAVE_MODIFF) { w->update_mode_line = Qt; --- 889,894 ---- update_mode_lines++; ! /* Detect case that we need to write or remove a star in the mode line. */ ! if ((SAVE_MODIFF < MODIFF) != !NILP (w->last_had_star)) { w->update_mode_line = Qt; *************** redisplay_internal (preserve_echo_area) *** 1074,1078 **** { FRAME_PTR f = XFRAME (frame); ! if (! FRAME_TERMCAP_P (f) || f == selected_frame) { --- 1080,1084 ---- { FRAME_PTR f = XFRAME (frame); ! if (FRAME_WINDOW_P (f) || f == selected_frame) { *************** update: *** 1123,1127 **** f = XFRAME (XCONS (tail)->car); ! if ((! FRAME_TERMCAP_P (f) || f == selected_frame) && FRAME_VISIBLE_P (f)) { --- 1129,1133 ---- f = XFRAME (XCONS (tail)->car); ! if ((FRAME_WINDOW_P (f) || f == selected_frame) && FRAME_VISIBLE_P (f)) { *************** update: *** 1156,1161 **** mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); ! if (mini_frame != selected_frame ! && ! FRAME_TERMCAP_P (mini_frame)) pause |= update_frame (mini_frame, 0, 0); } --- 1162,1166 ---- mini_frame = XFRAME (WINDOW_FRAME (XWINDOW (mini_window))); ! if (mini_frame != selected_frame && FRAME_WINDOW_P (mini_frame)) pause |= update_frame (mini_frame, 0, 0); } *************** update: *** 1203,1206 **** --- 1208,1214 ---- w->update_mode_line = Qnil; XSETFASTINT (w->last_modified, BUF_MODIFF (b)); + w->last_had_star + = (BUF_MODIFF (XBUFFER (w->buffer)) > BUF_SAVE_MODIFF (XBUFFER (w->buffer)) + ? Qt : Qnil); w->window_end_valid = w->buffer; last_arrow_position = Voverlay_arrow_position; *************** mark_window_display_accurate (window, fl *** 1271,1274 **** --- 1279,1285 ---- XSETFASTINT (w->last_modified, !flag ? 0 : BUF_MODIFF (XBUFFER (w->buffer))); + w->last_had_star + = (BUF_MODIFF (XBUFFER (w->buffer)) > BUF_SAVE_MODIFF (XBUFFER (w->buffer)) + ? Qt : Qnil); /* Record if we are showing a region, so can make sure to *************** update_menu_bar (f, save_match_data) *** 1343,1349 **** if (windows_or_buffers_changed || !NILP (w->update_mode_line) ! || (XFASTINT (w->last_modified) < MODIFF ! && (XFASTINT (w->last_modified) ! <= BUF_SAVE_MODIFF (XBUFFER (w->buffer)))) || ((!NILP (Vtransient_mark_mode) && !NILP (XBUFFER (w->buffer)->mark_active)) --- 1354,1360 ---- if (windows_or_buffers_changed || !NILP (w->update_mode_line) ! || ((BUF_SAVE_MODIFF (XBUFFER (w->buffer)) ! < BUF_MODIFF (XBUFFER (w->buffer))) ! != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) && !NILP (XBUFFER (w->buffer)->mark_active)) *************** update_menu_bar (f, save_match_data) *** 1370,1379 **** safe_run_hooks (Qmenu_bar_update_hook); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); ! /* Make sure to redisplay the menu bar in case we change it. */ ! w->update_mode_line = Qt; #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) if (FRAME_WINDOW_P (f)) set_frame_menubar (f, 0, 0); ! #endif /* USE_X_TOOLKIT || HAVE_NTGUI */ unbind_to (count, Qnil); --- 1381,1397 ---- safe_run_hooks (Qmenu_bar_update_hook); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); ! /* Redisplay the menu bar in case we changed it. */ #if defined (USE_X_TOOLKIT) || defined (HAVE_NTGUI) if (FRAME_WINDOW_P (f)) set_frame_menubar (f, 0, 0); ! else ! /* On a terminal screen, the menu bar is an ordinary screen ! line, and this makes it get updated. */ ! w->update_mode_line = Qt; ! #else /* ! (USE_X_TOOLKIT || HAVE_NTGUI) */ ! /* In the non-toolkit version, the menu bar is an ordinary screen ! line, and this makes it get updated. */ ! w->update_mode_line = Qt; ! #endif /* ! (USE_X_TOOLKIT || HAVE_NTGUI) */ unbind_to (count, Qnil); *************** display_text_line (w, start, vpos, hpos, *** 2815,2819 **** use now. We also hit this the first time through the loop, to see what face we should start with. */ ! if (pos >= next_face_change && (FRAME_WINDOW_P (f))) current_face = compute_char_face (f, w, pos, region_beg, region_end, --- 2833,2838 ---- use now. We also hit this the first time through the loop, to see what face we should start with. */ ! if (pos >= next_face_change ! && (FRAME_WINDOW_P (f) || FRAME_MSDOS_P (f))) current_face = compute_char_face (f, w, pos, region_beg, region_end, *************** decode_mode_spec (w, c, spec_width, maxw *** 3727,3731 **** if (!NILP (f->title)) return (char *) XSTRING (f->title)->data; ! if (f->explicit_name || FRAME_TERMCAP_P (f)) return (char *) XSTRING (f->name)->data; #endif --- 3746,3750 ---- if (!NILP (f->title)) return (char *) XSTRING (f->title)->data; ! if (f->explicit_name || ! FRAME_WINDOW_P (f)) return (char *) XSTRING (f->name)->data; #endif diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xfaces.c emacs-19.32/src/xfaces.c *** emacs-19.31/src/xfaces.c Mon Jan 15 04:06:29 1996 --- emacs-19.32/src/xfaces.c Mon Jun 10 16:24:33 1996 *************** init_frame_faces (f) *** 568,572 **** result = Qnil; FOR_EACH_FRAME (tail, frame) ! if (FRAME_X_P (XFRAME (frame)) && XFRAME (frame) != f) { --- 568,572 ---- result = Qnil; FOR_EACH_FRAME (tail, frame) ! if ((FRAME_MSDOS_P (XFRAME (frame)) || FRAME_X_P (XFRAME (frame))) && XFRAME (frame) != f) { *************** DEFUN ("make-face-internal", Fmake_face_ *** 1122,1126 **** FOR_EACH_FRAME (rest, frame) { ! if (FRAME_X_P (XFRAME (frame))) ensure_face_ready (XFRAME (frame), id); } --- 1122,1126 ---- FOR_EACH_FRAME (rest, frame) { ! if (FRAME_MSDOS_P (XFRAME (frame)) || FRAME_X_P (XFRAME (frame))) ensure_face_ready (XFRAME (frame), id); } *************** DEFUN ("set-face-attribute-internal", Fs *** 1149,1153 **** error ("Face id out of range"); ! if (! FRAME_X_P (f)) return Qnil; --- 1149,1153 ---- error ("Face id out of range"); ! if (! FRAME_X_P (f) && ! FRAME_MSDOS_P (f)) return Qnil; *************** DEFUN ("set-face-attribute-internal", Fs *** 1184,1190 **** unsigned long new_color = load_color (f, attr_value); unload_color (f, face->background); - #if defined (MSDOS) && !defined (HAVE_X_WINDOWS) - new_color &= ~8; /* Bright would give blinking characters. */ - #endif face->background = new_color; garbaged = 1; --- 1184,1187 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xfns.c emacs-19.32/src/xfns.c *** emacs-19.31/src/xfns.c Fri Apr 26 12:21:49 1996 --- emacs-19.32/src/xfns.c Tue Jul 16 19:11:37 1996 *************** extern void _XEditResCheckMessages (); *** 90,95 **** extern LWLIB_ID widget_id_tick; /* This is part of a kludge--see lwlib/xlwmenu.c. */ ! XFontStruct *xlwmenu_default_font; extern void free_frame_menubar (); --- 90,97 ---- extern LWLIB_ID widget_id_tick; + #ifdef USE_LUCID /* This is part of a kludge--see lwlib/xlwmenu.c. */ ! extern XFontStruct *xlwmenu_default_font; ! #endif extern void free_frame_menubar (); *************** Lisp_Object Qbox; *** 170,174 **** Lisp_Object Qcursor_color; Lisp_Object Qcursor_type; - Lisp_Object Qfont; Lisp_Object Qforeground_color; Lisp_Object Qgeometry; --- 172,175 ---- *************** x_real_positions (f, xptr, yptr) *** 1004,1014 **** Detect that and try the whole thing over. */ if (! x_had_errors_p (FRAME_X_DISPLAY (f))) ! break; x_uncatch_errors (FRAME_X_DISPLAY (f)); } - x_uncatch_errors (FRAME_X_DISPLAY (f)); - *xptr = f->output_data.x->left_pos - win_x; *yptr = f->output_data.x->top_pos - win_y; --- 1005,1016 ---- Detect that and try the whole thing over. */ if (! x_had_errors_p (FRAME_X_DISPLAY (f))) ! { ! x_uncatch_errors (FRAME_X_DISPLAY (f)); ! break; ! } x_uncatch_errors (FRAME_X_DISPLAY (f)); } *xptr = f->output_data.x->left_pos - win_x; *yptr = f->output_data.x->top_pos - win_y; *************** This function is an internal primitive-- *** 3011,3015 **** int width, height; int count = specpdl_ptr - specpdl; ! struct gcpro gcpro1; Lisp_Object display; struct x_display_info *dpyinfo; --- 3013,3017 ---- int width, height; int count = specpdl_ptr - specpdl; ! struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; Lisp_Object display; struct x_display_info *dpyinfo; *************** This function is an internal primitive-- *** 3049,3052 **** --- 3051,3059 ---- CHECK_NUMBER (parent, 0); + /* make_frame_without_minibuffer can run Lisp code and garbage collect. */ + /* No need to protect DISPLAY because that's not used after passing + it to make_frame_without_minibuffer. */ + frame = Qnil; + GCPRO4 (parms, parent, name, frame); tem = x_get_arg (parms, Qminibuffer, 0, 0, symbol); if (EQ (tem, Qnone) || NILP (tem)) *************** This function is an internal primitive-- *** 3062,3071 **** f = make_frame (1); /* Note that X Windows does support scroll bars. */ FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; - XSETFRAME (frame, f); - GCPRO1 (frame); - f->output_method = output_x_window; f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output)); --- 3069,3077 ---- f = make_frame (1); + XSETFRAME (frame, f); + /* Note that X Windows does support scroll bars. */ FRAME_CAN_HAVE_SCROLL_BARS (f) = 1; f->output_method = output_x_window; f->output_data.x = (struct x_output *) xmalloc (sizeof (struct x_output)); *************** This function is an internal primitive-- *** 3144,3148 **** } ! #ifdef USE_X_TOOLKIT /* Prevent lwlib/xlwmenu.c from crashing because of a bug whereby it fails to get any font. */ --- 3150,3154 ---- } ! #ifdef USE_LUCID /* Prevent lwlib/xlwmenu.c from crashing because of a bug whereby it fails to get any font. */ *************** syms_of_xfns () *** 5033,5038 **** Qcursor_type = intern ("cursor-type"); staticpro (&Qcursor_type); - Qfont = intern ("font"); - staticpro (&Qfont); Qforeground_color = intern ("foreground-color"); staticpro (&Qforeground_color); --- 5039,5042 ---- diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xmenu.c emacs-19.32/src/xmenu.c *** emacs-19.31/src/xmenu.c Mon Apr 29 11:28:51 1996 --- emacs-19.32/src/xmenu.c Mon Jul 29 00:20:01 1996 *************** *** 1,4 **** /* X Communication module for terminals which understand the X protocol. ! Copyright (C) 1986, 1988, 1993, 1994 Free Software Foundation, Inc. This file is part of GNU Emacs. --- 1,4 ---- /* X Communication module for terminals which understand the X protocol. ! Copyright (C) 1986, 1988, 1993, 1994, 1996 Free Software Foundation, Inc. This file is part of GNU Emacs. *************** Boston, MA 02111-1307, USA. */ *** 89,92 **** --- 89,94 ---- Lisp_Object Qdebug_on_next_call; + Lisp_Object Qmenu_alias; + extern Lisp_Object Qmenu_enable; extern Lisp_Object Qmenu_bar; *************** static int popup_activated_flag; *** 170,173 **** --- 172,184 ---- static int next_menubar_widget_id; + + /* This is set nonzero after the user activates the menu bar, and set + to zero again after the menu bars are redisplayed by prepare_menu_bar. + While it is nonzero, all calls to set_frame_menubar go deep. + + I don't understand why this is needed, but it does seem to be + needed on Motif, according to Marcus Daniels . */ + + int pending_menu_activation; #ifdef USE_X_TOOLKIT *************** menu_item_equiv_key (item_string, item1, *** 397,401 **** (such as easymenu.el and lmenu.el set it up), see if the original command name has equivalent keys. */ ! if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function)) savedkey = Fwhere_is_internal (XSYMBOL (def)->function, Qnil, Qt, Qnil); --- 408,413 ---- (such as easymenu.el and lmenu.el set it up), see if the original command name has equivalent keys. */ ! if (SYMBOLP (def) && SYMBOLP (XSYMBOL (def)->function) ! && ! NILP (Fget (def, Qmenu_alias))) savedkey = Fwhere_is_internal (XSYMBOL (def)->function, Qnil, Qt, Qnil); *************** on the left of the dialog box and all fo *** 1003,1006 **** --- 1015,1020 ---- else if (WINDOWP (position) || FRAMEP (position)) window = position; + else + window = Qnil; /* Decode where to put the menu. */ *************** popup_get_selection (initial_event, dpyi *** 1094,1101 **** if (event.type == Expose) process_expose_from_menu (event); ! /* Make sure we don't consider buttons grabbed after menu goes. */ else if (event.type == ButtonRelease && dpyinfo->display == event.xbutton.display) ! dpyinfo->grabbed &= ~(1 << event.xbutton.button); /* If the user presses a key, deactivate the menu. The user is likely to do that if we get wedged. */ --- 1108,1120 ---- if (event.type == Expose) process_expose_from_menu (event); ! /* Make sure we don't consider buttons grabbed after menu goes. ! And make sure to deactivate for any ButtonRelease, ! even if XtDispatchEvent doesn't do that. */ else if (event.type == ButtonRelease && dpyinfo->display == event.xbutton.display) ! { ! dpyinfo->grabbed &= ~(1 << event.xbutton.button); ! popup_activated_flag = 0; ! } /* If the user presses a key, deactivate the menu. The user is likely to do that if we get wedged. */ *************** popup_get_selection (initial_event, dpyi *** 1116,1124 **** /* Queue all events not for this popup, ! except for Expose, which we've already handled. Note that the X window is associated with the frame if this is a menu bar popup, but not if it's a dialog box. So we use x_non_menubar_window_to_frame, not x_any_window_to_frame. */ if (event.type != Expose && (event.xany.display != dpyinfo->display || x_non_menubar_window_to_frame (dpyinfo, event.xany.window))) --- 1135,1145 ---- /* Queue all events not for this popup, ! except for Expose, which we've already handled, and ButtonRelease. Note that the X window is associated with the frame if this is a menu bar popup, but not if it's a dialog box. So we use x_non_menubar_window_to_frame, not x_any_window_to_frame. */ if (event.type != Expose + && !(event.type == ButtonRelease + && dpyinfo->display == event.xbutton.display) && (event.xany.display != dpyinfo->display || x_non_menubar_window_to_frame (dpyinfo, event.xany.window))) *************** popup_get_selection (initial_event, dpyi *** 1158,1162 **** To activate the menu bar, we use the X button-press event ! that was saved in saved_button_event. That makes the toolkit do its thing. --- 1179,1183 ---- To activate the menu bar, we use the X button-press event ! that was saved in saved_menu_event. That makes the toolkit do its thing. *************** x_activate_menubar (f) *** 1170,1184 **** FRAME_PTR f; { ! if (f->output_data.x->saved_button_event->type != ButtonPress) return; set_frame_menubar (f, 0, 1); - BLOCK_INPUT; ! XtDispatchEvent ((XEvent *) f->output_data.x->saved_button_event); UNBLOCK_INPUT; ! /* Ignore this if we get it a second time. */ ! f->output_data.x->saved_button_event->type = 0; } --- 1191,1208 ---- FRAME_PTR f; { ! if (!f->output_data.x->saved_menu_event->type) return; set_frame_menubar (f, 0, 1); BLOCK_INPUT; ! XtDispatchEvent ((XEvent *) f->output_data.x->saved_menu_event); UNBLOCK_INPUT; ! #ifdef USE_MOTIF ! if (f->output_data.x->saved_menu_event->type == ButtonRelease) ! pending_menu_activation = 1; ! #endif ! /* Ignore this if we get it a second time. */ ! f->output_data.x->saved_menu_event->type = 0; } *************** single_submenu (item_key, item_name, map *** 1378,1383 **** for (i = 0; i < len; i++) { ! if (SYMBOLP (mapvec[i])) { top_level_items = 1; push_menu_pane (Qnil, Qnil); --- 1402,1411 ---- for (i = 0; i < len; i++) { ! if (SYMBOLP (mapvec[i]) ! || (CONSP (mapvec[i]) ! && NILP (Fkeymapp (mapvec[i])))) { + /* Here we have a command at top level in the menu bar + as opposed to a submenu. */ top_level_items = 1; push_menu_pane (Qnil, Qnil); *************** set_frame_menubar (f, first_time, deep_p *** 1589,1592 **** --- 1617,1629 ---- if (! menubar_widget) deep_p = 1; + else if (pending_menu_activation && !deep_p) + deep_p = 1; + /* Make the first call for any given frame always go deep. */ + else if (!f->output_data.x->saved_menu_event && !deep_p) + { + deep_p = 1; + f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent)); + f->output_data.x->saved_menu_event->type = 0; + } wv = xmalloc_widget_value (); *************** set_frame_menubar (f, first_time, deep_p *** 1719,1722 **** --- 1756,1764 ---- wv->value = 0; wv->enabled = 1; + /* This prevents lwlib from assuming this + menu item is really supposed to be empty. */ + /* The EMACS_INT cast avoids a warning. + This value just has to be different from small integers. */ + wv->call_data = (void *) (EMACS_INT) (-1); if (prev_wv) *************** syms_of_xmenu () *** 2645,2648 **** --- 2687,2693 ---- staticpro (&menu_items); menu_items = Qnil; + + Qmenu_alias = intern ("menu-alias"); + staticpro (&Qmenu_alias); Qdebug_on_next_call = intern ("debug-on-next-call"); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xselect.c emacs-19.32/src/xselect.c *** emacs-19.31/src/xselect.c Thu Jan 25 17:00:10 1996 --- emacs-19.32/src/xselect.c Tue Jul 16 01:18:47 1996 *************** static Lisp_Object Vx_sent_selection_hoo *** 58,62 **** /* The timestamp of the last input event Emacs received from the X server. */ ! unsigned long last_event_timestamp; /* This is an association list whose elements are of the form --- 58,63 ---- /* The timestamp of the last input event Emacs received from the X server. */ ! /* Defined in keyboard.c. */ ! extern unsigned long last_event_timestamp; /* This is an association list whose elements are of the form *************** x_clear_frame_selections (f) *** 835,839 **** --- 836,844 ---- for (; CONSP (hooks); hooks = Fcdr (hooks)) call1 (Fcar (hooks), selection_symbol); + #if 0 /* This can crash when deleting a frame + from x_connection_closed. Anyway, it seems unnecessary; + something else should cause a redisplay. */ redisplay_preserve_echo_area (); + #endif } *************** x_clear_frame_selections (f) *** 855,859 **** --- 860,866 ---- for (; CONSP (hooks); hooks = Fcdr (hooks)) call1 (Fcar (hooks), selection_symbol); + #if 0 /* See above */ redisplay_preserve_echo_area (); + #endif } XCONS (rest)->cdr = Fcdr (XCONS (rest)->cdr); diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xterm.c emacs-19.32/src/xterm.c *** emacs-19.31/src/xterm.c Sat May 25 19:27:09 1996 --- emacs-19.32/src/xterm.c Wed Jul 31 13:16:54 1996 *************** extern void _XEditResCheckMessages (); *** 122,129 **** #endif - #ifdef SOLARIS2 - #define X_CONNECTION_LOCK_FLAG XlibDisplayWriting - #endif - #ifndef min #define min(a,b) ((a)<(b) ? (a) : (b)) --- 122,125 ---- *************** Lisp_Object x_display_name_list; *** 149,152 **** --- 145,150 ---- extern struct frame *updating_frame; + extern waiting_for_input; + /* This is a frame waiting to be autoraised, within XTread_socket. */ struct frame *pending_autoraise_frame; *************** static FRAME_PTR last_mouse_frame; *** 200,203 **** --- 198,203 ---- static XRectangle last_mouse_glyph; + static Lisp_Object last_mouse_press_frame; + /* The scroll bar in which the last X motion event occurred. *************** struct x_display_info *XTread_socket_fak *** 3214,3217 **** --- 3214,3233 ---- static struct x_display_info *next_noop_dpyinfo; + #define SET_SAVED_MENU_EVENT(size) { \ + if (f->output_data.x->saved_menu_event == 0) \ + f->output_data.x->saved_menu_event = (XEvent*)xmalloc (sizeof (XEvent)); \ + bcopy (&event, f->output_data.x->saved_menu_event, size); \ + if (numchars >= 1) \ + { \ + bufp->kind = menu_bar_activate_event; \ + XSETFRAME (bufp->frame_or_window, f); \ + bufp++; \ + count++; \ + numchars--; \ + } \ + } + #define SET_SAVED_BUTTON_EVENT SET_SAVED_MENU_EVENT (sizeof (XButtonEvent)) + #define SET_SAVED_KEY_EVENT SET_SAVED_MENU_EVENT (sizeof (XKeyEvent)) + /* Read events coming from the X server. This routine is called by the SIGIO handler. *************** int *** 3229,3234 **** XTread_socket (sd, bufp, numchars, waitp, expected) register int sd; ! register struct input_event *bufp; ! register int numchars; int waitp; int expected; --- 3245,3250 ---- XTread_socket (sd, bufp, numchars, waitp, expected) register int sd; ! /* register */ struct input_event *bufp; ! /* register */ int numchars; int waitp; int expected; *************** XTread_socket (sd, bufp, numchars, waitp *** 3303,3307 **** --- 3319,3328 ---- while (XPending (dpyinfo->display) != 0) { + #ifdef USE_X_TOOLKIT + /* needed to raise Motif submenus */ + XtAppNextEvent (Xt_app_con, &event); + #else XNextEvent (dpyinfo->display, &event); + #endif event_found = 1; *************** XTread_socket (sd, bufp, numchars, waitp *** 3352,3356 **** event.xclient.window, initial_argv, initial_argc); ! else XSetCommand (FRAME_X_DISPLAY (f), event.xclient.window, --- 3373,3377 ---- event.xclient.window, initial_argv, initial_argc); ! else if (f) XSetCommand (FRAME_X_DISPLAY (f), event.xclient.window, *************** XTread_socket (sd, bufp, numchars, waitp *** 3557,3561 **** has become iconified or invisible. So assume, if it was previously visible, than now it is iconified. ! We depend on x_make_frame_invisible to mark it iconified. */ if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) f->async_iconified = 1; --- 3578,3582 ---- has become iconified or invisible. So assume, if it was previously visible, than now it is iconified. ! We depend on x_make_frame_invisible to mark it invisible. */ if (FRAME_VISIBLE_P (f) || FRAME_ICONIFIED_P (f)) f->async_iconified = 1; *************** XTread_socket (sd, bufp, numchars, waitp *** 3614,3617 **** --- 3635,3653 ---- int modifiers; + #if 0 /* This was how we made f10 work in Motif. + The drawback is, you can't type at Emacs when the + the mouse is in the menu bar. So it is better to + turn off f10 in Motif and let Emacs handle it. */ + #ifdef USE_MOTIF + if (lw_window_is_in_menubar (event.xkey.window, + f->output_data.x->menubar_widget + )) + { + SET_SAVED_KEY_EVENT; + break; + } + #endif /* USE_MOTIF */ + #endif /* 0 */ + event.xkey.state |= x_emacs_to_x_modifiers (FRAME_X_DISPLAY_INFO (f), *************** XTread_socket (sd, bufp, numchars, waitp *** 4018,4035 **** && event.xbutton.same_screen) { ! if (f->output_data.x->saved_button_event == 0) ! f->output_data.x->saved_button_event ! = (XButtonEvent *) xmalloc (sizeof (XButtonEvent)); ! bcopy (&event, f->output_data.x->saved_button_event, ! sizeof (XButtonEvent)); ! if (numchars >= 1) { ! bufp->kind = menu_bar_activate_event; ! XSETFRAME (bufp->frame_or_window, f); ! bufp++; ! count++; ! numchars--; } } else goto OTHER; --- 4054,4081 ---- && event.xbutton.same_screen) { ! SET_SAVED_BUTTON_EVENT; ! XSETFRAME (last_mouse_press_frame, f); ! } ! else if (event.type == ButtonPress) ! { ! last_mouse_press_frame = Qnil; ! goto OTHER; ! } ! #ifdef USE_MOTIF /* This should do not harm for Lucid, ! but I am trying to be cautious. */ ! else if (event.type == ButtonRelease) ! { ! if (!NILP (last_mouse_press_frame)) { ! f = XFRAME (last_mouse_press_frame); ! if (f->output_data.x) ! { ! SET_SAVED_BUTTON_EVENT; ! } } + else + goto OTHER; } + #endif /* USE_MOTIF */ else goto OTHER; *************** x_connection_closed (display, error_mess *** 4517,4521 **** if (x_display_list == 0) { ! fprintf (stderr, "%s", error_message); shut_down_emacs (0, 0, Qnil); exit (70); --- 4563,4567 ---- if (x_display_list == 0) { ! fprintf (stderr, "%s\n", error_message); shut_down_emacs (0, 0, Qnil); exit (70); *************** x_connection_closed (display, error_mess *** 4529,4532 **** --- 4575,4579 ---- TOTALLY_UNBLOCK_INPUT; + clear_waiting_for_input (); error ("%s", error_message); } *************** x_error_quitter (display, error) *** 4547,4551 **** XGetErrorText (display, error->error_code, buf, sizeof (buf)); ! sprintf (buf1, "X protocol error: %s on protocol request %d\n", buf, error->request_code); x_connection_closed (display, buf1); --- 4594,4598 ---- XGetErrorText (display, error->error_code, buf, sizeof (buf)); ! sprintf (buf1, "X protocol error: %s on protocol request %d", buf, error->request_code); x_connection_closed (display, buf1); *************** x_io_error_quitter (display) *** 4568,4620 **** /* Handle SIGPIPE, which can happen when the connection to a server simply goes away. SIGPIPE is handled by x_connection_signal. ! It works by sending a no-op command to each X server connection. ! When we try a connection that has closed, we get SIGPIPE again. ! But this time, it is handled by x_connection_signal_1. ! That function knows which connection we were testing, ! so it closes that one. - x_connection_closed never returns, - so if more than one connection was lost at once, - we only find one. But XTread_socket keeps trying them all, - so it will notice the other closed one sooner or later. */ - - - static struct x_display_info *x_connection_signal_dpyinfo; - - static SIGTYPE x_connection_signal (); - - static SIGTYPE - x_connection_signal_1 (signalnum) /* If we don't have an argument, */ - int signalnum; /* some compilers complain in signal calls. */ - { - signal (SIGPIPE, x_connection_signal); - x_connection_closed (x_connection_signal_dpyinfo->display, - "connection was lost"); - } - static SIGTYPE x_connection_signal (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { ! x_connection_signal_dpyinfo = x_display_list; ! ! sigunblock (sigmask (SIGPIPE)); ! ! while (x_connection_signal_dpyinfo) ! { ! signal (SIGPIPE, x_connection_signal_1); ! ! x_connection_close_if_hung (x_connection_signal_dpyinfo); ! ! XNoOp (x_connection_signal_dpyinfo->display); ! ! XSync (x_connection_signal_dpyinfo->display, False); ! ! /* Each time we get here, cycle through the displays now open. */ ! x_connection_signal_dpyinfo = x_connection_signal_dpyinfo->next; ! } ! ! /* We should have found some closed connection. */ ! abort (); } --- 4615,4631 ---- /* Handle SIGPIPE, which can happen when the connection to a server simply goes away. SIGPIPE is handled by x_connection_signal. ! Don't need to do anything, because the write which caused the ! SIGPIPE will fail, causing Xlib to invoke the X IO error handler, ! which will do the appropriate cleanup for us. */ static SIGTYPE x_connection_signal (signalnum) /* If we don't have an argument, */ int signalnum; /* some compilers complain in signal calls. */ { ! #ifdef USG ! /* USG systems forget handlers when they are used; ! must reestablish each time */ ! signal (signalnum, x_connection_signal); ! #endif /* USG */ } *************** x_iconify_frame (f) *** 5439,5442 **** --- 5450,5458 ---- /* This was XtPopup, but that did nothing for an iconified frame. */ XtMapWidget (f->output_data.x->widget); + /* The server won't give us any event to indicate + that an invisible frame was changed to an icon, + so we have to record it here. */ + f->iconified = 1; + f->async_iconified = 1; UNBLOCK_INPUT; return; *************** syms_of_xterm () *** 6226,6274 **** staticpro (&Qvendor_specific_keysyms); Qvendor_specific_keysyms = intern ("vendor-specific-keysyms"); - } - - /* Avoid warnings or errors from including Xlibint.h. - We don't need these functions for the rest of this file. */ - #undef bzero - #undef bcopy - #undef bcmp - #undef min - #undef max - - #ifdef X_CONNECTION_LOCK_FLAG - #define free loserfree - #define malloc losermalloc - #define exit loserexit - #define abort loserabort - /* For XlibDisplayWriting */ - #include - #endif - - /* Check whether display connection DPYINFO is hung - because its thread-interlock is locked. - If it is, close the connection. - Do nothing if this system does not have a thread interlock. */ ! x_connection_close_if_hung (dpyinfo) ! struct x_display_info *dpyinfo; ! { ! /* This tests (1) whether X_CONNECTION_LOCK_FLAG is defined at all, ! and (2) whether the name it is defined as is itself defined. ! (It ought to have been defined by Xlibint.h. */ ! #if X_CONNECTION_LOCK_FLAG ! ! if (dpyinfo->display->flags & X_CONNECTION_LOCK_FLAG) ! { ! /* If the thread-interlock is locked, assume this connection is dead. ! This assumes that the library does not make other threads ! that can be locking the display legitimately. */ ! ! dpyinfo->display->flags &= ~X_CONNECTION_LOCK_FLAG; ! x_connection_closed (dpyinfo->display, "connection was lost"); ! } ! #endif /* X_CONNECTION_LOCK_FLAG */ } - - /* Don't put any additional functions here! */ #endif /* not HAVE_X_WINDOWS */ --- 6242,6249 ---- staticpro (&Qvendor_specific_keysyms); Qvendor_specific_keysyms = intern ("vendor-specific-keysyms"); ! staticpro (&last_mouse_press_frame); ! last_mouse_press_frame = Qnil; } #endif /* not HAVE_X_WINDOWS */ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/src/xterm.h emacs-19.32/src/xterm.h *** emacs-19.31/src/xterm.h Thu Apr 18 00:12:27 1996 --- emacs-19.32/src/xterm.h Tue Jul 16 01:59:38 1996 *************** Boston, MA 02111-1307, USA. */ *** 72,83 **** #endif ! #ifdef XlibSpecificationRelease ! #if XlibSpecificationRelease >= 5 ! #define HAVE_X11R5 /* In case someone has X11R5 on AIX 3.1, make sure HAVE_X11R4 is defined as well as HAVE_X11R5. */ #define HAVE_X11R4 #endif - #endif #ifdef HAVE_X11R5 --- 72,80 ---- #endif ! #ifdef HAVE_X11R5 /* In case someone has X11R5 on AIX 3.1, make sure HAVE_X11R4 is defined as well as HAVE_X11R5. */ #define HAVE_X11R4 #endif #ifdef HAVE_X11R5 *************** struct x_output *** 457,462 **** /* This is a button event that wants to activate the menubar. ! We save it here until the command loop gets to think about it. */ ! XButtonEvent *saved_button_event; /* This is the widget id used for this frame's menubar in lwlib. */ --- 454,459 ---- /* This is a button event that wants to activate the menubar. ! We save it here until the command loop gets to think about it. */ ! XEvent *saved_menu_event; /* This is the widget id used for this frame's menubar in lwlib. */ diff -2rcpP --exclude=*.elc --exclude=*.aux --exclude=*.cps --exclude=*.fns --exclude=*.kys --exclude=*.vrs emacs-19.31/vms/ChangeLog emacs-19.32/vms/ChangeLog *** emacs-19.31/vms/ChangeLog Thu Jul 7 14:53:42 1994 --- emacs-19.32/vms/ChangeLog Thu Aug 1 01:13:09 1996 *************** *** 1,33 **** ! Please note that Jim Blandy knows nothing about Emacs' VMS support, even ! though his name appears here. A better person to ask might be Richard ! Levitte . ! ! Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) ! ! * Version 19.16 released. ! ! Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) ! ! * version 19.15 released. ! ! Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) ! ! * Version 19.14 released. ! ! Tue Jun 8 08:29:36 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) ! ! * Version 19.13 released. ! ! Thu May 27 02:35:32 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) ! ! * Version 19.9 released. ! ! Mon May 24 12:14:41 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) ! ! * Version 19.8 released. ! ! Sat May 22 19:37:01 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) ! ! * Version 19.7 released. Sat Sep 19 16:15:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu) --- 1,3 ---- ! For information abut VMS support, contact Richard Levitte . Sat Sep 19 16:15:54 1992 Richard Stallman (rms@mole.gnu.ai.mit.edu)