#!/bin/sh #### Patch script - GNU Emacs - version 19.17 to 19.18 #### This file contains patches to turn version 19.17 of GNU Emacs into #### 19.18. To apply them, cd to the top of the Emacs source tree, and #### then type 'sh '. #### After you apply the patches, you should run Emacs (an earlier 19 will do) #### and type M-x byte-recompile-directory RET lisp RET #### to recompile the changed Emacs Lisp files. #### Then you can build the new Emacs version. #### Also compile some new files: hilit19.el, tpu-edt.el, tpu-extras.el #### tpu-mapper.el, cl-compat.el, cl-extra.el, cl-macs.el, cl-seq.el, #### and texinfmt.el. #### Use M-x byte-compile-file RET RET to compile #### file . You need to do it once for each of these new files. #### 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; makeinfo emacs.texi; makeinfo cl.texinfo; makeinfo gnus.texi) ### Patchmaker's checklist: ### - update version numbers in comments and version.el tweak ### - diff -u ls -R listings, and decide on rm's and mv's. ### - apply rm's and mv's, and then do a diff -cprP --exclude=\*.elc ### to generate the body. ### - stick a line saying "end-of-emacs-patch-kit" on the end. if [ -d lisp ] ; then true else if [ -d emacs-19.17/lisp ] ; then cd emacs-19.17 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 fi ### We can't patch version.el, because it contains some random dump ### number. So we'll be a little more relaxed about this edit. sed < lisp/version.el > $$ \ -e 's/defconst emacs-version "[^"]*"/defconst emacs-version "19.18.0"/' mv lisp/version.el lisp/version.el~ mv $$ lisp/version.el ### Put moves and renames here. (cd src; mv ChangeLog OChangeLog; rm gnu-hp300) (cd lisp; mv ChangeLog OChangeLog; rm cl.el sc-alist.el*) (cd man; rm cl.texinfo) (cd info; rm cl) patch -p1 << \end-of-emacs-patch-kit diff -rc2P --exclude-from=exceptions emacs-19.17/ChangeLog emacs-19.18/ChangeLog *** emacs-19.17/ChangeLog Mon Jul 19 01:58:10 1993 --- emacs-19.18/ChangeLog Mon Aug 9 01:56:36 1993 *************** *** 1,2 **** --- 1,69 ---- + Sun Aug 8 13:42:49 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * Version 19.18 released. + + * make-dist (src): Don't put gnu-hp300 in dist. + (src, lisp): Include OChangeLog in dist. + + Sun Aug 8 01:52:55 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * configure.in: Test for presence of logb and frexp functions. + + Thu Aug 5 17:10:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * configure.in (machine): Add i370-ibm-aix*. + + Tue Aug 3 02:55:17 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * configure.in (function checks): Test for mkdir and rmdir. + + * configure.in (function checks): Don't test for random and bcopy + only when we're building with X; look for them all the time. + + Fri Jul 30 21:07:00 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * configure.in: Test for availability of bcopy functions, searching + the X libraries if we're using X. + + * configure.in: Test for the presence of/usr/lpp/X11/bin/smt.exp, + and #define HAVE_AIX_SMT_EXP if we do. This is present in some + versions of AIX, and needs to be passed to the loader. + + * configure.in: Test for the availablility of the + XScreenResourceString function. + + Fri Jul 30 20:54:58 1993 David J. MacKenzie (djm@frob.eng.umd.edu) + + * configure.in: If we found X on our own, set C_SWITCH_X_SITE and + LD_SWITCH_X_SITE and assume --with-x11. + Only look for X11 files if we weren't told about a window system + or if we were told to use X11 but not told where. + Search the libraries from the s and/or m files when checking for + functions. + + * configure.in: Remove any trailing slashes in prefix and exec_prefix. + + Tue Jul 27 19:43:41 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * make-dist: Include lisp/dired.todo in the distribution. + + Fri Jul 23 15:51:24 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * configure.in: Add code to set HAVE_INET_SOCKETS. + + Wed Jul 21 18:05:58 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * configure.in: If we do find x_includes and x_libraries + via AC_FIND_X, set C_SWITCH_X_SITE and LD_SWITCH_X_SITE. + + Mon Jul 19 15:19:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * make-dist: Include src/gnu-hp300 in the dist. + + * configure.in (canonical): New variable holds the canonicalized + configuration. Don't alter `configuration'. Use `configuration' + for Makefile.in for file naming. + (testing x_includes and x_libraries): Use =, not ==. + Sat Jul 17 19:53:06 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) diff -rc2P --exclude-from=exceptions emacs-19.17/INSTALL emacs-19.18/INSTALL *** emacs-19.17/INSTALL Wed Jun 9 06:54:50 1993 --- emacs-19.18/INSTALL Thu Aug 5 17:58:27 1993 *************** *** 25,31 **** final dumped Emacs. ! Building Emacs requires about 30 Mb of disk space. Installed, Emacs ! occupies about 20 Mb; this includes the executable files, lisp ! libraries, miscellaneous data files, and on-line documentation. 2) Consult `./etc/MACHINES' to see what configuration name you should --- 25,34 ---- final dumped Emacs. ! Building Emacs requires about 30 Mb of disk space (including the Emacs ! sources). Once installed, Emacs occupies about 20 Mb in the file ! system where it is installed; this includes the executable files, Lisp ! libraries, miscellaneous data files, and on-line documentation. If ! the building and installation take place in different directories, ! then the installation procedure momentarily requires 30+20 Mb. 2) Consult `./etc/MACHINES' to see what configuration name you should *************** *** 72,75 **** --- 75,83 ---- processes should look for the Emacs source code in DIR, when DIR is not the current directory. + + You can use `--srcdir' to build Emacs for several different machine + types from a single source directory. Make separate build directories + for the different configuration types, and in each one, build Emacs + specifying the common source directory with `--srcdir'. The `--prefix=PREFIXDIR' option specifies where the installation process diff -rc2P --exclude-from=exceptions emacs-19.17/PROBLEMS emacs-19.18/PROBLEMS *** emacs-19.17/PROBLEMS Fri Jul 16 13:49:38 1993 --- emacs-19.18/PROBLEMS Sat Jul 31 14:56:31 1993 *************** *** 2,13 **** in compiling, installing and running GNU Emacs. ! * Inability to send an Alt-modified key, while using Emacs with X Windows. ! If you have tried to bind an Alt key as a command, and it does not ! work to type the command, the first thing you should check is whether ! the key is getting through to Emacs. To do this, type C-h c followed ! by the Alt-modified key. C-h c should say what kind of event it ! read. If it says it read an Alt key, then make sure you have made the ! key binding correctly. If C-h c reports an event that doesn't have the Alt modifier, it may --- 2,38 ---- in compiling, installing and running GNU Emacs. ! * Watch out for .emacs files and EMACSLOADPATH environment vars ! ! These control the actions of Emacs. ! ~/.emacs is your Emacs init file. ! EMACSLOADPATH overrides which directories the function ! "load" will search. ! ! If you observe strange problems, check for these and get rid ! of them, then try again. ! ! * After running emacs once, subsequent invocations crash. ! Some versions of SVR4 have a serious bug in the implementation of the ! mmap () system call in the kernel; this causes emacs to run correctly ! the first time, and then crash when run a second time. ! ! Contact your vendor and ask for the mmap bug fix; in the mean time, ! you may be able to work around the problem by adding a line to your ! operating system description file (whose name is reported by the ! configure script) that reads: ! #define SYSTEM_MALLOC ! This makes Emacs use memory less efficiently, but seems to work around ! the kernel bug. ! ! * Inability to send an Alt-modified key, when Emacs is communicating ! directly with an X server. ! ! If you have tried to bind an Alt-modified key as a command, and it ! does not work to type the command, the first thing you should check is ! whether the key is getting through to Emacs. To do this, type C-h c ! followed by the Alt-modified key. C-h c should say what kind of event ! it read. If it says it read an Alt-modified key, then make sure you ! have made the key binding correctly. If C-h c reports an event that doesn't have the Alt modifier, it may *************** *** 31,34 **** --- 56,62 ---- commands show above to make them modifier keys. + Note that if you have Alt keys but no Meta keys, Emacs translates Alt + into Meta. This is because of the great importance of Meta in Emacs. + * `Pid xxx killed due to text modification or page I/O error' *************** *** 130,146 **** the environment. - * Emacs starts in a directory other than the one that is current in the shell. - - If the PWD environment variable exists, Emacs uses this variable as - the initial working directory. - - Some shells automatically update this variable, while other shells fail - to do so. If you use two such shells in combination, the variable can - end up wrong. This confuses Emacs. - - The solution is to put something in the start-up file for the shell - that does not update PWD, to get rid of that environment variable. - For example, in csh, use `unsetenv PWD'. - * Emacs gets error message from linker on Sun. --- 158,161 ---- *************** *** 216,229 **** As a result, the host name you specify may not be recognized. - * Watch out for .emacs files and EMACSLOADPATH environment vars - - These control the actions of Emacs. - ~/.emacs is your Emacs init file. - EMACSLOADPATH overrides which directories the function - "load" will search. - - If you observe strange problems, check for these and get rid - of them, then try again. - * Shell mode ignores interrupts on Apollo Domain --- 231,234 ---- *************** *** 475,480 **** (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") ! An even more drastic measure is to make Emacs use flow control. ! To do this, evaluate the Lisp expression (set-input-mode nil t). Emacs will then interpret C-s and C-q as flow control commands. (More precisely, it will allow the kernel to do so as it usually does.) You --- 480,487 ---- (enable-flow-control-on "vt200" "vt300" "vt101" "vt131") ! An even more drastic measure is to make Emacs use flow control. To do ! this, evaluate the Lisp expression (set-input-mode nil t META). (The ! argument META should be t if you have a meta key, and nil otherwise.) ! Emacs will then interpret C-s and C-q as flow control commands. (More precisely, it will allow the kernel to do so as it usually does.) You diff -rc2P --exclude-from=exceptions emacs-19.17/README emacs-19.18/README *** emacs-19.17/README Sun Jul 18 04:29:18 1993 --- emacs-19.18/README Mon Aug 9 02:21:26 1993 *************** *** 1,3 **** ! This directory tree holds version 19.17 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. --- 1,3 ---- ! This directory tree holds version 19.18 of GNU Emacs, the extensible, customizable, self-documenting real-time display editor. diff -rc2P --exclude-from=exceptions emacs-19.17/config.sub emacs-19.18/config.sub *** emacs-19.17/config.sub Sun Jul 18 04:29:17 1993 --- emacs-19.18/config.sub Mon Aug 9 02:21:24 1993 *************** *** 98,101 **** --- 98,104 ---- basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'` ;; + -lynx) + os=-lynxos + ;; esac *************** *** 516,520 **** | -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \ | -riscos* | -linux* | -uniplus* | -iris* | -rtu* | -xenix* \ ! | -386bsd*) ;; -sunos5*) --- 519,523 ---- | -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \ | -riscos* | -linux* | -uniplus* | -iris* | -rtu* | -xenix* \ ! | -386bsd* | -lynxos*) ;; -sunos5*) *************** *** 671,674 **** --- 674,680 ---- -sunos*) vendor=sun + ;; + -lynxos*) + vendor=lynx ;; -aix*) diff -rc2P --exclude-from=exceptions emacs-19.17/configure emacs-19.18/configure *** emacs-19.17/configure Sun Jul 18 02:31:01 1993 --- emacs-19.18/configure Mon Aug 9 01:58:50 1993 *************** *** 196,200 **** fi x_includes="${val}" - C_SWITCH_X_SITE="-I\"${x_includes}\"" ;; "x_libraries" ) --- 196,199 ---- *************** *** 212,216 **** fi x_libraries="${val}" - LD_SWITCH_X_SITE="-L\"${x_libraries}\"" ;; --- 211,214 ---- *************** *** 374,378 **** ### Canonicalize the configuration name. echo "Checking the configuration name." ! if configuration=`${srcdir}/config.sub "${configuration}"` ; then : ; else exit $? fi --- 372,376 ---- ### Canonicalize the configuration name. echo "Checking the configuration name." ! if canonical=`${srcdir}/config.sub "${configuration}"` ; then : ; else exit $? fi *************** *** 402,406 **** machine='' opsys='' unported='false' ! case "${configuration}" in ## Alliant machines --- 400,404 ---- machine='' opsys='' unported='false' ! case "${canonical}" in ## Alliant machines *************** *** 598,601 **** --- 596,602 ---- machine=ibmps2-aix opsys=usg5-3 ;; + i370-ibm-aix*) + machine=ibm370aix opsys=usg5-3 + ;; rs6000-ibm-aix3.1 ) machine=ibmrs6000 opsys=aix3-1 *************** *** 771,775 **** ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* ) ! case "${configuration}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; --- 772,776 ---- ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* ) ! case "${canonical}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; *************** *** 779,783 **** * ) unported=true ;; esac ! case "${configuration}" in *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.3* ) opsys=sunos4-1-3 ;; --- 780,784 ---- * ) unported=true ;; esac ! case "${canonical}" in *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.3* ) opsys=sunos4-1-3 ;; *************** *** 835,839 **** vax-dec-* ) machine=vax ! case "${configuration}" in *-bsd4.1 ) opsys=bsd4-1 ;; *-bsd4.2 | *-ultrix[0-3].* | *-ultrix4.0 ) opsys=bsd4-2 ;; --- 836,840 ---- vax-dec-* ) machine=vax ! case "${canonical}" in *-bsd4.1 ) opsys=bsd4-1 ;; *-bsd4.2 | *-ultrix[0-3].* | *-ultrix4.0 ) opsys=bsd4-2 ;; *************** *** 862,866 **** i[34]86-*-* ) machine=intel386 ! case "${configuration}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2 ) opsys=isc2-2 ;; --- 863,867 ---- i[34]86-*-* ) machine=intel386 ! case "${canonical}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2 ) opsys=isc2-2 ;; *************** *** 889,893 **** ### above. if [ x"${opsys}" = x ]; then ! case "${configuration}" in *-bsd4.[01] ) opsys=bsd4-1 ;; *-bsd4.2 ) opsys=bsd4-2 ;; --- 890,894 ---- ### above. if [ x"${opsys}" = x ]; then ! case "${canonical}" in *-bsd4.[01] ) opsys=bsd4-1 ;; *-bsd4.2 ) opsys=bsd4-2 ;; *************** *** 906,910 **** if $unported ; then ! (echo "${progname}: Emacs hasn't been ported to \`${configuration}' systems." echo "${progname}: Check \`etc/MACHINES' for recognized configuration names." ) >&2 --- 907,911 ---- if $unported ; then ! (echo "${progname}: Emacs hasn't been ported to \`${canonical}' systems." echo "${progname}: Check \`etc/MACHINES' for recognized configuration names." ) >&2 *************** *** 1072,1077 **** --- 1073,1081 ---- fi INSTALL=${INSTALL-cp} + test -n "$verbose" && echo " setting INSTALL to $INSTALL" INSTALL_PROGRAM=${INSTALL_PROGRAM-'$(INSTALL)'} + test -n "$verbose" && echo " setting INSTALL_PROGRAM to $INSTALL_PROGRAM" INSTALL_DATA=${INSTALL_DATA-'$(INSTALL)'} + test -n "$verbose" && echo " setting INSTALL_DATA to $INSTALL_DATA" for p in 'bison -y' byacc *************** *** 1109,1115 **** err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` if test -z "$err"; then ! { test -n "$verbose" && \ ! echo ' defining' ${trhdr} DEFS="$DEFS -D${trhdr}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trhdr}\${SEDdB}${trhdr}\${SEDdC}1\${SEDdD} --- 1113,1120 ---- err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` if test -z "$err"; then ! ! { test -n "$verbose" && \ ! echo " defining ${trhdr}" DEFS="$DEFS -D${trhdr}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trhdr}\${SEDdB}${trhdr}\${SEDdC}1\${SEDdD} *************** *** 1149,1155 **** eval $compile if test -s conftest && (./conftest; exit) 2>/dev/null; then ! { test -n "$verbose" && \ ! echo ' defining' STDC_HEADERS DEFS="$DEFS -DSTDC_HEADERS=1" SEDDEFS="${SEDDEFS}\${SEDdA}STDC_HEADERS\${SEDdB}STDC_HEADERS\${SEDdC}1\${SEDdD} --- 1154,1161 ---- eval $compile if test -s conftest && (./conftest; exit) 2>/dev/null; then ! ! { test -n "$verbose" && \ ! echo " defining STDC_HEADERS" DEFS="$DEFS -DSTDC_HEADERS=1" SEDDEFS="${SEDDEFS}\${SEDdA}STDC_HEADERS\${SEDdB}STDC_HEADERS\${SEDdC}1\${SEDdD} *************** *** 1176,1182 **** EOF if eval $compile; then ! { test -n "$verbose" && \ ! echo ' defining' TIME_WITH_SYS_TIME DEFS="$DEFS -DTIME_WITH_SYS_TIME=1" SEDDEFS="${SEDDEFS}\${SEDdA}TIME_WITH_SYS_TIME\${SEDdB}TIME_WITH_SYS_TIME\${SEDdC}1\${SEDdD} --- 1182,1189 ---- EOF if eval $compile; then ! ! { test -n "$verbose" && \ ! echo " defining TIME_WITH_SYS_TIME" DEFS="$DEFS -DTIME_WITH_SYS_TIME=1" SEDDEFS="${SEDDEFS}\${SEDdA}TIME_WITH_SYS_TIME\${SEDdB}TIME_WITH_SYS_TIME\${SEDdC}1\${SEDdD} *************** *** 1190,1222 **** - LIBS_save="${LIBS}" - LIBS="${LIBS} -ldnet" - have_lib="" - echo checking for -ldnet - cat > conftest.c < conftest.c < conftest.c < conftest.c < conftest.out 2>&1" - if egrep "winnitude" conftest.out >/dev/null 2>&1; then - echo checking for _getb67 - cat > conftest.c < - int main() { exit(0); } - int t() { - /* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ - #if defined (__stub__getb67) || defined (__stub____getb67) - choke me - #else - /* Override any gcc2 internal prototype to avoid an error. */ - extern char _getb67(); _getb67(); - #endif - } - EOF - if eval $compile; then - { - test -n "$verbose" && \ - echo ' defining' CRAY_STACKSEG_END to be '_getb67' - DEFS="$DEFS -DCRAY_STACKSEG_END=_getb67" - SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}_getb67\${SEDdD} - \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}_getb67\${SEDuD} - \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}_getb67\${SEDeD} - " - } - - else - echo checking for GETB67 - cat > conftest.c < - int main() { exit(0); } - int t() { - /* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ - #if defined (__stub_GETB67) || defined (__stub___GETB67) - choke me - #else - /* Override any gcc2 internal prototype to avoid an error. */ - extern char GETB67(); GETB67(); - #endif - } - EOF - if eval $compile; then - { - test -n "$verbose" && \ - echo ' defining' CRAY_STACKSEG_END to be 'GETB67' - DEFS="$DEFS -DCRAY_STACKSEG_END=GETB67" - SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}GETB67\${SEDdD} - \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}GETB67\${SEDuD} - \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}GETB67\${SEDeD} - " - } - - else - echo checking for getb67 - cat > conftest.c < - int main() { exit(0); } - int t() { - /* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ - #if defined (__stub_getb67) || defined (__stub___getb67) - choke me - #else - /* Override any gcc2 internal prototype to avoid an error. */ - extern char getb67(); getb67(); - #endif - } - EOF - if eval $compile; then - { - test -n "$verbose" && \ - echo ' defining' CRAY_STACKSEG_END to be 'getb67' - DEFS="$DEFS -DCRAY_STACKSEG_END=getb67" - SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}getb67\${SEDdD} - \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}getb67\${SEDuD} - \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}getb67\${SEDeD} - " - } - - fi - rm -f conftest* - - fi - rm -f conftest* - - fi - rm -f conftest* - - fi - rm -f conftest* - - - fi - rm -f conftest* - - if test -n "$alloca_missing"; then - # The SVR3 libPW and SVR4 libucb both contain incompatible functions - # that cause trouble. Some versions do not even contain alloca or - # contain a buggy version. If you still want to use their alloca, - # use ar to extract alloca.o from them instead of compiling alloca.c. - ALLOCA=alloca.o - - echo 'checking stack direction for C alloca' - echo checking whether cross-compiling - # If we cannot run a trivial program, we must be cross compiling. - cat > conftest.c </dev/null; then - : - else - cross_compiling=1 - fi - rm -f conftest* - - if test -n "$cross_compiling" - then - { - test -n "$verbose" && \ - echo ' defining' STACK_DIRECTION to be '0' - DEFS="$DEFS -DSTACK_DIRECTION=0" - SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}0\${SEDdD} - \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}0\${SEDuD} - \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}0\${SEDeD} - " - } - - else - cat > conftest.c < addr) ? 1 : -1; - } - main () - { - exit (find_stack_direction() < 0); - } - EOF - eval $compile - if test -s conftest && (./conftest; exit) 2>/dev/null; then - { - test -n "$verbose" && \ - echo ' defining' STACK_DIRECTION to be '1' - DEFS="$DEFS -DSTACK_DIRECTION=1" - SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}1\${SEDdD} - \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}1\${SEDuD} - \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}1\${SEDeD} - " - } - - else - { - test -n "$verbose" && \ - echo ' defining' STACK_DIRECTION to be '-1' - DEFS="$DEFS -DSTACK_DIRECTION=-1" - SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}-1\${SEDdD} - \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}-1\${SEDuD} - \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}-1\${SEDeD} - " - } - - fi - fi - rm -f conftest* - fi - - for func in gettimeofday gethostname dup2 rename closedir - do - trfunc=HAVE_`echo $func | tr '[a-z]' '[A-Z]'` - echo checking for ${func} - cat > conftest.c < - int main() { exit(0); } - int t() { - /* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ - #if defined (__stub_${func}) || defined (__stub___${func}) - choke me - #else - /* Override any gcc2 internal prototype to avoid an error. */ - extern char ${func}(); ${func}(); - #endif - } - EOF - if eval $compile; then - { - test -n "$verbose" && \ - echo ' defining' ${trfunc} - DEFS="$DEFS -D${trfunc}=1" - SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} - \${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD} - \${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD} - " - } - - fi - rm -f conftest* - done - - echo checking for struct tm in time.h cat > conftest.c <&2 ! exit 1 ! ;; ! esac ! ! case "${window_system}" in ! "" | "x11" ) ! ### If the user hasn't specified where we should find X, try ! ### letting autoconf figure that out. ! if [ -z "${x_includes}" ] && [ -z "${x_libraries}" ]; then ! ! # If we find X, set shell vars x_includes and x_libraries to the paths. echo checking for X include and library files with xmkmf rm -fr conftestdir *************** *** 1729,1738 **** if mkdir conftestdir; then cd conftestdir ! cat < /dev/null > Imakefile ! if xmkmf >/dev/null 2>/dev/null && test -f Makefile; then ! eval `sed -n \ ! -e 's,.* INCROOT *=[^/]*,x_includes=,p' \ ! -e 's,.* USRLIBDIR *=[^/]*,x_libraries=,p' \ ! Makefile` fi cd .. --- 1468,1477 ---- if mkdir conftestdir; then cd conftestdir ! cat > Imakefile <<\EOF ! acfindx: ! @echo "x_includes=$(INCROOT); x_libraries=$(USRLIBDIR)" ! EOF ! if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then ! eval `make acfindx` fi cd .. *************** *** 1740,1764 **** fi ! ! fi ! ! case "${window_system}" in ! "none" | "x11" | "x10" ) ;; ! "" ) ! echo " No window system specified. Looking for X11." ! window_system=none ! if [ -r /usr/lib/libX11.a \ ! -o -d /usr/include/X11 \ ! -o -d /usr/X386/include \ ! -o -d ${x_includes}/X11 ]; then window_system=x11 fi ;; - * ) - echo "Don't specify the window system more than once." >&2 - exit 1 - ;; esac case "${window_system}" in x11 ) --- 1479,1495 ---- fi ! ! fi ! if [ -n "${x_includes}" ] || [ -n "${x_libraries}" ]; then window_system=x11 fi ;; esac + [ -z "${window_system}" ] && window_system=none + + [ -n "${x_libraries}" ] && LD_SWITCH_X_SITE="-L${x_libraries}" + [ -n "${x_includes}" ] && C_SWITCH_X_SITE="-I${x_includes}" + case "${window_system}" in x11 ) *************** *** 1813,1816 **** --- 1544,1560 ---- @configure@ c_switch_system=C_SWITCH_SYSTEM + #ifndef LIB_X11_LIB + #define LIB_X11_LIB + #endif + + #ifndef LIBX11_MACHINE + #define LIBX11_MACHINE + #endif + + #ifndef LIBX11_SYSTEM + #define LIBX11_SYSTEM + #endif + @configure@ LIBX=LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM + #ifdef UNEXEC @configure@ unexec=UNEXEC *************** *** 1866,1872 **** ! #### Add the X libraries to the list, and check for some functions found there. ! CFLAGS_save="$CFLAGS" ! CFLAGS="${CFLAGS} ${LD_SWITCH_X_SITE}" LIBS_save="${LIBS}" --- 1610,1648 ---- ! #### Add the libraries to LIBS and check for some functions. ! ! ! DEFS="$c_switch_system $DEFS" ! LIBS="$libsrc_libs" ! ! LIBS_save="${LIBS}" ! LIBS="${LIBS} -ldnet" ! have_lib="" ! echo checking for -ldnet ! cat > conftest.c < conftest.c < ! int main() { exit(0); } ! int t() { ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub_${func}) || defined (__stub___${func}) ! choke me ! #else ! /* Override any gcc2 internal prototype to avoid an error. */ ! extern char ${func}(); ${func}(); ! #endif ! } ! EOF ! if eval $compile; then ! { test -n "$verbose" && \ ! echo " defining ${trfunc}" ! DEFS="$DEFS -D${trfunc}=1" ! SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} ! \${SEDuA}${trfunc}\${SEDuB}${trfunc}\${SEDuC}1\${SEDuD} ! \${SEDeA}${trfunc}\${SEDeB}${trfunc}\${SEDeC}1\${SEDeD} " } fi + rm -f conftest* + done + fi ! # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works ! # for constant arguments. Useless! ! echo checking for working alloca.h ! cat > conftest.c < ! int main() { exit(0); } ! int t() { char *p = alloca(2 * sizeof(int)); } ! EOF ! if eval $compile; then ! ! { ! test -n "$verbose" && \ ! echo " defining HAVE_ALLOCA_H" ! DEFS="$DEFS -DHAVE_ALLOCA_H=1" ! SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_ALLOCA_H\${SEDdB}HAVE_ALLOCA_H\${SEDdC}1\${SEDdD} ! \${SEDuA}HAVE_ALLOCA_H\${SEDuB}HAVE_ALLOCA_H\${SEDuC}1\${SEDuD} ! \${SEDeA}HAVE_ALLOCA_H\${SEDeB}HAVE_ALLOCA_H\${SEDeC}1\${SEDeD} ! " ! } ! ! fi ! rm -f conftest* ! ! decl="#ifdef __GNUC__ ! #define alloca __builtin_alloca ! #else ! #if HAVE_ALLOCA_H ! #include ! #else ! #ifdef _AIX ! #pragma alloca ! #else ! char *alloca (); ! #endif ! #endif ! #endif ! " ! echo checking for alloca ! cat > conftest.c < conftest.c < conftest.out 2>&1" ! if egrep "winnitude" conftest.out >/dev/null 2>&1; then ! echo checking for _getb67 ! cat > conftest.c < ! int main() { exit(0); } ! int t() { ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub__getb67) || defined (__stub____getb67) ! choke me ! #else ! /* Override any gcc2 internal prototype to avoid an error. */ ! extern char _getb67(); _getb67(); ! #endif ! } ! EOF ! if eval $compile; then ! { ! test -n "$verbose" && \ ! echo " defining CRAY_STACKSEG_END to be _getb67" ! DEFS="$DEFS -DCRAY_STACKSEG_END=_getb67" ! SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}_getb67\${SEDdD} ! \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}_getb67\${SEDuD} ! \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}_getb67\${SEDeD} ! " ! } ! ! else ! echo checking for GETB67 ! cat > conftest.c < ! int main() { exit(0); } ! int t() { ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub_GETB67) || defined (__stub___GETB67) ! choke me ! #else ! /* Override any gcc2 internal prototype to avoid an error. */ ! extern char GETB67(); GETB67(); ! #endif ! } ! EOF ! if eval $compile; then ! { ! test -n "$verbose" && \ ! echo " defining CRAY_STACKSEG_END to be GETB67" ! DEFS="$DEFS -DCRAY_STACKSEG_END=GETB67" ! SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}GETB67\${SEDdD} ! \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}GETB67\${SEDuD} ! \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}GETB67\${SEDeD} ! " ! } ! ! else ! echo checking for getb67 ! cat > conftest.c < ! int main() { exit(0); } ! int t() { ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub_getb67) || defined (__stub___getb67) ! choke me ! #else ! /* Override any gcc2 internal prototype to avoid an error. */ ! extern char getb67(); getb67(); ! #endif ! } ! EOF ! if eval $compile; then ! { ! test -n "$verbose" && \ ! echo " defining CRAY_STACKSEG_END to be getb67" ! DEFS="$DEFS -DCRAY_STACKSEG_END=getb67" ! SEDDEFS="${SEDDEFS}\${SEDdA}CRAY_STACKSEG_END\${SEDdB}CRAY_STACKSEG_END\${SEDdC}getb67\${SEDdD} ! \${SEDuA}CRAY_STACKSEG_END\${SEDuB}CRAY_STACKSEG_END\${SEDuC}getb67\${SEDuD} ! \${SEDeA}CRAY_STACKSEG_END\${SEDeB}CRAY_STACKSEG_END\${SEDeC}getb67\${SEDeD} ! " ! } ! ! fi ! rm -f conftest* ! ! fi ! rm -f conftest* ! ! fi ! rm -f conftest* ! ! fi ! rm -f conftest* ! ! ! fi ! rm -f conftest* ! ! if test -n "$alloca_missing"; then ! # The SVR3 libPW and SVR4 libucb both contain incompatible functions ! # that cause trouble. Some versions do not even contain alloca or ! # contain a buggy version. If you still want to use their alloca, ! # use ar to extract alloca.o from them instead of compiling alloca.c. ! ALLOCA=alloca.o ! ! echo 'checking stack direction for C alloca' ! echo checking whether cross-compiling ! # If we cannot run a trivial program, we must be cross compiling. ! cat > conftest.c </dev/null; then ! : ! else ! cross_compiling=1 ! fi ! rm -f conftest* ! ! if test -n "$cross_compiling" ! then ! ! { ! test -n "$verbose" && \ ! echo " defining STACK_DIRECTION to be 0" ! DEFS="$DEFS -DSTACK_DIRECTION=0" ! SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}0\${SEDdD} ! \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}0\${SEDuD} ! \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}0\${SEDeD} ! " ! } ! ! else ! cat > conftest.c < addr) ? 1 : -1; ! } ! main () ! { ! exit (find_stack_direction() < 0); ! } ! EOF ! eval $compile ! if test -s conftest && (./conftest; exit) 2>/dev/null; then ! ! { ! test -n "$verbose" && \ ! echo " defining STACK_DIRECTION to be 1" ! DEFS="$DEFS -DSTACK_DIRECTION=1" ! SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}1\${SEDdD} ! \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}1\${SEDuD} ! \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}1\${SEDeD} ! " ! } ! ! else ! ! { ! test -n "$verbose" && \ ! echo " defining STACK_DIRECTION to be -1" ! DEFS="$DEFS -DSTACK_DIRECTION=-1" ! SEDDEFS="${SEDDEFS}\${SEDdA}STACK_DIRECTION\${SEDdB}STACK_DIRECTION\${SEDdC}-1\${SEDdD} ! \${SEDuA}STACK_DIRECTION\${SEDuB}STACK_DIRECTION\${SEDuC}-1\${SEDuD} ! \${SEDeA}STACK_DIRECTION\${SEDeB}STACK_DIRECTION\${SEDeC}-1\${SEDeD} ! " ! } ! ! fi fi + rm -f conftest* + fi ! for func in gettimeofday gethostname dup2 rename closedir mkdir rmdir random bcopy logb frexp do trfunc=HAVE_`echo $func | tr '[a-z]' '[A-Z]'` *************** *** 1926,1930 **** { test -n "$verbose" && \ ! echo ' defining' ${trfunc} DEFS="$DEFS -D${trfunc}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} --- 1972,1976 ---- { test -n "$verbose" && \ ! echo " defining ${trfunc}" DEFS="$DEFS -D${trfunc}=1" SEDDEFS="${SEDDEFS}\${SEDdA}${trfunc}\${SEDdB}${trfunc}\${SEDdC}1\${SEDdD} *************** *** 1939,1955 **** ! CFLAGS="$CFLAGS_save" ! LIBS="$LIBS_save" ! case "${window_system}:${LIBS}" in ! x11:*-lXbsd* ) ! if [ -d /usr/X386/include ]; then ! HAVE_XFREE386=yes ! if [ "${C_SWITCH_X_SITE}" = "" ]; then ! C_SWITCH_X_SITE="-I/usr/X386/include" ! fi ! fi ! ;; ! esac #### Find out which version of Emacs this is. --- 1985,2053 ---- ! ok_so_far=true ! echo checking for socket ! cat > conftest.c < ! int main() { exit(0); } ! int t() { ! /* The GNU C library defines this for functions which it implements ! to always fail with ENOSYS. Some functions are actually named ! something starting with __ and the normal name is an alias. */ ! #if defined (__stub_socket) || defined (__stub___socket) ! choke me ! #else ! /* Override any gcc2 internal prototype to avoid an error. */ ! extern char socket(); socket(); ! #endif ! } ! EOF ! if eval $compile; then ! : ! else ! ok_so_far= ! fi ! rm -f conftest* ! if test -n "$ok_so_far"; then ! echo checking for netinet/in.h ! cat > conftest.c < ! EOF ! err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` ! if test -z "$err"; then ! : ! else ! ok_so_far= ! fi ! rm -f conftest* ! ! fi ! if test -n "$ok_so_far"; then ! echo checking for arpa/inet.h ! cat > conftest.c < ! EOF ! err=`eval "($CPP \$DEFS conftest.c >/dev/null) 2>&1"` ! if test -z "$err"; then ! : ! else ! ok_so_far= ! fi ! rm -f conftest* ! ! fi ! if test -n "$ok_so_far"; then ! ! { ! test -n "$verbose" && \ ! echo " defining HAVE_INET_SOCKETS" ! DEFS="$DEFS -DHAVE_INET_SOCKETS=1" ! SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_INET_SOCKETS\${SEDdB}HAVE_INET_SOCKETS\${SEDdC}1\${SEDdD} ! \${SEDuA}HAVE_INET_SOCKETS\${SEDuB}HAVE_INET_SOCKETS\${SEDuC}1\${SEDuD} ! \${SEDeA}HAVE_INET_SOCKETS\${SEDeB}HAVE_INET_SOCKETS\${SEDeC}1\${SEDeD} ! " ! } ! ! fi #### Find out which version of Emacs this is. *************** *** 1962,1967 **** --- 2060,2082 ---- fi + if [ -f /usr/lpp/X11/bin/smt.exp ]; then + + + { + test -n "$verbose" && \ + echo " defining HAVE_AIX_SMT_EXP" + DEFS="$DEFS -DHAVE_AIX_SMT_EXP=1" + SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_AIX_SMT_EXP\${SEDdB}HAVE_AIX_SMT_EXP\${SEDdC}1\${SEDdD} + \${SEDuA}HAVE_AIX_SMT_EXP\${SEDuB}HAVE_AIX_SMT_EXP\${SEDuC}1\${SEDuD} + \${SEDeA}HAVE_AIX_SMT_EXP\${SEDeB}HAVE_AIX_SMT_EXP\${SEDeC}1\${SEDeD} + " + } + + + fi + #### Specify what sort of things we'll be editing into Makefile and config.h. + ### Use configuration here uncanonicalized to avoid exceeding size limits. *************** *** 1978,1984 **** { test -n "$verbose" && \ ! echo ' defining' config_machfile to be '"\"${machfile}\""' DEFS="$DEFS -Dconfig_machfile="\"${machfile}\""" SEDDEFS="${SEDDEFS}\${SEDdA}config_machfile\${SEDdB}config_machfile\${SEDdC}"\"${machfile}\""\${SEDdD} --- 2093,2100 ---- + { test -n "$verbose" && \ ! echo " defining config_machfile to be "\"${machfile}\""" DEFS="$DEFS -Dconfig_machfile="\"${machfile}\""" SEDDEFS="${SEDDEFS}\${SEDdA}config_machfile\${SEDdB}config_machfile\${SEDdC}"\"${machfile}\""\${SEDdD} *************** *** 1988,1994 **** } { test -n "$verbose" && \ ! echo ' defining' config_opsysfile to be '"\"${opsysfile}\""' DEFS="$DEFS -Dconfig_opsysfile="\"${opsysfile}\""" SEDDEFS="${SEDDEFS}\${SEDdA}config_opsysfile\${SEDdB}config_opsysfile\${SEDdC}"\"${opsysfile}\""\${SEDdD} --- 2104,2111 ---- } + { test -n "$verbose" && \ ! echo " defining config_opsysfile to be "\"${opsysfile}\""" DEFS="$DEFS -Dconfig_opsysfile="\"${opsysfile}\""" SEDDEFS="${SEDDEFS}\${SEDdA}config_opsysfile\${SEDdB}config_opsysfile\${SEDdC}"\"${opsysfile}\""\${SEDdD} *************** *** 1998,2004 **** } { test -n "$verbose" && \ ! echo ' defining' LD_SWITCH_X_SITE to be '${LD_SWITCH_X_SITE}' DEFS="$DEFS -DLD_SWITCH_X_SITE=${LD_SWITCH_X_SITE}" SEDDEFS="${SEDDEFS}\${SEDdA}LD_SWITCH_X_SITE\${SEDdB}LD_SWITCH_X_SITE\${SEDdC}${LD_SWITCH_X_SITE}\${SEDdD} --- 2115,2122 ---- } + { test -n "$verbose" && \ ! echo " defining LD_SWITCH_X_SITE to be ${LD_SWITCH_X_SITE}" DEFS="$DEFS -DLD_SWITCH_X_SITE=${LD_SWITCH_X_SITE}" SEDDEFS="${SEDDEFS}\${SEDdA}LD_SWITCH_X_SITE\${SEDdB}LD_SWITCH_X_SITE\${SEDdC}${LD_SWITCH_X_SITE}\${SEDdD} *************** *** 2008,2014 **** } { test -n "$verbose" && \ ! echo ' defining' C_SWITCH_X_SITE to be '${C_SWITCH_X_SITE}' DEFS="$DEFS -DC_SWITCH_X_SITE=${C_SWITCH_X_SITE}" SEDDEFS="${SEDDEFS}\${SEDdA}C_SWITCH_X_SITE\${SEDdB}C_SWITCH_X_SITE\${SEDdC}${C_SWITCH_X_SITE}\${SEDdD} --- 2126,2133 ---- } + { test -n "$verbose" && \ ! echo " defining C_SWITCH_X_SITE to be ${C_SWITCH_X_SITE}" DEFS="$DEFS -DC_SWITCH_X_SITE=${C_SWITCH_X_SITE}" SEDDEFS="${SEDDEFS}\${SEDdA}C_SWITCH_X_SITE\${SEDdB}C_SWITCH_X_SITE\${SEDdC}${C_SWITCH_X_SITE}\${SEDdD} *************** *** 2018,2024 **** } { test -n "$verbose" && \ ! echo ' defining' UNEXEC_SRC to be '${UNEXEC_SRC}' DEFS="$DEFS -DUNEXEC_SRC=${UNEXEC_SRC}" SEDDEFS="${SEDDEFS}\${SEDdA}UNEXEC_SRC\${SEDdB}UNEXEC_SRC\${SEDdC}${UNEXEC_SRC}\${SEDdD} --- 2137,2144 ---- } + { test -n "$verbose" && \ ! echo " defining UNEXEC_SRC to be ${UNEXEC_SRC}" DEFS="$DEFS -DUNEXEC_SRC=${UNEXEC_SRC}" SEDDEFS="${SEDDEFS}\${SEDdA}UNEXEC_SRC\${SEDdB}UNEXEC_SRC\${SEDdC}${UNEXEC_SRC}\${SEDdD} *************** *** 2031,2037 **** if [ "${HAVE_X_WINDOWS}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' HAVE_X_WINDOWS DEFS="$DEFS -DHAVE_X_WINDOWS=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X_WINDOWS\${SEDdB}HAVE_X_WINDOWS\${SEDdC}1\${SEDdD} --- 2151,2158 ---- if [ "${HAVE_X_WINDOWS}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining HAVE_X_WINDOWS" DEFS="$DEFS -DHAVE_X_WINDOWS=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X_WINDOWS\${SEDdB}HAVE_X_WINDOWS\${SEDdC}1\${SEDdD} *************** *** 2043,2049 **** fi if [ "${HAVE_X11}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' HAVE_X11 DEFS="$DEFS -DHAVE_X11=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X11\${SEDdB}HAVE_X11\${SEDdC}1\${SEDdD} --- 2164,2171 ---- fi if [ "${HAVE_X11}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining HAVE_X11" DEFS="$DEFS -DHAVE_X11=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X11\${SEDdB}HAVE_X11\${SEDdC}1\${SEDdD} *************** *** 2055,2061 **** fi if [ "${HAVE_XFREE386}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' HAVE_XFREE386 DEFS="$DEFS -DHAVE_XFREE386=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_XFREE386\${SEDdB}HAVE_XFREE386\${SEDdC}1\${SEDdD} --- 2177,2184 ---- fi if [ "${HAVE_XFREE386}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining HAVE_XFREE386" DEFS="$DEFS -DHAVE_XFREE386=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_XFREE386\${SEDdB}HAVE_XFREE386\${SEDdC}1\${SEDdD} *************** *** 2067,2073 **** fi if [ "${HAVE_X_MENU}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' HAVE_X_MENU DEFS="$DEFS -DHAVE_X_MENU=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X_MENU\${SEDdB}HAVE_X_MENU\${SEDdC}1\${SEDdD} --- 2190,2197 ---- fi if [ "${HAVE_X_MENU}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining HAVE_X_MENU" DEFS="$DEFS -DHAVE_X_MENU=1" SEDDEFS="${SEDDEFS}\${SEDdA}HAVE_X_MENU\${SEDdB}HAVE_X_MENU\${SEDdC}1\${SEDdD} *************** *** 2079,2085 **** fi if [ "${GNU_MALLOC}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' GNU_MALLOC DEFS="$DEFS -DGNU_MALLOC=1" SEDDEFS="${SEDDEFS}\${SEDdA}GNU_MALLOC\${SEDdB}GNU_MALLOC\${SEDdC}1\${SEDdD} --- 2203,2210 ---- fi if [ "${GNU_MALLOC}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining GNU_MALLOC" DEFS="$DEFS -DGNU_MALLOC=1" SEDDEFS="${SEDDEFS}\${SEDdA}GNU_MALLOC\${SEDdB}GNU_MALLOC\${SEDdC}1\${SEDdD} *************** *** 2091,2097 **** fi if [ "${REL_ALLOC}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' REL_ALLOC DEFS="$DEFS -DREL_ALLOC=1" SEDDEFS="${SEDDEFS}\${SEDdA}REL_ALLOC\${SEDdB}REL_ALLOC\${SEDdC}1\${SEDdD} --- 2216,2223 ---- fi if [ "${REL_ALLOC}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining REL_ALLOC" DEFS="$DEFS -DREL_ALLOC=1" SEDDEFS="${SEDDEFS}\${SEDdA}REL_ALLOC\${SEDdB}REL_ALLOC\${SEDdC}1\${SEDdD} *************** *** 2103,2109 **** fi if [ "${LISP_FLOAT_TYPE}" = "yes" ] ; then ! { test -n "$verbose" && \ ! echo ' defining' LISP_FLOAT_TYPE DEFS="$DEFS -DLISP_FLOAT_TYPE=1" SEDDEFS="${SEDDEFS}\${SEDdA}LISP_FLOAT_TYPE\${SEDdB}LISP_FLOAT_TYPE\${SEDdC}1\${SEDdD} --- 2229,2236 ---- fi if [ "${LISP_FLOAT_TYPE}" = "yes" ] ; then ! ! { test -n "$verbose" && \ ! echo " defining LISP_FLOAT_TYPE" DEFS="$DEFS -DLISP_FLOAT_TYPE=1" SEDDEFS="${SEDDEFS}\${SEDdA}LISP_FLOAT_TYPE\${SEDdB}LISP_FLOAT_TYPE\${SEDdC}1\${SEDdD} *************** *** 2119,2123 **** echo " ! Configured for \`${configuration}'. Where should the build process find the source code? ${srcdir} --- 2246,2250 ---- echo " ! Configured for \`${canonical}'. Where should the build process find the source code? ${srcdir} *************** *** 2133,2136 **** --- 2260,2269 ---- " + # Remove any trailing slashes in these variables. + test -n "${prefix}" && + prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` + test -n "${exec_prefix}" && + exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` + if test -n "$prefix"; then test -z "$exec_prefix" && exec_prefix='${prefix}' *************** *** 2164,2167 **** --- 2297,2301 ---- case "\$arg" in -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + echo running /bin/sh $0 $configure_args exec /bin/sh $0 $configure_args ;; *) echo "Usage: config.status --recheck" 2>&1; exit 1 ;; diff -rc2P --exclude-from=exceptions emacs-19.17/configure.in emacs-19.18/configure.in *** emacs-19.17/configure.in Sun Jul 18 02:03:00 1993 --- emacs-19.18/configure.in Mon Aug 9 01:51:34 1993 *************** *** 204,208 **** fi x_includes="${val}" - C_SWITCH_X_SITE="-I\"${x_includes}\"" ;; "x_libraries" ) --- 204,207 ---- *************** *** 220,224 **** fi x_libraries="${val}" - LD_SWITCH_X_SITE="-L\"${x_libraries}\"" ;; --- 219,222 ---- *************** *** 382,386 **** ### Canonicalize the configuration name. echo "Checking the configuration name." ! if configuration=`${srcdir}/config.sub "${configuration}"` ; then : ; else exit $? fi --- 380,384 ---- ### Canonicalize the configuration name. echo "Checking the configuration name." ! if canonical=`${srcdir}/config.sub "${configuration}"` ; then : ; else exit $? fi *************** *** 410,414 **** machine='' opsys='' unported='false' ! case "${configuration}" in ## Alliant machines --- 408,412 ---- machine='' opsys='' unported='false' ! case "${canonical}" in ## Alliant machines *************** *** 606,609 **** --- 604,610 ---- machine=ibmps2-aix opsys=usg5-3 ;; + i370-ibm-aix*) + machine=ibm370aix opsys=usg5-3 + ;; rs6000-ibm-aix3.1 ) machine=ibmrs6000 opsys=aix3-1 *************** *** 779,783 **** ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* ) ! case "${configuration}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; --- 780,784 ---- ## Suns *-sun-sunos* | *-sun-bsd* | *-sun-solaris* ) ! case "${canonical}" in m68*-sunos1* ) machine=sun1 ;; m68*-sunos2* ) machine=sun2 ;; *************** *** 787,791 **** * ) unported=true ;; esac ! case "${configuration}" in *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.3* ) opsys=sunos4-1-3 ;; --- 788,792 ---- * ) unported=true ;; esac ! case "${canonical}" in *-sunos4.0* ) opsys=sunos4-0 ;; *-sunos4.1.3* ) opsys=sunos4-1-3 ;; *************** *** 843,847 **** vax-dec-* ) machine=vax ! case "${configuration}" in *-bsd4.1 ) opsys=bsd4-1 ;; *-bsd4.2 | *-ultrix[0-3].* | *-ultrix4.0 ) opsys=bsd4-2 ;; --- 844,848 ---- vax-dec-* ) machine=vax ! case "${canonical}" in *-bsd4.1 ) opsys=bsd4-1 ;; *-bsd4.2 | *-ultrix[0-3].* | *-ultrix4.0 ) opsys=bsd4-2 ;; *************** *** 870,874 **** i[34]86-*-* ) machine=intel386 ! case "${configuration}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2 ) opsys=isc2-2 ;; --- 871,875 ---- i[34]86-*-* ) machine=intel386 ! case "${canonical}" in *-isc1.* | *-isc2.[01]* ) opsys=386-ix ;; *-isc2.2 ) opsys=isc2-2 ;; *************** *** 897,901 **** ### above. if [ x"${opsys}" = x ]; then ! case "${configuration}" in *-bsd4.[01] ) opsys=bsd4-1 ;; *-bsd4.2 ) opsys=bsd4-2 ;; --- 898,902 ---- ### above. if [ x"${opsys}" = x ]; then ! case "${canonical}" in *-bsd4.[01] ) opsys=bsd4-1 ;; *-bsd4.2 ) opsys=bsd4-2 ;; *************** *** 914,918 **** if $unported ; then ! (echo "${progname}: Emacs hasn't been ported to \`${configuration}' systems." echo "${progname}: Check \`etc/MACHINES' for recognized configuration names." ) >&2 --- 915,919 ---- if $unported ; then ! (echo "${progname}: Emacs hasn't been ported to \`${canonical}' systems." echo "${progname}: Check \`etc/MACHINES' for recognized configuration names." ) >&2 *************** *** 953,966 **** AC_TIME_WITH_SYS_TIME - dnl checks for library files - AC_HAVE_LIBRARY(-ldnet) - dnl checks for typedefs AC_RETSIGTYPE - dnl checks for functions - AC_ALLOCA - AC_HAVE_FUNCS(gettimeofday gethostname dup2 rename closedir) - dnl checks for structure members AC_STRUCT_TM --- 954,960 ---- *************** *** 999,1024 **** esac - ### If the user hasn't specified where we should find X, try - ### letting autoconf figure that out. - if [ "0${x_includes}" == 0 ] && [ "0${x_libraries}" == 0 ]; then - ] - AC_FIND_X - [ - fi - case "${window_system}" in "none" | "x11" | "x10" ) ;; "" ) ! echo " No window system specified. Looking for X11." ! window_system=none ! if [ -r /usr/lib/libX11.a \ -o -d /usr/include/X11 \ -o -d /usr/X386/include \ -o -d ${x_includes}/X11 ]; then ! window_system=x11 fi ;; * ) ! echo "Don't specify the window system more than once." >&2 exit 1 ;; --- 993,1015 ---- esac case "${window_system}" in "none" | "x11" | "x10" ) ;; "" ) ! # --x-includes or --x-libraries implies --with-x11. ! if [ -n "${x_includes}" ] || [ -n "${x_libraries}" ]; then ! window_system=x11 ! else ! echo " No window system specified. Looking for X11." ! # If the user didn't specify a window system and we found X11, use it. ! if [ -r /usr/lib/libX11.a \ -o -d /usr/include/X11 \ -o -d /usr/X386/include \ -o -d ${x_includes}/X11 ]; then ! window_system=x11 ! fi fi ;; * ) ! echo "Don't specify a window system more than once." >&2 exit 1 ;; *************** *** 1026,1029 **** --- 1017,1040 ---- case "${window_system}" in + "" | "x11" ) + ### If the user hasn't specified where we should find X, try + ### letting autoconf figure that out. + if [ -z "${x_includes}" ] && [ -z "${x_libraries}" ]; then + ] + AC_FIND_X + [ + fi + if [ -n "${x_includes}" ] || [ -n "${x_libraries}" ]; then + window_system=x11 + fi + ;; + esac + + [ -z "${window_system}" ] && window_system=none + + [ -n "${x_libraries}" ] && LD_SWITCH_X_SITE="-L${x_libraries}" + [ -n "${x_includes}" ] && C_SWITCH_X_SITE="-I${x_includes}" + + case "${window_system}" in x11 ) HAVE_X_WINDOWS=yes *************** *** 1077,1080 **** --- 1088,1104 ---- @configure@ c_switch_system=C_SWITCH_SYSTEM + #ifndef LIB_X11_LIB + #define LIB_X11_LIB + #endif + + #ifndef LIBX11_MACHINE + #define LIBX11_MACHINE + #endif + + #ifndef LIBX11_SYSTEM + #define LIBX11_SYSTEM + #endif + @configure@ LIBX=LIB_X11_LIB LIBX11_MACHINE LIBX11_SYSTEM + #ifdef UNEXEC @configure@ unexec=UNEXEC *************** *** 1130,1160 **** ! #### Add the X libraries to the list, and check for some functions found there. ! CFLAGS_save="$CFLAGS" ! CFLAGS="${CFLAGS} ${LD_SWITCH_X_SITE}" ! ] ! AC_HAVE_LIBRARY(-lXbsd) ! [ ! LIBS_save="$LIBS" ! if [ "${HAVE_X11}" = "yes" ] ; then ! LIBS="-lX11 ${LIBS}" ! fi ] ! AC_HAVE_FUNCS(XrmSetDatabase random) ! [ ! CFLAGS="$CFLAGS_save" ! LIBS="$LIBS_save" ! case "${window_system}:${LIBS}" in ! x11:*-lXbsd* ) ! if [ -d /usr/X386/include ]; then HAVE_XFREE386=yes ! if [ "${C_SWITCH_X_SITE}" = "" ]; then ! C_SWITCH_X_SITE="-I/usr/X386/include" ! fi ! fi ! ;; ! esac #### Find out which version of Emacs this is. version=`grep 'defconst[ ]*emacs-version' ${srcdir}/lisp/version.el \ --- 1154,1194 ---- ! #### Add the libraries to LIBS and check for some functions. ! ] ! DEFS="$c_switch_system $DEFS" ! LIBS="$libsrc_libs" ! dnl If found, this defines HAVE_LIBDNET, which m/pmax.h checks, ! dnl and also adds -ldnet to LIBS, which Autoconf uses for checks. ! AC_HAVE_LIBRARY(-ldnet) ! ! AC_HAVE_LIBRARY(-lXbsd, LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd" ! if test -d /usr/X386/include; then HAVE_XFREE386=yes ! test -z "${C_SWITCH_X_SITE}" && C_SWITCH_X_SITE="-I/usr/X386/include" ! fi) + if test "${HAVE_X11}" = "yes"; then + DEFS="$C_SWITCH_X_SITE $DEFS" + LIBS="$LD_SWITCH_X_SITE $LIBX $LIBS" + AC_HAVE_FUNCS(XrmSetDatabase XScreenResourceString) + fi + + AC_ALLOCA + AC_HAVE_FUNCS(gettimeofday gethostname dup2 rename closedir mkdir rmdir random bcopy logb frexp) + + ok_so_far=true + AC_FUNC_CHECK(socket, , ok_so_far=) + if test -n "$ok_so_far"; then + AC_HEADER_CHECK(netinet/in.h, , ok_so_far=) + fi + if test -n "$ok_so_far"; then + AC_HEADER_CHECK(arpa/inet.h, , ok_so_far=) + fi + if test -n "$ok_so_far"; then + AC_DEFINE(HAVE_INET_SOCKETS) + fi + [ #### Find out which version of Emacs this is. version=`grep 'defconst[ ]*emacs-version' ${srcdir}/lisp/version.el \ *************** *** 1166,1171 **** --- 1200,1212 ---- fi + if [ -f /usr/lpp/X11/bin/smt.exp ]; then + ] + AC_DEFINE(HAVE_AIX_SMT_EXP) + [ + fi + #### Specify what sort of things we'll be editing into Makefile and config.h. + ### Use configuration here uncanonicalized to avoid exceeding size limits. ] AC_SUBST(configuration) *************** *** 1215,1219 **** echo " ! Configured for \`${configuration}'. Where should the build process find the source code? ${srcdir} --- 1256,1260 ---- echo " ! Configured for \`${canonical}'. Where should the build process find the source code? ${srcdir} *************** *** 1228,1231 **** --- 1269,1278 ---- " + + # Remove any trailing slashes in these variables. + test -n "${prefix}" && + prefix=`echo "${prefix}" | sed 's,\([^/]\)/*$,\1,'` + test -n "${exec_prefix}" && + exec_prefix=`echo "${exec_prefix}" | sed 's,\([^/]\)/*$,\1,'` ] AC_OUTPUT(Makefile) diff -rc2P --exclude-from=exceptions emacs-19.17/etc/AIX.DUMP emacs-19.18/etc/AIX.DUMP *** emacs-19.17/etc/AIX.DUMP Wed Jun 9 06:55:04 1993 --- emacs-19.18/etc/AIX.DUMP Thu Jul 22 03:54:09 1993 *************** *** 1,4 **** The following text was written by someone at IBM to describe an older ! version of the code for dumping on AIX. I (rms) couldn't understand the code, and I can't fully understand --- 1,7 ---- The following text was written by someone at IBM to describe an older ! version of the code for dumping on AIX. It does NOT apply to ! the current version of Emacs. It is included in case someone ! is curious. ! I (rms) couldn't understand the code, and I can't fully understand diff -rc2P --exclude-from=exceptions emacs-19.17/etc/ChangeLog emacs-19.18/etc/ChangeLog *** emacs-19.17/etc/ChangeLog Mon Jul 19 02:02:59 1993 --- emacs-19.18/etc/ChangeLog Sun Aug 8 03:13:30 1993 *************** *** 1,5 **** ! Mon Jul 19 02:02:53 1993 Richard Stallman (rms@sugar-bombs.gnu.ai.mit.edu) ! * Version 19.17 released. Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) --- 1,5 ---- ! Sun Aug 8 01:15:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) ! * Version 19.18 released. Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) diff -rc2P --exclude-from=exceptions emacs-19.17/etc/MACHINES emacs-19.18/etc/MACHINES *** emacs-19.17/etc/MACHINES Sun Jul 18 02:05:05 1993 --- emacs-19.18/etc/MACHINES Tue Aug 3 23:25:19 1993 *************** *** 126,129 **** --- 126,134 ---- 3B-MAXMEM in this directory explains how to increase MAXMEM. + On some of these machines, you may need to define IN_SCCS_ID + in config.h to make Emacs work. Supposedly you can tell whether + this is necessary by checking something in /usr/include/sys/time.h; + we do not know precisely what. + AT&T 7300 or 3b1 (m68k-att-sysv) *************** *** 207,214 **** Motorola Delta 147 (m68k-motorola-sysv) ! Emacs runs as of version 19.6. Motorola Delta boxes running System V/68 release 3. ! (tested on sys1147 with SVR3V5). Motorola Delta 187 (m88k-motorola-sysv, --- 212,229 ---- Motorola Delta 147 (m68k-motorola-sysv) ! Emacs runs as of version 19.17. Motorola Delta boxes running System V/68 release 3. ! Tested on 147 board with SVR3V7, no X and gcc. ! Tested on 167 board with SVR3V7, no X, cc, gnucc and gcc. ! ! There are three ways to use the gnucc provided with R3V7. Either ! link /bin/ccd/cc to /bin/cc and then configure (supposing that CC ! is unset or set to cc). Or configure like this: `CC=/bin/ccd/cc ! configure', or else configure like this: `CC=gnucc configure'. ! ! If you have not installed the optional NSE package (Network Services ! Extensions), then edit src/m/delta.h and remove the line where ! HAVE_SOCKETS is defined. Motorola Delta 187 (m88k-motorola-sysv, *************** *** 341,344 **** --- 356,368 ---- Ucode Code Generator - HP-UX.09.00.23.5 (patch) 2/18/93 + For 700 series machines, the HP-UX patch needed is known as + PHSS_2653. (Perhaps for 800 series machines as well; we don't + know.) If you are on the Internet, you should be able to obtain + 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 you are running HP/UX release 8.0 or later, you need the optional "C/ANSI C" software in order to build Emacs (older releases of HP/UX *************** *** 444,449 **** If you are using SCO Unix, see notes at end under SCO. ! On 386bsd, you should use GNU make, not the system's make. ! Assuming it's installed as gmake, do `gmake install MAKE=gmake'. If you are using System V release 4.2, you may find that `cc -E' --- 468,474 ---- If you are using SCO Unix, see notes at end under SCO. ! On 386bsd, netbsd and freebsd, you should use GNU make, not the ! system's make. Assuming it's installed as gmake, do `gmake install ! MAKE=gmake'. If you are using System V release 4.2, you may find that `cc -E' *************** *** 656,660 **** Sequent Symmetry (i386-sequent-bsd) ! Emacs 19 should work. SONY News (m68k-sony-bsd4.2 or m68k-sony-bsd4.3) --- 681,687 ---- Sequent Symmetry (i386-sequent-bsd) ! Emacs 19 should work. However, if you compile with the Sequent compiler, ! you may find Emacs does not restore the terminal settings on exit. ! If this happens, compile with GCC. SONY News (m68k-sony-bsd4.2 or m68k-sony-bsd4.3) *************** *** 701,712 **** Presumably this patch comes from Sun. You must alter the definition of LD_SWITCH_SYSTEM if your X11 libraries are not in /usr/openwin/lib. ! You must make sure that /usr/ucblib is not in your path. ! ! On Solaris 2, Emacs 19.12 currently expects certain optional packages ! to be installed. This may be changed in the future. ! There are three machine files for the different versions of SunOS ! that run on the Motorola 68000 processors. All are derived from ! Berkeley 4.2. Emacs 17 has run on all of them. If you have trouble using open-network-stream, get the distribution --- 728,740 ---- Presumably this patch comes from Sun. You must alter the definition of LD_SWITCH_SYSTEM if your X11 libraries are not in /usr/openwin/lib. ! You must make sure that /usr/ucblib is not in your LD_LIBRARY_PATH. ! On Solaris 2.2, with a multiprocessor SparcCenter 1000, Emacs 19.17 is ! reported to hang sometimes if it exits while it has one or more ! subprocesses (e.g. the `wakeup' subprocess used by `display-time'). ! Emacs and its subprocesses become zombies, and in their zombie state ! slow down their host and disable rlogin and telnet. This is most ! likely due to a bug in Solaris 2.2's multiprocessor support, ! rather than an Emacs bug. If you have trouble using open-network-stream, get the distribution *************** *** 723,727 **** We recommend that you instead use the X window system, which has technical advantages, is an industry standard, and is also ! free software. If you are compiling for X windows, and the X window library was --- 751,757 ---- We recommend that you instead use the X window system, which has technical advantages, is an industry standard, and is also ! free software. The FSF does not support the SunWindows code; ! we installed it only on the understanding we would not let it ! divert our efforts from what we think is important. If you are compiling for X windows, and the X window library was diff -rc2P --exclude-from=exceptions emacs-19.17/etc/NEWS emacs-19.18/etc/NEWS *** emacs-19.17/etc/NEWS Sun Jul 18 02:31:21 1993 --- emacs-19.18/etc/NEWS Sun Aug 8 20:49:36 1993 *************** *** 7,10 **** --- 7,150 ---- see the file LNEWS. + Changes in version 19.18. + + * Typing C-z in an iconified Emacs frame now deiconifies it. + + * hilit19 is a new library for automatic highlighting of parts of the + text in the buffer, based on its meaning and context. + + * Killing no longer sends the killed text to the X clipboard. + And large strings are not put in the cut buffer either. + The variable x-cut-buffer-max specifies the maximum number of characters + to put in the cut buffer. + + * The new command C-x 5 o (other-frame) selects different frames, + successively, in cyclic order. It does for frames what C-x o + does for windows. + + * The command M-ESC (eval-expression) has its own command history. + + * The commands M-! and M-| for running shell commands have their own + command history. + + * If the directory containing the Emacs executable has a sibling named + `lisp', that `lisp' directory is added to the end of `load-path' + (provided you don't override the normal value with the EMACSLOADPATH + environment variable). This feature may make it easier to move + an installed Emacs from place to place. + + * M-x validate-tex-buffer now records the locations of mismatches + found in the `*Occur*' buffer. You can go to that buffer and type C-c + C-c to visit a particular mismatch. + + * There are new commands in Shell mode. + + C-c C-n and C-c C-p move point to the next or previous shell input line. + + C-c C-d is now another way to send an end-of-file to the subshell. + + * Changes to calendar/diary. + + Time zone data is now determined automatically, including the + start/stop days and times of daylight savings time. The code now + works correctly almost anywhere in the world. + + The format of the holiday specifications has changed and IS NO LONGER + COMPATIBLE with the old (version 18) format. See the documentation of + the variable calendar-holidays for details of the new, improved + format. + + The hook `diary-display-hook' has been split into two: + diary-display-hook which should be used ONLY for the display and + `diary-hook' which should be used for appointment notification. If + diary-display-hook is nil (the default), simple-diary-display is + used. This allows the diary hooks to be correctly set with add-hook. + + The forms used for dates in diary entries and general display are no + longer autoloaded, but set at load time; this means they will be set + correctly based on values you assign to various variables. + + * The functions x-rebind-key and x-rebind-keys have been deleted, + because you can accomplish the same job by binding keys to keyboard + macros. + + * Emacs now distinguishes double and triple drag events and double and + triple button-down events. These work analogously to double and + triple click events. + + Double drag events, if not defined, convert to ordinary click events. + Double down events, if not defined, convert first to ordinary down + events, which are then discarded if not defined. Triple events that + are not defined convert to the corresponding double event; if that is + also not defined, it may convert further. + + * The new function event-click-count returns the number of clicks, + from an event which is a list. It is 1 for an ordinary click, drag, + or button-down event, 2 for a double event, and 3 or more for a triple + event. + + * The new function previous-frame is like next-frame, but moves + around through the set of existing frames in the opposite order. + + * The post-command-hook now runs even after commands that get an error + and return to top level. As a consequence of the same change, this + hook also runs before Emacs reads the first command. That might sound + paradoxical, as if this hook were the same as the pre-command-hook. + Actually, they are not similar; the latter runs before *execution* of + a command, but after it has been read. + + * You can turn off the text property hooks that run when point moves + to certain places in the buffer, by binding inhibit-point-motion-hooks + to a non-nil value. + + * Inserting a string with no text properties into the buffer normally + inherits the properties of the preceding character. You can now + control this inheritence by setting the front-sticky and + rear-nonsticky properties of a character. + + If you make a character's front-sticky property t, then insertion + before the character inherits its properties. If you make the + rear-nonsticky property t, then insertion after the character does not + inherit its properties. You can regard characters as normally being + rear-sticky and not front-sticky, and this is why insertion normally + inherits from the previous character. + + If neither side of an insertion is suitably sticky, then the inserted + text gets no properties. If both sides are sticky, then the inserted + text gets the properties of both sides, with the previous character's + properties taking precedence when both sides have a property in + common. + + You can also specify stickiness for individual properties. To do so, + use a list of property names as the value of the front-sticky property + or the rear-nonsticky property. For example, if a character has a + rear-nonsticky property whose value is (face read-only), then + insertion after the character will not inherit its face property or + read-only property (if any), but will inherit any other properties. + + The merging of properties when both sides of the insertion are sticky + takes place one property at a time. If the preceding character is + rear-sticky for the property, and the property is non-nil, it + dominates. Otherwise, the following character's property value is + used if it is front-sticky for that property. + + * If you give a character a non-nil `invisible' text property, the + character does not appear on the screen. This works much like + selective display. + + The details of this feature are likely to change in future Emacs + versions. + + * In Info, when you go to a node, it runs the normal hook + Info-selection-hook. + + * You can use the new function `invocation-directory' to get the name + of the directory containing the Emacs executable that was run. + + * Entry to the minibuffer runs the normal hook minibuffer-setup-hook. + + * The new function minibuffer-window-active-p takes one argument, a + minibuffer window, and returns t if the window is currently active. + Changes in version 19.17. diff -rc2P --exclude-from=exceptions emacs-19.17/etc/TUTORIAL emacs-19.18/etc/TUTORIAL *** emacs-19.17/etc/TUTORIAL Tue May 18 17:04:03 1993 --- emacs-19.18/etc/TUTORIAL Fri Jul 30 01:58:11 1993 *************** *** 45,50 **** C-l Clear screen and redisplay everything putting the text near the cursor at the center. ! (That's control-L, not control-1. ! There is no such character as control-1.) >> Find the cursor and remember what text is near it. --- 45,49 ---- C-l Clear screen and redisplay everything putting the text near the cursor at the center. ! (That's control-L, not control-1.) >> Find the cursor and remember what text is near it. *************** *** 558,562 **** it is called the MODE LINE. The mode line says something like ! ----**--Emacs: TUTORIAL (Fundamental)----58%------------- This is a very useful "information" line. --- 557,561 ---- it is called the MODE LINE. The mode line says something like ! --**-Emacs: TUTORIAL (Fundamental)--58%---------------------- This is a very useful "information" line. *************** *** 565,571 **** found. What the --NN%-- means is that NN percent of the file is above the top of the screen. If the top of the file is on the screen, ! it will say --TOP-- instead of --00%--. If the bottom of the file is ! on the screen, it will say --BOT--. If you are looking at a file so ! small it all fits on the screen, it says --ALL--. The stars near the front mean that you have made changes to the text. --- 564,570 ---- found. What the --NN%-- means is that NN percent of the file is above the top of the screen. If the top of the file is on the screen, ! it will say --Top-- instead of --00%--. If the bottom of the file is ! on the screen, it will say --Bot--. If you are looking at a file so ! small it all fits on the screen, it says --All--. The stars near the front mean that you have made changes to the text. *************** *** 584,588 **** comments differently. Each major mode is the name of an extended command, which is how you get into the mode. For example, ! M-X fundamental-mode is how to get into Fundamental mode. If you are going to be editing English text, such as this file, you --- 583,587 ---- comments differently. Each major mode is the name of an extended command, which is how you get into the mode. For example, ! M-x fundamental-mode is how to get into Fundamental mode. If you are going to be editing English text, such as this file, you *************** *** 652,656 **** area. This tells you that Emacs is in what is called an incremental search waiting for you to type the thing that you want to search for. ! terminates a search. >> Now type C-s to start a search. SLOWLY, one letter at a time, --- 651,655 ---- area. This tells you that Emacs is in what is called an incremental search waiting for you to type the thing that you want to search for. ! terminates a search. >> Now type C-s to start a search. SLOWLY, one letter at a time, *************** *** 659,663 **** >> Type C-s to find the next occurrence of "cursor". >> Now type four times and see how the cursor moves. ! >> Type to terminate the search. Did you see what happened? Emacs, in an incremental search, tries to --- 658,662 ---- >> Type C-s to find the next occurrence of "cursor". >> Now type four times and see how the cursor moves. ! >> Type to terminate the search. Did you see what happened? Emacs, in an incremental search, tries to *************** *** 677,683 **** are searching. ! If you are in the middle of a search and happen to type a control ! character (other than a C-s or C-r, which tell Emacs to search for the ! next occurrence of the string), the search is terminated. The C-s starts a search that looks for any occurrence of the search --- 676,682 ---- are searching. ! If you are in the middle of a search and type a control or meta ! character (with a few exceptions--characters that are special in ! a search, such as C-s and C-r), the search is terminated. The C-s starts a search that looks for any occurrence of the search *************** *** 780,784 **** type C-h ? and Emacs will tell you what kinds of help it can give. If you have typed C-h and decide you don't want any help, just ! type C-G to cancel it. The most basic HELP feature is C-h c. Type C-h, a c, and a --- 779,783 ---- type C-h ? and Emacs will tell you what kinds of help it can give. If you have typed C-h and decide you don't want any help, just ! type C-g to cancel it. The most basic HELP feature is C-h c. Type C-h, a c, and a *************** *** 816,820 **** >> Try typing C-h f previous-line. This prints all the information Emacs has about the ! function which implements the C-P command. C-h a Command Apropos. Type in a keyword and Emacs will list --- 815,819 ---- >> Try typing C-h f previous-line. This prints all the information Emacs has about the ! function which implements the C-p command. C-h a Command Apropos. Type in a keyword and Emacs will list diff -rc2P --exclude-from=exceptions emacs-19.17/etc/news.texi emacs-19.18/etc/news.texi *** emacs-19.17/etc/news.texi Mon Jul 19 02:21:24 1993 --- emacs-19.18/etc/news.texi Thu Jul 8 14:11:57 1993 *************** *** 885,890 **** @item ! The hook @code{after-save-hook} runs just after a buffer has been saved ! in its visited file. @item --- 885,890 ---- @item ! The hook @code{after-save-buffer-hook} runs just after a buffer has been ! saved in its visited file. @item diff -rc2P --exclude-from=exceptions emacs-19.17/info/dir emacs-19.18/info/dir *** emacs-19.17/info/dir Sat Jul 17 14:49:40 1993 --- emacs-19.18/info/dir Sun Aug 8 13:22:18 1993 *************** *** 16,22 **** * Emacs: (emacs). The extensible self-documenting text editor. * VIP: (vip). A VI-emulation for Emacs. ! * Forms: (forms). Forms mode is an Emacs package ! that lets the user edit a data structure ! by filling in a form. * GNUS: (gnus). The news reader GNUS. * CL: (cl). Partial Common Lisp support for Emacs Lisp. --- 16,21 ---- * Emacs: (emacs). The extensible self-documenting text editor. * VIP: (vip). A VI-emulation for Emacs. ! * Forms: (forms). Emacs package for editing data bases ! by filling in forms. * GNUS: (gnus). The news reader GNUS. * CL: (cl). Partial Common Lisp support for Emacs Lisp. diff -rc2P --exclude-from=exceptions emacs-19.17/info/info emacs-19.18/info/info *** emacs-19.17/info/info Fri Jun 11 19:21:13 1993 --- emacs-19.18/info/info Fri Jul 23 13:46:15 1993 *************** *** 656,675 ****  Tag table: ! File: info, Node: Checking25796 ! File: info, Node: Tags24579 ! File: info, Node: Cross-refs23926 ! File: info, Node: Menus21121 ! File: info, Node: Add18186 ! File: info, Node: Expert15972 ! File: info Node: Help-Q15421 ! File: info Node: Help-Cross14907 ! File: info Node: Help-Adv12631 ! File: info Node: Help-FOO11930 ! File: info Node: Help-M6648 ! File: info Node: Help-^L4141 ! File: info Node: Help-P3393 ! File: info Node: Help2444 ! File: info Node: Help-Small-Screen816 ! File: info Node: Top111  End tag table --- 656,676 ----  Tag table: ! Node: Top111 ! Node: Help-Small-Screen872 ! Node: Help2491 ! Node: Help-P3436 ! Node: Help-^L4184 ! Node: Help-M6910 ! Node: Help-FOO12624 ! Node: Help-Adv13325 ! Node: Help-Cross15882 ! Node: Help-Q16396 ! Node: Expert16965 ! Node: Add19184 ! Node: Menus22420 ! Node: Cross-refs25224 ! Node: Tags25877 ! Node: Checking27094 ! Node: Variables27983  End tag table diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/ChangeLog emacs-19.18/lib-src/ChangeLog *** emacs-19.17/lib-src/ChangeLog Mon Jul 19 02:01:37 1993 --- emacs-19.18/lib-src/ChangeLog Sun Aug 8 03:12:22 1993 *************** *** 1,5 **** ! Thu Jul 15 22:03:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) ! * Version 19.17 released. * etags.c (print_help): Break up the very long strings containing --- 1,53 ---- ! Sun Aug 8 01:15:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) ! ! * Version 19.18 released. ! ! Wed Aug 4 18:51:10 1993 Francesco Potorti` (pot@spiff.gnu.ai.mit.edu) ! ! * etags.c (L_isdef, L_isquote, L_getit): small optimisations. ! (L_funcs): the (foo::defmumble stuff now should work. ! (consider_token): function returned random value--corrected. ! (C_entries): corrected == versus = typo. ! ! Sun Aug 1 18:14:02 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) ! ! * etags.c (put_entries): For NODE->rewritten, put pattern before ! \177 and name after, not vice versa. ! ! Sun Aug 1 03:45:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) ! ! * timer.c (main): Generate a SIGIO as soon as we've initialized. ! ! Fri Jul 30 15:54:59 1993 Francesco Potorti` (pot@cnuce.cnr.it) ! ! * etags.c (FINCST): added the fignore status. Means we are ! after the parameter list and before the open curly brace. ! Allows correct parsing of C++ constructors. ! (C_entries, consider_token): make use of fignore. ! (consider_token): reset funcdef when next_token_is_func: when in ! ctags mode makes DEFVAR and others work better. ! (L_isquote): function that recognises the "(quote" string. ! (L_getit): ignore quoting via "'" or "(quote". Useful for defalias. ! Thu Jul 29 12:57:38 1993 Paul Eggert (eggert@twinsun.com) ! ! * rcs-checkin: Don't check whether a file is readable until we have ! decided not to ignore it. ! ! Tue Jul 20 01:16:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) ! ! * Makefile.in (etags): Depend on ../src/config.h. ! ! * emacsserver.c: Include types.h before file.h. ! ! Mon Jul 19 15:10:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) ! ! * Makefile.in (install): Use .n, not .new, for temporary filenames. ! ! Sun Jul 18 15:10:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) ! ! * Version 19.17 released. ! ! Thu Jul 15 22:03:13 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) * etags.c (print_help): Break up the very long strings containing diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/Makefile.in emacs-19.18/lib-src/Makefile.in *** emacs-19.17/lib-src/Makefile.in Mon Jun 21 23:57:34 1993 --- emacs-19.18/lib-src/Makefile.in Tue Jul 20 23:29:13 1993 *************** *** 143,146 **** --- 143,147 ---- # We don't need to install `wakeup' explicitly, because it will be copied when # this whole directory is copied. + # We use .n, not .new as before, to avoid exceeding the 14-character limit. install: ${archlibdir} @echo *************** *** 147,156 **** @echo "Installing utilities for users to run." for file in ${INSTALLABLES} ; do \ ! cp $${file} ${bindir}/$${file}.new ; \ ! chmod 755 ${bindir}/$${file}.new ; \ done for file in ${INSTALLABLE_SCRIPTS} ; do \ ! cp ${srcdir}/$${file} ${bindir}/$${file}.new ; \ ! chmod 755 ${bindir}/$${file}.new ; \ done @echo --- 148,157 ---- @echo "Installing utilities for users to run." for file in ${INSTALLABLES} ; do \ ! cp $${file} ${bindir}/$${file}.n ; \ ! chmod 755 ${bindir}/$${file}.n ; \ done for file in ${INSTALLABLE_SCRIPTS} ; do \ ! cp ${srcdir}/$${file} ${bindir}/$${file}.n ; \ ! chmod 755 ${bindir}/$${file}.n ; \ done @echo *************** *** 158,165 **** @echo "(You may ignore errors here if you don't care about this.)" -for file in ${INSTALLABLES} ${INSTALLABLE_SCRIPTS} ; do \ ! chgrp bin ${bindir}/$${file}.new ; \ ! chown bin ${bindir}/$${file}.new ; \ rm -f ${bindir}/$${file} ; \ ! mv ${bindir}/$${file}.new ${bindir}/$${file} ; \ done --- 159,166 ---- @echo "(You may ignore errors here if you don't care about this.)" -for file in ${INSTALLABLES} ${INSTALLABLE_SCRIPTS} ; do \ ! chgrp bin ${bindir}/$${file}.n ; \ ! chown bin ${bindir}/$${file}.n ; \ rm -f ${bindir}/$${file} ; \ ! mv ${bindir}/$${file}.n ${bindir}/$${file} ; \ done *************** *** 210,214 **** ${CC} -c ${CPP_CFLAGS} ${srcdir}/getopt1.c ! etags: ${srcdir}/etags.c $(GETOPTDEPS) $(CC) ${CPP_CFLAGS} -DETAGS ${srcdir}/etags.c $(GETOPTOBJS) $(LOADLIBES) -o etags --- 211,215 ---- ${CC} -c ${CPP_CFLAGS} ${srcdir}/getopt1.c ! etags: ${srcdir}/etags.c $(GETOPTDEPS) ../src/config.h $(CC) ${CPP_CFLAGS} -DETAGS ${srcdir}/etags.c $(GETOPTOBJS) $(LOADLIBES) -o etags diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/emacsserver.c emacs-19.18/lib-src/emacsserver.c *** emacs-19.17/lib-src/emacsserver.c Wed Jun 9 08:37:03 1993 --- emacs-19.18/lib-src/emacsserver.c Tue Jul 20 01:16:39 1993 *************** *** 49,54 **** /* BSD code is very different from SYSV IPC code */ - #include #include #include #include --- 49,54 ---- /* BSD code is very different from SYSV IPC code */ #include + #include #include #include diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/etags.c emacs-19.18/lib-src/etags.c *** emacs-19.17/lib-src/etags.c Sun Jul 18 02:06:26 1993 --- emacs-19.18/lib-src/etags.c Wed Aug 4 18:51:49 1993 *************** *** 25,28 **** --- 25,30 ---- * Gnu Emacs TAGS format and modifications by RMS? * Sam Kendall added C++. + * + * Francesco Potorti` is the current maintainer. 7.5 */ *************** *** 158,162 **** char *xmalloc (); char *xrealloc (); ! int L_isdef (); int PF_funcs (); int total_size_of_entries (); --- 160,164 ---- char *xmalloc (); char *xrealloc (); ! int L_isdef (), L_isquote (); int PF_funcs (); int total_size_of_entries (); *************** *** 1176,1180 **** { fprintf (outf, "%s\177%s\001%d,%d\n", ! node->name, node->pat, node->lno, node->cno); } else --- 1178,1183 ---- { fprintf (outf, "%s\177%s\001%d,%d\n", ! node->pat, node->name, ! node->lno, node->cno); } else *************** *** 1181,1185 **** { fprintf (outf, "%s\177%d,%d\n", ! node->pat, node->lno, node->cno); } } --- 1184,1189 ---- { fprintf (outf, "%s\177%d,%d\n", ! node->pat, ! node->lno, node->cno); } } *************** *** 1331,1335 **** /* - * etags.c 4.2 1993/03/22 12:13:40 pot Exp * C functions are recognized using a simple finite automaton. * funcdef is its state variable. --- 1335,1338 ---- *************** *** 1337,1341 **** typedef enum { ! fnone, ftagseen, finlist, flistseen } FUNCST; FUNCST funcdef; --- 1340,1348 ---- typedef enum { ! fnone, /* nothing seen */ ! ftagseen, /* function-like tag seen */ ! finlist, /* in parameter list */ ! flistseen, /* after parameter list */ ! fignore, /* before open brace */ } FUNCST; FUNCST funcdef; *************** *** 1347,1351 **** typedef enum { ! tnone, ttypedseen, tinbody, tend } TYPEDST; TYPEDST typdef; --- 1354,1361 ---- typedef enum { ! tnone, /* nothing seen */ ! ttypedseen, /* typedef keyword seen */ ! tinbody, /* inside typedef body */ ! tend, /* just before typedef tag */ } TYPEDST; TYPEDST typdef; *************** *** 1364,1368 **** stagseen, /* struct-like tag seen */ scolonseen, /* colon seen after struct-like tag */ ! sinbody /* in struct body: recognize member func defs*/ } STRUCTST; STRUCTST structdef; --- 1374,1378 ---- stagseen, /* struct-like tag seen */ scolonseen, /* colon seen after struct-like tag */ ! sinbody, /* in struct body: recognize member func defs*/ } STRUCTST; STRUCTST structdef; *************** *** 1382,1386 **** dsharpseen, /* '#' seen as first char on line */ ddefineseen, /* '#' and 'define' seen */ ! dignorerest /* ignore rest of line */ } DEFINEST; DEFINEST definedef; --- 1392,1396 ---- dsharpseen, /* '#' seen as first char on line */ ddefineseen, /* '#' and 'define' seen */ ! dignorerest, /* ignore rest of line */ } DEFINEST; DEFINEST definedef; *************** *** 1630,1634 **** case flistseen: MAKE_TAG_FROM_OTH_LB (TRUE); ! /* FALLTHRU */ case ftagseen: funcdef = fnone; --- 1640,1645 ---- case flistseen: MAKE_TAG_FROM_OTH_LB (TRUE); ! funcdef = fignore; ! break; case ftagseen: funcdef = fnone; *************** *** 1658,1662 **** { MAKE_TAG_FROM_OTH_LB (FALSE); ! funcdef == fnone; } break; --- 1669,1673 ---- { MAKE_TAG_FROM_OTH_LB (FALSE); ! funcdef = fignore; } break; *************** *** 1667,1671 **** MAKE_TAG_FROM_OTH_LB (FALSE); } ! funcdef = fnone; /* FALLTHRU */ case ',': --- 1678,1683 ---- MAKE_TAG_FROM_OTH_LB (FALSE); } ! if (funcdef != fignore) ! funcdef = fnone; /* FALLTHRU */ case ',': *************** *** 1672,1676 **** /* FALLTHRU */ case '[': ! if (funcdef != finlist) funcdef = fnone; if (structdef == stagseen) --- 1684,1688 ---- /* FALLTHRU */ case '[': ! if (funcdef != finlist && funcdef != fignore) funcdef = fnone; if (structdef == stagseen) *************** *** 1708,1713 **** break; } cblev++; ! /* FALLTHRU */ case '*': if (funcdef == flistseen) --- 1720,1733 ---- break; } + switch (funcdef) + { + case flistseen: + MAKE_TAG_FROM_OTH_LB (TRUE); + /* FALLTHRU */ + case fignore: + funcdef = fnone; + } cblev++; ! break; case '*': if (funcdef == flistseen) *************** *** 1714,1718 **** { MAKE_TAG_FROM_OTH_LB (TRUE); ! funcdef = fnone; } break; --- 1734,1738 ---- { MAKE_TAG_FROM_OTH_LB (TRUE); ! funcdef = fignore; } break; *************** *** 1919,1923 **** { next_token_is_func = FALSE; ! *is_func = TRUE; return (TRUE); } --- 1939,1944 ---- { next_token_is_func = FALSE; ! funcdef = fnone; ! *is_func = TRUE; /* to force search string in ctags */ return (TRUE); } *************** *** 1930,1937 **** return (FALSE); default: ! funcdef = ftagseen; ! *is_func = TRUE; ! return (TRUE); } } --- 1951,1963 ---- return (FALSE); default: ! if (funcdef == fnone) ! { ! funcdef = ftagseen; ! *is_func = TRUE; ! return (TRUE); ! } } + + return (FALSE); } *************** *** 2342,2354 **** { /* Check for (foo::defmumble name-defined ... */ ! while (*dbp && *dbp != ':' && !isspace (*dbp) ! && *dbp != '(' && *dbp != ')') dbp++; if (*dbp == ':') { ! while (*dbp == ':') dbp++; ! if (L_isdef (dbp)) { while (!isspace (*dbp)) --- 2368,2382 ---- { /* Check for (foo::defmumble name-defined ... */ ! do dbp++; + while (*dbp && !isspace (*dbp) + && *dbp != ':' && *dbp != '(' && *dbp != ')'); if (*dbp == ':') { ! do dbp++; + while (*dbp == ':'); ! if (L_isdef (dbp - 1)) { while (!isspace (*dbp)) *************** *** 2366,2374 **** int L_isdef (dbp) ! char *dbp; { ! return ((dbp[1] == 'D' || dbp[1] == 'd') && ! (dbp[2] == 'E' || dbp[2] == 'e') && ! (dbp[3] == 'F' || dbp[3] == 'f')); } --- 2394,2414 ---- int L_isdef (dbp) ! register char *dbp; ! { ! return ((dbp[1] == 'd' || dbp[1] == 'D') ! && (dbp[2] == 'e' || dbp[2] == 'E') ! && (dbp[3] == 'f' || dbp[3] == 'F')); ! } ! ! int ! L_isquote (dbp) ! register char *dbp; { ! return ((*(++dbp) == 'q' || *dbp == 'Q') ! && (*(++dbp) == 'u' || *dbp == 'U') ! && (*(++dbp) == 'o' || *dbp == 'O') ! && (*(++dbp) == 't' || *dbp == 'T') ! && (*(++dbp) == 'e' || *dbp == 'E') ! && isspace(*(++dbp))); } *************** *** 2380,2387 **** char nambuf[BUFSIZ]; ! if (*dbp == 0) ! return; ! for (cp = dbp + 1; *cp && *cp != '(' && *cp != ' '; cp++) continue; c = cp[0]; cp[0] = 0; --- 2420,2436 ---- char nambuf[BUFSIZ]; ! if (*dbp == '\'') /* Skip prefix quote */ ! dbp++; ! else if (*dbp == '(' && L_isquote (dbp)) /* Skip "(quote " */ ! { ! dbp += 7; ! while (isspace(*dbp)) ! dbp++; ! } ! for (cp = dbp /*+1*/; *cp && *cp != '(' && *cp != ' ' && *cp != ')'; cp++) continue; + if (cp == dbp) + return; + c = cp[0]; cp[0] = 0; diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/getopt1.c emacs-19.18/lib-src/getopt1.c *** emacs-19.17/lib-src/getopt1.c Sun Jul 18 04:33:23 1993 --- emacs-19.18/lib-src/getopt1.c Sat Aug 7 16:55:04 1993 *************** *** 23,28 **** #include "getopt.h" ! #if !__STDC__ && !defined(const) && IN_GCC #define const #endif --- 23,32 ---- #include "getopt.h" ! #ifndef __STDC__ ! /* This is a separate conditional since some stdc systems ! reject `defined (const)'. */ ! #ifndef const #define const + #endif #endif diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/rcs-checkin emacs-19.18/lib-src/rcs-checkin *** emacs-19.17/lib-src/rcs-checkin Mon Apr 26 00:28:27 1993 --- emacs-19.18/lib-src/rcs-checkin Thu Jul 29 15:56:26 1993 *************** *** 36,42 **** for file do - # Check that file is readable. - <$file || exit - # Make it easier to say `rcs-checkin *' # by ignoring file names that already contain `~', or end in `,v'. --- 36,39 ---- *************** *** 46,49 **** --- 43,49 ---- # Ignore non-files too. test -f "$file" || continue + + # Check that file is readable. + <$file || exit # If the RCS file does not already exist, diff -rc2P --exclude-from=exceptions emacs-19.17/lib-src/timer.c emacs-19.18/lib-src/timer.c *** emacs-19.17/lib-src/timer.c Wed Jun 9 08:46:02 1993 --- emacs-19.18/lib-src/timer.c Sun Aug 1 03:43:59 1993 *************** *** 294,299 **** #endif /* USG */ for (;;) ! pause (); } --- 294,303 ---- #endif /* USG */ + /* In case Emacs sent some input before we set up + the handling of SIGIO, read it now. */ + kill (0, SIGIO); + for (;;) ! pause (); } diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/ChangeLog emacs-19.18/lisp/ChangeLog *** emacs-19.17/lisp/ChangeLog --- emacs-19.18/lisp/ChangeLog Mon Aug 9 02:20:46 1993 *************** *** 0 **** --- 1,2539 ---- + Sun Aug 8 00:39:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * Version 19.18 released. + + * tpu-doc.el (enable-local-variables): setq deleted. + * tpu-extras.el (edit-picture-hook): Use add-hook to modify it. + + * server.el (server-visit-files): Restore current-buffer by hand, + not using save-excursion. + + * gud.el (gud-dbx-marker-filter): Detect signals as well as bpts. + + * ange-ftp.el (ange-ftp-send-cmd): Bind ange-ftp-this-... + in the outermost let, not an inner one. + + * comint.el (comint-mode-map): Delete C-c C-y binding. + + * mh-e.el (mh-read-msg-list): Undo previous change. + + * subr.el (minibuffer-window-active-p): New function. + + * mouse.el (mouse-set-point): Error if click in inactive minibuffer. + (mouse-drag-region): Use mouse-set-point. + Don't set a mark if final event wasn't suitable for setting point. + + * etags.el (etags-goto-tag-location): If match started with Ctrl-m, + compensate when setting point. + + * simple.el (shell-command, shell-command-on-region): + Fix bugs in previous change. + + * dired-aux.el (dired-compress-file): For .z file, run gunzip. + When running gzip, see if it made .gz or .z. + (dired-compress): Delete any old entry for new-file. + + Sat Aug 7 20:42:29 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * vc.el (vc-diff, vc-directory-18): Add missing paren to end of + vc-diff, and remove extra paren from vc-directory-18. + + Sat Aug 7 04:18:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * dired-aux.el (dired-diff): Read options right here; + don't try to use diff-read-switches. Always call diff with 3 args. + (dired-backup-diff): Likewise. + + * simple.el (do-auto-fill): Don't keep breaking the line + if it doesn't help matters. + + Fri Aug 6 18:10:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * indent.el (indent-region): Fix paren error in last change. + + * mouse.el (mouse-save-then-kill): Fix paren error in last change. + + Fri Aug 6 16:25:08 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + Fix {menu,scroll}-bar-mode so prefix arg of M-- works. + * scroll-bar.el (scroll-bar-mode): If FLAG is non-nil, set it to + its prefix-numeric-value. + * menu-bar.el (menu-bar-mode): Defvar removed. + (menu-bar-mode): Rewritten to parallel scroll-bar-mode. + + * info.el (Info-goto-emacs-command-node, + Info-goto-emacs-key-command-node): Doc fix. + + * help.el (help-for-help): Mention C-k and C-f. + + Fri Aug 6 14:02:22 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * files.el (after-find-file): Improve warning message about + existing file that can't be read. + + Thu Aug 5 02:54:42 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * indent.el (indent-region): Rename arg ARG to COLUMN. + Don't add fill-prefix to empty line. + Don't change whitespace in empty line. + + * mouse.el (help-admin-map): Fix menu item text. + + * font-lock.el (font-lock-fontify-region): + Handle comment-start-skip = nil. + + * rmail.el (rmail-resend): Delete any Sender field. + + Wed Aug 4 00:36:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * perl-mode.el (perl-mode): Add autoload cookie. + + * paths.el (sendmail-program): Try /usr/sbin/sendmail.el also. + + * mouse.el (mouse-save-then-kill): Don't discard all the normal + undo info; just replace the deletion entry. + + * tpu-edt.el, tpu-doc.el, tpu-extras.el, tpu-mapper.el: New files. + * vt-control.el: New file. + + Wed Aug 4 14:42:17 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) + + * diary.el (list-diary-entries): Split diary-display-hook into two + pieces, diary-display-hook and diary-hook. If diary-display-hook + is nil, use simple display. + (include-other-diary-files): Set those hooks properly for other files. + + * calendar.el (diary-display-hook): Change default and fix doc string. + (diary-hook): New user variable. + (diary-date-forms, calendar-date-display-form): Don't autoload + them so the European/American style is decided at load time. + + Tue Aug 3 23:40:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * lpr.el (print-region-1): Make END a marker so untabify relocates it. + + Tue Aug 3 17:38:47 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * compile.el (compilation-minor-mode): Make variable buffer-local. + (compilation-minor-mode): Autoload this function. + + Tue Aug 3 13:44:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * man.el (man): Define as alias. + + * paren.el (window-setup-hook): Add hook function. + + Tue Aug 3 03:52:36 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * comint.el (comint-dynamic-list-completions): Expand PATHDIR in + call to file-name-completion. + + Tue Aug 3 03:09:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * faces.el: Make boldness/italicness affect frames created later. + (make-face-bold, make-face-italic, make-face-bold-italic) + (make-face-unbold, make-face-unitalic): Update global-face-data. + Ignore a list found in the font slot. + (make-face-bold-internal, make-face-italic-internal): + (make-face-bold-italic-internal): New subroutines. + (x-create-frame-with-faces): If global-face-data's font slot + indicates bold and/or italic, make it so. + + Tue Aug 3 02:38:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * window.el (shrink-window-if-larger-than-buffer): Pass WINDOW to + pos-visible-in-window-p. + + Tue Aug 3 00:08:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * completion.el (cmpl-read-time-eval): Make it no-op. + (cmpl-hours-since-origin): Use truncate to make an integer. + (completion-search-reset): Use completion-prefix-min-length. + + * telnet.el (telnet): If we already have a telnet to HOST, + just switch buffers. + + Mon Aug 2 23:33:34 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * frame.el (other-frame): Skip iconified and invisible frames. + + Mon Aug 2 21:07:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * replace.el (occur-mode-goto-occurrence): Give meaningful error + message if there's nowhere useful to go. + + Mon Aug 2 18:18:52 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * comint.el (comint-dynamic-complete): If called interactively + twice in a row, give the completion list. + + * comint.el (comint-dynamic-complete): Expand PATHDIR in call to + file-name-completion. + + * comint.el (comint-dynamic-completion): Say "Sole completion", + not "Unique completion". + + * frame.el (other-frame): New function, analogous to other-window. + (ctl-x-5-map): Bind C-x 5 o to other-frame. + + Mon Aug 2 00:47:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * subr.el (add-hook): Change a single function into a list. + + * lucid.el (remove-hook): Doc string added. + Change a single function into a list. + + * sendmail.el (mail-yank-hooks): Initialize to nil. + (mail-yank-original): If mail-yank-hooks is nil, + call mail-indent-citation. + + * c-mode.el (indent-c-exp): Don't document ENDPOS. + (c-indent-region): Rewrite to use indent-c-exp on one sexp at a time, + then use c-indent-line on the next line, etc. + + * bytecomp.el (byte-recompile-directory): At end of compiling a file, + put back the "Checking DIR..." message. + + Sun Aug 1 18:22:59 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * etags.el (etags-tags-completion-table): Fixed regexp for today's + format. + (etags-snarf-tag): Skip explicit tag name if present. + + Sun Aug 1 20:50:07 1993 Paul Eggert (eggert@twinsun.com) + + * dissociate.el (dissociated-press): + Use `(random N)' instead of while loop. + * dunnet.el: (dun-endgame-question, tcom, tloc): + Use (random N) instead of combination of %, abs and random. + * life.el (life-insert-random-pattern): Simplify (% (abs (random)) N) + to (random N). + * cookie1.el (pick-random): Remove. + All callers changed to use `random' instead. + * gomoku.el (random-number): Likewise. + * mpuz.el (mpuz-random): Likewise. + + * emerge.el (emerge-default-[AB]): Use (zerop (% A B)) instead of + (= (* (/ A B) B) A). + + Sun Aug 1 01:17:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * subr.el (event-click-count): New function. + + * texinfmt.el: Installed the version from the Texinfo package. + + * dired.el (dired-sort-mode): Variable deleted. + Don't display it in mode line. + (dired-sort-set-modeline): Set mode-name instead. + + * etags.el (visit-tags-table-buffer): New local named + visit-tags-table-buffer-cont copies cont. + (tags-table-including): Set that, instead of cont. + + * c-mode.el (indent-c-exp): Don't move an { from column 0. + + Sat Jul 31 01:31:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * tar-mode.el: Fix doc strings and error message syntax. + Add menu bar items. + (tar-subfile-mode): Set a local-write-file-hook + rather than using key bindings. + (tar-subfile-save-buffer): Return t. + + * add-log.el (change-log-mode): Use \f for formfeed, to avoid + syntax error. + + * isearch.el (isearch-done): Move point (for small window) + before deciding whether to set the mark. + + * man.el (Man-build-references-alist): When setting word, + use only what Man-reference-regexp matched. + (Man-reference-regexp): Don't match starting with a period. + (Man-first-heading-regexp): Allow leading space. + (Man-heading-regexp): Allow leading space. + (Man-section-translations-alist): Add entries for xlib. + + * completion.el (completion-version): New variable. + (save-completions-to-file): Use completion-version. + + * tex-mode.el (validate-tex-buffer): Record mismatches in *Occur*. + + * files.el (basic-save-buffer): When we read a file name, + use set-visited-file-name to put it in. + + * mouse.el (mouse-choose-completion): Actually choose that alternative, + don't just insert its name. + + * simple.el (shell-command-history): New variable. + (shell-command, shell-command-on-region): Use it. + + Fri Jul 30 14:25:24 1993 Paul Eggert (eggert@twinsun.com) + + * window.el (shrink-window-if-larger-than-buffer): Do nothing if the + window is the only window of its frame. If the buffer ends in newline + and point is not at the end of the buffer, do not display the + last (empty) line. + + * vc.el (vc-shrink-to-fit): Deleted. All callers changed to use + the new, fixed `shrink-window-if-larger-than-buffer' instead. + In some places move it after a (goto-char (point-min)). + + Fri Jul 30 20:19:06 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * blackbox.el (blackbox-mode-map): Now that we have + terminal-independent function-key facilities, we ought to use + them. Remove hack which looks for all bindings for the simple + motion keys and locally binds them to blackbox keys; add bindings + for the [up], [down], [left], and [right] keys. + + * frame.el (frame-notice-user-settings): If we had to create a new + frame in order to obey initial-frame-alist, use delete-frame's + FORCE argument to get rid of the old frame even if the new one + hasn't been mapped yet. + + Fri Jul 30 20:18:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * fill.el (fill-region-as-paragraph): When we take one word + after the fill column, don't stop at period with just one space. + When checking whether at beginning of line, if no fill prefix, + ignore intervening whitespace. + + Fri Jul 30 18:38:56 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * gud.el (gud-gdb-marker-filter): Preserve the match data across + the filter's execution. + + * gud.el (gud-gdb-marker-filter): If we received some text after + the position marker, append it to any text before the marker, + instead of throwing away the text before the marker. + + Fri Jul 30 03:00:20 1993 David Gillespie (synaptx!daveg@uunet.UU.NET) + + * cl.el: File totally replaced. + * cl-compat.el, cl-extra.el, cl-macs.el, cl-seq.el: New files. + + * info.el (Info-fontify-node): New function. + (Info-fontify): New variable. + (Info-mode): Initialize Info-related faces. + (Info-select-node): Fontify the node if necessary. + + * info.el (Info-goto-node): Provide completion for node names. + (Info-read-node-name, Info-build-node-completions): New functions. + (Info-current-file-completions): New variable. + (Info-find-node): Clear completions cache. + + * info.el (Info-next-reference, Info-prev-reference): New commands. + (Info-mode-map): Bind these to TAB and M-TAB. + (Info-next-preorder): Special case if sitting on "*Note" reference. + + * info.el (Info-standalone): New variable. + (Info-exit): Exit Emacs if in standalone mode. + (info-standalone): New function. + + * info.el (Info-summary): Added `bury-buffer' call. + (Info-no-error): Renamed from `no-error'. + (Info-suffix-list): Put ".info" before "" to deal with directory + named "foo" next to file "foo.info". + + Fri Jul 30 03:00:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * fill.el (fill-region-as-paragraph): Move misplaced paren + ending `(if (eobp) nil ...)'. + In the loop that avoids breaking after `.' with one space, + break if we actually have two spaces. + + Fri Jul 30 01:32:53 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * compile.el (compilation-error-regexp-alist): Broaden RS6000 + regexp to match "lines N-M," or "line N,". + + Thu Jul 29 19:21:10 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * gud.el (gud-gdb-marker-filter): Do not assume that the position + markers from GDB will always be received in one chunk of input; + gud-gdb-marker-filter may be called several times, each time + providing a little more of the position marker. + (gud-gdb-marker-acc): New variable. + (gud-gdb-marker-filter): If we have received what could be the + beginning of a position marker, hold that text in + gud-gdb-marker-acc for the next time we get called, until we have + enough information to decide for sure. + + * gud.el (gud-gdb-marker-filter): Only recognize GDB position + markers if they occur at the beginning of the line. They always + do, and this reduces the likelihood that the above change will + hold back output that isn't really a position marker. + + * mpuz.el (mpuz-board): Doc fix. + + Thu Jul 29 01:10:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * gud.el (dbx): Use %d in gud-break. + (gud-format-command): Support %d. Delete spurious progns. + + * etags.el (etags-goto-tag-location): Handle selective display. + + * sendmail.el: Do the global key bindings only via loaddefs.el, + not when sendmail.el is loaded. + + * buff-menu.el (Buffer-menu-mode-map): Undo previous change. + + * rmail.el (rmail-nuke-pinhead-header): Tell replace-match not to + alter the case. + (rmail-toggle-header, rmail-reformat-message): Ignore case + when checking for Summary-line. + + * calendar.el (calendar-mode-map): Bind C-SPC. + + Thu Jul 29 04:58:47 1993 Paul Eggert (eggert@twinsun.com) + + * (vc-mode-line): Set vc-mode to nil if FILE no longer is + version-controlled. + + Thu Jul 29 00:47:52 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * menu-bar.el (delete-frame): Permit it, if > 1 frame is vis or iconic. + + Wed Jul 28 23:02:45 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * man.el (Man-find-section): HP/UX man pages have section names + indented by a single space; recognize them. + + * gud.el (gud-last-last-frame): Specify initial value. `dbx' + doesn't work unless we do. + + Thu Jul 29 00:00:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * c-mode.el (calculate-c-indent): When checking whether function decl + is inside a comment, move back to the `(' that starts the arglist. + + Wed Jul 28 19:50:53 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmail.el (rmail-convert-file): If file needs conversion, + convert it all. + + * macros.el (name-last-kbd-macro): Handle macros that are vectors. + + * man.el (Man-filter-list): Insert \n newlines in awk script. + + * time-stamp.el (time-stamp): Add autoload cookie. + + Wed Jul 28 18:41:55 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * comint.el (comint-replace-by-expanded-filename, + comint-dynamic-complete): Say "Sole completion" instead of "Unique + completion", for consistency with the rest of the known universe. + + Wed Jul 28 04:21:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * sc.el: Require assoc instead of sc-alist. + * sc-alist.el: File deleted. + + * gnus.el (gnus-apply-kill-hook): Make the value a list of functions. + (gnus-mark-article-hook, gnus-select-digest-hook): Likewise. + (gnus-select-article-hook, gnus-select-group-hook): Likewise. + + Tue Jul 27 17:58:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * bytecomp.el (byte-recompile-directory): Doc fix. + + * term/x-win.el (iconify-or-deiconify-frame): New function. + Use it for C-z. + + Tue Jul 27 19:28:46 1993 Paul Eggert (eggert@twinsun.com) + + * vc-hooks.el (vc-rcs-status): Removing any trailing "-". + + Tue Jul 27 01:48:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * cplus-md.el (c++-mode-syntax-table): Don't alter syntax of '. + + * term/x-win.el (x-handle-iconic): New function. + (command-switch-alist): Use that. + (x-switch-definitions): Delete elt for `-iconic'. + + * gud.el (dbx): For gud-break, send a file command and a stop command. + + * diary.el: Doc fixes. + + Mon Jul 26 15:55:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * mouse.el (font-menu-add-default): New function. + * startup.el (normal-top-level): Call font-menu-add-default. + + Mon Jul 26 14:32:18 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * simple.el (read-expression-history): New defvar. + (eval-expression): Use it has history var in interactive spec. + + Mon Jul 26 01:54:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * frame.el (frame-notice-user-settings): Don't reapply a parm + whose value is ot changed (as far as we know) since frame-initialize. + + * simple.el (kill-ring-save): Delete spurious `message' call. + (set-mark): If POS is nil, call deactivate-mark. + + * c-mode.el (indent-c-exp): When previous line ends in comma, + use calculate-c-indent. Fix the "inner loop" to properly detect + a line that ends outside of comments and strings. + + * cplus-md.el (c++-mode-syntax-table): Handle C-style comments. + + * files.el (insert-directory): Make sure default-directory is absolute. + + * dired.el (dired-readin-insert): If we got a list of files, + pass nil for WILDCARD arg to dired-insert-directory. + + Sun Jul 25 16:19:47 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * vc.el (vc-backend-steal): Pass arg omitted in last change. + + * term/x-win.el (x-selection-timeout): Use 20000 as default. + + * mouse.el (x-fixed-font-alist): Give some fonts long patterns. + Delete 9x15 bold and 8x13 and 8x13 bold. Add some fonts. + + * term/x-win.el (x-select-text): Never set the CLIPBOARD selection. + (x-cut-buffer-or-selection-value): Try PRIMARY before cut buffer. + (x-cut-buffer-max): Set based on x-server-max-request-size. + + Sat Jul 24 01:33:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * unrmail.el (unrmail): Total rewrite. + * rmailout.el (rmail-output): New arg NOATTRIBUTE. + + * rmailout.el (rmail-output-to-rmail-file): Set rmail-last-rmail-file + while reading the interactive args. + (rmail-output): Likewise, for rmail-last-file. + (rmail-output-to-rmail-file): Use default-file consistently. + + * replace.el (occur): If no default, don't mention one. + + * rmail.el (rmail-last-rmail-file): Initialize to a file name. + (rmail): Don't set rmail-last-rmail-file. + + * info.el (Info-select-node): Run Info-selection-hook. + + * ispell.el (ispell-point): Do nothing if there's no word at START. + + Fri Jul 23 00:42:36 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * doctor.el (doctor-type-symbol): Win if auto-fill-function is nil. + + * edt.el (advance-direction): Set kp-f3, not kp-f1. + + * term/x-win.el (x-select-text): Always set the cut buffer, + but sometimes set it to nothing. Don't put large strings in clipboard. + + * dired.el (dired-readin-insert): Don't use the "whole directory" + case if DIR-OR-LIST is a list. + + * font-lock.el (font-lock-after-change-function): + Scan for comments and strings from beg of line. + (c-font-lock-keywords-1): Recognize &, like *, before fn name. + (perl-font-lock-keywords): Put digit 1 into function-name-face items. + Allow whitespace before the open-brace. + + * sort.el (sort-skip-fields): Really implement fields as runs + of nonwhitespace chars. + (sort-fields, sort-float-fields, sort-numeric-fields): + Don't subtract 1 when calling sort-skip-fields. + + Thu Jul 22 13:44:22 1993 Ron Schnell (ronnie@media.mit.edu) + + * dunnet.el (dun-special-object): Fixed so that bus will + explode if falls through hole instead of making adventurer + trapped in room with no escape and no way off the bus. + + Thu Jul 22 13:34:32 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * term/x-win.el (x-select-text): Limit size of text sent to cut buffer. + + * subr.el (keyboard-translate): Properly lengthen existing table. + + * files.el (set-auto-mode): Fix backwards test + involving inhibit-local-variables-regexps. + + * loaddefs.el (ctl-x-map): Correct C-x r t to string-rectangle. + + * paren.el (show-paren-command-hook): Specify buffer for move-overay. + + Thu Jul 22 03:59:42 1993 Paul Eggert (eggert@twinsun.com) + + * vc.el (vc-backend-revert): Use `co -f' instead of deleting the + working file ourselves; that way, if `co' fails, we won't have + deleted the working file. + (vc-backend-steal): Don't delete the working file. Use `rcs -u -l', + not `rcs -u ; rcs -l'; it's faster. Use vc-backend-dispatch -- the + old code couldn't have possibly worked. + + Thu Jul 22 01:34:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * map-ynp.el (map-y-or-n-p): If LIST is nil, just return. + + * mouse.el (mouse-secondary-save-then-kill): When making the undo item, + use an integer, not a marker, for the position. + + * rmail.el (rmail-forward): Call rmail-start-mail for new frame + even if just one window. + (rmail-start-mail): Return what mail-other-frame returned. + + * mouse.el (mouse-set-font): Update faces bold, italic and bold-italic. + + * completion.el (complete): Use sit-for, not cmpl19-sit-for. + + * simple.el (completion-list-mode): Renamed from completion-mode. + (completion-list-mode-map): Likewise. + + * files.el (parse-colon-path): Really make nil, not ".", + for empty path element. + + Wed Jul 21 00:07:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * autoload.el (generate-file-autoloads): Bind float-output-format. + Bind print-escape-newlines. + + * inc-vers.el: Try deleting version.el if it's not writable. + + * term/lk201.el: Explicitly define kp-f1... + + * tar-mode.el (tar-parse-info, tar-header-offset, tar-superior-buffer) + (tar-superior-descriptor): Make them permanent locals. + (tar-mode): Call kill-all-local-variables. + Locally set enable-local-variables to nil. + + * man.el (Man-set-fonts): Don't look for another char after + the backspace; instead look for a sequence CHAR BS CHAR BS CHAR BS... + Delete all the CHAR BS pairs found, after making the text property. + + * c-mode.el (indent-c-exp): If ENDPOS, always set OPOINT + to the function start. And don't indent a line which is past ENDPOS. + Don't indent a comment on the first line if it's the only + thing on that line. + Call calculate-c-indent-within-comment when appropriate. + + * mouse.el (mouse-drag-region): Use deactivate-mark. + + * font-lock.el (perl-font-lock-keywords): Add a `(... . 1)' to the + first element of the list. + (font-lock-hack-keywords, font-lock-unfontify-region) + (font-lock-fontify-region): Bind buffer-read-only to nil, + and don't alter buffer-modified-p. + (font-lock-fontify-region): Use comment-start-skip, not comment-start. + + Tue Jul 20 00:34:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * buff-menu.el (Buffer-menu-mode-map): Bind delete like DEL. + + * files.el (parse-colon-path): Turn empty substring into nil. + + * sendmail.el (mail-bury): Check that frame-parameters is defined. + + * font-lock.el (font-lock-function-name-face): defvar renamed. + (font-lock-hack-keywords): Evaluate face specs from keyword list. + + * dunnet.el: New version from Schnell, to fix possible bad patch run. + + * subr.el (define-key-after): Fix typo in previous change. + + * outline.el (outline-mode-map): Delete spurious `outline-' + from show and hide command names in menu. + + * ange-ftp.el (file-name-handler-alist): Have two separate regexps + with different hooks. + * files.el (ange-ftp-completion-hook-function): New function. + + * paren.el (show-paren-face): New variable. + (show-paren-command-hook): Use it. + Call set-face-background properly. + + * reposition.el (reposition-window): Don't forward-char if eobp. + + * startup.el (normal-top-level): Call abbreviate-file-name again + after calling command-line. + + * rmailedit.el (rmail-edit-map): Inherit properly from text-mode-map; + use the whole thing, not its cdr. + + * man.el (Man-getpage-in-background): Copy process-environment + so we only alter the copy. + + * mh-e.el (mh-read-msg-list): Add space to message-number regexp. + + Mon Jul 19 19:27:01 1993 Paul Eggert (eggert@twinsun.com) + + * vc-hooks.el (vc-rcs-status): Use "-", not " ", to separate locks, + so that the RCS minor mode label doesn't contain internal spaces. + + Mon Jul 19 14:56:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * dired.el (dired-unmark-all-files-no-query): New command. + (dired-mode-map): Use that for the Unmark All item. + Fix typo that made the Flag Backup Files item not show up. + + * mlconvert.el (while): Comment out converter. + + * calendar.el (hebrew-holidays): Split into 4 sub-variables. + + Mon Jul 19 16:06:31 1993 Masanobu UMEDA (umerin at orchid) + + * gnus.el (gnus-emacs-version): New variable. + (gnus-version): Updated to 4.1. + (gnus-newsrc-to-gnus-format): Use different regexp in 18 and 19. + (gnus-group-startup-message): Use gnus-emacs-version. + + * gnuspost.el (gnus-current-time-zone): Fix typo. + (gnus-inews-organization): Fix zero length string operation bug. + + * metamail.el (metamail-environment): Format changed. It + must be a list of strings that have the format ENVVARNAME=VALUE. + (metamail-region): Corresponding changes. + + * metamail.el (metamail-region): Optional 2nd argument NODISPLAY + controls redisplay behavior. + (metamail-buffer): LIkewise. + + Mon Jul 19 01:44:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * menu-bar.el (mouse-menu-bar-buffers): Add Frames pane if there + are multiple panes. + + Sun Jul 18 21:05:05 1993 Paul Eggert (eggert@twinsun.com) + + * vc-hooks.el (vc-rcs-status): Omit "LOCKER:" if you are the locker. + + Sun Jul 18 16:41:08 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * vc.el (vc-comment-to-change-log): Complete rewrite. Do not use + vc-update-change-log. Instead, snarf last comment from + vc-comment-ring and insert it with add-change-log-entry. + + * add-log.el (prompt-for-change-log-name): Autoload this (for + vc-comment-to-change-log). + (add-change-log-entry): Take optional fourth arg NEW-ENTRY. If + non-nil, never append to an existing entry. + (change-log-fill-paragraph): New function. + It might be nice to have a general feature to replace this. The + idea I have is a variable giving a regexp matching text which + should not be moved from bol by filling. change-log-mode would + set this to "^\\s *\\s(". But I don't feel up to implementing + that today. + (change-log-mode-map): New defvar for keymap. Bind M-q to + change-log-fill-paragraph in it. + (change-log-mode): Use that as local map. + + * add-log.el (add-log-current-defun-function): New defvar. + (add-change-log-entry): Call its value if non-nil instead of + add-log-current-defun. + (add-change-log-entry-other-window): Doc fix. + + * compile.el (compilation-error-list): An elt's cdr's car is again + a cons (DIRECTORY . FILE) if it's not a marker. The conversion to + using a string containing an expanded file name was never + finished, and anyway it utterly broke compilation-search-path and + a few other things. + (next-error): Expect them that way. + (compilation-parse-errors): Make them that way. + (compile-file-of-error): Function removed. + (compilation-error-filedata, compilation-error-filedata-file-name): New + defsubsts. + (compilation-next-file): Use them instead of compile-file-of-error. + + Sun Jul 18 16:01:03 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * autoload.el (update-file-autoloads): + Go to the beginning of FILE before searching it + for generate-autoload-cookie. + + * cookie1.el (cookie, cookie-insert, cookie-snarf, shuffle-vector): + Autoload these. + + Sun Jul 18 02:38:03 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * Version 19.17 released. + + * makeinfo.el: Don't (require 'texinfmt) - that file doesn't exist + any more; all its functions have been moved into other files. + + * files.el (insert-directory): Doc fix. + + * files.el (insert-directory): If FULL-DIRECTORY-P is non-nil, + add "." component to the end of the path, so that if file is a + symlink, we get the contents of the directory, not the symlink + itself. + + Sat Jul 17 13:25:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * tar-mode.el (tar-extract): Use view-exit-action to kill viewed buf. + + * view.el: Doc fixes; some args renamed. + + * gnus.el (gnus-info-nodes): Update node names. + + * makeinfo.el (makeinfo-options): Fix option syntax in initial value. + + * texinfo.el (texinfo-mode): Undo changes mistakenly added with + previous batch: texinfo-{start,end}-of-header are now tex-... + + Sat Jul 17 18:13:11 1993 Johan Vromans (jv@mh.nl) + + * forms.el: New version 2.0. + Redesigned and rewritten to use Emacs 19 text properties. + Requires Emacs 19.16 or later. + + Sat Jul 17 01:58:36 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * term/x-win.el: Include (invocation-name) in the error messages + which might occur during startup. + + * shell.el (shell-process-pushd): Fix syntax error in + condition-case. + + Fri Jul 16 20:16:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * menu-bar.el (revert-buffer): Make menu-enable form more accurate + using revert-buffer-function and verify-visited-file-modtime. + (menu-bar-help-menu): Put back under global-map. + (menu-bar-final-items): Set it. + + * mh-e.el (mh-yank-hooks): Use (mark t). + (mh-new-draft-name): Likewise. + + Fri Jul 16 16:30:18 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * comint.el (comint-{next,prev}-prompt, comint-send-eof): New defuns. + (comint-mode-map): Bind C-c C-n, C-c C-p, and C-c C-d to those. + Bind C-c C-y to comint-previous-input, for compatibility with v18 + shell.el. + + Fri Jul 16 15:53:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * advice.el (ad-start-advice-on-load): Initialize to t. + + Fri Jul 16 04:45:14 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * term/x-win.el: Make the `-rn NAME' option specify a resource + name, as documented, and not a resource database string. Make + `-name NAME' act like `-rn NAME' and also set the name of the + initial frame. + (command-switch-alist): Process the `-rn' and `-name' options + using the x-handle-name-rn-switch function. + (x-handle-name-rn-switch): New function, which sets the + x-resource-name variable. + (opening connection): Make sure x-resource-name is valid. If it's + not a string, set it to (invocation-name), with any periods or + asterisks changed to hyphens. + + * term/x-win.el: Make the `-xrm STRING' option specify a resource + database string. `-rn' used to behave this way. + (command-switch-alist): Process the `-xrm' switch using + x-handle-xrm-switch. + (x-handle-xrm-switch): Renamed from x-handle-rn-switch; this + function does the right thing for `-xrm', not for `-rn'. + + Fri Jul 16 00:11:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * sendmail.el (mail-bury): If selected frame is dedicated, + and there are other visible frames, delete this frame. + + * rmail.el (rmail-mail-new-frame): New variable. + (rmail-start-mail): New function. + (rmail-mail, rmail-continue, rmail-reply, rmail-forward) + (rmail-retry-failure): Use rmail-start-mail. + + Thu Jul 15 01:29:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * faces.el (face-equal): Don't mess with face-background-pixmap. + + * ispell.el (ispell-menu-map): Add missing quote in defalias. + (ispell-window-configuration): Initialize to nil. + + * vc-hooks.el (vc-rcs-status): Make work buffer's name start w/ space. + + * simple.el (completion-setup-function): Insert the mouse help message + only if non-nil `window-system'. + + * paren.el: Enable the hook only if window-system. + Clear blink-paren-function at the same time. + (show-paren-command-hook): If after a closeparen, + highlight that closeparen as well as matching open. + Use a different color for a mismatch, if color screen. + + Thu Jul 15 01:07:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * assoc.el (asort): First argument should be named alist-symbol, + not assoc-symbol. + + Wed Jul 14 23:52:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * server.el (server-done): Let save-buffer make the backup, + so that make-backup-files remains effective. + + * loaddefs.el: Delete C-x a C-h binding. + + * menu-bar.el (help-menu-bar-map): Put the Help item in this map. + + Wed Jul 14 23:46:02 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * isearch.el (isearch-edit-string): Bind isearch-nonincremental to + its own value, not to nil. + + Wed Jul 14 23:35:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * hippie-exp.el: Renamed from hippie.el. + + Wed Jul 14 23:08:17 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * compile.el (compilation-parse-errors): After skipping two lines, + move one char back so point is before the newline. + + Wed Jul 14 21:55:13 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * gud.el (gud-debugger-startup): Replaced with gud-massage-args. + (gud-{gdb,sdb,xdb}-debugger-startup): Replaced with gud-*-massage-args. + (gdb, sdb, xdb): Argument is command line, not args for it. Remove + debugger name from prompt and put it in the default input instead. + Overload gud-massage-args instead of gud-debugger-startup. + (gud-chop-words): New function; subr for gud-common-init. + (gud-common-init): Argument is command line, not args for it. + Rewritten to use gud-chop-words instead of temp buffer and kludge + involving read. Find the program name as the first word of the + command line. Use make-comint and gud-massage-args in place of + gud-debugger-startup. + Expand the file name before passing it to gud-massage-args. + + Wed Jul 14 19:38:00 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * spook.el (snarf-spooks): Restore function. + + * cookie1.el (cookie-cache): New defvar. + (cookie-snarf): Cache cookies in cookie-cache, not in obarray (idiot). + Also store the modtime and punt the cache when it changes. + + Wed Jul 14 19:14:37 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + Changes from Anders Holst, to bring hippie-expand up to version 1.2: + * hippie-exp.el (hippie-expand-max-buffers): New variable. + (try-expand-line-all-buffers, try-expand-list-all-buffers, + try-expand-dabbrev-all-buffers): Use it. + (try-expand-list, try-expand-list-all-buffers): New functions. + (he-string-beg, he-string-end, he-search-loc): These values are + now markers, not integers. Uses changed. + (he-reset-string, he-substitute-string): Use a marker to preserve + the old position of point. + (try-expand-all-abbrevs): handle case the same way as the + usual expand-abbrev (which is not a very good way, but for + consistency...). + (he-dabbrev-beg): Use `skip-syntax' instead of `skip-chars', to + adjust its behavior to different modes. + (hippie-expand): Don't messages which try function it is using, + when the expansion itself is done in the minibuffer (it was very + annoying to have the message obscuring the expansion). + (try-complete-file-name, try-complete-file-name-partially, + try-complete-lisp-symbol, try-complete-lisp-symbol-partially, + try-expand-line, try-expand-line-all-buffers, + try-expand-all-abbrevs, try-expand-dabbrev, + try-expand-dabbrev-all-buffers): No unnecessary "resetting" of the + epansion, when no expansion is done (caused the buffer to be + marked as changed, although nothing was done, among other things). + (he-reset-string): Undoing of last expansion at a later occasion, now + undoes correctly (before, it garbled things up). + (make-hippie-expand-function): now uses "(function ...)" + instead of "'" (matters for compilation). + (try-expand-line, try-expand-line-all-buffers, + he-line-search-regexp): uses `comint-prompt-regexp' instead of + `shell-prompt-pattern', to strip off prompt in process buffers. + + Wed Jul 14 16:56:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * autoload.el (generate-file-autoloads): + Fix FILE truename hacking to substring + SOURCE-TRUENAME instead of FILE. + + Tue Jul 13 01:51:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * faces.el (copy-face): New arg NEW-FRAME. + (list-faces-display): New command. + + * simple.el (completion-mode): New major mode. + (completion-setup-function): New function. + Add it to completion-setup-hook. + + * mouse.el (mouse-choose-completion): New function. + + * dunnet.el: Many functions and variables renamed. + + * sendmail.el (mail-bury): New function. + (mail-send-and-exit): Call mail-bury. + (mail-dont-send): New command, with menu bar binding. + + * compare-w.el (compare-windows-skip-whitespace): New function. + (compare-windows): Use that. + (compare-windows-whitespace): Value is now regexp. + + * rmail.el (rmail-insert-inbox-text): If inbox is not in the + spool dir, try copying before renaming. + + Tue Jul 13 00:38:53 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * shell.el (shell-prompt-pattern): Don't match more than one line. + Doc fix. + + * bytecomp.el (byte-compile-from-buffer): Bind float-output-format + to "%.20e", not "%20e"; the latter is always ignored, since it + doesn't have a decimal point after the percent sign. + + Mon Jul 12 23:17:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * autoload.el (generate-file-autoloads): Correctly detect when the + buffer receiving the autoload forms is in a parent of or the same + directory as FILE, even in the presence of symlinks. + + Mon Jul 12 23:57:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * subr.el (define-key-after): Error if KEY has two elements. + + * dired.el (dired-mode-map): Add menu bar items. + + Mon Jul 12 23:17:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * autoload.el (generate-file-autoloads): Correctly detect when the + buffer receiving the autoload forms is in a parent of or the same + directory as FILE. + + Mon Jul 12 16:44:47 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) + + * ange-ftp.el: Install the correct regexp in + file-name-handler-alist. + + * term/x-win.el: Recognize affirmative values for reverseVideo + properly. Include "on" in the list of recognized values. + + Mon Jul 12 15:11:55 1993 Paul Eggert (eggert@twinsun.com) + + * vc-hooks.el (vc-rcs-status): Include head version number + in mode line if there are no locks. + + Mon Jul 12 14:36:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * menu-bar.el (menu-bar-file-menu): Add menu item for dired. + + * menu-bar.el (ispell-menu-map): New autoload definition. + (menu-bar-edit-menu): Add "Spell" item. + * ispell.el (ispell-menu-map): New keymap--both fn and var. + + * loaddefs.el (mode-line-buffer-identification): Doc fix. + + Sat Jul 10 23:28:50 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * calendar.el (calendar-holidays): Don't autoload this; its value + must be set after the user's .emacs file is loaded. + + Sat Jul 10 01:15:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * paren.el (show-paren-command-hook): Do nothing if not window-system. + + Fri Jul 9 00:04:12 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmailout.el (rmail-output): If file is an Rmail file, + use rmail-output-to-rmail-file. + (rmail-output-to-rmail-file): If file exists + and is not an Rmail file, use rmail-output. + If we find an element in rmail-output-file-alist, eval it. + (rmail-file-p): New function. + (rmail-output-file-alist): Now contains expressions to eval. + + * font-lock.el: New file. + + * bytecomp.el (byte-compile-setq-default): + Generate a progn of calls to set-default, then compile it. + + * menu-bar.el (mouse-menu-bar-buffers): + Don't lose if all buffer names are short. + + * dunnet.el: New file. + + Thu Jul 8 19:31:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * loaddefs.el (global-map): Bind M-next to scroll-other-window. + + * compile.el (compilation-error-regexp-alist): + Broaden ``Line N of "FILE": msg'' regexp + to also match Ultrix f77: ``Error on line N of FILE: msg''. + + Thu Jul 8 18:42:14 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * Make everything that deactivates the mark do it consistently. + * simple.el (deactivate-mark): New function. + (kill-ring-save, pop-mark, keyboard-quit): Call it. + * ispell.el (ispell): + Call deactivate-mark instead of setting mark-active directly. Do + this regardless of transient-mark-mode. + * isearch.el (isearch-done): + Call deactivate-mark instead of setting mark-active + directly. Do this regardless of transient-mark-mode. + + Thu Jul 8 20:51:51 1993 Richard Stallman (rms@churchy.gnu.ai.mit.edu) + + * files.el (basic-save-buffer): Use after-save-hook. + + Thu Jul 8 17:46:22 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * simple.el: Put error-conditions and error-message properties on + 'mark-inactive. + (mark): Signal 'mark-inactive instead of using error with a message. + + Thu Jul 8 17:14:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * mailabbrev.el (mail-abbrev-end-of-buffer): Fix interactive spec + to "P", same as end-of-buffer. + + Thu Jul 8 15:06:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * hanoi.el: Add (provide 'hanoi). + + Wed Jul 7 18:19:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * files.el (file-relative-name): If we use default-directory, + call expand-file-name anyway. + + * texnfo-upd.el (texinfo-update-node): Bind auto-fill-hook + as well as auto-fill-function. + (texinfo-sequential-node-update): Likewise. + + Wed Jul 7 09:25:37 1993 Robert J. Chassell (bob at grackle) + + * texnfo-upd.el: Fix typo re `texinfo-sequential-node-update.' + Ensure that no commands depend on the value of + case-fold-search. + Rewrite messages. Avoid using `mark-whole-buffer'. + + (texinfo-start-menu-description): + New function to insert title as description in a menu. + (texinfo-make-menu-list): Remove automatic title insertion. + (texinfo-master-menu): Error message if file + contains too few nodes for a master menu. + Handle the case where no master menu was inserted. + (texinfo-insert-master-menu-list): Only attempt to insert detailed + master menu if there is one. + Insert a master menu only after `Top' node and before next node. + + (texinfo-check-for-node-name): Offer section title as prompt. + (texinfo-copy-next-section-title): Copy title correctly. + Handle failure to find @node. + (texinfo-copy-menu): Error message if menu empty. + (texinfo-pointer-name): Find only those + section commands that are accompanied by `@node' lines. + (texinfo-section-types-regexp): Look for subh and subs, not just sub. + (texinfo-make-one-menu): Copy node-name correctly for message. + (texinfo-copy-menu-title): Copy title as it + should rather than node line. + + (texinfo-find-higher-level-node): Stop search at limit. + Special handling for `top' and `chapter' levels. + (texinfo-copy-menu-title): Rewrite to handle outer include files. + (texinfo-multi-file-update): Update all nodes properly (and sooner); + rewrite doc string and interactive. Copy title properly. + (texinfo-all-menus-update): Fixed typo that + caused the function to create a master menu when it shouldn't. + Update pre-existing master menu, if there is one. + + (texinfo-incorporate-descriptions): Use a regexp search to look for + both kinds of menu item. + (texinfo-menu-indent-description): Likewise. + (texinfo-incorporate-menu-entry-names): New function. + (texinfo-insert-menu): Handle both kinds of menu item. + (texinfo-multi-files-insert-main-menu): Likewise. + (texinfo-update-node): Pass t as second arg to push-mark. + (texinfo-sequential-node-update): Likewise. + (texinfo-insert-node-lines): Bind `title' at a higher level. + Don't find previous @node if it's close. + Take region to process as arguments. + (texinfo-multiple-files-update): Handle prefix arg better within + `interactive'. Canonicalize the blank lines. + + Wed Jul 7 16:13:57 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * autoload.el (update-file-autoloads): + Correctly do nothing when there are no cookies. + + Wed Jul 7 15:58:54 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * menu-bar.el (mouse-menu-choose-yank): + Change menu title to "Choose Next Yank". + + Wed Jul 7 03:19:41 1993 Paul Eggert (eggert@twinsun.com) + + * vc-hooks.el (vc-rcs-status): Removed unused variable `status'. + + * rmail.el (rmail-resend): Use RFC 822 style date in Resent-Date: line. + * sendmail.el (mail-do-fcc): Likewise, for appending Date: lines to + RMAIL mode buffers. Use new `mail-rfc822-time-zone' function + to simplify pinhead generation. + * mail-utils.el (mail-rfc822-time-zone, mail-rfc822-date): New fns. + + Wed Jul 7 02:26:31 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * files.el (cd-absolute): Use abbreviate-file-name on expansion of DIR. + + * gud.el: Add (provide 'gud). + + * files.el (basic-save-buffer): + Invoke after-save-hook, not after-save-hooks. + + * time.el (display-time-file-nonempty-p): Use file-chase-links. + + * bytecomp.el (byte-compile-setq-default): Handle multiple pairs + args like setq (as the setq-default subr does). + + * autoload.el: Doc fix. + + Tue Jul 6 18:07:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmail.el (rmail-variables): Compare truename as well as given name + against rmail-file-name. + + * man.el (Man-mode-line-format): Add a space after global-mode-string. + + Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * Version 19.16 released. + + Tue Jul 6 01:21:37 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * vc.el (vc-start-entry): Don't call file-name-nondirectory on + FILE before passing it to vc-mode-line. Everyplace else passes + vc-mode-line full filenames, and vc-mode-line now needs the real + file name to decide which version-control system the file is under. + + * man.el (Man-build-man-command): Don't leave a pipe symbol at the + end of the command list if Man-filter-list is nil. + (Man-default-man-args): Don't write out assq and mapconcat. + (Man-default-man-entry): Don't default to section 2 for C-mode. + Call Man-default-man-args, and let people use + Man-auto-section-alist if this is what they want. + (manual-entry): Call Man-translate-references, instead of writing + it out. + (Man-getpage-in-background): Don't apply Man-default-man-args + here; manual-entry has already run it, and + Man-follow-manual-reference provides the sections itself. + + Mon Jul 5 00:43:20 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * map-ynp.el (map-y-or-n-p): If we get a switch-frame-event, + save it until we're done asking questions, and then unread it. + + Mon Jul 5 03:20:12 1993 Paul Eggert (eggert@twinsun.com) + + * vc.el (vc-name): Move to vc-hooks.el. + * vc-hooks.el (vc-name): Moved from vc.el; vc-rcs-status now uses it. + (vc-name, vc-backend-deduce): Set both vc-name and vc-backend + properties, to avoid calling vc-registered unnecessarily when + the other property is needed. + (vc-rcs-status): Yield only status of locks; do not try to yield " REV" + if there are no locks, since this cannot be done easily if there are + branches. Use vc-name instead of duplicating its function incorrectly. + Fix off-by-one bug when inserting master header pieces. Read headers + 8192 bytes at a time instead of 100. Don't bother to expand-file-name. + (vc-rcs-glean-field): Removed. + + Sun Jul 4 17:29:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * outline.el (outline-mode-map): Add menu bar items. + (outline-minor-mode-map): Copy menu bar submap from outline-mode-map. + + * help.el (describe-key-briefly): Don't set `foo'. + + Sun Jul 4 17:01:01 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * subr.el (posn-point): Properly extract the BUFFER-POSITION field + of an event when read-key-sequence has placed it in a singleton + list. + + * comint.el (comint-prompt-regexp): Double the backslashes in the + sample prompt regexps, so that they print properly when unquoted. + + Sun Jul 4 18:54:59 1993 Paul Eggert (eggert@twinsun.com) + + * vc.el (vc-backend-diff): Undo "-q" change. This was fixed + instead by adding -q support to vcdiff. + + Sun Jul 4 13:55:13 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * help.el (describe-prefix-bindings): New command. + (prefix-help-command): Set it. + + * hexl.el: Added a keyword. + + Sun Jul 4 12:46:27 1993 Johan Vromans (jv@mh.nl) + + * forms.el (forms-new-record-filter): Correct default value. + (forms-modified-record-filter): Correct default value. + + Sun Jul 4 00:53:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * paren.el (show-paren-command-hook): Add message for paren mismatch. + + * vc-hooks.el (vc-mode-line): Put `RCS' or `SCCS' before version num. + + Sat Jul 3 21:44:54 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * faces.el (make-face-bold, make-face-italic, + make-face-bold-italic, make-face-unbold, make-face-unitalic): + Properly pass noerror argument to recursive calls. + + * frame.el (frame-remove-geometry-params): New function. + (frame-initialize): Call it, instead of writing it out. + + Sat Jul 3 15:03:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * simple.el (kill-region): Cope with change hooks that change props. + + Sat Jul 3 06:15:43 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * term/x-win.el: Check the reverseVideo/ReverseVideo resource, + correctly distinguish between "on" and "off" values, and put a + parameter in default-frame-alist. + * frame.el (frame-initialize): Don't call x-get-resource here. + + Sat Jul 3 03:22:04 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * autoload.el (update-file-autoloads): + Do nothing when there are no cookies. + + Fri Jul 2 18:55:23 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * mouse.el (mouse-drag-region): Correctly handle drags which enter + other frames. + + Fri Jul 2 17:28:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * vc.el (vc-path): New variable. + (vc-do-command): Use vc-path. + + * menu-bar.el (menu-bar-edit-menu): Rename menu item to + Choose Next Paste. Create this item along with all the others. + + * isearch.el (isearch-other-meta-char): Handle sequences + containing mouse clicks in scroll-bar that used another buffer's map. + + Fri Jul 2 16:06:38 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * vc.el (vc-backend-diff): Pass the "-q" flag only if we're using + rcsdiff. + + Fri Jul 2 14:31:59 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * menu-bar.el: Put mouse-menu-choose-yank binding after + paste=>yank binding in menu-bar-edit-menu. + + Fri Jul 2 13:32:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * bytecomp.el (byte-compile-keep-pending): Handle fset like defalias. + (byte-compile-file-form-defmumble): Fix backward if in prev change. + + Thu Jul 1 20:14:44 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * dired-aux.el (dired-diff): Work even when the mark is inactive. + + Thu Jul 1 18:10:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * sendmail.el (mail-send): Don't test buffer-modified-p + if buffer is visiting a file. + + * bytecomp.el (byte-compile-file-form-defmumble): + If byte-compile-compatibility, use fset, not defalias. + + Thu Jul 1 16:33:01 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) + + * simple.el: Add bindings to function-key-map so that the keypad + keys act like ordinary self-insertion keys, unless explicitly bound. + + Thu Jul 1 14:39:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * mailabbrev.el (build-mail-abbrevs): Do substitute-in-file-name + on the abbrev, for `source'. + + * files.el (set-visited-file-name): Rename the old auto save file. + + Thu Jun 30 23:31:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * menu-bar.el (mouse-menu-choose-yank): + Just return when x-popup-menu returns nil. + Add menu-enable property to this function. + + Wed Jun 30 17:50:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * compile.el (compile-abbreviate-directory): New function. + (compilation-parse-errors): Use that, to visit files with a dirname + more like the one the user specified. + + Wed Jun 30 15:38:53 1993 Johan Vromans (jv@mh.nl) + + * forms.el: Add e-mail address and version info. + Adjust commentary and doc strings. + (forms-mode): Add ###autoload. + (forms-find-file): Add ###autoload. + (forms-find-file-other-window): Add ###autoload. + + Wed Jun 30 21:35:59 1993 Paul Eggert (eggert@twinsun.com) + + * vc.el (vc-update-change-log): Ensure that file names inserted + into a ChangeLog are relative to that ChangeLog. + + Wed Jun 30 12:43:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * simple.el (mark-even-if-inactive): New variable. + (mark): Test it. + + * rmail.el: Doc fixes. + + Wed Jun 30 00:29:08 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * gud.el: Add history lists to the debugging commands, so we don't + have to retype the filename every invocation. + (gud-gdb-history, gud-sdb-history, gud-dbx-history, + gud-xdb-history): New variables. + (gdb, sdb, dbx, xdb): Use them when reading the argument string. + + * mouse.el (mouse-drag-region-1): Commented out. + (mouse-drag-region): Commented out, and replaced with new version, + which highlights the region as we drag. + (mouse-scroll-delay, mouse-drag-overlay): New variables. + (mouse-scroll-subr): New function. + + * sun-fns.el, sun-curs.el: Move these to lisp/term, to be with + sun-mouse.el. + + Tue Jun 29 19:00:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * faces.el (global-face-data): Doc fix. + + * gnus.el (gnus-newsrc-to-gnus-format): Correct regexp which + matches .newsrc lines not to match more than one line. + + Tue Jun 29 13:05:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * ls-lisp.el (insert-directory): Doc fix. + (ls-lisp-format): Provide user name when known. + On ms-dos, provide a name for the group, to be prettier. + + Mon Jun 28 00:47:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * subr.el (define-key-after): Delete duplicate bindings that come + after the new one. Do insert when we reach the end, if haven't before. + + * paren.el: New file. + + * faces.el (face-initialize): Create `underline' face. + (x-initialize-frame-faces): Set up `underline' face. + + * faces.el (x-initialize-frame-faces): Check x-display-color-p + and x-display-planes to decide whether to try using colors or gray. + + * man.el (Man-auto-section-alist): Default value nil. + (Man-getpage-in-background): Call Man-default-man-args. + (Man-filter-list): Don't discard overstrike here. + (Man-set-fonts): New function. + (Man-bgproc-sentinel): Call Man-set-fonts. + (Man-version-number): Var deleted. + (Man-version): Command and binding deleted. + (Man-mode): Use Manual, not Man, as official mode name. + + * solar.el: Doc fixes. + + * c-mode.el (c-forward-conditional): New function. + (c-up-conditional): Use c-forward-conditional. + (c-backward-conditional): New function. + (c-mode-map): Make bindings for them. + + Sun Jun 27 20:56:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * vc.el (vc-update-change-log): Restore previous default-directory + for running rcs2log. + + Sat Jun 26 00:18:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * subr.el (define-key-after): New function. + + Fri Jun 25 13:58:52 1993 Barry A. Warsaw (warsaw@anthem.nlm.nih.gov) + + * reporter.el (reporter-submit-bug-report): Rename local var curbuf + to reporter-eval-buffer. + (reporter-dump-variable): Eval varsym in reporter-eval-buffer. + + * c++-mode.el (c++-fast-backward-syntactic-ws-2) + (c++-fast-backward-syntactic-ws-1): Change the proper syntax table + depending on whether we are editing C or C++ code. + + * c++-mode.el (c++-indent-exp): When computing offset for open-brace + line, check not at class top level before adding c-indent-level. + Fix bug handling member init lists. + Fix case where comments follow a continued statement. + Fix handling of c-brace-offset < 0. + + * c++-mode.el (c++-calculate-indent): + Fixed indentation when base class declaration is on a separate line + then the derived class intro header. + Don't skip up past compound statement if we're in a member init list. + + * c++-mode.el (c++-indent-line): Clean up adjustment + of block closing braces. Handle a list as value of + c++-block-close-brace-offset. + + * c++-mode.el (c++-indent-exp): Use c-continued-statement-offset + instead of c-indent-level to indent comma separated arg decl lists. + + * c++-mode.el (c++-fast-backward-syntactic-ws-2): Simplify for + new forward-comment semantics. + + * c++-mode.el (c++-calculate-indent): Change if's to cond in CASE3. + Require colon when looking for `case' or `default'. + Use c++-compound-offset. + (c++-compound-offset): New function. + Distinguish statement continuation from enum and initializer lists. + + Fri Jun 25 18:30:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * vc-hooks.el (vc-rcs-status): New variable. + (vc-mode-line): Display the lock status and head version. + (vc-rcs-status, vc-rcs-glean-field): New function. + + * menu-bar.el (mouse-menu-bar-buffers): Include % and * in each item. + Calculate amount of space needed for longest buffer name. + * mouse.el (mouse-buffer-menu): Likewise. + + Fri Jun 25 18:01:47 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * add-log.el (find-change-log): Try get-file-buffer before + file-exists-p. + + Fri Jun 25 17:30:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * vc.el (vc-diff): If `diff' gives empty output, return nil. + + Wed Jun 23 21:45:19 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * ange-ftp.el: Loosen file-name-handler-alist regexp so we can do + host name completion. + + * hexl.el (hexl-in-save-buffer): New flag. + (hexl-save-buffer): Prevent infinite recursion. + + Tue Jun 22 04:11:33 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * term/x-win.el (command-switch-alist): "-ib" takes a numeric + argument; use x-handle-numeric-switch for it. + + * replace.el (query-replace-map): Fix typo in binding for [return]. + + Tue Jun 22 00:23:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmailsort.el: Don't touch rmail-summary-mode-map. + Don't touch rmail-mode-map. Don't require rmail or sort. + (rmail-summary-sort-...): Moved to rmailsum.el. + (rmail-sort-from-summary): Likewise. + + * rmail.el: Add autoloads for rmailsort commands. + (rmail-mode-map): Add bindings for those commands. + + * rmailsum.el (rmail-summary-mode-map): Bind summary sort commands. + (rmail-summary-sort-...): Moved from rmailsort.el. + (rmail-sort-from-summary): Likewise. Require rmailsort. + + Mon Jun 21 22:01:23 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * compile.el (compile-file-of-error): Remember that + compilation-error-list stores file names as strings, not as (DIR . + FILE) pairs. + + * diff.el (diff-parse-differences): Preserve the match data + across the call to find-file-noselect. + + * subr.el (event-end): Modified to account for multi-click events. + + Mon Jun 21 01:53:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmail.el (rmail-mode-map): Add local menu bar bindings. + (rmail-search-backward): New command. + (rmail-mode): Move to the last message. + + * rmailsum.el (rmail-summary-mode-map): Add local menu bar bindings. + (rmail-summary-search-backward): New command. + (rmail-summary-search): Don't use save-excursion. + + * sendmail.el (mail-mode-map): Add local menu bar bindings. + + * texinfo.el: Set up autoloads for files `makeinfo' and `texnfo-upd'. + (texinfo-delete-from-print-queue-command): New var. + (texinfo-tex-trailer): New var. + (texinfo-tex-region): Use that. + (texinfo-tex-buffer): Rewritten; use the actual source file. + Binding is now C-c C-t C-b. + (texinfo-texindex): Turned back on. + (texinfo-quit-job): New command, with binding. + (texinfo-delete-from-print-queue): Likewise. + (texinfo-show-structure): Indent each line according to depth. + Require texnfo-upd. + (texinfo-section-types-regexp): Var deleted. + (texinfo-insert-@-with-arg): New function. + (texinfo-insert-@var, etc.): Use that. + (texinfo-insert-@end): New command, now on C-c C-c e. + (texinfo-insert-@end-example): Deleted. + (texinfo-insert-@table): New command, on C-c C-c t. + (texinfo-start-menu-description): New command, on C-c C-c C-d. + (texinfo-mode): No longer set tex-trailer. + Make the @node for the top node start a page. + Use shorter values for tex-end-of-header and tex-start-of-header. + (texinfo-mode-map): Add bindings for makeinfo-buffer, etc. + Delete bindings for texinfo-format-buffer/region. + (texinfo-define-common-keys): New function. + + * texinfmt.el: File deleted. + + * makeinfo.el: New file. + + * metamail.el: New file. + + * time-stamp.el: New file. + + Sun Jun 20 20:44:36 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * add-log.el (add-log-current-defun): To find the name of the + function being defined in emacs-lisp-mode, lisp-mode, and + scheme-mode, skip an opening paren and an s-expression, instead of + just one word. This allows us to properly recognize things like + define-key and define-macro. + + * replace.el (query-replace-map): Make RET exit query-replace, + just like ESC. + + Sun Jun 20 18:44:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * mh-e.el (mh-yank-cur-msg): Test mark-active. + + Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * version 19.15 released. + + Sat Jun 19 17:47:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * info.el (Info-insert-dir): Remove the call to recursive-edit. + + Sat Jun 19 15:05:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * info.el (Info-insert-dir): Record file attributes of files used. + Recompute the dir if they change. + + * files.el (insert-file): Report error if file is directory. + + Fri Jun 18 21:43:43 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * man.el (Man-switches): New variable. + (Man-build-man-command): Use it to build the man command. + (Man-mode): Mention it in documentation. + + Fri Jun 18 21:13:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmailout.el (rmail-output): Check file can be read before trying + to read part of it. + + * ange-ftp.el (ange-ftp-insert-file-contents): + Handle extra args BEG, END. + + Fri Jun 18 19:25:02 1993 Johan Vromans (jv@mh.nl) + + * forms.el: Delete local variables list. + (forms-forms-scrolls): Deleted. + (forms-forms-jumps): Deleted. + (forms--change-commands): Use substitute-key-definition. + (forms-mode): Call forms--change-commands later on. + + Fri Jun 18 13:55:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * compile.el (compilation-error-regexp-alist): Generalize the + Apollo/BSD4.3 regexp to handle IBM RS6k too. + + * mouse.el (mouse-secondary-save-then-kill): Don't switch windows. + Just set-buffer, and put save-excursion around it. + (mouse-set-secondary, mouse-start-secondary): Likewise. + (mouse-drag-secondary): Switch windows and move point just temporarily. + + Fri Jun 18 13:49:53 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) + + * dired.el (dired-summary): dired-do-rename is on "R", not "r". + + Fri Jun 18 10:14:45 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) + + * calendar.el (calendar-version): Update to 5.1. Fixed a variety + of spelling error in comments and doc strings. + (calendar-sexp-debug): New variable to turn off error catching. + (calendar-absolute-from-gregorian): Removed unused vars month, day. + (view-calendar-holidays-initially, all-hebrew-calendar-holidays, + all-christian-calendar-holidays, all-christian-islamic-holidays, + diary-nonmarking-symbol, hebrew-diary-entry-symbol, + islamic-diary-entry-symbol, diary-include-string, + abbreviated-calendar-year, european-calendar-style, + european-calendar-display-form, american-calendar-display-form, + calendar-date-display-form, print-diary-entries-hook, + list-diary-entries-hook, nongregorian-diary-listing-hook, + nongregorian-diary-marking-hook, diary-list-include-blanks, + holidays-in-diary-buffer, general-holidays, + increment-calendar-month, calendar-sum, calendar-string-spread, + calendar-absolute-from-iso, calendar-print-iso-date, + hebrew-calendar-elapsed-days, list-yahrzeit-dates, + calendar-print-astro-day-number): Fix doc strings. + (calendar-nth-named-day): Rewritten to include optional day of month. + (general-holidays, calendar-holidays, hebrew-holidays, + christian-holidays, islamic-holidays, + solar-holidays): Rewritten to include require of cal-dst.el and to + show the time of the change to/from daylight savings time. + (calendar-current-time-zone, calendar-time-zone, + calendar-daylight-time-offset, calendar-standard-time-zone-name, + calendar-daylight-time-zone-name, calendar-daylight-savings-starts, + calendar-daylight-savings-ends, + calendar-daylight-savings-switchover-time): Moved to cal-dst.el. + (calendar-location-name, calendar-time-display-form, calendar-latitude, + calendar-longitude): Moved to solar.el. + (calendar-holidays): Unquote it! + + * solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed + solar-equinoxes-solstices. + (calendar-time-display-form, calendar-latitude, + calendar-longitude): Moved from calendar.el. + (calendar-time-zone, calendar-standard-time-zone-name, + calendar-daylight-time-zone-name, + calendar-daylight-savings-starts, calendar-daylight-savings-ends): + Take default values from calendar-current-time-zone, instead of + being overwritten in open code if they were set to nil. + (solar-time-string): Subtract calendar-daylight-time-offset when + computing dst-ends. Avoid rounding errors when rounding time to + the nearest minute. + + * diary.el (list-sexp-diary-entries, + hebrew-calendar-year-Saturday-incomplete-Sunday, + hebrew-calendar-year-Monday-incomplete-Tuesday, + hebrew-calendar-year-Tuesday-regular-Thursday, + hebrew-calendar-year-Thursday-complete-Sunday, + hebrew-calendar-year-Saturday-complete-Thursday, + hebrew-calendar-year-Monday-complete-Saturday, + hebrew-calendar-year-Thursday-incomplete-Sunday): Fix doc strings. + (diary-sexp-entry): Use calendar-sexp-debug to turn off error catching. + + * diary-ins.el (insert-cyclic-diary-entry): Fix date form. + + * cal-mayan.el (calendar-mayan-days-before-absolute-zero, + calendar-mayan-haab-difference, calendar-mayan-tzolkin-difference, + calendar-mayan-tzolkin-haab-on-or-before, + calendar-previous-calendar-round-date, + calendar-absolute-from-mayan-long-count, + calendar-print-mayan-date): Fix doc strings. + + * holidays.el (calendar-holiday-function-fixed, + calendar-holiday-function-float, calendar-holiday-function-julian, + calendar-holiday-function-islamic, + calendar-holiday-function-hebrew, calendar-holiday-function-sexp, + calendar-holiday-function-advent, + calendar-holiday-function-easter-etc, + calendar-holiday-function-greek-orthodox-easter, + calendar-holiday-function-rosh-hashanah-etc, + calendar-holiday-function-hanukkah, + calendar-holiday-function-passover-etc, + calendar-holiday-function-tisha-b-av-etc): Renamed without words + "calendar" and "function"; changed argument from a list of values to + individual values. Fixed doc strings. + (calendar-holiday-function-if): Removed. + (calendar-holiday-solar-equinoxes-solstices): Renamed + solar-equinoxes-solstices. + (calendar-holiday-list): Rewrote to accomodate the name changes + above and the unquoting of calendar-holidays. + (calendar-cursor-holidays): Change screen-width to frame-width. + (holiday-sexp): Rewritten. + + * lunar.el (lunar-phase): Use time conversion from solar.el + + * cal-dst.el: New file. + (calendar-/, calendar-%, calendar-absolute-from-time, + calendar-time-from-absolute, calendar-next-time-zone-transition, + calendar-time-zone-daylight-rules): New functions. + (calendar-current-time-zone): Moved from calendar.el and rewritten. + (calendar-current-time-zone-cache): New variable. + (calendar-current-time-zone, calendar-time-zone, + calendar-daylight-time-offset, calendar-standard-time-zone-name, + calendar-daylight-time-zone-name, + calendar-daylight-savings-starts, calendar-daylight-savings-ends, + calendar-daylight-savings-switchover-time): Moved from calendar.el. + + Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * Version 19.14 released. + + Thu Jun 17 19:41:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * sendmail.el (mail-citation-hook): New hook var. + (mail-yank-original): Use that hook if not nil. + + * sc.el: Change usage comment. + + Thu Jun 17 18:57:01 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * faces.el (make-face-bold, make-face-italic, + make-face-bold-italic, make-face-unbold, make-face-unitalic): + Always pass the frame parameter to internal-try-face-font; we only + want to set the face for this frame. + + * faces.el (make-face-bold, make-face-italic, + make-face-bold-italic, make-face-unbold, make-face-unitalic): + Fix error messages. + + Thu Jun 17 00:12:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * faces.el (set-face-background-pixmap, face-background-pixmap): + Functions commented out. + + * mouse.el (mouse-start-secondary): New function. + (mouse-set-secondary, mouse-drag-secondary): New functions. + (mouse-kill-secondary, mouse-secondary-save-then-kill): New functions. + + * term/vt200.el: Translate F11 (ESC [ 23 ~) to ESC. + * term/vt201.el, term/vt220.el, term/vt240.el: Likewise. + + * autoload.el (generate-file-autoloads): Undo previous change + because make-docfile requires defvar doc string to start on first line. + + * cplus-md.el: Renamed from c++-mode.el. + * cplus-md1.el: Renamed from c++-mode-1.el. + + * vc.el (vc-rename-file): Remove periods from error messages. + (vc-backend-logentry-check, vc-revert-buffer): Likewise. + (vc-retrieve-snapshot, vc-create-snapshot): Likewise. + (vc-diff, vc-finish-logentry, vc-steal-lock): Likewise. + (vc-register, vc-next-action-on-file, vc-registration-error): Likewise. + (vc-cancel-version): Add space to end of question. + + * menu-bar.el (mouse-menu-choose-yank): New function. + Put it in the edit menu. + (yank-menu-length): New variable. + + Wed Jun 16 20:16:10 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * subr.el (event-basic-type): Deal with listy events properly. + + Wed Jun 16 23:06:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) + + * autoload.el (make-autoload): Use memq once instead eq twice. + (generate-file-autoloads): For non-autoloads, copy the defn textually + rather than printing it after reading. + + * autoload.el (generate-autoload-cookie, update-autoloads-here): + Doc fixes. + + Wed Jun 16 17:21:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * frame.el (set-frame-configuration): Don't try to set a frame's + minibuffer. This parameter can't be changed, so that would signal + an error. + + Wed Jun 16 13:42:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * assoc.el (aput): Doc fix. + + * ls-lisp.el (insert-directory): If no handler, convert SWITCHES + from a string to a list of characters. + + * disass.el (disassemble-internal): If function is autoload, load it. + + * lisp.el (parens-require-spaces): Var renamed and sense changed. + (insert-parentheses): Corresponding changes. + + * rmailout.el (rmail-output): Use insert-file-contents to look at + beginning of output file. + + * term/x-win.el (x-switch-definitions): Fix -iconic. + + * bytecomp.el (byte-compile-file-form-defmumble): Typo in prev change. + + Tue Jun 15 03:56:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * server.el (server-process-filter): Use server-switch-buffer. + + * gud.el (gud-xdb-directories): Renamed from gud-xdb-paths. + Defvar moved earlier. All uses changed. + (gud-xdb-debugger-startup): Rename local var `paths'. + (gud-xdb-file-name): Likewise. + + * inf-lisp.el (inferior-lisp-buffer): Move defvar earlier. + + * mailalias.el (define-mail-alias): Remove excess whitespace better. + + * mailabbrev.el (define-mail-abbrev): Renamed from define-mail-alias. + (build-mail-abbrevs): Use new name. + + * bytecomp.el (byte-compile-file-form-defmumble): Use defalias + for named function, even if no doc string. + + * dired.el (dired-repeat-over-lines): Going fwd, skip new lines + that FUNCTION inserts after the current line. + Going backwd, no need for dired-move-to-filename each time. + + Tue Jun 15 21:10:22 1993 Shane Hartman (shane@nugget.spr.com) + + * gud.el (xdb): New debugger supported (xdb under HPUX-PARISC). + (gud-xdb-debugger-startup): New function. + (gud-xdb-file-name, gud-xdb-accumulation): New functions. + (gud-xdb-marker-filter, gud-xdb-paths, gud-xdb-find-file): New. + + Mon Jun 14 14:53:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * lisp.el (parens-dont-require-spaces): New variable. + (insert-parentheses): Obey that variable. + + * emerge.el (emerge-make-diff3-list): Pass ancestor second. + (emerge-extract-diffs3): Replace group-1 with group-2. + (emerge-handle-local-variables): Pass no arg to hack-local-variables. + + * picture.el (picture-replace-match): New function. + * dabbrev.el (dabbrev-expand): Do all changes with replace-match. + In picture-mode, use picture-replace-match instead. + + Mon Jun 14 10:57:43 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * holidays.el: Eval calendar-holidays; don't just use its value. + + * complete.el: (provide 'complete). + + Mon Jun 14 03:10:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * window.el (balance-windows): Total rewrite. + + Sun Jun 13 00:33:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * bytecomp.el (byte-compile-file): Undo previous change. + (batch-byte-recompile-directory): Doc fix. + + * isearch.el (isearch-highlight): If no face `isearch', use `region'. + + * c-mode.el (c-indent-line): Call c-backward-to-start-of-if + in the case of else following a close brace. + + * man.el (Man-getpage-in-background): Use TERM=dumb to prevent + terminal control sequences in the output. + + Sat Jun 12 16:58:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * files.el (abbreviate-file-name): Match home dir with no / + if nothing else follows. + + * finder.el (finder-find-library): New function. + (finder-commentary): Use it. + + * forms.el, forms-pass.el, forms-d2.el, forms-dat.el, forms.README: + Moved from subdir forms-mode. Subdir deleted. + + Sat Jun 12 16:03:03 1993 Johan Vromans (jv@mh.nl) + + * forms.el (forms--change-commands): + Use (function (lambda ...)) instead of '(lambda...). + + * forms.el: Provide `forms' as well as `forms-mode'. + (forms-new-record-filter, forms-modified-record-filter): Add defvars. + + Sat Jun 12 02:53:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * files.el (make-directory): By default create dir default-dir. + + Fri Jun 11 11:46:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * vc.el (vc-backend-diff): Always use -q option. + + * files.el (file-truename): Don't use expand-file-name to merge + a link target into the previous dir. Handle .. and . explicitly. + + * env.el (setenv): Treat case as significant. + + * mailabbrev.el (sendmail-pre-abbrev-expand-hook): + If last-command-char is not a character, don't check char-syntax. + + * inf-lisp.el: Doc fixes. + (run-lisp): Add autoload. + (inferior-lisp-mode-map): Explicitly make local prefix keys. + + * cmulisp.el: File deleted. + + * server.el (server-window): New variable. + (server-switch-buffer): Use it. + + * flow-ctrl.el (enable-flow-control): Don't alter the 8-bit flag. + + * man.el (Man-filter-list): Add an element for X man pages. + (Man-goto-page): Continue past errors in Man-build-references-alist. + + * rmailout.el (rmail-output-to-rmail-file): Use the smart default + in the prompt. + + * register.el (view-register): Handle file name values. + + * etags.el (etags-tags-completion-table): When skipping the noise + before the tag name, let it end with any char not allowed in a tag. + + * files.el (cd): Use file-name-absolute-p. + (cd-absolute): No longer interactive. + + * echistory.el (electric-history-map): Don't use fillarray; + make default bindings instead. Bind up, down, home, next, prior. + + Fri Jun 11 05:44:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * frame.el (frame-initialize): Remember to actually traverse + initial-frame-alist. + + * gud.el (gud-last-last-frame): New variable. + (gud-display-frame): Save the frame we displayed in + gud-last-last-frame. + (gud-refresh): Force gud-display-frame to jump to the last frame + displayed, even if it has already done so once. + + * man.el (manual-entry): Recognize the subject(section) syntax. + + * picture.el (move-to-column-force): If column is negative, go + flush left. + + * simple.el (hscroll-point-visible): Work as documented in the + docstring for hscroll-step. + + Fri Jun 11 00:04:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * lisp-mode.el (lisp-indent-function): Look for either + lisp-indent-hook or lisp-indent-function property. + + * files.el (make-backup-files): Doc fix. + + * mouse.el (mouse-set-mark-fast): New function. + (mouse-show-mark): New function. + (mouse-kill-ring-save, mouse-save-then-kill): Use them. + (mouse-save-then-kill): Don't let kill-region alter this-command. + Check last-command accordingly. + (mouse-split-window-vertically): Handle scroll bar events. + + Thu Jun 10 13:41:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * rmail.el (rmail-primary-inbox-list): Use defvar, not defconst. + + * files.el (basic-save-buffer): Cal auto-save-mode with t as arg + if and only if auto save was off and default is on. + (set-visited-file-name): Likewise. + + * simple.el (append-to-buffer): Interactively, supply all 3 args. + Allow nonexistent buffers. + + * files.el (abbreviate-file-name): Make abbreviated-home-dir + from `~/', not from just `~'. + (hack-one-local-variable): Query for ...-hook(s) and ..-function(s) + as the `eval' variable. + + * ispell.el: Doc fixes. + (ispell-command, ispell-command-options): New defvars. + (start-ispell): Use them. + + * ange-ftp.el (ange-ftp-multi-msgs): Add 331-. + + * man.el (Man-mode): Run Man-mode-hook. + + * bibtex.el (bibtex-mode-map): Use tex-insert-quote, not TeX-... + + Thu Jun 10 15:16:11 1993 Shane Hartman (shane@nugget.spr.com) + + * c++-mode.el (calculate-c++-indent): Respect + c-continued-brace-offset (as in c-mode.el). + + Thu Jun 10 06:39:46 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * frame.el (frame-initialize): When deleting geometry + specifications from initial-frame-alist, remember that they may + occur more than once, and do, if the -geometry option was + specified as well as a .geometry resource. + + * scroll-bar.el (scroll-bar-mode): Variable deleted. + (scroll-bar-mode): Function changed to consult default-frame-alist + instead of the variable. + + * gnus.el (gnus-start-news-server): If no server has been + specified, but gnus-nntp-service is nil, don't ask for a server + name; use the local host. + + * ange-ftp.el (ange-ftp-make-directory): Take second optional + argument parents, like the original. Implement it. + + * gnus.el (gnus-newsrc-to-gnus-format): Change regexp which + matches .newsrc lines for better performance under the new regexp + routines. + + Thu Jun 10 13:40:44 1993 Dave Gillespie (daveg@synaptics.com) + + * bytecomp.el: Bug fixes and upgrade to match Zawinski's v2.10. + (byte-compile-dest-file): Added support for emacs-lisp-file-regexp. + (byte-recompile-directory): Several things involving `noninteractive'. + (byte-compile-file): Changed prompting in read-file-name. + (byte-compile-insert-header): Put a magic number at top of .elc files, + fixed backwards test of byte-compile-compatibility. + (byte-compile-form, byte-defop-compiler19, byte-compile-list, + byte-compile-concat, byte-compile-insert): Likewise. + (byte-compile-condition-case): Added checking for unknown conditions. + (batch-byte-recompile-directory): New function. + + Wed Jun 9 05:43:49 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * compile.el (compilation-error-list): When we haven't yet + generated a marker for the source position of an error message, + store (FILENAME . LINE-NUMBER), not ((DIRECTORY . FILE) + LINE-NUMBER). Doc fix. + (next-error, compilation-parse-errors): Adjusted appropriately. + + * scroll-bar.el (scroll-bar-set-window-start): Remember that the + scroll bar numbers reflect the accessible region of the buffer, + not the entire buffer. + + Tue Jun 8 12:28:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * dired.el (dired-flag-auto-save-files): Ignore `*' added by ls -F. + + * sc.el (sc-mark): Use mark-marker. + + Tue Jun 8 08:28:14 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * Version 19.13 released. + + Tue Jun 8 00:40:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * fortran.el (fortran-indent-new-line): Renamed from + fortran-reindent-then-newline-and-indent. + + * mouse.el (mouse-drag-region-1): Un-comment-out this function. + + * info.el (Info-follow-reference): Fix completion defaulting. + + Mon Jun 7 21:47:37 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) + + * calendar.el (calendar-current-time-zone): Change variable names + to make them more readable. + (calendar-time-zone, calendar-standard-time-zone-name, + calendar-daylight-time-zone-name, calendar-daylight-savings-ends, + calendar-daylight-savings-starts): Don't autload them. + + Mon Jun 7 00:25:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * apropos.el (safe-documentation): Don't crash on byte-compiled macro. + + * telnet.el (telnet-simple-send): New function. + (telnet): Arrange to use that. + + * sun-keys.el: File deleted. + + * texinfo.el (texinfo-section-types-regexp): Add @chapheading. + + * gud.el: Doc fixes. Delete local variable list at the end. + (expr-forward-sexp): Renamed from forw-expr. + (expr-backward-sexp): Renamed from back-expr. + + * case-table.el (describe-buffer-case-table): Merge locals i and ch. + Make *Help* current buffer for describe-vector. + + * bibtex.el: Fix typos in previous change. + Add a few menu items. + + * compile.el (compilation-error-regexp-alist): Make sure each regexp + can only match a few characters at the front. Split off the Mips + CC regexp from the Apollo regexp. + + * rmail.el (rmail-variables): Default rmail-inbox-list here. + (rmail): Not here. + + * ange-ftp.el (ange-ftp-real-load): New function. + (ange-ftp-load): New function--handles `load'. + + Sun Jun 6 18:29:36 1993 Paul Eggert (eggert@twinsun.com) + + * term/sun-mouse.el (mouse-union-first-preferred): Renamed from + mouse-union-first-prefered. + + Sun Jun 6 17:46:25 1993 Paul Eggert (eggert@twinsun.com) + + * sc.el (sc-consistent-cite-p): Renamed from sc-consistant-cite-p. + + * etags.el (etags-recognize-tags-table): Fix misspelling of + find-tag-regexp-next-line-after-failure-p. + + * bibtex.el (bibtex-name-alignment): Renamed from + bibtex-name-alignement. + + * allout.el (outlinify-sticky): Renamed from outlineify-sticky. + + * faces.el (x-create-frame-with-faces): Reversevideo -> ReverseVideo. + * frame.el (frame-initialize): Likewise. + + Sun Jun 6 01:27:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * outline.el (outline-minor-mode): Add autoload cookie. + + * bibtex.el: Define 2 local menu-bar submaps. + (bibtex-x-help, bibtex-x-environment): Deleted. + + * isearch.el (search-upper-case): Make `no-yanks' the default. + (isearch-no-upper-case-p): New arg REGEXP-FLAG. + (isearch-search): Pass new arg. + (isearch-member-equal): Deleted. + (isearch-overlay): New variable. + (isearch-highlight, isearch-dehighlight): Rewritten to use overlays. + + * dired.el (dired-unmark-all-files): Read arg as just a character. + Use non-regexp search to find a specific mark. + Use subst-char-in-region to make the change. + Improve the message at the end. + + * vip.el (vip-ctl-key-equivalent): Use vip-escape-to-emacs. + (vip-escape-to-emacs): Use read-key-sequence and key-binding. + Arg EVENTS replaces arg CHAR. + (vip-ESC, vip-ctl-c, vip-ctl-x, vip-ctl-h): These callers changed. + + * compile.el (compile-internal): Alter current buffer only temporarily. + + Sat Jun 5 13:08:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * sendmail.el (mail-do-fcc): Replace the code for appending to buffer. + + * rmailsum.el (rmail-summary-next-msg): Fix number of dots in regexp. + + * scroll-bar.el (scroll-bar-drag-1): + Calculate position relative to the accessible part of the buffer. + + * menu-bar.el (menu-bar-help-menu): Add defvar. + (menu-bar-edit-menu, menu-bar-file-menu): Likewise. + + * dired.el (dired-flag-backup-files): Handle `*' made by `ls -F'. + + * ange-ftp.el (internal-ange-ftp-mode): Renamed from ange-ftp-mode. + Callers changed. + + * menu-bar.el (window-system): Enable menu bars only if + window-system is non-nil. + + * add-log.el (add-log-current-defun): Fix typos in last change. + + Sat Jun 5 04:39:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * term/x-win.el (x-selection-timeout): Set it, using x-get-resource. + + Fri Jun 4 07:14:44 1993 Paul Eggert (eggert@twinsun.com) + + * timezone.el: (timezone-make-date-arpa-standard, + timezone-make-date-sortable): Move common code into timezone-fix-time. + (timezone-fix-time): Merge common code from above two functions. + Yield time zone at end of result vector. + Set time zone offset correctly as of the given time, + instead of guessing from the current offset. + (timezone-make-arpa-date, timezone-zone-to-minute): Convert + current-time-zone style timezones into RFC-822 style timezones. + + (timezone-time-from-absolute, timezone-time-zone-from-absolute, + timezone-day-number, timezone-absolute-from-gregorian): + More functions borrowed from Reingold's calendar package. + + (timezone-make-arpa-date, timezone-make-sortable-date): Can safely + assume that year includes century, since timezone-fix-time guarantees + this. + + * gnuspost.el (gnus-current-time-zone): New function, which tries + current-time-zone, and if that fails falls back on gnus-local-timezone. + (gnus-inews-date): Use it. + (gnus-inews-valid-date): New optional args TIME (default now) and ZONE + (default GMT). + (gnus-inews-buggy-date): New optional arg TIME (default now). + + * gnus.el (gnus-local-timezone): Now used only if current-time-zone + does not work. + + Fri Jun 4 01:16:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * mh-e.el (mh-yank-cur-msg): Use (mark t). + + * simple.el (mark): Doc fix. + + * add-log.el (add-log-current-defun): Handle Fortran. + + * rmail.el (rmail-resend): Require sendmail and mailalias. + + * time.el (display-time-24hr-format): Make it a user option. + + * edt.el (GOLD-prefix): Define *after* GOLD-map. + + * dired.el (dired-change-marks): Just ding if one arg is RET. + Search for strings, not regexps. Use subst-char-in-region. + + * isearch.el (isearch-mode): Set isearch-window-configuration + only if in slow mode. + (isearch-done): Use isearch-window-configuration only if non-nil. + (isearch-other-control-char): For mouse event, call isearch-done + in the buffer whose keymap was used. + + * flow-ctrl.el (enable-flow-control): Doc fix. + + Thu Jun 3 20:01:19 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) + + * calendar.el (calendar-holidays): Quote it to delay evaluation + until it's needed. + + * holidays.el (calendar-holiday-list): Eval calendar-holidays. + + Thu Jun 3 00:47:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * sendmail.el (mail-do-fcc): Omit first 2 lines when appending + to an RMAIL buffer. + + * simple.el (kill-ring-save): Doc fix. + + * rmailsum.el (rmail-summary-expunge-and-save): Do save-buffer last. + Use two separate save-excursion calls. + (rmail-summary-input): Use pop-to-buffer. + (rmail-summary-get-new-mail): Gobble rmail-current-message; + later go to that message. + (rmail-summary-next-msg): Start at end of line, if moving forward. + Move to beginning of line, after the loop. + (rmail-new-summary): Fix format of elt in minor-mode-alist. + + * rmail.el (rmail-select-summary): Add a save-excursion. + + * rmailsum.el (rmail-summary-expunge-and-save): + Call set-buffer again after rmail-only-expunge. + (rmail-summary-add-label, rmail-summary-kill-label): + Fix reading the label. + (rmail-summary-rmail-update): Bind window locally. + Use unwind-protect, not save-window-excursion. + + * vc-hooks.el (vc-find-file-hook): Check buffer-file-name is non-nil. + + * hideif.el (define-hide-ifdef-mode-map): Don't bind C-c LETTER. + Use C-c ESC LETTER instead. + Handle case where where-is-internal returns nil. + + * texinfmt.el: Provide texinfmt. + + * bytecomp.el (byte-compile-insert-header): Fix backwards test + of byte-compile-compatibility. + + * info.el (Info-mode-map): Bind mouse-2, not mouse-3. + + * view.el (View-scroll-lines-forward): If we exit, do nothing else. + + * calendar.el (calendar-mode): Doc fix. + (calendar-mark-ring): New defvar. + + * frame.el (frame-initialize): Set cursor-color last. + + * vip.el (vip-escape-to-emacs): Temporarily restore local map + and use read-key-sequence. + + * rmailsum.el (rmail-summary-by-senders): New function. + (rmail-message-senders-p): New function. + + Thu Jun 3 17:58:59 1993 Dave Gillespie (daveg@synaptics.com) + + * complete.el (PC-lisp-complete-symbol): Added. + (PC-look-for-include-file): Recognize some Lisp notations. + (PC-include-file-all-completions): Fixed uppercase variable names. + + Wed Jun 2 12:56:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * info.el (Info-suffix-list): Handle .gz suffix. + * ange-ftp.el (ange-ftp-binary-file-name-regexp): Handle .gz. + + * ehelp.el (electric-help-command-loop): Use equal to compare + lists of events. + + * electric.el (Electric-command-loop): Use eq to compare events. + + * diff.el (diff): Really do use arg SWITCHES. + + * frame.el (frame-initialize): Delete geometry parms + from initial-frame-alist. + + Wed Jun 2 09:59:02 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) + + * calendar.el (calendar-daylight-savings-starts): Mention use of + nil value in documentation string. + (calendar-daylight-time-offset): New variable. + (calendar-daylight-savings-switchover-time): New variable. + (calendar-mode): Mention them. + (calendar-time-zone, calendar-print-astro-day-number, + calendar-time-display-form): Change Universal Time (UT) to + Coordinated Universal Time (UTC). + + *solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change + Universal Time (UT) to Coordinated Universal Time (UTC). + (solar-time-string): Use calendar-daylight-time-offset instead of + 1 hr, and use calendar-daylight-savings-switchover-time instead of + midnight. Add an optional parameter to allow forcing the use of + standard or daylight savings time. Fix code so it works in + southern hemisphere (start of dst precedes end of dst in a + calendar year) and when dst either starts or ends in a calendar + year, but not both. + + Tue Jun 1 17:40:30 1993 Ken Manheimer (klm@coil.nist.gov) + + * allout.el (outlineify-sticky): Reconciled provisions for + non-standard and standard prefix leaders. + + Tue Jun 1 16:09:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * Version 19.12 released. + + * reporter.el: New file. + + * mouse.el (mouse-buffer-menu): Don't select the event's window, + if event has frame instead. + + * tar-mode.el: Typo in autoload cookie. + + * shell.el (shell-prompt-pattern): Use defvar. + + * ange-ftp.el (ange-ftp-make-backup-files): Doc fix. + + * sendmail.el (mail-signature): Do not insert a line with `--'. + + * menu-bar.el (mouse-menu-bar-buffers): Renamed from mouse-buffer-menu. + + * subr.el (posn-timestamp): Doc fix. + + * sort.el (sort-fold-case): New variable. + (sort-subr): Bind case-fold-search from sort-fold-case. + + * simple.el (undo): + Pass proper arg to delete-auto-save-file-if-necessary. + + * desktop.el: New file. + + * c++-mode-1.el: New file. + + Tue Jun 1 16:03:30 1993 Ken Manheimer (klm@coil.nist.gov) + + * allout.el (move-to-column): Pass zero instead of negative arg. + Added some free variables defvars, so byte-comple doesn't complain. + Included some stub code, eventually will be proper use of Emacs 19 + minor-mode-sensitive keymaps. + + Tue Jun 1 14:01:25 1993 Stephen A. Wood (saw@cebaf.gov) + + * fortran.el (fortran-mode): Replace comment-indent-hook with + comment-indent-function. + + * fortran.el (fortran-is-in-string-p): Replaced with new version + that uses the syntax table. + + * fortran.el (calculate-fortran-indent): Lines that have a # after + whitespace are interpreted as cpp directives and outdented back to + column zero. + + Tue Jun 1 00:27:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * lucid.el (map-keymap): Doc fix. + + * dired-aux.el (dired-compress-file): Use gzip when proper/possible. + + * sc.el: Fix installation instructions. + (sc-cite-original): Add autoload cookie. + + * sendmail.el (mail-yank-hooks): New hook variable. + (mail-yank-original): Run the hook. + (mail-indent-citation): New function. + + * cl.el (cl-mod): Renamed from mod. + + * Version 19.11 released. + + * lucid.el (copy-tree): Use let* to bind new before i. + + * terminal.el (te-pass-through): Delete debugging code left by mistake. + + * comint.el (comint-filter): Put window-start before the input. + + * isearch.el (isearch-mode): If enter recursive-edit, + also bind isearch-recursive-edit. + + * cookie1.el: Renamed from cookie.el. + Provide cookie1. + * yow.el, spook.el: Changed accordingly. + + Mon May 31 23:21:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * outline.el (outline-flag-region): Pass t as NOUNDO arg + to subst-char-in-region. No need to restore buffer-modified-p by hand. + + Mon May 31 20:29:00 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) + + * term/x-win.el (x-invocation-args): Add defvar. + + Mon May 31 19:59:12 1993 Junio Hamano (junio@twinsun.com) + + * window.el (count-windows): PROC argument of + walk-windows takes an argument. + + Mon May 31 00:20:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * gnus.el (gnus-summary-isearch-article): Call isearch-forward + in ordinary fashion with no args. + (gnus-inews-article-hook, gnus-prepare-article-hook): + Initialize to a list. + (gnus-read-newsrc-file): If timestamps are equal, reload .newsrc. + + * bibtex.el (bibtex-mode): Add autoload. + + * files.el (inhibit-local-variables-regexps): New variable. + (set-auto-mode): Handle inhibit-local-variables-regexps. + + * tar-mode.el: Don't initialize write-file-hooks. + Don't change auto-mode-alist. + (tar-regexp): Deleted. + (tar-normal-mode): Deleted. + (tar-mode): Add autoload. + + * faces.el (x-resolve-font-name): Clean up error messages. + + * timer.el (run-at-time): Pass args to start-process in right order. + + * info.el (Info-get-token): Check that thesecond search succeeded. + + * edebug.el: Provide edebug. + + * rmailsum.el (rmail-message-subject-p): Fix typo in string constant. + + * cl.el (mod): Use cl-floor. + (rem): Use cl-truncate. + + * gud.el (gud-def): Don't use gud-key-prefix at compile time. + + * window.el (shrink-window-if-larger-than-buffer): Add `interactive'. + Do nothing if window contents not entirely visible. + + * sendmail.el (mail-do-fcc): Put back the newline at the start + of the fcc temp buffer. It got lost somewhere. + + Sun May 30 15:14:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) + + * gnus.el (gnus-nntp-server): Use gnus-default-nntp-server. + + * info.el (Info-mode-map): Correct Info-top to Info-top-node. + + * man.el (Man-notify-when-ready): Correct previous change. + + Sun May 30 18:28:43 1993 Stephen Gildea (gildea@alex.lcs.mit.edu) + + * mh-e.el (mh-signature-file-name): New variable. + mh-e version 3.8.2. + + Sun May 30 13:21:04 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) + + * faces.el (x-resolve-font-name): Fix args to error; the format + string was changed, but not the arguments to be substituted. + + * faces.el (x-resolve-font-name): Give correct error message + depending on whether or not FACE was non-nil. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/OChangeLog emacs-19.18/lisp/OChangeLog *** emacs-19.17/lisp/OChangeLog Mon Jul 19 02:01:07 1993 --- emacs-19.18/lisp/OChangeLog Sun Aug 8 01:33:56 1993 *************** *** 1,1791 **** - Sun Jul 18 02:38:03 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * Version 19.17 released. - - * makeinfo.el: Don't (require 'texinfmt) - that file doesn't exist - any more. - - * files.el (insert-directory): Doc fix. - - * files.el (insert-directory): If FULL-DIRECTORY-P is non-nil, - add "." component to the end of the path, so that if file is a - symlink, we get the contents of the directory, not the symlink - itself. - - Sat Jul 17 13:25:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * tar-mode.el (tar-extract): Use view-exit-action to kill viewed buf. - - * view.el: Doc fixes; some args renamed. - - * gnus.el (gnus-info-nodes): Update node names. - - * makeinfo.el (makeinfo-options): Fix option syntax in initial value. - - * texinfo.el (texinfo-mode): Undo changes mistakenly added with - previous batch: texinfo-{start,end}-of-header are now tex-... - - Sat Jul 17 18:13:11 1993 Johan Vromans (jv@mh.nl) - - * forms.el: New version 2.0. - Redesigned and rewritten to use Emacs 19 text properties. - Requires Emacs 19.16 or later. - - Sat Jul 17 01:58:36 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) - - * term/x-win.el: Include (invocation-name) in the error messages - which might occur during startup. - - * shell.el (shell-process-pushd): Fix syntax error in - condition-case. - - Fri Jul 16 20:16:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * menu-bar.el (revert-buffer): Make menu-enable form more accurate - using revert-buffer-function and verify-visited-file-modtime. - (menu-bar-help-menu): Put back under global-map. - (menu-bar-final-items): Set it. - - * mh-e.el (mh-yank-hooks): Use (mark t). - (mh-new-draft-name): Likewise. - - Fri Jul 16 16:30:18 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * comint.el (comint-{next,prev}-prompt, comint-send-eof): New defuns. - (comint-mode-map): Bind C-c C-n, C-c C-p, and C-c C-d to those. - Bind C-c C-y to comint-previous-input, for compatibility with v18 - shell.el. - - Fri Jul 16 15:53:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * advice.el (ad-start-advice-on-load): Initialize to t. - - Fri Jul 16 04:45:14 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) - - * term/x-win.el: Make the `-rn NAME' option specify a resource - name, as documented, and not a resource database string. Make - `-name NAME' act like `-rn NAME' and also set the name of the - initial frame. - (command-switch-alist): Process the `-rn' and `-name' options - using the x-handle-name-rn-switch function. - (x-handle-name-rn-switch): New function, which sets the - x-resource-name variable. - (opening connection): Make sure x-resource-name is valid. If it's - not a string, set it to (invocation-name), with any periods or - asterisks changed to hyphens. - - * term/x-win.el: Make the `-xrm STRING' option specify a resource - database string. `-rn' used to behave this way. - (command-switch-alist): Process the `-xrm' switch using - x-handle-xrm-switch. - (x-handle-xrm-switch): Renamed from x-handle-rn-switch; this - function does the right thing for `-xrm', not for `-rn'. - - Fri Jul 16 00:11:29 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * sendmail.el (mail-bury): If selected frame is dedicated, - and there are other visible frames, delete this frame. - - * rmail.el (rmail-mail-new-frame): New variable. - (rmail-start-mail): New function. - (rmail-mail, rmail-continue, rmail-reply, rmail-forward) - (rmail-retry-failure): Use rmail-start-mail. - - Thu Jul 15 01:29:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * faces.el (face-equal): Don't mess with face-background-pixmap. - - * ispell.el (ispell-menu-map): Add missing quote in defalias. - (ispell-window-configuration): Initialize to nil. - - * vc-hooks.el (vc-rcs-status): Make work buffer's name start w/ space. - - * simple.el (completion-setup-function): Insert the mouse help message - only if non-nil `window-system'. - - * paren.el: Enable the hook only if window-system. - Clear blink-paren-function at the same time. - (show-paren-command-hook): If after a closeparen, - highlight that closeparen as well as matching open. - Use a different color for a mismatch, if color screen. - - Thu Jul 15 01:07:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * assoc.el (asort): First argument should be named alist-symbol, - not assoc-symbol. - - Wed Jul 14 23:52:20 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * server.el (server-done): Let save-buffer make the backup, - so that make-backup-files remains effective. - - * loaddefs.el: Delete C-x a C-h binding. - - * menu-bar.el (help-menu-bar-map): Put the Help item in this map. - - Wed Jul 14 23:46:02 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * isearch.el (isearch-edit-string): Bind isearch-nonincremental to - its own value, not to nil. - - Wed Jul 14 23:35:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * hippie-exp.el: Renamed from hippie.el. - - Wed Jul 14 23:08:17 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * compile.el (compilation-parse-errors): After skipping two lines, - move one char back so point is before the newline. - - Wed Jul 14 21:55:13 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * gud.el (gud-debugger-startup): Replaced with gud-massage-args. - (gud-{gdb,sdb,xdb}-debugger-startup): Replaced with gud-*-massage-args. - (gdb, sdb, xdb): Argument is command line, not args for it. Remove - debugger name from prompt and put it in the default input instead. - Overload gud-massage-args instead of gud-debugger-startup. - (gud-chop-words): New function; subr for gud-common-init. - (gud-common-init): Argument is command line, not args for it. - Rewritten to use gud-chop-words instead of temp buffer and kludge - involving read. Find the program name as the first word of the - command line. Use make-comint and gud-massage-args in place of - gud-debugger-startup. - Expand the file name before passing it to gud-massage-args. - - Wed Jul 14 19:38:00 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * spook.el (snarf-spooks): Restore function. - - * cookie1.el (cookie-cache): New defvar. - (cookie-snarf): Cache cookies in cookie-cache, not in obarray (idiot). - Also store the modtime and punt the cache when it changes. - - Wed Jul 14 19:14:37 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) - - Changes from Anders Holst, to bring hippie-expand up to version 1.2: - * hippie-exp.el (hippie-expand-max-buffers): New variable. - (try-expand-line-all-buffers, try-expand-list-all-buffers, - try-expand-dabbrev-all-buffers): Use it. - (try-expand-list, try-expand-list-all-buffers): New functions. - (he-string-beg, he-string-end, he-search-loc): These values are - now markers, not integers. Uses changed. - (he-reset-string, he-substitute-string): Use a marker to preserve - the old position of point. - (try-expand-all-abbrevs): handle case the same way as the - usual expand-abbrev (which is not a very good way, but for - consistency...). - (he-dabbrev-beg): Use `skip-syntax' instead of `skip-chars', to - adjust its behavior to different modes. - (hippie-expand): Don't messages which try function it is using, - when the expansion itself is done in the minibuffer (it was very - annoying to have the message obscuring the expansion). - (try-complete-file-name, try-complete-file-name-partially, - try-complete-lisp-symbol, try-complete-lisp-symbol-partially, - try-expand-line, try-expand-line-all-buffers, - try-expand-all-abbrevs, try-expand-dabbrev, - try-expand-dabbrev-all-buffers): No unnecessary "resetting" of the - epansion, when no expansion is done (caused the buffer to be - marked as changed, although nothing was done, among other things). - (he-reset-string): Undoing of last expansion at a later occasion, now - undoes correctly (before, it garbled things up). - (make-hippie-expand-function): now uses "(function ...)" - instead of "'" (matters for compilation). - (try-expand-line, try-expand-line-all-buffers, - he-line-search-regexp): uses `comint-prompt-regexp' instead of - `shell-prompt-pattern', to strip off prompt in process buffers. - - Wed Jul 14 16:56:19 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * autoload.el (generate-file-autoloads): - Fix FILE truename hacking to substring - SOURCE-TRUENAME instead of FILE. - - Tue Jul 13 01:51:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * faces.el (copy-face): New arg NEW-FRAME. - (list-faces-display): New command. - - * simple.el (completion-mode): New major mode. - (completion-setup-function): New function. - Add it to completion-setup-hook. - - * mouse.el (mouse-choose-completion): New function. - - * dunnet.el: Many functions and variables renamed. - - * sendmail.el (mail-bury): New function. - (mail-send-and-exit): Call mail-bury. - (mail-dont-send): New command, with menu bar binding. - - * compare-w.el (compare-windows-skip-whitespace): New function. - (compare-windows): Use that. - (compare-windows-whitespace): Value is now regexp. - - * rmail.el (rmail-insert-inbox-text): If inbox is not in the - spool dir, try copying before renaming. - - Tue Jul 13 00:38:53 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) - - * shell.el (shell-prompt-pattern): Don't match more than one line. - Doc fix. - - * bytecomp.el (byte-compile-from-buffer): Bind float-output-format - to "%.20e", not "%20e"; the latter is always ignored, since it - doesn't have a decimal point after the percent sign. - - Mon Jul 12 23:17:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * autoload.el (generate-file-autoloads): Correctly detect when the - buffer receiving the autoload forms is in a parent of or the same - directory as FILE, even in the presence of symlinks. - - Mon Jul 12 23:57:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * subr.el (define-key-after): Error if KEY has two elements. - - * dired.el (dired-mode-map): Add menu bar items. - - Mon Jul 12 23:17:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * autoload.el (generate-file-autoloads): Correctly detect when the - buffer receiving the autoload forms is in a parent of or the same - directory as FILE. - - Mon Jul 12 16:44:47 1993 Jim Blandy (jimb@totoro.cs.oberlin.edu) - - * ange-ftp.el: Install the correct regexp in - file-name-handler-alist. - - * term/x-win.el: Recognize affirmative values for reverseVideo - properly. Include "on" in the list of recognized values. - - Mon Jul 12 15:11:55 1993 Paul Eggert (eggert@twinsun.com) - - * vc-hooks.el (vc-rcs-status): Include head version number - in mode line if there are no locks. - - Mon Jul 12 14:36:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * menu-bar.el (menu-bar-file-menu): Add menu item for dired. - - * menu-bar.el (ispell-menu-map): New autoload definition. - (menu-bar-edit-menu): Add "Spell" item. - * ispell.el (ispell-menu-map): New keymap--both fn and var. - - * loaddefs.el (mode-line-buffer-identification): Doc fix. - - Sat Jul 10 23:28:50 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - - * calendar.el (calendar-holidays): Don't autoload this; its value - must be set after the user's .emacs file is loaded. - - Sat Jul 10 01:15:54 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * paren.el (show-paren-command-hook): Do nothing if not window-system. - - Fri Jul 9 00:04:12 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * rmailout.el (rmail-output): If file is an Rmail file, - use rmail-output-to-rmail-file. - (rmail-output-to-rmail-file): If file exists - and is not an Rmail file, use rmail-output. - If we find an element in rmail-output-file-alist, eval it. - (rmail-file-p): New function. - (rmail-output-file-alist): Now contains expressions to eval. - - * font-lock.el: New file. - - * bytecomp.el (byte-compile-setq-default): - Generate a progn of calls to set-default, then compile it. - - * menu-bar.el (mouse-menu-bar-buffers): - Don't lose if all buffer names are short. - - * dunnet.el: New file. - - Thu Jul 8 19:31:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * loaddefs.el (global-map): Bind M-next to scroll-other-window. - - * compile.el (compilation-error-regexp-alist): - Broaden ``Line N of "FILE": msg'' regexp - to also match Ultrix f77: ``Error on line N of FILE: msg''. - - Thu Jul 8 18:42:14 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * Make everything that deactivates the mark do it consistently. - * simple.el (deactivate-mark): New function. - (kill-ring-save, pop-mark, keyboard-quit): Call it. - * ispell.el (ispell): - Call deactivate-mark instead of setting mark-active directly. Do - this regardless of transient-mark-mode. - * isearch.el (isearch-done): - Call deactivate-mark instead of setting mark-active - directly. Do this regardless of transient-mark-mode. - - Thu Jul 8 20:51:51 1993 Richard Stallman (rms@churchy.gnu.ai.mit.edu) - - * files.el (basic-save-buffer): Use after-save-hook. - - Thu Jul 8 17:46:22 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * simple.el: Put error-conditions and error-message properties on - 'mark-inactive. - (mark): Signal 'mark-inactive instead of using error with a message. - - Thu Jul 8 17:14:43 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * mailabbrev.el (mail-abbrev-end-of-buffer): Fix interactive spec - to "P", same as end-of-buffer. - - Thu Jul 8 15:06:38 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * hanoi.el: Add (provide 'hanoi). - - Wed Jul 7 18:19:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * files.el (file-relative-name): If we use default-directory, - call expand-file-name anyway. - - * texnfo-upd.el (texinfo-update-node): Bind auto-fill-hook - as well as auto-fill-function. - (texinfo-sequential-node-update): Likewise. - - Wed Jul 7 09:25:37 1993 Robert J. Chassell (bob at grackle) - - * texnfo-upd.el: Fix typo re `texinfo-sequential-node-update.' - Ensure that no commands depend on the value of - case-fold-search. - Rewrite messages. Avoid using `mark-whole-buffer'. - - (texinfo-start-menu-description): - New function to insert title as description in a menu. - (texinfo-make-menu-list): Remove automatic title insertion. - (texinfo-master-menu): Error message if file - contains too few nodes for a master menu. - Handle the case where no master menu was inserted. - (texinfo-insert-master-menu-list): Only attempt to insert detailed - master menu if there is one. - Insert a master menu only after `Top' node and before next node. - - (texinfo-check-for-node-name): Offer section title as prompt. - (texinfo-copy-next-section-title): Copy title correctly. - Handle failure to find @node. - (texinfo-copy-menu): Error message if menu empty. - (texinfo-pointer-name): Find only those - section commands that are accompanied by `@node' lines. - (texinfo-section-types-regexp): Look for subh and subs, not just sub. - (texinfo-make-one-menu): Copy node-name correctly for message. - (texinfo-copy-menu-title): Copy title as it - should rather than node line. - - (texinfo-find-higher-level-node): Stop search at limit. - Special handling for `top' and `chapter' levels. - (texinfo-copy-menu-title): Rewrite to handle outer include files. - (texinfo-multi-file-update): Update all nodes properly (and sooner); - rewrite doc string and interactive. Copy title properly. - (texinfo-all-menus-update): Fixed typo that - caused the function to create a master menu when it shouldn't. - Update pre-existing master menu, if there is one. - - (texinfo-incorporate-descriptions): Use a regexp search to look for - both kinds of menu item. - (texinfo-menu-indent-description): Likewise. - (texinfo-incorporate-menu-entry-names): New function. - (texinfo-insert-menu): Handle both kinds of menu item. - (texinfo-multi-files-insert-main-menu): Likewise. - (texinfo-update-node): Pass t as second arg to push-mark. - (texinfo-sequential-node-update): Likewise. - (texinfo-insert-node-lines): Bind `title' at a higher level. - Don't find previous @node if it's close. - Take region to process as arguments. - (texinfo-multiple-files-update): Handle prefix arg better within - `interactive'. Canonicalize the blank lines. - - Wed Jul 7 16:13:57 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * autoload.el (update-file-autoloads): - Correctly do nothing when there are no cookies. - - Wed Jul 7 15:58:54 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * menu-bar.el (mouse-menu-choose-yank): - Change menu title to "Choose Next Yank". - - Wed Jul 7 03:19:41 1993 Paul Eggert (eggert@twinsun.com) - - * vc-hooks.el (vc-rcs-status): Removed unused variable `status'. - - * rmail.el (rmail-resend): Use RFC 822 style date in Resent-Date: line. - * sendmail.el (mail-do-fcc): Likewise, for appending Date: lines to - RMAIL mode buffers. Use new `mail-rfc822-time-zone' function - to simplify pinhead generation. - * mail-utils.el (mail-rfc822-time-zone, mail-rfc822-date): New fns. - - Wed Jul 7 02:26:31 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * files.el (cd-absolute): Use abbreviate-file-name on expansion of DIR. - - * gud.el: Add (provide 'gud). - - * files.el (basic-save-buffer): - Invoke after-save-hook, not after-save-hooks. - - * time.el (display-time-file-nonempty-p): Use file-chase-links. - - * bytecomp.el (byte-compile-setq-default): Handle multiple pairs - args like setq (as the setq-default subr does). - - * autoload.el: Doc fix. - - Tue Jul 6 18:07:14 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * rmail.el (rmail-variables): Compare truename as well as given name - against rmail-file-name. - - * man.el (Man-mode-line-format): Add a space after global-mode-string. - - Tue Jul 6 11:05:14 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - - * Version 19.16 released. - - Tue Jul 6 01:21:37 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - - * vc.el (vc-start-entry): Don't call file-name-nondirectory on - FILE before passing it to vc-mode-line. Everyplace else passes - vc-mode-line full filenames, and vc-mode-line now needs the real - file name to decide which version-control system the file is under. - - * man.el (Man-build-man-command): Don't leave a pipe symbol at the - end of the command list if Man-filter-list is nil. - (Man-default-man-args): Don't write out assq and mapconcat. - (Man-default-man-entry): Don't default to section 2 for C-mode. - Call Man-default-man-args, and let people use - Man-auto-section-alist if this is what they want. - (manual-entry): Call Man-translate-references, instead of writing - it out. - (Man-getpage-in-background): Don't apply Man-default-man-args - here; manual-entry has already run it, and - Man-follow-manual-reference provides the sections itself. - - Mon Jul 5 00:43:20 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - - * map-ynp.el (map-y-or-n-p): If we get a switch-frame-event, - save it until we're done asking questions, and then unread it. - - Mon Jul 5 03:20:12 1993 Paul Eggert (eggert@twinsun.com) - - * vc.el (vc-name): Move to vc-hooks.el. - * vc-hooks.el (vc-name): Moved from vc.el; vc-rcs-status now uses it. - (vc-name, vc-backend-deduce): Set both vc-name and vc-backend - properties, to avoid calling vc-registered unnecessarily when - the other property is needed. - (vc-rcs-status): Yield only status of locks; do not try to yield " REV" - if there are no locks, since this cannot be done easily if there are - branches. Use vc-name instead of duplicating its function incorrectly. - Fix off-by-one bug when inserting master header pieces. Read headers - 8192 bytes at a time instead of 100. Don't bother to expand-file-name. - (vc-rcs-glean-field): Removed. - - Sun Jul 4 17:29:43 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * outline.el (outline-mode-map): Add menu bar items. - (outline-minor-mode-map): Copy menu bar submap from outline-mode-map. - - * help.el (describe-key-briefly): Don't set `foo'. - - Sun Jul 4 17:01:01 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * subr.el (posn-point): Properly extract the BUFFER-POSITION field - of an event when read-key-sequence has placed it in a singleton - list. - - * comint.el (comint-prompt-regexp): Double the backslashes in the - sample prompt regexps, so that they print properly when unquoted. - - Sun Jul 4 18:54:59 1993 Paul Eggert (eggert@twinsun.com) - - * vc.el (vc-backend-diff): Undo "-q" change. This was fixed - instead by adding -q support to vcdiff. - - Sun Jul 4 13:55:13 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * help.el (describe-prefix-bindings): New command. - (prefix-help-command): Set it. - - * hexl.el: Added a keyword. - - Sun Jul 4 12:46:27 1993 Johan Vromans (jv@mh.nl) - - * forms.el (forms-new-record-filter): Correct default value. - (forms-modified-record-filter): Correct default value. - - Sun Jul 4 00:53:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * paren.el (show-paren-command-hook): Add message for paren mismatch. - - * vc-hooks.el (vc-mode-line): Put `RCS' or `SCCS' before version num. - - Sat Jul 3 21:44:54 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * faces.el (make-face-bold, make-face-italic, - make-face-bold-italic, make-face-unbold, make-face-unitalic): - Properly pass noerror argument to recursive calls. - - * frame.el (frame-remove-geometry-params): New function. - (frame-initialize): Call it, instead of writing it out. - - Sat Jul 3 15:03:44 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * simple.el (kill-region): Cope with change hooks that change props. - - Sat Jul 3 06:15:43 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * term/x-win.el: Check the reverseVideo/ReverseVideo resource, - correctly distinguish between "on" and "off" values, and put a - parameter in default-frame-alist. - * frame.el (frame-initialize): Don't call x-get-resource here. - - Sat Jul 3 03:22:04 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * autoload.el (update-file-autoloads): - Do nothing when there are no cookies. - - Fri Jul 2 18:55:23 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * mouse.el (mouse-drag-region): Correctly handle drags which enter - other frames. - - Fri Jul 2 17:28:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * vc.el (vc-path): New variable. - (vc-do-command): Use vc-path. - - * menu-bar.el (menu-bar-edit-menu): Rename menu item to - Choose Next Paste. Create this item along with all the others. - - * isearch.el (isearch-other-meta-char): Handle sequences - containing mouse clicks in scroll-bar that used another buffer's map. - - Fri Jul 2 16:06:38 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * vc.el (vc-backend-diff): Pass the "-q" flag only if we're using - rcsdiff. - - Fri Jul 2 14:31:59 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * menu-bar.el: Put mouse-menu-choose-yank binding after - paste=>yank binding in menu-bar-edit-menu. - - Fri Jul 2 13:32:10 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * bytecomp.el (byte-compile-keep-pending): Handle fset like defalias. - (byte-compile-file-form-defmumble): Fix backward if in prev change. - - Thu Jul 1 20:14:44 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * dired-aux.el (dired-diff): Work even when the mark is inactive. - - Thu Jul 1 18:10:45 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * sendmail.el (mail-send): Don't test buffer-modified-p - if buffer is visiting a file. - - * bytecomp.el (byte-compile-file-form-defmumble): - If byte-compile-compatibility, use fset, not defalias. - - Thu Jul 1 16:33:01 1993 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) - - * simple.el: Add bindings to function-key-map so that the keypad - keys act like ordinary self-insertion keys, unless explicitly bound. - - Thu Jul 1 14:39:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * mailabbrev.el (build-mail-abbrevs): Do substitute-in-file-name - on the abbrev, for `source'. - - * files.el (set-visited-file-name): Rename the old auto save file. - - Thu Jun 30 23:31:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * menu-bar.el (mouse-menu-choose-yank): - Just return when x-popup-menu returns nil. - Add menu-enable property to this function. - - Wed Jun 30 17:50:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * compile.el (compile-abbreviate-directory): New function. - (compilation-parse-errors): Use that, to visit files with a dirname - more like the one the user specified. - - Wed Jun 30 15:38:53 1993 Johan Vromans (jv@mh.nl) - - * forms.el: Add e-mail address and version info. - Adjust commentary and doc strings. - (forms-mode): Add ###autoload. - (forms-find-file): Add ###autoload. - (forms-find-file-other-window): Add ###autoload. - - Wed Jun 30 21:35:59 1993 Paul Eggert (eggert@twinsun.com) - - * vc.el (vc-update-change-log): Ensure that file names inserted - into a ChangeLog are relative to that ChangeLog. - - Wed Jun 30 12:43:18 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * simple.el (mark-even-if-inactive): New variable. - (mark): Test it. - - * rmail.el: Doc fixes. - - Wed Jun 30 00:29:08 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * gud.el: Add history lists to the debugging commands, so we don't - have to retype the filename every invocation. - (gud-gdb-history, gud-sdb-history, gud-dbx-history, - gud-xdb-history): New variables. - (gdb, sdb, dbx, xdb): Use them when reading the argument string. - - * mouse.el (mouse-drag-region-1): Commented out. - (mouse-drag-region): Commented out, and replaced with new version, - which highlights the region as we drag. - (mouse-scroll-delay, mouse-drag-overlay): New variables. - (mouse-scroll-subr): New function. - - * sun-fns.el, sun-curs.el: Move these to lisp/term, to be with - sun-mouse.el. - - Tue Jun 29 19:00:38 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * faces.el (global-face-data): Doc fix. - - * gnus.el (gnus-newsrc-to-gnus-format): Correct regexp which - matches .newsrc lines not to match more than one line. - - Tue Jun 29 13:05:15 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * ls-lisp.el (insert-directory): Doc fix. - (ls-lisp-format): Provide user name when known. - On ms-dos, provide a name for the group, to be prettier. - - Mon Jun 28 00:47:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * subr.el (define-key-after): Delete duplicate bindings that come - after the new one. Do insert when we reach the end, if haven't before. - - * paren.el: New file. - - * faces.el (face-initialize): Create `underline' face. - (x-initialize-frame-faces): Set up `underline' face. - - * faces.el (x-initialize-frame-faces): Check x-display-color-p - and x-display-planes to decide whether to try using colors or gray. - - * man.el (Man-auto-section-alist): Default value nil. - (Man-getpage-in-background): Call Man-default-man-args. - (Man-filter-list): Don't discard overstrike here. - (Man-set-fonts): New function. - (Man-bgproc-sentinel): Call Man-set-fonts. - (Man-version-number): Var deleted. - (Man-version): Command and binding deleted. - (Man-mode): Use Manual, not Man, as official mode name. - - * solar.el: Doc fixes. - - * c-mode.el (c-forward-conditional): New function. - (c-up-conditional): Use c-forward-conditional. - (c-backward-conditional): New function. - (c-mode-map): Make bindings for them. - - Sun Jun 27 20:56:11 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * vc.el (vc-update-change-log): Restore previous default-directory - for running rcs2log. - - Sat Jun 26 00:18:21 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * subr.el (define-key-after): New function. - - Fri Jun 25 13:58:52 1993 Barry A. Warsaw (warsaw@anthem.nlm.nih.gov) - - * reporter.el (reporter-submit-bug-report): Rename local var curbuf - to reporter-eval-buffer. - (reporter-dump-variable): Eval varsym in reporter-eval-buffer. - - * c++-mode.el (c++-fast-backward-syntactic-ws-2) - (c++-fast-backward-syntactic-ws-1): Change the proper syntax table - depending on whether we are editing C or C++ code. - - * c++-mode.el (c++-indent-exp): When computing offset for open-brace - line, check not at class top level before adding c-indent-level. - Fix bug handling member init lists. - Fix case where comments follow a continued statement. - Fix handling of c-brace-offset < 0. - - * c++-mode.el (c++-calculate-indent): - Fixed indentation when base class declaration is on a separate line - then the derived class intro header. - Don't skip up past compound statement if we're in a member init list. - - * c++-mode.el (c++-indent-line): Clean up adjustment - of block closing braces. Handle a list as value of - c++-block-close-brace-offset. - - * c++-mode.el (c++-indent-exp): Use c-continued-statement-offset - instead of c-indent-level to indent comma separated arg decl lists. - - * c++-mode.el (c++-fast-backward-syntactic-ws-2): Simplify for - new forward-comment semantics. - - * c++-mode.el (c++-calculate-indent): Change if's to cond in CASE3. - Require colon when looking for `case' or `default'. - Use c++-compound-offset. - (c++-compound-offset): New function. - Distinguish statement continuation from enum and initializer lists. - - Fri Jun 25 18:30:17 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * vc-hooks.el (vc-rcs-status): New variable. - (vc-mode-line): Display the lock status and head version. - (vc-rcs-status, vc-rcs-glean-field): New function. - - * menu-bar.el (mouse-menu-bar-buffers): Include % and * in each item. - Calculate amount of space needed for longest buffer name. - * mouse.el (mouse-buffer-menu): Likewise. - - Fri Jun 25 18:01:47 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * add-log.el (find-change-log): Try get-file-buffer before - file-exists-p. - - Fri Jun 25 17:30:19 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * vc.el (vc-diff): If `diff' gives empty output, return nil. - - Wed Jun 23 21:45:19 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * ange-ftp.el: Loosen file-name-handler-alist regexp so we can do - host name completion. - - * hexl.el (hexl-in-save-buffer): New flag. - (hexl-save-buffer): Prevent infinite recursion. - - Tue Jun 22 04:11:33 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * term/x-win.el (command-switch-alist): "-ib" takes a numeric - argument; use x-handle-numeric-switch for it. - - * replace.el (query-replace-map): Fix typo in binding for [return]. - - Tue Jun 22 00:23:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * rmailsort.el: Don't touch rmail-summary-mode-map. - Don't touch rmail-mode-map. Don't require rmail or sort. - (rmail-summary-sort-...): Moved to rmailsum.el. - (rmail-sort-from-summary): Likewise. - - * rmail.el: Add autoloads for rmailsort commands. - (rmail-mode-map): Add bindings for those commands. - - * rmailsum.el (rmail-summary-mode-map): Bind summary sort commands. - (rmail-summary-sort-...): Moved from rmailsort.el. - (rmail-sort-from-summary): Likewise. Require rmailsort. - - Mon Jun 21 22:01:23 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * compile.el (compile-file-of-error): Remember that - compilation-error-list stores file names as strings, not as (DIR . - FILE) pairs. - - * diff.el (diff-parse-differences): Preserve the match data - across the call to find-file-noselect. - - * subr.el (event-end): Modified to account for multi-click events. - - Mon Jun 21 01:53:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * rmail.el (rmail-mode-map): Add local menu bar bindings. - (rmail-search-backward): New command. - (rmail-mode): Move to the last message. - - * rmailsum.el (rmail-summary-mode-map): Add local menu bar bindings. - (rmail-summary-search-backward): New command. - (rmail-summary-search): Don't use save-excursion. - - * sendmail.el (mail-mode-map): Add local menu bar bindings. - - * texinfo.el: Set up autoloads for files `makeinfo' and `texnfo-upd'. - (texinfo-delete-from-print-queue-command): New var. - (texinfo-tex-trailer): New var. - (texinfo-tex-region): Use that. - (texinfo-tex-buffer): Rewritten; use the actual source file. - Binding is now C-c C-t C-b. - (texinfo-texindex): Turned back on. - (texinfo-quit-job): New command, with binding. - (texinfo-delete-from-print-queue): Likewise. - (texinfo-show-structure): Indent each line according to depth. - Require texnfo-upd. - (texinfo-section-types-regexp): Var deleted. - (texinfo-insert-@-with-arg): New function. - (texinfo-insert-@var, etc.): Use that. - (texinfo-insert-@end): New command, now on C-c C-c e. - (texinfo-insert-@end-example): Deleted. - (texinfo-insert-@table): New command, on C-c C-c t. - (texinfo-start-menu-description): New command, on C-c C-c C-d. - (texinfo-mode): No longer set tex-trailer. - Make the @node for the top node start a page. - Use shorter values for tex-end-of-header and tex-start-of-header. - (texinfo-mode-map): Add bindings for makeinfo-buffer, etc. - Delete bindings for texinfo-format-buffer/region. - (texinfo-define-common-keys): New function. - - * texinfmt.el: File deleted. - - * makeinfo.el: New file. - - * metamail.el: New file. - - * time-stamp.el: New file. - - Sun Jun 20 20:44:36 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * add-log.el (add-log-current-defun): To find the name of the - function being defined in emacs-lisp-mode, lisp-mode, and - scheme-mode, skip an opening paren and an s-expression, instead of - just one word. This allows us to properly recognize things like - define-key and define-macro. - - * replace.el (query-replace-map): Make RET exit query-replace, - just like ESC. - - Sun Jun 20 18:44:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * mh-e.el (mh-yank-cur-msg): Test mark-active. - - Sat Jun 19 17:14:27 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * version 19.15 released. - - Sat Jun 19 17:47:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * info.el (Info-insert-dir): Remove the call to recursive-edit. - - Sat Jun 19 15:05:59 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * info.el (Info-insert-dir): Record file attributes of files used. - Recompute the dir if they change. - - * files.el (insert-file): Report error if file is directory. - - Fri Jun 18 21:43:43 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - - * man.el (Man-switches): New variable. - (Man-build-man-command): Use it to build the man command. - (Man-mode): Mention it in documentation. - - Fri Jun 18 21:13:02 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * rmailout.el (rmail-output): Check file can be read before trying - to read part of it. - - * ange-ftp.el (ange-ftp-insert-file-contents): - Handle extra args BEG, END. - - Fri Jun 18 19:25:02 1993 Johan Vromans (jv@mh.nl) - - * forms.el: Delete local variables list. - (forms-forms-scrolls): Deleted. - (forms-forms-jumps): Deleted. - (forms--change-commands): Use substitute-key-definition. - (forms-mode): Call forms--change-commands later on. - - Fri Jun 18 13:55:31 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * compile.el (compilation-error-regexp-alist): Generalize the - Apollo/BSD4.3 regexp to handle IBM RS6k too. - - * mouse.el (mouse-secondary-save-then-kill): Don't switch windows. - Just set-buffer, and put save-excursion around it. - (mouse-set-secondary, mouse-start-secondary): Likewise. - (mouse-drag-secondary): Switch windows and move point just temporarily. - - Fri Jun 18 13:49:53 1993 Jim Blandy (jimb@geech.gnu.ai.mit.edu) - - * dired.el (dired-summary): dired-do-rename is on "R", not "r". - - Fri Jun 18 10:14:45 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) - - * calendar.el (calendar-version): Update to 5.1. Fixed a variety - of spelling error in comments and doc strings. - (calendar-sexp-debug): New variable to turn off error catching. - (calendar-absolute-from-gregorian): Removed unused vars month, day. - (view-calendar-holidays-initially, all-hebrew-calendar-holidays, - all-christian-calendar-holidays, all-christian-islamic-holidays, - diary-nonmarking-symbol, hebrew-diary-entry-symbol, - islamic-diary-entry-symbol, diary-include-string, - abbreviated-calendar-year, european-calendar-style, - european-calendar-display-form, american-calendar-display-form, - calendar-date-display-form, print-diary-entries-hook, - list-diary-entries-hook, nongregorian-diary-listing-hook, - nongregorian-diary-marking-hook, diary-list-include-blanks, - holidays-in-diary-buffer, general-holidays, - increment-calendar-month, calendar-sum, calendar-string-spread, - calendar-absolute-from-iso, calendar-print-iso-date, - hebrew-calendar-elapsed-days, list-yahrzeit-dates, - calendar-print-astro-day-number): Fix doc strings. - (calendar-nth-named-day): Rewritten to include optional day of month. - (general-holidays, calendar-holidays, hebrew-holidays, - christian-holidays, islamic-holidays, - solar-holidays): Rewritten to include require of cal-dst.el and to - show the time of the change to/from daylight savings time. - (calendar-current-time-zone, calendar-time-zone, - calendar-daylight-time-offset, calendar-standard-time-zone-name, - calendar-daylight-time-zone-name, calendar-daylight-savings-starts, - calendar-daylight-savings-ends, - calendar-daylight-savings-switchover-time): Moved to cal-dst.el. - (calendar-location-name, calendar-time-display-form, calendar-latitude, - calendar-longitude): Moved to solar.el. - (calendar-holidays): Unquote it! - - * solar.el (calendar-holiday-solar-equinoxes-solstices): Renamed - solar-equinoxes-solstices. - (calendar-time-display-form, calendar-latitude, - calendar-longitude): Moved from calendar.el. - (calendar-time-zone, calendar-standard-time-zone-name, - calendar-daylight-time-zone-name, - calendar-daylight-savings-starts, calendar-daylight-savings-ends): - Take default values from calendar-current-time-zone, instead of - being overwritten in open code if they were set to nil. - (solar-time-string): Subtract calendar-daylight-time-offset when - computing dst-ends. Avoid rounding errors when rounding time to - the nearest minute. - - * diary.el (list-sexp-diary-entries, - hebrew-calendar-year-Saturday-incomplete-Sunday, - hebrew-calendar-year-Monday-incomplete-Tuesday, - hebrew-calendar-year-Tuesday-regular-Thursday, - hebrew-calendar-year-Thursday-complete-Sunday, - hebrew-calendar-year-Saturday-complete-Thursday, - hebrew-calendar-year-Monday-complete-Saturday, - hebrew-calendar-year-Thursday-incomplete-Sunday): Fix doc strings. - (diary-sexp-entry): Use calendar-sexp-debug to turn off error catching. - - * diary-ins.el (insert-cyclic-diary-entry): Fix date form. - - * cal-mayan.el (calendar-mayan-days-before-absolute-zero, - calendar-mayan-haab-difference, calendar-mayan-tzolkin-difference, - calendar-mayan-tzolkin-haab-on-or-before, - calendar-previous-calendar-round-date, - calendar-absolute-from-mayan-long-count, - calendar-print-mayan-date): Fix doc strings. - - * holidays.el (calendar-holiday-function-fixed, - calendar-holiday-function-float, calendar-holiday-function-julian, - calendar-holiday-function-islamic, - calendar-holiday-function-hebrew, calendar-holiday-function-sexp, - calendar-holiday-function-advent, - calendar-holiday-function-easter-etc, - calendar-holiday-function-greek-orthodox-easter, - calendar-holiday-function-rosh-hashanah-etc, - calendar-holiday-function-hanukkah, - calendar-holiday-function-passover-etc, - calendar-holiday-function-tisha-b-av-etc): Renamed without words - "calendar" and "function"; changed argument from a list of values to - individual values. Fixed doc strings. - (calendar-holiday-function-if): Removed. - (calendar-holiday-solar-equinoxes-solstices): Renamed - solar-equinoxes-solstices. - (calendar-holiday-list): Rewrote to accomodate the name changes - above and the unquoting of calendar-holidays. - (calendar-cursor-holidays): Change screen-width to frame-width. - (holiday-sexp): Rewritten. - - * lunar.el (lunar-phase): Use time conversion from solar.el - - * cal-dst.el: New file. - (calendar-/, calendar-%, calendar-absolute-from-time, - calendar-time-from-absolute, calendar-next-time-zone-transition, - calendar-time-zone-daylight-rules): New functions. - (calendar-current-time-zone): Moved from calendar.el and rewritten. - (calendar-current-time-zone-cache): New variable. - (calendar-current-time-zone, calendar-time-zone, - calendar-daylight-time-offset, calendar-standard-time-zone-name, - calendar-daylight-time-zone-name, - calendar-daylight-savings-starts, calendar-daylight-savings-ends, - calendar-daylight-savings-switchover-time): Moved from calendar.el. - - Thu Jun 17 19:29:56 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * Version 19.14 released. - - Thu Jun 17 19:41:01 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * sendmail.el (mail-citation-hook): New hook var. - (mail-yank-original): Use that hook if not nil. - - * sc.el: Change usage comment. - - Thu Jun 17 18:57:01 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * faces.el (make-face-bold, make-face-italic, - make-face-bold-italic, make-face-unbold, make-face-unitalic): - Always pass the frame parameter to internal-try-face-font; we only - want to set the face for this frame. - - * faces.el (make-face-bold, make-face-italic, - make-face-bold-italic, make-face-unbold, make-face-unitalic): - Fix error messages. - - Thu Jun 17 00:12:30 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * faces.el (set-face-background-pixmap, face-background-pixmap): - Functions commented out. - - * mouse.el (mouse-start-secondary): New function. - (mouse-set-secondary, mouse-drag-secondary): New functions. - (mouse-kill-secondary, mouse-secondary-save-then-kill): New functions. - - * term/vt200.el: Translate F11 (ESC [ 23 ~) to ESC. - * term/vt201.el, term/vt220.el, term/vt240.el: Likewise. - - * autoload.el (generate-file-autoloads): Undo previous change - because make-docfile requires defvar doc string to start on first line. - - * cplus-md.el: Renamed from c++-mode.el. - * cplus-md1.el: Renamed from c++-mode-1.el. - - * vc.el (vc-rename-file): Remove periods from error messages. - (vc-backend-logentry-check, vc-revert-buffer): Likewise. - (vc-retrieve-snapshot, vc-create-snapshot): Likewise. - (vc-diff, vc-finish-logentry, vc-steal-lock): Likewise. - (vc-register, vc-next-action-on-file, vc-registration-error): Likewise. - (vc-cancel-version): Add space to end of question. - - * menu-bar.el (mouse-menu-choose-yank): New function. - Put it in the edit menu. - (yank-menu-length): New variable. - - Wed Jun 16 20:16:10 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * subr.el (event-basic-type): Deal with listy events properly. - - Wed Jun 16 23:06:58 1993 Roland McGrath (roland@churchy.gnu.ai.mit.edu) - - * autoload.el (make-autoload): Use memq once instead eq twice. - (generate-file-autoloads): For non-autoloads, copy the defn textually - rather than printing it after reading. - - * autoload.el (generate-autoload-cookie, update-autoloads-here): - Doc fixes. - - Wed Jun 16 17:21:51 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * frame.el (set-frame-configuration): Don't try to set a frame's - minibuffer. This parameter can't be changed, so that would signal - an error. - - Wed Jun 16 13:42:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * assoc.el (aput): Doc fix. - - * ls-lisp.el (insert-directory): If no handler, convert SWITCHES - from a string to a list of characters. - - * disass.el (disassemble-internal): If function is autoload, load it. - - * lisp.el (parens-require-spaces): Var renamed and sense changed. - (insert-parentheses): Corresponding changes. - - * rmailout.el (rmail-output): Use insert-file-contents to look at - beginning of output file. - - * term/x-win.el (x-switch-definitions): Fix -iconic. - - * bytecomp.el (byte-compile-file-form-defmumble): Typo in prev change. - - Tue Jun 15 03:56:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * server.el (server-process-filter): Use server-switch-buffer. - - * gud.el (gud-xdb-directories): Renamed from gud-xdb-paths. - Defvar moved earlier. All uses changed. - (gud-xdb-debugger-startup): Rename local var `paths'. - (gud-xdb-file-name): Likewise. - - * inf-lisp.el (inferior-lisp-buffer): Move defvar earlier. - - * mailalias.el (define-mail-alias): Remove excess whitespace better. - - * mailabbrev.el (define-mail-abbrev): Renamed from define-mail-alias. - (build-mail-abbrevs): Use new name. - - * bytecomp.el (byte-compile-file-form-defmumble): Use defalias - for named function, even if no doc string. - - * dired.el (dired-repeat-over-lines): Going fwd, skip new lines - that FUNCTION inserts after the current line. - Going backwd, no need for dired-move-to-filename each time. - - Tue Jun 15 21:10:22 1993 Shane Hartman (shane@nugget.spr.com) - - * gud.el (xdb): New debugger supported (xdb under HPUX-PARISC). - (gud-xdb-debugger-startup): New function. - (gud-xdb-file-name, gud-xdb-accumulation): New functions. - (gud-xdb-marker-filter, gud-xdb-paths, gud-xdb-find-file): New. - - Mon Jun 14 14:53:25 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * lisp.el (parens-dont-require-spaces): New variable. - (insert-parentheses): Obey that variable. - - * emerge.el (emerge-make-diff3-list): Pass ancestor second. - (emerge-extract-diffs3): Replace group-1 with group-2. - (emerge-handle-local-variables): Pass no arg to hack-local-variables. - - * picture.el (picture-replace-match): New function. - * dabbrev.el (dabbrev-expand): Do all changes with replace-match. - In picture-mode, use picture-replace-match instead. - - Mon Jun 14 10:57:43 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * holidays.el: Eval calendar-holidays; don't just use its value. - - * complete.el: (provide 'complete). - - Mon Jun 14 03:10:35 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * window.el (balance-windows): Total rewrite. - - Sun Jun 13 00:33:55 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * bytecomp.el (byte-compile-file): Undo previous change. - (batch-byte-recompile-directory): Doc fix. - - * isearch.el (isearch-highlight): If no face `isearch', use `region'. - - * c-mode.el (c-indent-line): Call c-backward-to-start-of-if - in the case of else following a close brace. - - * man.el (Man-getpage-in-background): Use TERM=dumb to prevent - terminal control sequences in the output. - - Sat Jun 12 16:58:04 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * files.el (abbreviate-file-name): Match home dir with no / - if nothing else follows. - - * finder.el (finder-find-library): New function. - (finder-commentary): Use it. - - * forms.el, forms-pass.el, forms-d2.el, forms-dat.el, forms.README: - Moved from subdir forms-mode. Subdir deleted. - - Sat Jun 12 16:03:03 1993 Johan Vromans (jv@mh.nl) - - * forms.el (forms--change-commands): - Use (function (lambda ...)) instead of '(lambda...). - - * forms.el: Provide `forms' as well as `forms-mode'. - (forms-new-record-filter, forms-modified-record-filter): Add defvars. - - Sat Jun 12 02:53:34 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * files.el (make-directory): By default create dir default-dir. - - Fri Jun 11 11:46:51 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * vc.el (vc-backend-diff): Always use -q option. - - * files.el (file-truename): Don't use expand-file-name to merge - a link target into the previous dir. Handle .. and . explicitly. - - * env.el (setenv): Treat case as significant. - - * mailabbrev.el (sendmail-pre-abbrev-expand-hook): - If last-command-char is not a character, don't check char-syntax. - - * inf-lisp.el: Doc fixes. - (run-lisp): Add autoload. - (inferior-lisp-mode-map): Explicitly make local prefix keys. - - * cmulisp.el: File deleted. - - * server.el (server-window): New variable. - (server-switch-buffer): Use it. - - * flow-ctrl.el (enable-flow-control): Don't alter the 8-bit flag. - - * man.el (Man-filter-list): Add an element for X man pages. - (Man-goto-page): Continue past errors in Man-build-references-alist. - - * rmailout.el (rmail-output-to-rmail-file): Use the smart default - in the prompt. - - * register.el (view-register): Handle file name values. - - * etags.el (etags-tags-completion-table): When skipping the noise - before the tag name, let it end with any char not allowed in a tag. - - * files.el (cd): Use file-name-absolute-p. - (cd-absolute): No longer interactive. - - * echistory.el (electric-history-map): Don't use fillarray; - make default bindings instead. Bind up, down, home, next, prior. - - Fri Jun 11 05:44:40 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * frame.el (frame-initialize): Remember to actually traverse - initial-frame-alist. - - * gud.el (gud-last-last-frame): New variable. - (gud-display-frame): Save the frame we displayed in - gud-last-last-frame. - (gud-refresh): Force gud-display-frame to jump to the last frame - displayed, even if it has already done so once. - - * man.el (manual-entry): Recognize the subject(section) syntax. - - * picture.el (move-to-column-force): If column is negative, go - flush left. - - * simple.el (hscroll-point-visible): Work as documented in the - docstring for hscroll-step. - - Fri Jun 11 00:04:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * lisp-mode.el (lisp-indent-function): Look for either - lisp-indent-hook or lisp-indent-function property. - - * files.el (make-backup-files): Doc fix. - - * mouse.el (mouse-set-mark-fast): New function. - (mouse-show-mark): New function. - (mouse-kill-ring-save, mouse-save-then-kill): Use them. - (mouse-save-then-kill): Don't let kill-region alter this-command. - Check last-command accordingly. - (mouse-split-window-vertically): Handle scroll bar events. - - Thu Jun 10 13:41:06 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * rmail.el (rmail-primary-inbox-list): Use defvar, not defconst. - - * files.el (basic-save-buffer): Cal auto-save-mode with t as arg - if and only if auto save was off and default is on. - (set-visited-file-name): Likewise. - - * simple.el (append-to-buffer): Interactively, supply all 3 args. - Allow nonexistent buffers. - - * files.el (abbreviate-file-name): Make abbreviated-home-dir - from `~/', not from just `~'. - (hack-one-local-variable): Query for ...-hook(s) and ..-function(s) - as the `eval' variable. - - * ispell.el: Doc fixes. - (ispell-command, ispell-command-options): New defvars. - (start-ispell): Use them. - - * ange-ftp.el (ange-ftp-multi-msgs): Add 331-. - - * man.el (Man-mode): Run Man-mode-hook. - - * bibtex.el (bibtex-mode-map): Use tex-insert-quote, not TeX-... - - Thu Jun 10 15:16:11 1993 Shane Hartman (shane@nugget.spr.com) - - * c++-mode.el (calculate-c++-indent): Respect - c-continued-brace-offset (as in c-mode.el). - - Thu Jun 10 06:39:46 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * frame.el (frame-initialize): When deleting geometry - specifications from initial-frame-alist, remember that they may - occur more than once, and do, if the -geometry option was - specified as well as a .geometry resource. - - * scroll-bar.el (scroll-bar-mode): Variable deleted. - (scroll-bar-mode): Function changed to consult default-frame-alist - instead of the variable. - - * gnus.el (gnus-start-news-server): If no server has been - specified, but gnus-nntp-service is nil, don't ask for a server - name; use the local host. - - * ange-ftp.el (ange-ftp-make-directory): Take second optional - argument parents, like the original. Implement it. - - * gnus.el (gnus-newsrc-to-gnus-format): Change regexp which - matches .newsrc lines for better performance under the new regexp - routines. - - Thu Jun 10 13:40:44 1993 Dave Gillespie (daveg@synaptics.com) - - * bytecomp.el: Bug fixes and upgrade to match Zawinski's v2.10. - (byte-compile-dest-file): Added support for emacs-lisp-file-regexp. - (byte-recompile-directory): Several things involving `noninteractive'. - (byte-compile-file): Changed prompting in read-file-name. - (byte-compile-insert-header): Put a magic number at top of .elc files, - fixed backwards test of byte-compile-compatibility. - (byte-compile-form, byte-defop-compiler19, byte-compile-list, - byte-compile-concat, byte-compile-insert): Likewise. - (byte-compile-condition-case): Added checking for unknown conditions. - (batch-byte-recompile-directory): New function. - - Wed Jun 9 05:43:49 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * compile.el (compilation-error-list): When we haven't yet - generated a marker for the source position of an error message, - store (FILENAME . LINE-NUMBER), not ((DIRECTORY . FILE) - LINE-NUMBER). Doc fix. - (next-error, compilation-parse-errors): Adjusted appropriately. - - * scroll-bar.el (scroll-bar-set-window-start): Remember that the - scroll bar numbers reflect the accessible region of the buffer, - not the entire buffer. - - Tue Jun 8 12:28:05 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * dired.el (dired-flag-auto-save-files): Ignore `*' added by ls -F. - - * sc.el (sc-mark): Use mark-marker. - - Tue Jun 8 08:28:14 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * Version 19.13 released. - - Tue Jun 8 00:40:46 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * fortran.el (fortran-indent-new-line): Renamed from - fortran-reindent-then-newline-and-indent. - - * mouse.el (mouse-drag-region-1): Un-comment-out this function. - - * info.el (Info-follow-reference): Fix completion defaulting. - - Mon Jun 7 21:47:37 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) - - * calendar.el (calendar-current-time-zone): Change variable names - to make them more readable. - (calendar-time-zone, calendar-standard-time-zone-name, - calendar-daylight-time-zone-name, calendar-daylight-savings-ends, - calendar-daylight-savings-starts): Don't autload them. - - Mon Jun 7 00:25:00 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * apropos.el (safe-documentation): Don't crash on byte-compiled macro. - - * telnet.el (telnet-simple-send): New function. - (telnet): Arrange to use that. - - * sun-keys.el: File deleted. - - * texinfo.el (texinfo-section-types-regexp): Add @chapheading. - - * gud.el: Doc fixes. Delete local variable list at the end. - (expr-forward-sexp): Renamed from forw-expr. - (expr-backward-sexp): Renamed from back-expr. - - * case-table.el (describe-buffer-case-table): Merge locals i and ch. - Make *Help* current buffer for describe-vector. - - * bibtex.el: Fix typos in previous change. - Add a few menu items. - - * compile.el (compilation-error-regexp-alist): Make sure each regexp - can only match a few characters at the front. Split off the Mips - CC regexp from the Apollo regexp. - - * rmail.el (rmail-variables): Default rmail-inbox-list here. - (rmail): Not here. - - * ange-ftp.el (ange-ftp-real-load): New function. - (ange-ftp-load): New function--handles `load'. - - Sun Jun 6 18:29:36 1993 Paul Eggert (eggert@twinsun.com) - - * term/sun-mouse.el (mouse-union-first-preferred): Renamed from - mouse-union-first-prefered. - - Sun Jun 6 17:46:25 1993 Paul Eggert (eggert@twinsun.com) - - * sc.el (sc-consistent-cite-p): Renamed from sc-consistant-cite-p. - - * etags.el (etags-recognize-tags-table): Fix misspelling of - find-tag-regexp-next-line-after-failure-p. - - * bibtex.el (bibtex-name-alignment): Renamed from - bibtex-name-alignement. - - * allout.el (outlinify-sticky): Renamed from outlineify-sticky. - - * faces.el (x-create-frame-with-faces): Reversevideo -> ReverseVideo. - * frame.el (frame-initialize): Likewise. - - Sun Jun 6 01:27:16 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * outline.el (outline-minor-mode): Add autoload cookie. - - * bibtex.el: Define 2 local menu-bar submaps. - (bibtex-x-help, bibtex-x-environment): Deleted. - - * isearch.el (search-upper-case): Make `no-yanks' the default. - (isearch-no-upper-case-p): New arg REGEXP-FLAG. - (isearch-search): Pass new arg. - (isearch-member-equal): Deleted. - (isearch-overlay): New variable. - (isearch-highlight, isearch-dehighlight): Rewritten to use overlays. - - * dired.el (dired-unmark-all-files): Read arg as just a character. - Use non-regexp search to find a specific mark. - Use subst-char-in-region to make the change. - Improve the message at the end. - - * vip.el (vip-ctl-key-equivalent): Use vip-escape-to-emacs. - (vip-escape-to-emacs): Use read-key-sequence and key-binding. - Arg EVENTS replaces arg CHAR. - (vip-ESC, vip-ctl-c, vip-ctl-x, vip-ctl-h): These callers changed. - - * compile.el (compile-internal): Alter current buffer only temporarily. - - Sat Jun 5 13:08:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * sendmail.el (mail-do-fcc): Replace the code for appending to buffer. - - * rmailsum.el (rmail-summary-next-msg): Fix number of dots in regexp. - - * scroll-bar.el (scroll-bar-drag-1): - Calculate position relative to the accessible part of the buffer. - - * menu-bar.el (menu-bar-help-menu): Add defvar. - (menu-bar-edit-menu, menu-bar-file-menu): Likewise. - - * dired.el (dired-flag-backup-files): Handle `*' made by `ls -F'. - - * ange-ftp.el (internal-ange-ftp-mode): Renamed from ange-ftp-mode. - Callers changed. - - * menu-bar.el (window-system): Enable menu bars only if - window-system is non-nil. - - * add-log.el (add-log-current-defun): Fix typos in last change. - - Sat Jun 5 04:39:08 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * term/x-win.el (x-selection-timeout): Set it, using x-get-resource. - - Fri Jun 4 07:14:44 1993 Paul Eggert (eggert@twinsun.com) - - * timezone.el: (timezone-make-date-arpa-standard, - timezone-make-date-sortable): Move common code into timezone-fix-time. - (timezone-fix-time): Merge common code from above two functions. - Yield time zone at end of result vector. - Set time zone offset correctly as of the given time, - instead of guessing from the current offset. - (timezone-make-arpa-date, timezone-zone-to-minute): Convert - current-time-zone style timezones into RFC-822 style timezones. - - (timezone-time-from-absolute, timezone-time-zone-from-absolute, - timezone-day-number, timezone-absolute-from-gregorian): - More functions borrowed from Reingold's calendar package. - - (timezone-make-arpa-date, timezone-make-sortable-date): Can safely - assume that year includes century, since timezone-fix-time guarantees - this. - - * gnuspost.el (gnus-current-time-zone): New function, which tries - current-time-zone, and if that fails falls back on gnus-local-timezone. - (gnus-inews-date): Use it. - (gnus-inews-valid-date): New optional args TIME (default now) and ZONE - (default GMT). - (gnus-inews-buggy-date): New optional arg TIME (default now). - - * gnus.el (gnus-local-timezone): Now used only if current-time-zone - does not work. - - Fri Jun 4 01:16:48 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * mh-e.el (mh-yank-cur-msg): Use (mark t). - - * simple.el (mark): Doc fix. - - * add-log.el (add-log-current-defun): Handle Fortran. - - * rmail.el (rmail-resend): Require sendmail and mailalias. - - * time.el (display-time-24hr-format): Make it a user option. - - * edt.el (GOLD-prefix): Define *after* GOLD-map. - - * dired.el (dired-change-marks): Just ding if one arg is RET. - Search for strings, not regexps. Use subst-char-in-region. - - * isearch.el (isearch-mode): Set isearch-window-configuration - only if in slow mode. - (isearch-done): Use isearch-window-configuration only if non-nil. - (isearch-other-control-char): For mouse event, call isearch-done - in the buffer whose keymap was used. - - * flow-ctrl.el (enable-flow-control): Doc fix. - - Thu Jun 3 20:01:19 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) - - * calendar.el (calendar-holidays): Quote it to delay evaluation - until it's needed. - - * holidays.el (calendar-holiday-list): Eval calendar-holidays. - - Thu Jun 3 00:47:23 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * sendmail.el (mail-do-fcc): Omit first 2 lines when appending - to an RMAIL buffer. - - * simple.el (kill-ring-save): Doc fix. - - * rmailsum.el (rmail-summary-expunge-and-save): Do save-buffer last. - Use two separate save-excursion calls. - (rmail-summary-input): Use pop-to-buffer. - (rmail-summary-get-new-mail): Gobble rmail-current-message; - later go to that message. - (rmail-summary-next-msg): Start at end of line, if moving forward. - Move to beginning of line, after the loop. - (rmail-new-summary): Fix format of elt in minor-mode-alist. - - * rmail.el (rmail-select-summary): Add a save-excursion. - - * rmailsum.el (rmail-summary-expunge-and-save): - Call set-buffer again after rmail-only-expunge. - (rmail-summary-add-label, rmail-summary-kill-label): - Fix reading the label. - (rmail-summary-rmail-update): Bind window locally. - Use unwind-protect, not save-window-excursion. - - * vc-hooks.el (vc-find-file-hook): Check buffer-file-name is non-nil. - - * hideif.el (define-hide-ifdef-mode-map): Don't bind C-c LETTER. - Use C-c ESC LETTER instead. - Handle case where where-is-internal returns nil. - - * texinfmt.el: Provide texinfmt. - - * bytecomp.el (byte-compile-insert-header): Fix backwards test - of byte-compile-compatibility. - - * info.el (Info-mode-map): Bind mouse-2, not mouse-3. - - * view.el (View-scroll-lines-forward): If we exit, do nothing else. - - * calendar.el (calendar-mode): Doc fix. - (calendar-mark-ring): New defvar. - - * frame.el (frame-initialize): Set cursor-color last. - - * vip.el (vip-escape-to-emacs): Temporarily restore local map - and use read-key-sequence. - - * rmailsum.el (rmail-summary-by-senders): New function. - (rmail-message-senders-p): New function. - - Thu Jun 3 17:58:59 1993 Dave Gillespie (daveg@synaptics.com) - - * complete.el (PC-lisp-complete-symbol): Added. - (PC-look-for-include-file): Recognize some Lisp notations. - (PC-include-file-all-completions): Fixed uppercase variable names. - - Wed Jun 2 12:56:57 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * info.el (Info-suffix-list): Handle .gz suffix. - * ange-ftp.el (ange-ftp-binary-file-name-regexp): Handle .gz. - - * ehelp.el (electric-help-command-loop): Use equal to compare - lists of events. - - * electric.el (Electric-command-loop): Use eq to compare events. - - * diff.el (diff): Really do use arg SWITCHES. - - * frame.el (frame-initialize): Delete geometry parms - from initial-frame-alist. - - Wed Jun 2 09:59:02 1993 Edward M. Reingold (reingold@emr.cs.uiuc.edu) - - * calendar.el (calendar-daylight-savings-starts): Mention use of - nil value in documentation string. - (calendar-daylight-time-offset): New variable. - (calendar-daylight-savings-switchover-time): New variable. - (calendar-mode): Mention them. - (calendar-time-zone, calendar-print-astro-day-number, - calendar-time-display-form): Change Universal Time (UT) to - Coordinated Universal Time (UTC). - - *solar.el (solar-setup, solar-ephemeris-time, sunrise-sunset): Change - Universal Time (UT) to Coordinated Universal Time (UTC). - (solar-time-string): Use calendar-daylight-time-offset instead of - 1 hr, and use calendar-daylight-savings-switchover-time instead of - midnight. Add an optional parameter to allow forcing the use of - standard or daylight savings time. Fix code so it works in - southern hemisphere (start of dst precedes end of dst in a - calendar year) and when dst either starts or ends in a calendar - year, but not both. - - Tue Jun 1 17:40:30 1993 Ken Manheimer (klm@coil.nist.gov) - - * allout.el (outlineify-sticky): Reconciled provisions for - non-standard and standard prefix leaders. - - Tue Jun 1 16:09:26 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * Version 19.12 released. - - * reporter.el: New file. - - * mouse.el (mouse-buffer-menu): Don't select the event's window, - if event has frame instead. - - * tar-mode.el: Typo in autoload cookie. - - * shell.el (shell-prompt-pattern): Use defvar. - - * ange-ftp.el (ange-ftp-make-backup-files): Doc fix. - - * sendmail.el (mail-signature): Do not insert a line with `--'. - - * menu-bar.el (mouse-menu-bar-buffers): Renamed from mouse-buffer-menu. - - * subr.el (posn-timestamp): Doc fix. - - * sort.el (sort-fold-case): New variable. - (sort-subr): Bind case-fold-search from sort-fold-case. - - * simple.el (undo): - Pass proper arg to delete-auto-save-file-if-necessary. - - * desktop.el: New file. - - * c++-mode-1.el: New file. - - Tue Jun 1 16:03:30 1993 Ken Manheimer (klm@coil.nist.gov) - - * allout.el (move-to-column): Pass zero instead of negative arg. - Added some free variables defvars, so byte-comple doesn't complain. - Included some stub code, eventually will be proper use of Emacs 19 - minor-mode-sensitive keymaps. - - Tue Jun 1 14:01:25 1993 Stephen A. Wood (saw@cebaf.gov) - - * fortran.el (fortran-mode): Replace comment-indent-hook with - comment-indent-function. - - * fortran.el (fortran-is-in-string-p): Replaced with new version - that uses the syntax table. - - * fortran.el (calculate-fortran-indent): Lines that have a # after - whitespace are interpreted as cpp directives and outdented back to - column zero. - - Tue Jun 1 00:27:03 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * lucid.el (map-keymap): Doc fix. - - * dired-aux.el (dired-compress-file): Use gzip when proper/possible. - - * sc.el: Fix installation instructions. - (sc-cite-original): Add autoload cookie. - - * sendmail.el (mail-yank-hooks): New hook variable. - (mail-yank-original): Run the hook. - (mail-indent-citation): New function. - - * cl.el (cl-mod): Renamed from mod. - - * Version 19.11 released. - - * lucid.el (copy-tree): Use let* to bind new before i. - - * terminal.el (te-pass-through): Delete debugging code left by mistake. - - * comint.el (comint-filter): Put window-start before the input. - - * isearch.el (isearch-mode): If enter recursive-edit, - also bind isearch-recursive-edit. - - * cookie1.el: Renamed from cookie.el. - Provide cookie1. - * yow.el, spook.el: Changed accordingly. - - Mon May 31 23:21:41 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * outline.el (outline-flag-region): Pass t as NOUNDO arg - to subst-char-in-region. No need to restore buffer-modified-p by hand. - - Mon May 31 20:29:00 1993 Richard Stallman (rms@wookumz.gnu.ai.mit.edu) - - * term/x-win.el (x-invocation-args): Add defvar. - - Mon May 31 19:59:12 1993 Junio Hamano (junio@twinsun.com) - - * window.el (count-windows): PROC argument of - walk-windows takes an argument. - - Mon May 31 00:20:50 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * gnus.el (gnus-summary-isearch-article): Call isearch-forward - in ordinary fashion with no args. - (gnus-inews-article-hook, gnus-prepare-article-hook): - Initialize to a list. - (gnus-read-newsrc-file): If timestamps are equal, reload .newsrc. - - * bibtex.el (bibtex-mode): Add autoload. - - * files.el (inhibit-local-variables-regexps): New variable. - (set-auto-mode): Handle inhibit-local-variables-regexps. - - * tar-mode.el: Don't initialize write-file-hooks. - Don't change auto-mode-alist. - (tar-regexp): Deleted. - (tar-normal-mode): Deleted. - (tar-mode): Add autoload. - - * faces.el (x-resolve-font-name): Clean up error messages. - - * timer.el (run-at-time): Pass args to start-process in right order. - - * info.el (Info-get-token): Check that thesecond search succeeded. - - * edebug.el: Provide edebug. - - * rmailsum.el (rmail-message-subject-p): Fix typo in string constant. - - * cl.el (mod): Use cl-floor. - (rem): Use cl-truncate. - - * gud.el (gud-def): Don't use gud-key-prefix at compile time. - - * window.el (shrink-window-if-larger-than-buffer): Add `interactive'. - Do nothing if window contents not entirely visible. - - * sendmail.el (mail-do-fcc): Put back the newline at the start - of the fcc temp buffer. It got lost somewhere. - - Sun May 30 15:14:40 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) - - * gnus.el (gnus-nntp-server): Use gnus-default-nntp-server. - - * info.el (Info-mode-map): Correct Info-top to Info-top-node. - - * man.el (Man-notify-when-ready): Correct previous change. - - Sun May 30 18:28:43 1993 Stephen Gildea (gildea@alex.lcs.mit.edu) - - * mh-e.el (mh-signature-file-name): New variable. - mh-e version 3.8.2. - - Sun May 30 13:21:04 1993 Jim Blandy (jimb@wookumz.gnu.ai.mit.edu) - - * faces.el (x-resolve-font-name): Fix args to error; the format - string was changed, but not the arguments to be substituted. - - * faces.el (x-resolve-font-name): Give correct error message - depending on whether or not FACE was non-nil. - Sun May 30 00:15:27 1993 Richard Stallman (rms@mole.gnu.ai.mit.edu) --- 1,2 ---- *************** *** 2991,2995 **** * vc.el (vc-revert-buffer1): Typo fix in last change. ! * shell.el (shell-mode): isationization (doc fix). * shell.el (shell-mode): Capitalize mode name. --- 1202,1206 ---- * vc.el (vc-revert-buffer1): Typo fix in last change. ! * shell.el (shell-mode): isation/ization (doc fix). * shell.el (shell-mode): Capitalize mode name. *************** *** 3107,3111 **** * lisp-mnt.el (lm-commentary-region): Gone. - (lm-commentary): New function, replacing lm-commentary-region. --- 1318,1321 ---- diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/add-log.el emacs-19.18/lisp/add-log.el *** emacs-19.17/lisp/add-log.el Sat Jul 3 21:44:41 1993 --- emacs-19.18/lisp/add-log.el Sat Jul 31 14:41:01 1993 *************** *** 31,34 **** --- 31,41 ---- "*Name of a change log file for \\[add-change-log-entry].") + ;;;###autoload + (defvar add-log-current-defun-function nil + "\ + *If non-nil, function to guess name of current function from surrounding text. + \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun' + instead) with no arguments. It returns a string or nil if it cannot guess.") + (defun change-log-name () (or change-log-default-name *************** *** 35,38 **** --- 42,46 ---- (if (eq system-type 'vax-vms) "$CHANGE_LOG$.TXT" "ChangeLog"))) + ;;;###autoload (defun prompt-for-change-log-name () "Prompt for a change log name." *************** *** 94,102 **** ;;;###autoload ! (defun add-change-log-entry (&optional whoami file-name other-window) "Find change log file and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. ! Third arg OTHER-WINDOW non-nil means visit in other window." (interactive (list current-prefix-arg (prompt-for-change-log-name))) --- 102,112 ---- ;;;###autoload ! (defun add-change-log-entry (&optional whoami file-name other-window new-entry) "Find change log file and add an entry for today. Optional arg (interactive prefix) non-nil means prompt for user name and site. Second arg is file name of change log. If nil, uses `change-log-default-name'. ! Third arg OTHER-WINDOW non-nil means visit in other window. ! Fourth arg NEW-ENTRY non-nil means always create a new entry at the front; ! never append to an existing entry." (interactive (list current-prefix-arg (prompt-for-change-log-name))) *************** *** 114,118 **** (read-input "Site name: " (system-name)) (system-name))) ! (defun (add-log-current-defun)) paragraph-end entry) --- 124,129 ---- (read-input "Site name: " (system-name)) (system-name))) ! (defun (funcall (or add-log-current-defun-function ! 'add-log-current-defun))) paragraph-end entry) *************** *** 156,160 **** (if entry (insert entry))) ! ((and (re-search-forward (concat (regexp-quote (concat "* " entry)) ;; Don't accept `foo.bar' when --- 167,172 ---- (if entry (insert entry))) ! ((and (not new-entry) ! (re-search-forward (concat (regexp-quote (concat "* " entry)) ;; Don't accept `foo.bar' when *************** *** 203,209 **** (defun add-change-log-entry-other-window (&optional whoami file-name) "Find change log file in other window and add an entry for today. ! First arg (interactive prefix) non-nil means prompt for user name and site. ! Second arg is file name of change log. ! Interactively, with a prefix argument, the file name is prompted for." (interactive (if current-prefix-arg (list current-prefix-arg --- 215,221 ---- (defun add-change-log-entry-other-window (&optional whoami file-name) "Find change log file in other window and add an entry for today. ! Optional arg (interactive prefix) non-nil means prompt for user name and site. ! Second arg is file name of change log. \ ! If nil, uses `change-log-default-name'." (interactive (if current-prefix-arg (list current-prefix-arg *************** *** 226,236 **** left-margin 8 fill-column 74) ;; Let each entry behave as one paragraph: ! (set (make-local-variable 'paragraph-start) "^\\s *$\\|^^L") ! (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^^L\\|^\\sw") ;; Let all entries for one day behave as one page. ;; Match null string on the date-line so that the date-line ;; is grouped with what follows. ! (set (make-local-variable 'page-delimiter) "^\\<\\|^ ") (set (make-local-variable 'version-control) 'never) (set (make-local-variable 'adaptive-fill-regexp) "\\s *") --- 238,249 ---- left-margin 8 fill-column 74) + (use-local-map change-log-mode-map) ;; Let each entry behave as one paragraph: ! (set (make-local-variable 'paragraph-start) "^\\s *$\\|^\f") ! (set (make-local-variable 'paragraph-separate) "^\\s *$\\|^\f\\|^\\sw") ;; Let all entries for one day behave as one page. ;; Match null string on the date-line so that the date-line ;; is grouped with what follows. ! (set (make-local-variable 'page-delimiter) "^\\<\\|^\f") (set (make-local-variable 'version-control) 'never) (set (make-local-variable 'adaptive-fill-regexp) "\\s *") *************** *** 237,240 **** --- 250,272 ---- (run-hooks 'change-log-mode-hook)) + (defvar change-log-mode-map nil + "Keymap for Change Log major mode.") + (if change-log-mode-map + nil + (setq change-log-mode-map (make-sparse-keymap)) + (define-key change-log-mode-map "\M-q" 'change-log-fill-paragraph)) + + ;; It might be nice to have a general feature to replace this. The idea I + ;; have is a variable giving a regexp matching text which should not be + ;; moved from bol by filling. change-log-mode would set this to "^\\s *\\s(". + ;; But I don't feel up to implementing that today. + (defun change-log-fill-paragraph (&optional justify) + "Fill the paragraph, but preserve open parentheses at beginning of lines. + Prefix arg means justify as well." + (interactive "P") + (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s(")) + (paragraph-start (concat paragraph-start "\\|^\\s *\\s("))) + (fill-paragraph justify))) + (defvar add-log-current-defun-header-regexp "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[a-z_---A-Z]+\\)[ \t]*[:=]" diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/ange-ftp.el emacs-19.18/lisp/ange-ftp.el *** emacs-19.17/lisp/ange-ftp.el Sun Jul 18 02:18:15 1993 --- emacs-19.18/lisp/ange-ftp.el Mon Aug 9 01:03:39 1993 *************** *** 857,861 **** ;;;; ------------------------------------------------------------ ! (defconst ange-ftp-version "$Revision: 1.30 $") (defvar ange-ftp-data-buffer-name " *ftp data*" --- 857,861 ---- ;;;; ------------------------------------------------------------ ! (defconst ange-ftp-version "$Revision: 1.32 $") (defvar ange-ftp-data-buffer-name " *ftp data*" *************** *** 1976,1979 **** --- 1976,1982 ---- (let ((cmd0 (car cmd)) (cmd1 (nth 1 cmd)) + (ange-ftp-this-user user) + (ange-ftp-this-host host) + (ange-ftp-this-msg msg) cmd2 cmd3 host-type fix-name-func) *************** *** 2007,2013 **** ;; First argument is the remote name ! ((let ((ange-ftp-this-user user) ! (ange-ftp-this-host host) ! (ange-ftp-this-msg msg)) (setq fix-name-func (or (cdr (assq host-type ange-ftp-fix-name-func-alist)) --- 2010,2014 ---- ;; First argument is the remote name ! ((progn (setq fix-name-func (or (cdr (assq host-type ange-ftp-fix-name-func-alist)) *************** *** 3751,3760 **** ;;; This regexp takes care of real ange-ftp file names (with a slash ! ;;; and colon), and absolute filenames with only one component, for ! ;;; the sake of hostname completion. ;;;###autoload ! (or (assoc "^/[^/:]*\\([^/:]:\\|\\'\\)" file-name-handler-alist) (setq file-name-handler-alist ! (cons '("^/[^/:]*\\([^/:]:\\|\\'\\)" . ange-ftp-hook-function) file-name-handler-alist))) --- 3752,3768 ---- ;;; This regexp takes care of real ange-ftp file names (with a slash ! ;;; and colon). ! ;;;###autoload ! (or (assoc "^/[^/:]*[^/:]:" file-name-handler-alist) ! (setq file-name-handler-alist ! (cons '("^/[^/:]*[^/:]:" . ange-ftp-hook-function) ! file-name-handler-alist))) ! ! ;;; This regexp recognizes and absolute filenames with only one component, ! ;;; for the sake of hostname completion. ;;;###autoload ! (or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist ! (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function) file-name-handler-alist))) *************** *** 5084,5088 **** ;; Since CMS doesn't have any full file name syntax, we have to fudge ! ;; things with cd's. We actually send too many cd's, but is dangerous ;; to try to remember the current minidisk, because if the connection ;; is closed and needs to be reopened, we will find ourselves back in --- 5092,5096 ---- ;; Since CMS doesn't have any full file name syntax, we have to fudge ! ;; things with cd's. We actually send too many cd's, but it's dangerous ;; to try to remember the current minidisk, because if the connection ;; is closed and needs to be reopened, we will find ourselves back in diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/autoload.el emacs-19.18/lisp/autoload.el *** emacs-19.17/lisp/autoload.el Wed Jul 14 16:54:47 1993 --- emacs-19.18/lisp/autoload.el Wed Jul 21 18:35:16 1993 *************** *** 110,114 **** name))) (print-length nil) ! (floating-output-format "%20e") (done-any nil) (visited (get-file-buffer file)) --- 110,114 ---- name))) (print-length nil) ! (float-output-format "%.20e") (done-any nil) (visited (get-file-buffer file)) *************** *** 168,175 **** (setcdr p nil) (princ "\n(" outbuf) ! (mapcar (function (lambda (elt) ! (prin1 elt outbuf) ! (princ " " outbuf))) ! autoload) (princ "\"\\\n" outbuf) (princ (substring --- 168,176 ---- (setcdr p nil) (princ "\n(" outbuf) ! (let ((print-escape-newlines t)) ! (mapcar (function (lambda (elt) ! (prin1 elt outbuf) ! (princ " " outbuf))) ! autoload)) (princ "\"\\\n" outbuf) (princ (substring *************** *** 264,268 **** (set-buffer (find-file-noselect file)) (save-excursion ! (search-forward generate-autoload-cookie nil t))) ;; There are autoload cookies in FILE. ;; Have the user tell us where to put the new section. --- 265,272 ---- (set-buffer (find-file-noselect file)) (save-excursion ! (save-restriction ! (widen) ! (goto-char (point-min)) ! (search-forward generate-autoload-cookie nil t)))) ;; There are autoload cookies in FILE. ;; Have the user tell us where to put the new section. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/blackbox.el emacs-19.18/lisp/blackbox.el *** emacs-19.17/lisp/blackbox.el Wed Jun 9 06:57:29 1993 --- emacs-19.18/lisp/blackbox.el Sun Aug 1 18:43:47 1993 *************** *** 75,81 **** --- 75,85 ---- (suppress-keymap blackbox-mode-map t) (define-key blackbox-mode-map "\C-f" 'bb-right) + (define-key blackbox-mode-map [right] 'bb-right) (define-key blackbox-mode-map "\C-b" 'bb-left) + (define-key blackbox-mode-map [left] 'bb-left) (define-key blackbox-mode-map "\C-p" 'bb-up) + (define-key blackbox-mode-map [up] 'bb-up) (define-key blackbox-mode-map "\C-n" 'bb-down) + (define-key blackbox-mode-map [down] 'bb-down) (define-key blackbox-mode-map "\C-e" 'bb-eol) (define-key blackbox-mode-map "\C-a" 'bb-bol) *************** *** 83,98 **** (define-key blackbox-mode-map [insert] 'bb-romp) (define-key blackbox-mode-map "\C-m" 'bb-done) ! (define-key blackbox-mode-map [kp-enter] 'bb-done) ! ! ;; This is a kludge. What we really want is a general ! ;; feature for reminding terminal keys to the functions ! ;; corresponding to them in local maps. ! (mapcar (function ! (lambda (funk) ! (mapcar (function ! (lambda (key) ! (define-key blackbox-mode-map key funk))) ! (where-is-internal funk)))) ! '(previous-line next-line backward-character forward-character))) ;; Blackbox mode is suitable only for specially formatted data. --- 87,91 ---- (define-key blackbox-mode-map [insert] 'bb-romp) (define-key blackbox-mode-map "\C-m" 'bb-done) ! (define-key blackbox-mode-map [kp-enter] 'bb-done)) ;; Blackbox mode is suitable only for specially formatted data. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/bytecomp.el emacs-19.18/lisp/bytecomp.el *** emacs-19.17/lisp/bytecomp.el Sun Jul 18 02:02:01 1993 --- emacs-19.18/lisp/bytecomp.el Mon Aug 2 00:46:58 1993 *************** *** 1056,1059 **** --- 1056,1060 ---- "Recompile every `.el' file in DIRECTORY that needs recompilation. This is if a `.elc' file exists but is older than the `.el' file. + Files in subdirectories of DIRECTORY are processed also. If the `.elc' file does not exist, normally the `.el' file is *not* compiled. *************** *** 1060,1064 **** But a prefix argument (optional second arg) means ask user, for each such `.el' file, whether to compile it. Prefix argument 0 means ! don't ask and compile the file anyway." (interactive "DByte recompile directory: \nP") (if arg --- 1061,1067 ---- But a prefix argument (optional second arg) means ask user, for each such `.el' file, whether to compile it. Prefix argument 0 means ! don't ask and compile the file anyway. ! ! A nonzero prefix argument also means ask about each subdirectory." (interactive "DByte recompile directory: \nP") (if arg *************** *** 1098,1101 **** --- 1101,1106 ---- (message "Compiling %s..." source)) (byte-compile-file source) + (or noninteractive + (message "Checking %s..." directory)) (setq file-count (1+ file-count)) (if (not (eq last-dir directory)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/c-mode.el emacs-19.18/lisp/c-mode.el *** emacs-19.17/lisp/c-mode.el Mon Jun 28 00:48:39 1993 --- emacs-19.18/lisp/c-mode.el Mon Aug 2 01:48:32 1993 *************** *** 643,646 **** --- 643,648 ---- ;; is not inside a comment. (progn + ;; Move back to the `(' starting arglist + (goto-char lim) (beginning-of-line) (while (and (not comment) *************** *** 956,963 **** (backward-paragraph)) (defun indent-c-exp (&optional endpos) ! "Indent each line of the C grouping following point. ! If optional arg ENDPOS is given, indent each line, stopping when ! ENDPOS is encountered." (interactive) (let* ((indent-stack (list nil)) --- 958,965 ---- (backward-paragraph)) + ;; Idea of ENDPOS is, indent each line, stopping when + ;; ENDPOS is encountered. But it's too much of a pain to make that work. (defun indent-c-exp (&optional endpos) ! "Indent each line of the C grouping following point." (interactive) (let* ((indent-stack (list nil)) *************** *** 970,973 **** --- 972,976 ---- (beginning-of-defun) (setq funbeg (point))) + (setq opoint funbeg) ;; Try to find containing open, ;; but don't scan past that fcn-start. *************** *** 976,980 **** (condition-case nil (save-excursion ! (backward-up-list 1) (point)) ;; We gave up: must be between fcns. ;; Set opoint to beg of prev fcn --- 979,984 ---- (condition-case nil (save-excursion ! (backward-up-list 1) ! (point)) ;; We gave up: must be between fcns. ;; Set opoint to beg of prev fcn *************** *** 988,992 **** this-indent last-sexp at-else at-brace at-while ! last-depth (next-depth 0)) ;; If the braces don't match, get an error right away. --- 992,996 ---- this-indent last-sexp at-else at-brace at-while ! last-depth this-point (next-depth 0)) ;; If the braces don't match, get an error right away. *************** *** 999,1002 **** --- 1003,1012 ---- comment-start-skip (save-excursion (end-of-line) (point)) t) + ;; Make sure this isn't a comment alone on a line + ;; (which should be indented like code instead). + (save-excursion + (goto-char (match-beginning 0)) + (skip-chars-backward " \t") + (not (bolp))) ;; Make sure the comment starter we found ;; is not actually in a string or quoted. *************** *** 1026,1032 **** (>= (car (cdr (cdr state))) 0)) (setq last-sexp (car (cdr (cdr state))))) ! (if (or (nth 4 ostate)) (c-indent-line)) ! (if (or (nth 3 state)) (forward-line 1) (setq inner-loop-done t))) --- 1036,1045 ---- (>= (car (cdr (cdr state))) 0)) (setq last-sexp (car (cdr (cdr state))))) ! ;; If this line started within a comment, indent it as such. ! (if (or (nth 4 ostate) (nth 7 ostate)) (c-indent-line)) ! ;; If it ends outside of comments or strings, exit the inner loop. ! ;; Otherwise move on to next line. ! (if (or (nth 3 state) (nth 4 state) (nth 7 state)) (forward-line 1) (setq inner-loop-done t))) *************** *** 1061,1065 **** (forward-line 1) (skip-chars-forward " \t") ! (if (eolp) nil (if (and (car indent-stack) --- 1074,1083 ---- (forward-line 1) (skip-chars-forward " \t") ! ;; Don't really reindent if the line is just whitespace, ! ;; or if it is past the endpos. ! ;; (The exit test in the outer while ! ;; does not exit until we have passed the first line ! ;; past the region.) ! (if (or (eolp) (and endpos (>= (point) endpos))) nil (if (and (car indent-stack) *************** *** 1073,1076 **** --- 1091,1095 ---- ;; Find last non-comment character before this line (save-excursion + (setq this-point (point)) (setq at-else (looking-at "else\\W")) (setq at-brace (= (following-char) ?{)) *************** *** 1093,1096 **** --- 1112,1118 ---- ((and at-while (c-backward-to-start-of-do opoint)) (setq this-indent (current-indentation))) + ((eq (preceding-char) ?\,) + (goto-char this-point) + (setq this-indent (calculate-c-indent))) (t (setq this-indent (car indent-stack))))))) ;; Just started a new nesting level. *************** *** 1100,1103 **** --- 1122,1129 ---- (- (car indent-stack)) opoint)))) + ;; t means we are in a block comment and should + ;; calculate accordingly. + (if (eq val t) + (setq val (calculate-c-indent-within-comment))) (setcar indent-stack (setq this-indent val)))) *************** *** 1112,1116 **** (setq this-indent (- this-indent c-indent-level))) (if (= (following-char) ?{) ! (setq this-indent (+ this-indent c-brace-offset))) ;; Don't leave indentation in empty lines. (if (eolp) (setq this-indent 0)) --- 1138,1144 ---- (setq this-indent (- this-indent c-indent-level))) (if (= (following-char) ?{) ! (if (zerop (current-column)) ! (setq this-indent 0) ! (setq this-indent (+ this-indent c-brace-offset)))) ;; Don't leave indentation in empty lines. (if (eolp) (setq this-indent 0)) *************** *** 1157,1164 **** (save-excursion (goto-char start) ! (let ((endmark (copy-marker end))) ! (and (bolp) (not (eolp)) ! (c-indent-line)) ! (indent-c-exp endmark) (set-marker endmark nil)))) --- 1185,1217 ---- (save-excursion (goto-char start) ! (let ((endmark (copy-marker end)) ! (c-tab-always-indent t)) ! (while (and (bolp) (not (eolp))) ! ;; Indent one line as with TAB. ! (let ((shift-amt (c-indent-line)) ! nextline sexpend) ! (save-excursion ! ;; Find beginning of following line. ! (save-excursion ! (forward-line 1) (setq nextline (point))) ! ;; Find first beginning-of-sexp for sexp extending past this line. ! (beginning-of-line) ! (while (< (point) nextline) ! (condition-case nil ! (progn ! (forward-sexp 1) ! (setq sexpend (point-marker))) ! (error (setq sexpend nil) ! (goto-char nextline))) ! (skip-chars-forward " \t\n"))) ! ;; If that sexp ends within the region, ! ;; indent it all at once, fast. ! (if (and sexpend (> sexpend nextline) (<= sexpend endmark)) ! (progn ! (indent-c-exp) ! (goto-char sexpend))) ! ;; Move to following line and try again. ! (and sexpend (set-marker sexpend nil)) ! (forward-line 1))) (set-marker endmark nil)))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/calendar.el emacs-19.18/lisp/calendar.el *** emacs-19.17/lisp/calendar.el Sat Jul 10 23:28:39 1993 --- emacs-19.18/lisp/calendar.el Wed Aug 4 19:00:10 1993 *************** *** 379,383 **** See the documentation of diary-date-forms for an explanation.") - ;;;###autoload (defvar diary-date-forms (if european-calendar-style --- 379,382 ---- *************** *** 419,423 **** See the documentation of calendar-date-display-forms for an explanation.") - ;;;###autoload (defvar calendar-date-display-form (if european-calendar-style --- 418,421 ---- *************** *** 498,503 **** ;;;###autoload ! (defvar diary-display-hook 'simple-diary-display "*List of functions that handle the display of the diary. Ordinarily, this just displays the diary buffer (with holidays indicated in --- 496,508 ---- ;;;###autoload ! (defvar diary-hook nil ! "*List of functions called after the display of the diary. ! Can be used for appointment notification.") ! ! ;;;###autoload ! (defvar diary-display-hook nil "*List of functions that handle the display of the diary. + If nil (the default), `simple-diary-display' will be used. Use `ignore' for no + diary display. Ordinarily, this just displays the diary buffer (with holidays indicated in *************** *** 506,512 **** by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) STRING), where string is the diary entry for the given date. This can be ! used, for example, to handle appointment notification, prepare a different ! buffer for display (perhaps combined with holidays), or produce hard copy ! output. A function `fancy-diary-display' is provided as an alternative --- 511,516 ---- by date, of all relevant diary entries in the form of ((MONTH DAY YEAR) STRING), where string is the diary entry for the given date. This can be ! used, for example, a different buffer for display (perhaps combined with ! holidays), or produce hard copy output. A function `fancy-diary-display' is provided as an alternative *************** *** 598,602 **** ;;;###autoload ! (defvar hebrew-holidays '((holiday-rosh-hashanah-etc) (if all-hebrew-calendar-holidays --- 602,606 ---- ;;;###autoload ! (defvar hebrew-holidays-1 '((holiday-rosh-hashanah-etc) (if all-hebrew-calendar-holidays *************** *** 613,618 **** (if (zerop (% (1+ year) 4)) 22 ! 21))) "\"Tal Umatar\" (evening)")) ! (if all-hebrew-calendar-holidays (holiday-hanukkah) (holiday-hebrew 9 25 "Hanukkah")) --- 617,625 ---- (if (zerop (% (1+ year) 4)) 22 ! 21))) "\"Tal Umatar\" (evening)")))) ! ! ;;;###autoload ! (defvar hebrew-holidays-2 ! '((if all-hebrew-calendar-holidays (holiday-hanukkah) (holiday-hebrew 9 25 "Hanukkah")) *************** *** 630,635 **** "Tzom Teveth")) (if all-hebrew-calendar-holidays ! (holiday-hebrew 11 15 "Tu B'Shevat")) ! (if all-hebrew-calendar-holidays (holiday-hebrew 11 --- 637,645 ---- "Tzom Teveth")) (if all-hebrew-calendar-holidays ! (holiday-hebrew 11 15 "Tu B'Shevat")))) ! ! ;;;###autoload ! (defvar hebrew-holiday-3 ! '((if all-hebrew-calendar-holidays (holiday-hebrew 11 *************** *** 658,663 **** (day (extract-calendar-day s-s))) day)) ! "Shabbat Shirah")) ! (holiday-passover-etc) (if (and all-hebrew-calendar-holidays (let* ((m displayed-month) --- 668,676 ---- (day (extract-calendar-day s-s))) day)) ! "Shabbat Shirah")))) ! ! ;;;###autoload ! (defvar hebrew-holidays-4 ! '((holiday-passover-etc) (if (and all-hebrew-calendar-holidays (let* ((m displayed-month) *************** *** 672,676 **** (holiday-julian 3 26 "Kiddush HaHamah")) (if all-hebrew-calendar-holidays ! (holiday-tisha-b-av-etc))) "*Jewish holidays. See the documentation for `calendar-holidays' for details.") --- 685,693 ---- (holiday-julian 3 26 "Kiddush HaHamah")) (if all-hebrew-calendar-holidays ! (holiday-tisha-b-av-etc)))) ! ! ;;;###autoload ! (defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2 ! hebrew-holidays-3 hebrew-holidays-4) "*Jewish holidays. See the documentation for `calendar-holidays' for details.") *************** *** 1393,1396 **** --- 1410,1415 ---- (define-key calendar-mode-map "\e>" 'calendar-end-of-year) (define-key calendar-mode-map "\C-@" 'calendar-set-mark) + ;; Many people are used to typing C-SPC and getting C-@. + (define-key calendar-mode-map [?\C-\ ] 'calendar-set-mark) (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark) (define-key calendar-mode-map "\e=" 'calendar-count-days-region) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cl-compat.el emacs-19.18/lisp/cl-compat.el *** emacs-19.17/lisp/cl-compat.el --- emacs-19.18/lisp/cl-compat.el Fri Jul 30 16:15:09 1993 *************** *** 0 **** --- 1,191 ---- + ;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility) + + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Dave Gillespie + ;; Version: 2.02 + ;; Keywords: extensions + + ;; 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; Commentary: + + ;; These are extensions to Emacs Lisp that provide a degree of + ;; Common Lisp compatibility, beyond what is already built-in + ;; in Emacs Lisp. + ;; + ;; This package was written by Dave Gillespie; it is a complete + ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. + ;; + ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. + ;; + ;; Bug reports, comments, and suggestions are welcome! + + ;; This file contains emulations of internal routines of the older + ;; CL package which users may have called directly from their code. + ;; Use (require 'cl-compat) to get these routines. + + ;; See cl.el for Change Log. + + + ;; Code: + + ;; Require at load-time, but not when compiling cl-compat. + (or (featurep 'cl) (require 'cl)) + + + ;;; Keyword routines not supported by new package. + + (defmacro defkeyword (x &optional doc) + (list* 'defconst x (list 'quote x) (and doc (list doc)))) + + (defun keywordp (sym) + (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym))) + + (defun keyword-of (sym) + (or (keywordp sym) (keywordp (intern (format ":%s" sym))))) + + + ;;; Multiple values. Note that the new package uses a different + ;;; convention for multiple values. The following definitions + ;;; emulate the old convention; all function names have been changed + ;;; by capitalizing the first letter: Values, Multiple-value-*, + ;;; to avoid conflict with the new-style definitions in cl-macs. + + (put 'Multiple-value-bind 'lisp-indent-function 2) + (put 'Multiple-value-setq 'lisp-indent-function 2) + (put 'Multiple-value-call 'lisp-indent-function 1) + (put 'Multiple-value-prog1 'lisp-indent-function 1) + + (defvar *mvalues-values* nil) + + (defun Values (&rest val-forms) + (setq *mvalues-values* val-forms) + (car val-forms)) + + (defun Values-list (val-forms) + (apply 'values val-forms)) + + (defmacro Multiple-value-list (form) + (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form)) + '(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*) + (list *mvalues-temp*)))) + + (defmacro Multiple-value-call (function &rest args) + (list 'apply function + (cons 'append + (mapcar (function (lambda (x) (list 'Multiple-value-list x))) + args)))) + + (defmacro Multiple-value-bind (vars form &rest body) + (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) + + (defmacro Multiple-value-setq (vars form) + (list 'multiple-value-setq vars (list 'Multiple-value-list form))) + + (defmacro Multiple-value-prog1 (form &rest body) + (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) + + + ;;; Routines for parsing keyword arguments. + + (defun build-klist (arglist keys &optional allow-others) + (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist)))) + (or allow-others + (let ((bad (set-difference (mapcar 'car res) keys))) + (if bad (error "Bad keywords: %s not in %s" bad keys)))) + res)) + + (defun extract-from-klist (klist key &optional def) + (let ((res (assq key klist))) (if res (cdr res) def))) + + (defun keyword-argument-supplied-p (klist key) + (assq key klist)) + + (defun elt-satisfies-test-p (item elt klist) + (let ((test-not (cdr (assq ':test-not klist))) + (test (cdr (assq ':test klist))) + (key (cdr (assq ':key klist)))) + (if key (setq elt (funcall key elt))) + (if test-not (not (funcall test-not item elt)) + (funcall (or test 'eql) item elt)))) + + + ;;; Rounding functions with old-style multiple value returns. + + (defun cl-floor (a &optional b) (Values-list (floor* a b))) + (defun cl-ceiling (a &optional b) (Values-list (ceiling* a b))) + (defun cl-round (a &optional b) (Values-list (round* a b))) + (defun cl-truncate (a &optional b) (Values-list (truncate* a b))) + + (defun safe-idiv (a b) + (let* ((q (/ (abs a) (abs b))) + (s (* (signum a) (signum b)))) + (Values q (- a (* s q b)) s))) + + + ;; Internal routines. + + (defun pair-with-newsyms (oldforms) + (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms))) + (Values (mapcar* 'list newsyms oldforms) newsyms))) + + (defun zip-lists (evens odds) + (mapcan 'list evens odds)) + + (defun unzip-lists (list) + (let ((e nil) (o nil)) + (while list + (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list))) + (Values (nreverse e) (nreverse o)))) + + (defun reassemble-argslists (list) + (let ((n (apply 'min (mapcar 'length list))) (res nil)) + (while (>= (setq n (1- n)) 0) + (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res))) + res)) + + (defun duplicate-symbols-p (list) + (let ((res nil)) + (while list + (if (memq (car list) (cdr list)) (setq res (cons (car list) res))) + (setq list (cdr list))) + res)) + + + ;;; Setf internals. + + (defun setnth (n list x) + (setcar (nthcdr n list) x)) + + (defun setnthcdr (n list x) + (setcdr (nthcdr (1- n) list) x)) + + (defun setelt (seq n x) + (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x))) + + + ;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms, + ;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms, + ;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify, + ;;; all names with embedded `$'. + + + (provide 'cl-compat) + + ;;; cl-compat.el ends here + diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cl-extra.el emacs-19.18/lisp/cl-extra.el *** emacs-19.17/lisp/cl-extra.el --- emacs-19.18/lisp/cl-extra.el Fri Jul 30 16:14:23 1993 *************** *** 0 **** --- 1,930 ---- + ;; cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two) + + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Dave Gillespie + ;; Version: 2.02 + ;; Keywords: extensions + + ;; 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; Commentary: + + ;; These are extensions to Emacs Lisp that provide a degree of + ;; Common Lisp compatibility, beyond what is already built-in + ;; in Emacs Lisp. + ;; + ;; This package was written by Dave Gillespie; it is a complete + ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. + ;; + ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. + ;; + ;; Bug reports, comments, and suggestions are welcome! + + ;; This file contains portions of the Common Lisp extensions + ;; package which are autoloaded since they are relatively obscure. + + ;; See cl.el for Change Log. + + + ;; Code: + + (or (memq 'cl-19 features) + (error "Tried to load `cl-extra' before `cl'!")) + + + ;;; We define these here so that this file can compile without having + ;;; loaded the cl.el file already. + + (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) + (defmacro cl-pop (place) + (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) + + (defvar cl-emacs-type) + + + ;;; Type coercion. + + (defun coerce (x type) + "Coerce OBJECT to type TYPE. + TYPE is a Common Lisp type specifier." + (cond ((eq type 'list) (if (listp x) x (append x nil))) + ((eq type 'vector) (if (vectorp x) x (vconcat x))) + ((eq type 'string) (if (stringp x) x (concat x))) + ((eq type 'array) (if (arrayp x) x (vconcat x))) + ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0)) + ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type)) + ((eq type 'float) (float x)) + ((typep x type) x) + (t (error "Can't coerce %s to type %s" x type)))) + + + ;;; Predicates. + + (defun equalp (x y) + "T if two Lisp objects have similar structures and contents. + This is like `equal', except that it accepts numerically equal + numbers of different types (float vs. integer), and also compares + strings case-insensitively." + (cond ((eq x y) t) + ((stringp x) + (and (stringp y) (= (length x) (length y)) + (or (equal x y) + (equal (downcase x) (downcase y))))) ; lazy but simple! + ((numberp x) + (and (numberp y) (= x y))) + ((consp x) + (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y)))) + (and (not (consp x)) (equalp x y))) + ((vectorp x) + (and (vectorp y) (= (length x) (length y)) + (let ((i (length x))) + (while (and (>= (setq i (1- i)) 0) + (equalp (aref x i) (aref y i)))) + (< i 0)))) + (t (equal x y)))) + + + ;;; Control structures. + + (defun cl-mapcar-many (cl-func cl-seqs) + (if (cdr (cdr cl-seqs)) + (let* ((cl-res nil) + (cl-n (apply 'min (mapcar 'length cl-seqs))) + (cl-i 0) + (cl-args (copy-sequence cl-seqs)) + cl-p1 cl-p2) + (setq cl-seqs (copy-sequence cl-seqs)) + (while (< cl-i cl-n) + (setq cl-p1 cl-seqs cl-p2 cl-args) + (while cl-p1 + (setcar cl-p2 + (if (consp (car cl-p1)) + (prog1 (car (car cl-p1)) + (setcar cl-p1 (cdr (car cl-p1)))) + (aref (car cl-p1) cl-i))) + (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))) + (cl-push (apply cl-func cl-args) cl-res) + (setq cl-i (1+ cl-i))) + (nreverse cl-res)) + (let ((cl-res nil) + (cl-x (car cl-seqs)) + (cl-y (nth 1 cl-seqs))) + (let ((cl-n (min (length cl-x) (length cl-y))) + (cl-i -1)) + (while (< (setq cl-i (1+ cl-i)) cl-n) + (cl-push (funcall cl-func + (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i)) + (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i))) + cl-res))) + (nreverse cl-res)))) + + (defun map (cl-type cl-func cl-seq &rest cl-rest) + "Map a function across one or more sequences, returning a sequence. + TYPE is the sequence type to return, FUNC is the function, and SEQS + are the argument sequences." + (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest))) + (and cl-type (coerce cl-res cl-type)))) + + (defun maplist (cl-func cl-list &rest cl-rest) + "Map FUNC to each sublist of LIST or LISTS. + Like `mapcar', except applies to lists and their cdr's rather than to + the elements themselves." + (if cl-rest + (let ((cl-res nil) + (cl-args (cons cl-list (copy-sequence cl-rest))) + cl-p) + (while (not (memq nil cl-args)) + (cl-push (apply cl-func cl-args) cl-res) + (setq cl-p cl-args) + (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) ))) + (nreverse cl-res)) + (let ((cl-res nil)) + (while cl-list + (cl-push (funcall cl-func cl-list) cl-res) + (setq cl-list (cdr cl-list))) + (nreverse cl-res)))) + + (defun mapc (cl-func cl-seq &rest cl-rest) + "Like `mapcar', but does not accumulate values returned by the function." + (if cl-rest + (apply 'map nil cl-func cl-seq cl-rest) + (mapcar cl-func cl-seq)) + cl-seq) + + (defun mapl (cl-func cl-list &rest cl-rest) + "Like `maplist', but does not accumulate values returned by the function." + (if cl-rest + (apply 'maplist cl-func cl-list cl-rest) + (let ((cl-p cl-list)) + (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p))))) + cl-list) + + (defun mapcan (cl-func cl-seq &rest cl-rest) + "Like `mapcar', but nconc's together the values returned by the function." + (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest))) + + (defun mapcon (cl-func cl-list &rest cl-rest) + "Like `maplist', but nconc's together the values returned by the function." + (apply 'nconc (apply 'maplist cl-func cl-list cl-rest))) + + (defun some (cl-pred cl-seq &rest cl-rest) + "Return true if PREDICATE is true of any element of SEQ or SEQs. + If so, return the true (non-nil) value returned by PREDICATE." + (if (or cl-rest (nlistp cl-seq)) + (catch 'cl-some + (apply 'map nil + (function (lambda (&rest cl-x) + (let ((cl-res (apply cl-pred cl-x))) + (if cl-res (throw 'cl-some cl-res))))) + cl-seq cl-rest) nil) + (let ((cl-x nil)) + (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq)))))) + cl-x))) + + (defun every (cl-pred cl-seq &rest cl-rest) + "Return true if PREDICATE is true of every element of SEQ or SEQs." + (if (or cl-rest (nlistp cl-seq)) + (catch 'cl-every + (apply 'map nil + (function (lambda (&rest cl-x) + (or (apply cl-pred cl-x) (throw 'cl-every nil)))) + cl-seq cl-rest) t) + (while (and cl-seq (funcall cl-pred (car cl-seq))) + (setq cl-seq (cdr cl-seq))) + (null cl-seq))) + + (defun notany (cl-pred cl-seq &rest cl-rest) + "Return true if PREDICATE is false of every element of SEQ or SEQs." + (not (apply 'some cl-pred cl-seq cl-rest))) + + (defun notevery (cl-pred cl-seq &rest cl-rest) + "Return true if PREDICATE is false of some element of SEQ or SEQs." + (not (apply 'every cl-pred cl-seq cl-rest))) + + ;;; Support for `loop'. + (defun cl-map-keymap (cl-func cl-map) + (while (symbolp cl-map) (setq cl-map (symbol-function cl-map))) + (if (eq cl-emacs-type 'lucid) (funcall 'map-keymap cl-func cl-map) + (if (listp cl-map) + (let ((cl-p cl-map)) + (while (consp (setq cl-p (cdr cl-p))) + (cond ((consp (car cl-p)) + (funcall cl-func (car (car cl-p)) (cdr (car cl-p)))) + ((vectorp (car cl-p)) + (cl-map-keymap cl-func (car cl-p))) + ((eq (car cl-p) 'keymap) + (setq cl-p nil))))) + (let ((cl-i -1)) + (while (< (setq cl-i (1+ cl-i)) (length cl-map)) + (if (aref cl-map cl-i) + (funcall cl-func cl-i (aref cl-map cl-i)))))))) + + (defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base) + (or cl-base + (setq cl-base (copy-sequence (if (eq cl-emacs-type 18) "0" [0])))) + (cl-map-keymap + (function + (lambda (cl-key cl-bind) + (aset cl-base (1- (length cl-base)) cl-key) + (if (keymapp cl-bind) + (cl-map-keymap-recursively + cl-func-rec cl-bind + (funcall (if (eq cl-emacs-type 18) 'concat 'vconcat) + cl-base (list 0))) + (funcall cl-func-rec cl-base cl-bind)))) + cl-map)) + + (defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end) + (or cl-what (setq cl-what (current-buffer))) + (if (bufferp cl-what) + (let (cl-mark cl-mark2 (cl-next t) cl-next2) + (save-excursion + (set-buffer cl-what) + (setq cl-mark (copy-marker (or cl-start (point-min)))) + (setq cl-mark2 (and cl-end (copy-marker cl-end)))) + (while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2))) + (setq cl-next (and (fboundp 'next-property-change) + (if cl-prop (next-single-property-change + cl-mark cl-prop cl-what) + (next-property-change cl-mark cl-what))) + cl-next2 (or cl-next (save-excursion + (set-buffer cl-what) (point-max)))) + (funcall cl-func (prog1 (marker-position cl-mark) + (set-marker cl-mark cl-next2)) + (if cl-mark2 (min cl-next2 cl-mark2) cl-next2))) + (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))) + (or cl-start (setq cl-start 0)) + (or cl-end (setq cl-end (length cl-what))) + (while (< cl-start cl-end) + (let ((cl-next (or (and (fboundp 'next-property-change) + (if cl-prop (next-single-property-change + cl-start cl-prop cl-what) + (next-property-change cl-start cl-what))) + cl-end))) + (funcall cl-func cl-start (min cl-next cl-end)) + (setq cl-start cl-next))))) + + (defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg) + (or cl-buffer (setq cl-buffer (current-buffer))) + (if (fboundp 'overlay-lists) + + ;; This is the preferred algorithm, though overlay-lists is undocumented. + (let (cl-ovl) + (save-excursion + (set-buffer cl-buffer) + (setq cl-ovl (overlay-lists)) + (if cl-start (setq cl-start (copy-marker cl-start))) + (if cl-end (setq cl-end (copy-marker cl-end)))) + (setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl))) + (while (and cl-ovl + (or (not (overlay-start (car cl-ovl))) + (and cl-end (>= (overlay-start (car cl-ovl)) cl-end)) + (and cl-start (<= (overlay-end (car cl-ovl)) cl-start)) + (not (funcall cl-func (car cl-ovl) cl-arg)))) + (setq cl-ovl (cdr cl-ovl))) + (if cl-start (set-marker cl-start nil)) + (if cl-end (set-marker cl-end nil))) + + ;; This alternate algorithm fails to find zero-length overlays. + (let ((cl-mark (save-excursion (set-buffer cl-buffer) + (copy-marker (or cl-start (point-min))))) + (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer) + (copy-marker cl-end)))) + cl-pos cl-ovl) + (while (save-excursion + (and (setq cl-pos (marker-position cl-mark)) + (< cl-pos (or cl-mark2 (point-max))) + (progn + (set-buffer cl-buffer) + (setq cl-ovl (overlays-at cl-pos)) + (set-marker cl-mark (next-overlay-change cl-pos))))) + (while (and cl-ovl + (or (/= (overlay-start (car cl-ovl)) cl-pos) + (not (and (funcall cl-func (car cl-ovl) cl-arg) + (set-marker cl-mark nil))))) + (setq cl-ovl (cdr cl-ovl)))) + (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil))))) + + ;;; Support for `setf'. + (defun cl-set-frame-visible-p (frame val) + (cond ((null val) (make-frame-invisible frame)) + ((eq val 'icon) (iconify-frame frame)) + (t (make-frame-visible frame))) + val) + + ;;; Support for `progv'. + (defvar cl-progv-save) + (defun cl-progv-before (syms values) + (while syms + (cl-push (if (boundp (car syms)) + (cons (car syms) (symbol-value (car syms))) + (car syms)) cl-progv-save) + (if values + (set (cl-pop syms) (cl-pop values)) + (makunbound (cl-pop syms))))) + + (defun cl-progv-after () + (while cl-progv-save + (if (consp (car cl-progv-save)) + (set (car (car cl-progv-save)) (cdr (car cl-progv-save))) + (makunbound (car cl-progv-save))) + (cl-pop cl-progv-save))) + + + ;;; Numbers. + + (defun gcd (&rest args) + "Return the greatest common divisor of the arguments." + (let ((a (abs (or (cl-pop args) 0)))) + (while args + (let ((b (abs (cl-pop args)))) + (while (> b 0) (setq b (% a (setq a b)))))) + a)) + + (defun lcm (&rest args) + "Return the least common multiple of the arguments." + (if (memq 0 args) + 0 + (let ((a (abs (or (cl-pop args) 1)))) + (while args + (let ((b (abs (cl-pop args)))) + (setq a (* (/ a (gcd a b)) b)))) + a))) + + (defun isqrt (a) + "Return the integer square root of the argument." + (if (and (integerp a) (> a 0)) + (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000) + ((>= a 100) 100) (t 10))) + g2) + (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) + (setq g g2)) + g) + (if (eq a 0) 0 (signal 'arith-error nil)))) + + (defun cl-expt (x y) + "Return X raised to the power of Y. Works only for integer arguments." + (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) x 0)) + (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2))))) + (or (and (fboundp 'expt) (subrp (symbol-function 'expt))) + (defalias 'expt 'cl-expt)) + + (defun floor* (x &optional y) + "Return a list of the floor of X and the fractional part of X. + With two arguments, return floor and remainder of their quotient." + (if y + (if (and (integerp x) (integerp y)) + (if (and (>= x 0) (>= y 0)) + (list (/ x y) (% x y)) + (let ((q (cond ((>= x 0) (- (/ (- x y 1) (- y)))) + ((>= y 0) (- (/ (- y x 1) y))) + (t (/ (- x) (- y)))))) + (list q (- x (* q y))))) + (let ((q (floor (/ x y)))) + (list q (- x (* q y))))) + (if (integerp x) (list x 0) + (let ((q (floor x))) + (list q (- x q)))))) + + (defun ceiling* (x &optional y) + "Return a list of the ceiling of X and the fractional part of X. + With two arguments, return ceiling and remainder of their quotient." + (let ((res (floor* x y))) + (if (= (car (cdr res)) 0) res + (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) + + (defun truncate* (x &optional y) + "Return a list of the integer part of X and the fractional part of X. + With two arguments, return truncation and remainder of their quotient." + (if (eq (>= x 0) (or (null y) (>= y 0))) + (floor* x y) (ceiling* x y))) + + (defun round* (x &optional y) + "Return a list of X rounded to the nearest integer and the remainder. + With two arguments, return rounding and remainder of their quotient." + (if y + (if (and (integerp x) (integerp y)) + (let* ((hy (/ y 2)) + (res (floor* (+ x hy) y))) + (if (and (= (car (cdr res)) 0) + (= (+ hy hy) y) + (/= (% (car res) 2) 0)) + (list (1- (car res)) hy) + (list (car res) (- (car (cdr res)) hy)))) + (let ((q (round (/ x y)))) + (list q (- x (* q y))))) + (if (integerp x) (list x 0) + (let ((q (round x))) + (list q (- x q)))))) + + (defun mod* (x y) + "The remainder of X divided by Y, with the same sign as Y." + (nth 1 (floor* x y))) + + (defun rem* (x y) + "The remainder of X divided by Y, with the same sign as X." + (nth 1 (truncate* x y))) + + (defun signum (a) + "Return 1 if A is positive, -1 if negative, 0 if zero." + (cond ((> a 0) 1) ((< a 0) -1) (t 0))) + + + ;; Random numbers. + + (defvar *random-state*) + (defun random* (lim &optional state) + "Return a random nonnegative number less than LIM, an integer or float. + Optional second arg STATE is a random-state object." + (or state (setq state *random-state*)) + ;; Inspired by "ran3" from Numerical Recipes. Additive congruential method. + (let ((vec (aref state 3))) + (if (integerp vec) + (let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1) ii) + (aset state 3 (setq vec (make-vector 55 nil))) + (aset vec 0 j) + (while (> (setq i (% (+ i 21) 55)) 0) + (aset vec i (setq j (prog1 k (setq k (- j k)))))) + (while (< (setq i (1+ i)) 200) (random* 2 state)))) + (let* ((i (aset state 1 (% (1+ (aref state 1)) 55))) + (j (aset state 2 (% (1+ (aref state 2)) 55))) + (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j)))))) + (if (integerp lim) + (if (<= lim 512) (% n lim) + (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state)))) + (let ((mask 1023)) + (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) + (if (< (setq n (logand n mask)) lim) n (random* lim state)))) + (* (/ n '8388608e0) lim))))) + + (defun make-random-state (&optional state) + "Return a copy of random-state STATE, or of `*random-state*' if omitted. + If STATE is t, return a new state object seeded from the time of day." + (cond ((null state) (make-random-state *random-state*)) + ((vectorp state) (cl-copy-tree state t)) + ((integerp state) (vector 'cl-random-state-tag -1 30 state)) + (t (make-random-state (cl-random-time))))) + + (defun random-state-p (object) + "Return t if OBJECT is a random-state object." + (and (vectorp object) (= (length object) 4) + (eq (aref object 0) 'cl-random-state-tag))) + + + ;; Implementation limits. + + (defun cl-finite-do (func a b) + (condition-case err + (let ((res (funcall func a b))) ; check for IEEE infinity + (and (numberp res) (/= res (/ res 2)) res)) + (arith-error nil))) + + (defvar most-positive-float) + (defvar most-negative-float) + (defvar least-positive-float) + (defvar least-negative-float) + (defvar least-positive-normalized-float) + (defvar least-negative-normalized-float) + (defvar float-epsilon) + (defvar float-negative-epsilon) + + (defun cl-float-limits () + (or most-positive-float (not (numberp '2e1)) + (let ((x '2e0) y z) + ;; Find maximum exponent (first two loops are optimizations) + (while (cl-finite-do '* x x) (setq x (* x x))) + (while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2)))) + (while (cl-finite-do '+ x x) (setq x (+ x x))) + (setq z x y (/ x 2)) + ;; Now fill in 1's in the mantissa. + (while (and (cl-finite-do '+ x y) (/= (+ x y) x)) + (setq x (+ x y) y (/ y 2))) + (setq most-positive-float x + most-negative-float (- x)) + ;; Divide down until mantissa starts rounding. + (setq x (/ x z) y (/ 16 z) x (* x y)) + (while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0)) + (arith-error nil)) + (setq x (/ x 2) y (/ y 2))) + (setq least-positive-normalized-float y + least-negative-normalized-float (- y)) + ;; Divide down until value underflows to zero. + (setq x (/ 1 z) y x) + (while (condition-case err (> (/ x 2) 0) (arith-error nil)) + (setq x (/ x 2))) + (setq least-positive-float x + least-negative-float (- x)) + (setq x '1e0) + (while (/= (+ '1e0 x) '1e0) (setq x (/ x 2))) + (setq float-epsilon (* x 2)) + (setq x '1e0) + (while (/= (- '1e0 x) '1e0) (setq x (/ x 2))) + (setq float-negative-epsilon (* x 2)))) + nil) + + + ;;; Sequence functions. + + (defun subseq (seq start &optional end) + "Return the subsequence of SEQ from START to END. + If END is omitted, it defaults to the length of the sequence. + If START or END is negative, it counts from the end." + (if (stringp seq) (substring seq start end) + (let (len) + (and end (< end 0) (setq end (+ end (setq len (length seq))))) + (if (< start 0) (setq start (+ start (or len (setq len (length seq)))))) + (cond ((listp seq) + (if (> start 0) (setq seq (nthcdr start seq))) + (if end + (let ((res nil)) + (while (>= (setq end (1- end)) start) + (cl-push (cl-pop seq) res)) + (nreverse res)) + (copy-sequence seq))) + (t + (or end (setq end (or len (length seq)))) + (let ((res (make-vector (max (- end start) 0) nil)) + (i 0)) + (while (< start end) + (aset res i (aref seq start)) + (setq i (1+ i) start (1+ start))) + res)))))) + + (defun concatenate (type &rest seqs) + "Concatenate, into a sequence of type TYPE, the argument SEQUENCES." + (cond ((eq type 'vector) (apply 'vconcat seqs)) + ((eq type 'string) (apply 'concat seqs)) + ((eq type 'list) (apply 'append (append seqs '(nil)))) + (t (error "Not a sequence type name: %s" type)))) + + + ;;; List functions. + + (defun revappend (x y) + "Equivalent to (append (reverse X) Y)." + (nconc (reverse x) y)) + + (defun nreconc (x y) + "Equivalent to (nconc (nreverse X) Y)." + (nconc (nreverse x) y)) + + (defun list-length (x) + "Return the length of a list. Return nil if list is circular." + (let ((n 0) (fast x) (slow x)) + (while (and (cdr fast) (not (and (eq fast slow) (> n 0)))) + (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow))) + (if fast (if (cdr fast) nil (1+ n)) n))) + + (defun tailp (sublist list) + "Return true if SUBLIST is a tail of LIST." + (while (and (consp list) (not (eq sublist list))) + (setq list (cdr list))) + (if (numberp sublist) (equal sublist list) (eq sublist list))) + + (defun cl-copy-tree (tree &optional vecp) + "Make a copy of TREE. + If TREE is a cons cell, this recursively copies both its car and its cdr. + Constrast to copy-sequence, which copies only along the cdrs. With second + argument VECP, this copies vectors as well as conses." + (if (consp tree) + (let ((p (setq tree (copy-list tree)))) + (while (consp p) + (if (or (consp (car p)) (and vecp (vectorp (car p)))) + (setcar p (cl-copy-tree (car p) vecp))) + (or (listp (cdr p)) (setcdr p (cl-copy-tree (cdr p) vecp))) + (cl-pop p))) + (if (and vecp (vectorp tree)) + (let ((i (length (setq tree (copy-sequence tree))))) + (while (>= (setq i (1- i)) 0) + (aset tree i (cl-copy-tree (aref tree i) vecp)))))) + tree) + (or (and (fboundp 'copy-tree) (subrp (symbol-function 'copy-tree))) + (defalias 'copy-tree 'cl-copy-tree)) + + + ;;; Property lists. + + (defun get* (sym tag &optional def) ; See compiler macro in cl-macs.el + "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none." + (or (get sym tag) + (and def + (let ((plist (symbol-plist sym))) + (while (and plist (not (eq (car plist) tag))) + (setq plist (cdr (cdr plist)))) + (if plist (car (cdr plist)) def))))) + + (defun getf (plist tag &optional def) + "Search PROPLIST for property PROPNAME; return its value or DEFAULT. + PROPLIST is a list of the sort returned by `symbol-plist'." + (setplist '--cl-getf-symbol-- plist) + (or (get '--cl-getf-symbol-- tag) + (and def (get* '--cl-getf-symbol-- tag def)))) + + (defun cl-set-getf (plist tag val) + (let ((p plist)) + (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p)))) + (if p (progn (setcar (cdr p) val) plist) (list* tag val plist)))) + + (defun cl-do-remf (plist tag) + (let ((p (cdr plist))) + (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p)))) + (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t)))) + + (defun cl-remprop (sym tag) + "Remove from SYMBOL's plist the property PROP and its value." + (let ((plist (symbol-plist sym))) + (if (and plist (eq tag (car plist))) + (progn (setplist sym (cdr (cdr plist))) t) + (cl-do-remf plist tag)))) + (or (and (fboundp 'remprop) (subrp (symbol-function 'remprop))) + (defalias 'remprop 'cl-remprop)) + + + + ;;; Hash tables. + + (defun make-hash-table (&rest cl-keys) + "Make an empty Common Lisp-style hash-table. + If :test is `eq', this can use Lucid Emacs built-in hash-tables. + In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists. + Keywords supported: :test :size + The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." + (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql)) + (cl-size (or (car (cdr (memq ':size cl-keys))) 20))) + (if (and (eq cl-test 'eq) (fboundp 'make-hashtable)) + (funcall 'make-hashtable cl-size) + (list 'cl-hash-table-tag cl-test + (if (> cl-size 1) (make-vector cl-size 0) + (let ((sym (make-symbol "--hashsym--"))) (set sym nil) sym)) + 0)))) + + (defvar cl-lucid-hash-tag + (if (and (fboundp 'make-hashtable) (vectorp (make-hashtable 1))) + (aref (make-hashtable 1) 0) (make-symbol "--cl-hash-tag--"))) + + (defun hash-table-p (x) + "Return t if OBJECT is a hash table." + (or (eq (car-safe x) 'cl-hash-table-tag) + (and (vectorp x) (= (length x) 4) (eq (aref x 0) cl-lucid-hash-tag)) + (and (fboundp 'hashtablep) (funcall 'hashtablep x)))) + + (defun cl-not-hash-table (x &optional y &rest z) + (signal 'wrong-type-argument (list 'hash-table-p (or y x)))) + + (defun cl-hash-lookup (key table) + (or (eq (car-safe table) 'cl-hash-table-tag) (cl-not-hash-table table)) + (let* ((array (nth 2 table)) (test (car (cdr table))) (str key) sym) + (if (symbolp array) (setq str nil sym (symbol-value array)) + (while (or (consp str) (and (vectorp str) (> (length str) 0))) + (setq str (elt str 0))) + (cond ((stringp str) (if (eq test 'equalp) (setq str (downcase str)))) + ((symbolp str) (setq str (symbol-name str))) + ((and (numberp str) (> str -8000000) (< str 8000000)) + (or (integerp str) (setq str (truncate str))) + (setq str (aref ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" + "11" "12" "13" "14" "15"] (logand str 15)))) + (t (setq str "*"))) + (setq sym (symbol-value (intern-soft str array)))) + (list (and sym (cond ((or (eq test 'eq) + (and (eq test 'eql) (not (numberp key)))) + (assq key sym)) + ((memq test '(eql equal)) (assoc key sym)) + (t (assoc* key sym ':test test)))) + sym str))) + + (defvar cl-builtin-gethash + (if (and (fboundp 'gethash) (subrp (symbol-function 'gethash))) + (symbol-function 'gethash) 'cl-not-hash-table)) + (defvar cl-builtin-remhash + (if (and (fboundp 'remhash) (subrp (symbol-function 'remhash))) + (symbol-function 'remhash) 'cl-not-hash-table)) + (defvar cl-builtin-clrhash + (if (and (fboundp 'clrhash) (subrp (symbol-function 'clrhash))) + (symbol-function 'clrhash) 'cl-not-hash-table)) + (defvar cl-builtin-maphash + (if (and (fboundp 'maphash) (subrp (symbol-function 'maphash))) + (symbol-function 'maphash) 'cl-not-hash-table)) + + (defun cl-gethash (key table &optional def) + "Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT." + (if (consp table) + (let ((found (cl-hash-lookup key table))) + (if (car found) (cdr (car found)) def)) + (funcall cl-builtin-gethash key table def))) + (defalias 'gethash 'cl-gethash) + + (defun cl-puthash (key val table) + (if (consp table) + (let ((found (cl-hash-lookup key table))) + (if (car found) (setcdr (car found) val) + (if (nth 2 found) + (progn + (if (> (nth 3 table) (* (length (nth 2 table)) 3)) + (let ((new-table (make-vector (nth 3 table) 0))) + (mapatoms (function + (lambda (sym) + (set (intern (symbol-name sym) new-table) + (symbol-value sym)))) + (nth 2 table)) + (setcar (cdr (cdr table)) new-table))) + (set (intern (nth 2 found) (nth 2 table)) + (cons (cons key val) (nth 1 found)))) + (set (nth 2 table) (cons (cons key val) (nth 1 found)))) + (setcar (cdr (cdr (cdr table))) (1+ (nth 3 table))))) + (funcall 'puthash key val table)) val) + + (defun cl-remhash (key table) + "Remove KEY from HASH-TABLE." + (if (consp table) + (let ((found (cl-hash-lookup key table))) + (and (car found) + (let ((del (delq (car found) (nth 1 found)))) + (setcar (cdr (cdr (cdr table))) (1- (nth 3 table))) + (if (nth 2 found) (set (intern (nth 2 found) (nth 2 table)) del) + (set (nth 2 table) del)) t))) + (prog1 (not (eq (funcall cl-builtin-gethash key table '--cl--) '--cl--)) + (funcall cl-builtin-remhash key table)))) + (defalias 'remhash 'cl-remhash) + + (defun cl-clrhash (table) + "Clear HASH-TABLE." + (if (consp table) + (progn + (or (hash-table-p table) (cl-not-hash-table table)) + (if (symbolp (nth 2 table)) (set (nth 2 table) nil) + (setcar (cdr (cdr table)) (make-vector (length (nth 2 table)) 0))) + (setcar (cdr (cdr (cdr table))) 0)) + (funcall cl-builtin-clrhash table)) + nil) + (defalias 'clrhash 'cl-clrhash) + + (defun cl-maphash (cl-func cl-table) + "Call FUNCTION on keys and values from HASH-TABLE." + (or (hash-table-p cl-table) (cl-not-hash-table cl-table)) + (if (consp cl-table) + (mapatoms (function (lambda (cl-x) + (setq cl-x (symbol-value cl-x)) + (while cl-x + (funcall cl-func (car (car cl-x)) + (cdr (car cl-x))) + (setq cl-x (cdr cl-x))))) + (if (symbolp (nth 2 cl-table)) + (vector (nth 2 cl-table)) (nth 2 cl-table))) + (funcall cl-builtin-maphash cl-func cl-table))) + (defalias 'maphash 'cl-maphash) + + (defun hash-table-count (table) + "Return the number of entries in HASH-TABLE." + (or (hash-table-p table) (cl-not-hash-table table)) + (if (consp table) (nth 3 table) (funcall 'hashtable-fullness table))) + + + ;;; Some debugging aids. + + (defun cl-prettyprint (form) + "Insert a pretty-printed rendition of a Lisp FORM in current buffer." + (let ((pt (point)) last) + (insert "\n" (prin1-to-string form) "\n") + (setq last (point)) + (goto-char (1+ pt)) + (while (search-forward "(quote " last t) + (delete-backward-char 7) + (insert "'") + (forward-sexp) + (delete-char 1)) + (goto-char (1+ pt)) + (cl-do-prettyprint))) + + (defun cl-do-prettyprint () + (skip-chars-forward " ") + (if (looking-at "(") + (let ((skip (or (looking-at "((") (looking-at "(prog") + (looking-at "(unwind-protect ") + (looking-at "(function (") + (looking-at "(cl-block-wrapper "))) + (two (or (looking-at "(defun ") (looking-at "(defmacro "))) + (let (or (looking-at "(let\\*? ") (looking-at "(while "))) + (set (looking-at "(p?set[qf] "))) + (if (or skip let + (progn + (forward-sexp) + (and (>= (current-column) 78) (progn (backward-sexp) t)))) + (let ((nl t)) + (forward-char 1) + (cl-do-prettyprint) + (or skip (looking-at ")") (cl-do-prettyprint)) + (or (not two) (looking-at ")") (cl-do-prettyprint)) + (while (not (looking-at ")")) + (if set (setq nl (not nl))) + (if nl (insert "\n")) + (lisp-indent-line) + (cl-do-prettyprint)) + (forward-char 1)))) + (forward-sexp))) + + (defvar cl-macroexpand-cmacs nil) + (defvar cl-closure-vars nil) + + (defun cl-macroexpand-all (form &optional env) + "Expand all macro calls through a Lisp FORM. + This also does some trivial optimizations to make the form prettier." + (while (or (not (eq form (setq form (macroexpand form env)))) + (and cl-macroexpand-cmacs + (not (eq form (setq form (compiler-macroexpand form))))))) + (cond ((not (consp form)) form) + ((memq (car form) '(let let*)) + (if (null (nth 1 form)) + (cl-macroexpand-all (cons 'progn (cddr form)) env) + (let ((letf nil) (res nil) (lets (cadr form))) + (while lets + (cl-push (if (consp (car lets)) + (let ((exp (cl-macroexpand-all (caar lets) env))) + (or (symbolp exp) (setq letf t)) + (cons exp (cl-macroexpand-body (cdar lets) env))) + (let ((exp (cl-macroexpand-all (car lets) env))) + (if (symbolp exp) exp + (setq letf t) (list exp nil)))) res) + (setq lets (cdr lets))) + (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form)) + (nreverse res) (cl-macroexpand-body (cddr form) env))))) + ((eq (car form) 'cond) + (cons (car form) + (mapcar (function (lambda (x) (cl-macroexpand-body x env))) + (cdr form)))) + ((eq (car form) 'condition-case) + (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env) + (mapcar (function + (lambda (x) + (cons (car x) (cl-macroexpand-body (cdr x) env)))) + (cdddr form)))) + ((memq (car form) '(quote function)) + (if (eq (car-safe (nth 1 form)) 'lambda) + (let ((body (cl-macroexpand-body (cddadr form) env))) + (if (and cl-closure-vars (eq (car form) 'function) + (cl-expr-contains-any body cl-closure-vars)) + (let* ((new (mapcar 'gensym cl-closure-vars)) + (sub (pairlis cl-closure-vars new)) (decls nil)) + (while (or (stringp (car body)) + (eq (car-safe (car body)) 'interactive)) + (cl-push (list 'quote (cl-pop body)) decls)) + (put (car (last cl-closure-vars)) 'used t) + (append + (list 'list '(quote lambda) '(quote (&rest --cl-rest--))) + (sublis sub (nreverse decls)) + (list + (list* 'list '(quote apply) + (list 'list '(quote quote) + (list 'function + (list* 'lambda + (append new (cadadr form)) + (sublis sub body)))) + (nconc (mapcar (function + (lambda (x) + (list 'list '(quote quote) x))) + cl-closure-vars) + '((quote --cl-rest--))))))) + (list (car form) (list* 'lambda (cadadr form) body)))) + form)) + ((memq (car form) '(defun defmacro)) + (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env))) + ((and (eq (car form) 'progn) (not (cddr form))) + (cl-macroexpand-all (nth 1 form) env)) + ((eq (car form) 'setq) + (let* ((args (cl-macroexpand-body (cdr form) env)) (p args)) + (while (and p (symbolp (car p))) (setq p (cddr p))) + (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args)))) + (t (cons (car form) (cl-macroexpand-body (cdr form) env))))) + + (defun cl-macroexpand-body (body &optional env) + (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body)) + + (defun cl-prettyexpand (form &optional full) + (message "Expanding...") + (let ((cl-macroexpand-cmacs full) (cl-compiling-file full) + (byte-compile-macro-environment nil)) + (setq form (cl-macroexpand-all form + (and (not full) '((block) (eval-when))))) + (message "Formatting...") + (prog1 (cl-prettyprint form) + (message "")))) + + + + (run-hooks 'cl-extra-load-hook) + + ;;; cl-extra.el ends here diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cl-macs.el emacs-19.18/lisp/cl-macs.el *** emacs-19.17/lisp/cl-macs.el --- emacs-19.18/lisp/cl-macs.el Fri Jul 30 16:15:07 1993 *************** *** 0 **** --- 1,2610 ---- + ;; cl-macs.el --- Common Lisp extensions for GNU Emacs Lisp (part four) + + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Dave Gillespie + ;; Version: 2.02 + ;; Keywords: extensions + + ;; 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; Commentary: + + ;; These are extensions to Emacs Lisp that provide a degree of + ;; Common Lisp compatibility, beyond what is already built-in + ;; in Emacs Lisp. + ;; + ;; This package was written by Dave Gillespie; it is a complete + ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. + ;; + ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. + ;; + ;; Bug reports, comments, and suggestions are welcome! + + ;; This file contains the portions of the Common Lisp extensions + ;; package which should be autoloaded, but need only be present + ;; if the compiler or interpreter is used---this file is not + ;; necessary for executing compiled code. + + ;; See cl.el for Change Log. + + + ;; Code: + + (or (memq 'cl-19 features) + (error "Tried to load `cl-macs' before `cl'!")) + + + ;;; We define these here so that this file can compile without having + ;;; loaded the cl.el file already. + + (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) + (defmacro cl-pop (place) + (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) + (defmacro cl-pop2 (place) + (list 'prog1 (list 'car (list 'cdr place)) + (list 'setq place (list 'cdr (list 'cdr place))))) + (put 'cl-push 'edebug-form-spec 'edebug-sexps) + (put 'cl-pop 'edebug-form-spec 'edebug-sexps) + (put 'cl-pop2 'edebug-form-spec 'edebug-sexps) + + (defvar cl-emacs-type) + (defvar cl-optimize-safety) + (defvar cl-optimize-speed) + + + ;;; This kludge allows macros which use cl-transform-function-property + ;;; to be called at compile-time. + + (require + (progn + (or (fboundp 'defalias) (fset 'defalias 'fset)) + (or (fboundp 'cl-transform-function-property) + (defalias 'cl-transform-function-property + (function (lambda (n p f) + (list 'put (list 'quote n) (list 'quote p) + (list 'function (cons 'lambda f))))))) + (car (or features (setq features (list 'cl-kludge)))))) + + + ;;; Initialization. + + (defvar cl-old-bc-file-form nil) + + ;; Patch broken Emacs 18 compiler (re top-level macros). + ;; Emacs 19 compiler doesn't need this patch. + ;; Also, undo broken definition of `eql' that uses same bytecode as `eq'. + (defun cl-compile-time-init () + (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form)) + (or (fboundp 'byte-compile-flush-pending) ; Emacs 19 compiler? + (defalias 'byte-compile-file-form + (function + (lambda (form) + (setq form (macroexpand form byte-compile-macro-environment)) + (if (eq (car-safe form) 'progn) + (cons 'progn (mapcar 'byte-compile-file-form (cdr form))) + (funcall cl-old-bc-file-form form)))))) + (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro) + (run-hooks 'cl-hack-bytecomp-hook)) + + + ;;; Symbols. + + (defvar *gensym-counter*) + (defun gensym (&optional arg) + "Generate a new uninterned symbol. + The name is made by appending a number to PREFIX, default \"G\"." + (let ((prefix (if (stringp arg) arg "G")) + (num (if (integerp arg) arg + (prog1 *gensym-counter* + (setq *gensym-counter* (1+ *gensym-counter*)))))) + (make-symbol (format "%s%d" prefix num)))) + + (defun gentemp (&optional arg) + "Generate a new interned symbol with a unique name. + The name is made by appending a number to PREFIX, default \"G\"." + (let ((prefix (if (stringp arg) arg "G")) + name) + (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*))) + (setq *gensym-counter* (1+ *gensym-counter*))) + (intern name))) + + + ;;; Program structure. + + (defmacro defun* (name args &rest body) + "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. + Like normal `defun', except ARGLIST allows full Common Lisp conventions, + and BODY is implicitly surrounded by (block NAME ...)." + (let* ((res (cl-transform-lambda (cons args body) name)) + (form (list* 'defun name (cdr res)))) + (if (car res) (list 'progn (car res) form) form))) + + (defmacro defmacro* (name args &rest body) + "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro. + Like normal `defmacro', except ARGLIST allows full Common Lisp conventions, + and BODY is implicitly surrounded by (block NAME ...)." + (let* ((res (cl-transform-lambda (cons args body) name)) + (form (list* 'defmacro name (cdr res)))) + (if (car res) (list 'progn (car res) form) form))) + + (defmacro function* (func) + "(function* SYMBOL-OR-LAMBDA): introduce a function. + Like normal `function', except that if argument is a lambda form, its + ARGLIST allows full Common Lisp conventions." + (if (eq (car-safe func) 'lambda) + (let* ((res (cl-transform-lambda (cdr func) 'cl-none)) + (form (list 'function (cons 'lambda (cdr res))))) + (if (car res) (list 'progn (car res) form) form)) + (list 'function func))) + + (defun cl-transform-function-property (func prop form) + (let ((res (cl-transform-lambda form func))) + (append '(progn) (cdr (cdr (car res))) + (list (list 'put (list 'quote func) (list 'quote prop) + (list 'function (cons 'lambda (cdr res)))))))) + + (defconst lambda-list-keywords + '(&optional &rest &key &allow-other-keys &aux &whole &body &environment)) + + (defvar cl-macro-environment nil) + (defvar bind-block) (defvar bind-defs) (defvar bind-enquote) + (defvar bind-inits) (defvar bind-lets) (defvar bind-forms) + + (defun cl-transform-lambda (form bind-block) + (let* ((args (car form)) (body (cdr form)) + (bind-defs nil) (bind-enquote nil) + (bind-inits nil) (bind-lets nil) (bind-forms nil) + (header nil) (simple-args nil)) + (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive)) + (cl-push (cl-pop body) header)) + (setq args (if (listp args) (copy-list args) (list '&rest args))) + (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) + (if (setq bind-defs (cadr (memq '&cl-defs args))) + (setq args (delq '&cl-defs (delq bind-defs args)) + bind-defs (cadr bind-defs))) + (if (setq bind-enquote (memq '&cl-quote args)) + (setq args (delq '&cl-quote args))) + (if (memq '&whole args) (error "&whole not currently implemented")) + (let* ((p (memq '&environment args)) (v (cadr p))) + (if p (setq args (nconc (delq (car p) (delq v args)) + (list '&aux (list v 'cl-macro-environment)))))) + (while (and args (symbolp (car args)) + (not (memq (car args) '(nil &rest &body &key &aux))) + (not (and (eq (car args) '&optional) + (or bind-defs (consp (cadr args)))))) + (cl-push (cl-pop args) simple-args)) + (or (eq bind-block 'cl-none) + (setq body (list (list* 'block bind-block body)))) + (if (null args) + (list* nil (nreverse simple-args) (nconc (nreverse header) body)) + (if (memq '&optional simple-args) (cl-push '&optional args)) + (cl-do-arglist args nil (- (length simple-args) + (if (memq '&optional simple-args) 1 0))) + (setq bind-lets (nreverse bind-lets)) + (list* (and bind-inits (list* 'eval-when '(compile load eval) + (nreverse bind-inits))) + (nconc (nreverse simple-args) + (list '&rest (car (cl-pop bind-lets)))) + (nconc (nreverse header) + (list (nconc (list 'let* bind-lets) + (nreverse bind-forms) body))))))) + + (defun cl-do-arglist (args expr &optional num) ; uses bind-* + (if (nlistp args) + (if (or (memq args lambda-list-keywords) (not (symbolp args))) + (error "Invalid argument name: %s" args) + (cl-push (list args expr) bind-lets)) + (setq args (copy-list args)) + (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p))))) + (let ((p (memq '&body args))) (if p (setcar p '&rest))) + (if (memq '&environment args) (error "&environment used incorrectly")) + (let ((save-args args) + (restarg (memq '&rest args)) + (safety (if (cl-compiling-file) cl-optimize-safety 3)) + (keys nil) + (laterarg nil) (exactarg nil) minarg) + (or num (setq num 0)) + (if (listp (cadr restarg)) + (setq restarg (gensym "--rest--")) + (setq restarg (cadr restarg))) + (cl-push (list restarg expr) bind-lets) + (if (eq (car args) '&whole) + (cl-push (list (cl-pop2 args) restarg) bind-lets)) + (let ((p args)) + (setq minarg restarg) + (while (and p (not (memq (car p) lambda-list-keywords))) + (or (eq p args) (setq minarg (list 'cdr minarg))) + (setq p (cdr p))) + (if (memq (car p) '(nil &aux)) + (setq minarg (list '= (list 'length restarg) + (length (ldiff args p))) + exactarg (not (eq args p))))) + (while (and args (not (memq (car args) lambda-list-keywords))) + (let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car) + restarg))) + (cl-do-arglist + (cl-pop args) + (if (or laterarg (= safety 0)) poparg + (list 'if minarg poparg + (list 'signal '(quote wrong-number-of-arguments) + (list 'list (and (not (eq bind-block 'cl-none)) + (list 'quote bind-block)) + (list 'length restarg))))))) + (setq num (1+ num) laterarg t)) + (while (and (eq (car args) '&optional) (cl-pop args)) + (while (and args (not (memq (car args) lambda-list-keywords))) + (let ((arg (cl-pop args))) + (or (consp arg) (setq arg (list arg))) + (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t))) + (let ((def (if (cdr arg) (nth 1 arg) + (or (car bind-defs) + (nth 1 (assq (car arg) bind-defs))))) + (poparg (list 'pop restarg))) + (and def bind-enquote (setq def (list 'quote def))) + (cl-do-arglist (car arg) + (if def (list 'if restarg poparg def) poparg)) + (setq num (1+ num)))))) + (if (eq (car args) '&rest) + (let ((arg (cl-pop2 args))) + (if (consp arg) (cl-do-arglist arg restarg))) + (or (eq (car args) '&key) (= safety 0) exactarg + (cl-push (list 'if restarg + (list 'signal '(quote wrong-number-of-arguments) + (list 'list + (and (not (eq bind-block 'cl-none)) + (list 'quote bind-block)) + (list '+ num (list 'length restarg))))) + bind-forms))) + (while (and (eq (car args) '&key) (cl-pop args)) + (while (and args (not (memq (car args) lambda-list-keywords))) + (let ((arg (cl-pop args))) + (or (consp arg) (setq arg (list arg))) + (let* ((karg (if (consp (car arg)) (caar arg) + (intern (format ":%s" (car arg))))) + (varg (if (consp (car arg)) (cadar arg) (car arg))) + (def (if (cdr arg) (cadr arg) + (or (car bind-defs) (cadr (assq varg bind-defs))))) + (look (list 'memq (list 'quote karg) restarg))) + (and def bind-enquote (setq def (list 'quote def))) + (if (cddr arg) + (let* ((temp (or (nth 2 arg) (gensym))) + (val (list 'car (list 'cdr temp)))) + (cl-do-arglist temp look) + (cl-do-arglist varg + (list 'if temp + (list 'prog1 val (list 'setq temp t)) + def))) + (cl-do-arglist + varg + (list 'car + (list 'cdr + (if (null def) + look + (list 'or look + (if (eq (cl-const-expr-p def) t) + (list + 'quote + (list nil (cl-const-expr-val def))) + (list 'list nil def)))))))) + (cl-push karg keys) + (if (= (aref (symbol-name karg) 0) ?:) + (progn (set karg karg) + (cl-push (list 'setq karg (list 'quote karg)) + bind-inits))))))) + (setq keys (nreverse keys)) + (or (and (eq (car args) '&allow-other-keys) (cl-pop args)) + (null keys) (= safety 0) + (let* ((var (gensym "--keys--")) + (allow '(:allow-other-keys)) + (check (list + 'while var + (list + 'cond + (list (list 'memq (list 'car var) + (list 'quote (append keys allow))) + (list 'setq var (list 'cdr (list 'cdr var)))) + (list (list 'car + (list 'cdr + (list 'memq (cons 'quote allow) + restarg))) + (list 'setq var nil)) + (list t + (list + 'error + (format "Keyword argument %%s not one of %s" + keys) + (list 'car var))))))) + (cl-push (list 'let (list (list var restarg)) check) bind-forms))) + (while (and (eq (car args) '&aux) (cl-pop args)) + (while (and args (not (memq (car args) lambda-list-keywords))) + (if (consp (car args)) + (if (and bind-enquote (cadar args)) + (cl-do-arglist (caar args) + (list 'quote (cadr (cl-pop args)))) + (cl-do-arglist (caar args) (cadr (cl-pop args)))) + (cl-do-arglist (cl-pop args) nil)))) + (if args (error "Malformed argument list %s" save-args))))) + + (defun cl-arglist-args (args) + (if (nlistp args) (list args) + (let ((res nil) (kind nil) arg) + (while (consp args) + (setq arg (cl-pop args)) + (if (memq arg lambda-list-keywords) (setq kind arg) + (if (eq arg '&cl-defs) (cl-pop args) + (and (consp arg) kind (setq arg (car arg))) + (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg))) + (setq res (nconc res (cl-arglist-args arg)))))) + (nconc res (and args (list args)))))) + + (defmacro destructuring-bind (args expr &rest body) + (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil) + (bind-defs nil) (bind-block 'cl-none)) + (cl-do-arglist (or args '(&aux)) expr) + (append '(progn) bind-inits + (list (nconc (list 'let* (nreverse bind-lets)) + (nreverse bind-forms) body))))) + + + ;;; The `eval-when' form. + + (defvar cl-not-toplevel nil) + + (defmacro eval-when (when &rest body) + "(eval-when (WHEN...) BODY...): control when BODY is evaluated. + If `compile' is in WHEN, BODY is evaluated when compiled at top-level. + If `load' is in WHEN, BODY is evaluated when loaded after top-level compile. + If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level." + (if (and (fboundp 'cl-compiling-file) (cl-compiling-file) + (not cl-not-toplevel) (not (boundp 'for-effect))) ; horrible kludge + (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when))) + (cl-not-toplevel t)) + (if (or (memq 'load when) (memq ':load-toplevel when)) + (if comp (cons 'progn (mapcar 'cl-compile-time-too body)) + (list* 'if nil nil body)) + (progn (if comp (eval (cons 'progn body))) nil))) + (and (or (memq 'eval when) (memq ':execute when)) + (cons 'progn body)))) + + (defun cl-compile-time-too (form) + (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler)) + (setq form (macroexpand + form (cons '(eval-when) byte-compile-macro-environment)))) + (cond ((eq (car-safe form) 'progn) + (cons 'progn (mapcar 'cl-compile-time-too (cdr form)))) + ((eq (car-safe form) 'eval-when) + (let ((when (nth 1 form))) + (if (or (memq 'eval when) (memq ':execute when)) + (list* 'eval-when (cons 'compile when) (cddr form)) + form))) + (t (eval form) form))) + + (or (and (fboundp 'eval-when-compile) + (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload))) + (eval '(defmacro eval-when-compile (&rest body) + "Like `progn', but evaluates the body at compile time. + The result of the body appears to the compiler as a quoted constant." + (list 'quote (eval (cons 'progn body)))))) + + (defmacro load-time-value (form &optional read-only) + "Like `progn', but evaluates the body at load time. + The result of the body appears to the compiler as a quoted constant." + (if (cl-compiling-file) + (let* ((temp (gentemp "--cl-load-time--")) + (set (list 'set (list 'quote temp) form))) + (if (and (fboundp 'byte-compile-file-form-defmumble) + (boundp 'this-kind) (boundp 'that-one)) + (fset 'byte-compile-file-form + (list 'lambda '(form) + (list 'fset '(quote byte-compile-file-form) + (list 'quote + (symbol-function 'byte-compile-file-form))) + (list 'byte-compile-file-form (list 'quote set)) + '(byte-compile-file-form form))) + (print set (symbol-value 'outbuffer))) + (list 'symbol-value (list 'quote temp))) + (list 'quote (eval form)))) + + + ;;; Conditional control structures. + + (defmacro case (expr &rest clauses) + "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. + Each clause looks like (KEYLIST BODY...). EXPR is evaluated and compared + against each key in each KEYLIST; the corresponding BODY is evaluated. + If no clause succeeds, case returns nil. A single atom may be used in + place of a KEYLIST of one atom. A KEYLIST of `t' or `otherwise' is + allowed only in the final clause, and matches if no other keys match. + Key values are compared by `eql'." + (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) + (head-list nil) + (body (cons + 'cond + (mapcar + (function + (lambda (c) + (cons (cond ((memq (car c) '(t otherwise)) t) + ((eq (car c) 'ecase-error-flag) + (list 'error "ecase failed: %s, %s" + temp (list 'quote (reverse head-list)))) + ((listp (car c)) + (setq head-list (append (car c) head-list)) + (list 'member* temp (list 'quote (car c)))) + (t + (if (memq (car c) head-list) + (error "Duplicate key in case: %s" + (car c))) + (cl-push (car c) head-list) + (list 'eql temp (list 'quote (car c))))) + (or (cdr c) '(nil))))) + clauses)))) + (if (eq temp expr) body + (list 'let (list (list temp expr)) body)))) + + (defmacro ecase (expr &rest clauses) + "(ecase EXPR CLAUSES...): like `case', but error if no case fits. + `otherwise'-clauses are not allowed." + (list* 'case expr (append clauses '((ecase-error-flag))))) + + (defmacro typecase (expr &rest clauses) + "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value. + Each clause looks like (TYPE BODY...). EXPR is evaluated and, if it + satisfies TYPE, the corresponding BODY is evaluated. If no clause succeeds, + typecase returns nil. A TYPE of `t' or `otherwise' is allowed only in the + final clause, and matches if no other keys match." + (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym))) + (type-list nil) + (body (cons + 'cond + (mapcar + (function + (lambda (c) + (cons (cond ((eq (car c) 'otherwise) t) + ((eq (car c) 'ecase-error-flag) + (list 'error "etypecase failed: %s, %s" + temp (list 'quote (reverse type-list)))) + (t + (cl-push (car c) type-list) + (cl-make-type-test temp (car c)))) + (or (cdr c) '(nil))))) + clauses)))) + (if (eq temp expr) body + (list 'let (list (list temp expr)) body)))) + + (defmacro etypecase (expr &rest clauses) + "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits. + `otherwise'-clauses are not allowed." + (list* 'typecase expr (append clauses '((ecase-error-flag))))) + + + ;;; Blocks and exits. + + (defmacro block (name &rest body) + "(block NAME BODY...): define a lexically-scoped block named NAME. + NAME may be any symbol. Code inside the BODY forms can call `return-from' + to jump prematurely out of the block. This differs from `catch' and `throw' + in two respects: First, the NAME is an unevaluated symbol rather than a + quoted symbol or other form; and second, NAME is lexically rather than + dynamically scoped: Only references to it within BODY will work. These + references may appear inside macro expansions, but not inside functions + called from BODY." + (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body) + (list 'cl-block-wrapper + (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) + body)))) + + (defvar cl-active-block-names nil) + + (put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block) + (defun cl-byte-compile-block (cl-form) + (if (fboundp 'byte-compile-form-do-effect) ; Check for optimizing compiler + (progn + (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) + (cl-active-block-names (cons cl-entry cl-active-block-names)) + (cl-body (byte-compile-top-level + (cons 'progn (cddr (nth 1 cl-form)))))) + (if (cdr cl-entry) + (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body)) + (byte-compile-form cl-body)))) + (byte-compile-form (nth 1 cl-form)))) + + (put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw) + (defun cl-byte-compile-throw (cl-form) + (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names))) + (if cl-found (setcdr cl-found t))) + (byte-compile-normal-call (cons 'throw (cdr cl-form)))) + + (defmacro return (&optional res) + "(return [RESULT]): return from the block named nil. + This is equivalent to `(return-from nil RESULT)'." + (list 'return-from nil res)) + + (defmacro return-from (name &optional res) + "(return-from NAME [RESULT]): return from the block named NAME. + This jump out to the innermost enclosing `(block NAME ...)' form, + returning RESULT from that form (or nil if RESULT is omitted). + This is compatible with Common Lisp, but note that `defun' and + `defmacro' do not create implicit blocks as they do in Common Lisp." + (let ((name2 (intern (format "--cl-block-%s--" name)))) + (list 'cl-block-throw (list 'quote name2) res))) + + + ;;; The "loop" macro. + + (defvar args) (defvar loop-accum-var) (defvar loop-accum-vars) + (defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps) + (defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag) + (defvar loop-initially) (defvar loop-map-form) (defvar loop-name) + (defvar loop-result) (defvar loop-result-explicit) + (defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs) + + (defmacro loop (&rest args) + "(loop CLAUSE...): The Common Lisp `loop' macro. + Valid clauses are: + for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM, + for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR, + for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND, + always COND, never COND, thereis COND, collect EXPR into VAR, + append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR, + count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR, + if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], + unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...], + do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR, + finally return EXPR, named NAME." + (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args)))))) + (list 'block nil (list* 'while t args)) + (let ((loop-name nil) (loop-bindings nil) + (loop-body nil) (loop-steps nil) + (loop-result nil) (loop-result-explicit nil) + (loop-result-var nil) (loop-finish-flag nil) + (loop-accum-var nil) (loop-accum-vars nil) + (loop-initially nil) (loop-finally nil) + (loop-map-form nil) (loop-first-flag nil) + (loop-destr-temps nil) (loop-symbol-macs nil)) + (setq args (append args '(cl-end-loop))) + (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause)) + (if loop-finish-flag + (cl-push (list (list loop-finish-flag t)) loop-bindings)) + (if loop-first-flag + (progn (cl-push (list (list loop-first-flag t)) loop-bindings) + (cl-push (list 'setq loop-first-flag nil) loop-steps))) + (let* ((epilogue (nconc (nreverse loop-finally) + (list (or loop-result-explicit loop-result)))) + (ands (cl-loop-build-ands (nreverse loop-body))) + (while-body (nconc (cadr ands) (nreverse loop-steps))) + (body (append + (nreverse loop-initially) + (list (if loop-map-form + (list 'block '--cl-finish-- + (subst + (if (eq (car ands) t) while-body + (cons (list 'or (car ands) + '(return-from --cl-finish-- + nil)) + while-body)) + '--cl-map loop-map-form)) + (list* 'while (car ands) while-body))) + (if loop-finish-flag + (if (equal epilogue '(nil)) (list loop-result-var) + (list (list 'if loop-finish-flag + (cons 'progn epilogue) loop-result-var))) + epilogue)))) + (if loop-result-var (cl-push (list loop-result-var) loop-bindings)) + (while loop-bindings + (if (cdar loop-bindings) + (setq body (list (cl-loop-let (cl-pop loop-bindings) body t))) + (let ((lets nil)) + (while (and loop-bindings + (not (cdar loop-bindings))) + (cl-push (car (cl-pop loop-bindings)) lets)) + (setq body (list (cl-loop-let lets body nil)))))) + (if loop-symbol-macs + (setq body (list (list* 'symbol-macrolet loop-symbol-macs body)))) + (list* 'block loop-name body))))) + + (defun cl-parse-loop-clause () ; uses args, loop-* + (let ((word (cl-pop args)) + (hash-types '(hash-key hash-keys hash-value hash-values)) + (key-types '(key-code key-codes key-seq key-seqs + key-binding key-bindings))) + (cond + + ((null args) + (error "Malformed `loop' macro")) + + ((eq word 'named) + (setq loop-name (cl-pop args))) + + ((eq word 'initially) + (if (memq (car args) '(do doing)) (cl-pop args)) + (or (consp (car args)) (error "Syntax error on `initially' clause")) + (while (consp (car args)) + (cl-push (cl-pop args) loop-initially))) + + ((eq word 'finally) + (if (eq (car args) 'return) + (setq loop-result-explicit (or (cl-pop2 args) '(quote nil))) + (if (memq (car args) '(do doing)) (cl-pop args)) + (or (consp (car args)) (error "Syntax error on `finally' clause")) + (if (and (eq (caar args) 'return) (null loop-name)) + (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil))) + (while (consp (car args)) + (cl-push (cl-pop args) loop-finally))))) + + ((memq word '(for as)) + (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil) + (ands nil)) + (while + (let ((var (or (cl-pop args) (gensym)))) + (setq word (cl-pop args)) + (if (eq word 'being) (setq word (cl-pop args))) + (if (memq word '(the each)) (setq word (cl-pop args))) + (if (memq word '(buffer buffers)) + (setq word 'in args (cons '(buffer-list) args))) + (cond + + ((memq word '(from downfrom upfrom to downto upto + above below by)) + (cl-push word args) + (if (memq (car args) '(downto above)) + (error "Must specify `from' value for downward loop")) + (let* ((down (or (eq (car args) 'downfrom) + (memq (caddr args) '(downto above)))) + (excl (or (memq (car args) '(above below)) + (memq (caddr args) '(above below)))) + (start (and (memq (car args) '(from upfrom downfrom)) + (cl-pop2 args))) + (end (and (memq (car args) + '(to upto downto above below)) + (cl-pop2 args))) + (step (and (eq (car args) 'by) (cl-pop2 args))) + (end-var (and (not (cl-const-expr-p end)) (gensym))) + (step-var (and (not (cl-const-expr-p step)) + (gensym)))) + (and step (numberp step) (<= step 0) + (error "Loop `by' value is not positive: %s" step)) + (cl-push (list var (or start 0)) loop-for-bindings) + (if end-var (cl-push (list end-var end) loop-for-bindings)) + (if step-var (cl-push (list step-var step) + loop-for-bindings)) + (if end + (cl-push (list + (if down (if excl '> '>=) (if excl '< '<=)) + var (or end-var end)) loop-body)) + (cl-push (list var (list (if down '- '+) var + (or step-var step 1))) + loop-for-steps))) + + ((memq word '(in in-ref on)) + (let* ((on (eq word 'on)) + (temp (if (and on (symbolp var)) var (gensym)))) + (cl-push (list temp (cl-pop args)) loop-for-bindings) + (cl-push (list 'consp temp) loop-body) + (if (eq word 'in-ref) + (cl-push (list var (list 'car temp)) loop-symbol-macs) + (or (eq temp var) + (progn + (cl-push (list var nil) loop-for-bindings) + (cl-push (list var (if on temp (list 'car temp))) + loop-for-sets)))) + (cl-push (list temp + (if (eq (car args) 'by) + (let ((step (cl-pop2 args))) + (if (and (memq (car-safe step) + '(quote function + function*)) + (symbolp (nth 1 step))) + (list (nth 1 step) temp) + (list 'funcall step temp))) + (list 'cdr temp))) + loop-for-steps))) + + ((eq word '=) + (let* ((start (cl-pop args)) + (then (if (eq (car args) 'then) (cl-pop2 args) start))) + (cl-push (list var nil) loop-for-bindings) + (if (or ands (eq (car args) 'and)) + (progn + (cl-push (list var + (list 'if + (or loop-first-flag + (setq loop-first-flag + (gensym))) + start var)) + loop-for-sets) + (cl-push (list var then) loop-for-steps)) + (cl-push (list var + (if (eq start then) start + (list 'if + (or loop-first-flag + (setq loop-first-flag (gensym))) + start then))) + loop-for-sets)))) + + ((memq word '(across across-ref)) + (let ((temp-vec (gensym)) (temp-idx (gensym))) + (cl-push (list temp-vec (cl-pop args)) loop-for-bindings) + (cl-push (list temp-idx -1) loop-for-bindings) + (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx)) + (list 'length temp-vec)) loop-body) + (if (eq word 'across-ref) + (cl-push (list var (list 'aref temp-vec temp-idx)) + loop-symbol-macs) + (cl-push (list var nil) loop-for-bindings) + (cl-push (list var (list 'aref temp-vec temp-idx)) + loop-for-sets)))) + + ((memq word '(element elements)) + (let ((ref (or (memq (car args) '(in-ref of-ref)) + (and (not (memq (car args) '(in of))) + (error "Expected `of'")))) + (seq (cl-pop2 args)) + (temp-seq (gensym)) + (temp-idx (if (eq (car args) 'using) + (if (and (= (length (cadr args)) 2) + (eq (caadr args) 'index)) + (cadr (cl-pop2 args)) + (error "Bad `using' clause")) + (gensym)))) + (cl-push (list temp-seq seq) loop-for-bindings) + (cl-push (list temp-idx 0) loop-for-bindings) + (if ref + (let ((temp-len (gensym))) + (cl-push (list temp-len (list 'length temp-seq)) + loop-for-bindings) + (cl-push (list var (list 'elt temp-seq temp-idx)) + loop-symbol-macs) + (cl-push (list '< temp-idx temp-len) loop-body)) + (cl-push (list var nil) loop-for-bindings) + (cl-push (list 'and temp-seq + (list 'or (list 'consp temp-seq) + (list '< temp-idx + (list 'length temp-seq)))) + loop-body) + (cl-push (list var (list 'if (list 'consp temp-seq) + (list 'pop temp-seq) + (list 'aref temp-seq temp-idx))) + loop-for-sets)) + (cl-push (list temp-idx (list '1+ temp-idx)) + loop-for-steps))) + + ((memq word hash-types) + (or (memq (car args) '(in of)) (error "Expected `of'")) + (let* ((table (cl-pop2 args)) + (other (if (eq (car args) 'using) + (if (and (= (length (cadr args)) 2) + (memq (caadr args) hash-types) + (not (eq (caadr args) word))) + (cadr (cl-pop2 args)) + (error "Bad `using' clause")) + (gensym)))) + (if (memq word '(hash-value hash-values)) + (setq var (prog1 other (setq other var)))) + (setq loop-map-form + (list 'maphash (list 'function + (list* 'lambda (list var other) + '--cl-map)) table)))) + + ((memq word '(symbol present-symbol external-symbol + symbols present-symbols external-symbols)) + (let ((ob (and (memq (car args) '(in of)) (cl-pop2 args)))) + (setq loop-map-form + (list 'mapatoms (list 'function + (list* 'lambda (list var) + '--cl-map)) ob)))) + + ((memq word '(overlay overlays extent extents)) + (let ((buf nil) (from nil) (to nil)) + (while (memq (car args) '(in of from to)) + (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) + ((eq (car args) 'to) (setq to (cl-pop2 args))) + (t (setq buf (cl-pop2 args))))) + (setq loop-map-form + (list 'cl-map-extents + (list 'function (list 'lambda (list var (gensym)) + '(progn . --cl-map) nil)) + buf from to)))) + + ((memq word '(interval intervals)) + (let ((buf nil) (prop nil) (from nil) (to nil) + (var1 (gensym)) (var2 (gensym))) + (while (memq (car args) '(in of property from to)) + (cond ((eq (car args) 'from) (setq from (cl-pop2 args))) + ((eq (car args) 'to) (setq to (cl-pop2 args))) + ((eq (car args) 'property) + (setq prop (cl-pop2 args))) + (t (setq buf (cl-pop2 args))))) + (if (and (consp var) (symbolp (car var)) (symbolp (cdr var))) + (setq var1 (car var) var2 (cdr var)) + (cl-push (list var (list 'cons var1 var2)) loop-for-sets)) + (setq loop-map-form + (list 'cl-map-intervals + (list 'function (list 'lambda (list var1 var2) + '(progn . --cl-map))) + buf prop from to)))) + + ((memq word key-types) + (or (memq (car args) '(in of)) (error "Expected `of'")) + (let ((map (cl-pop2 args)) + (other (if (eq (car args) 'using) + (if (and (= (length (cadr args)) 2) + (memq (caadr args) key-types) + (not (eq (caadr args) word))) + (cadr (cl-pop2 args)) + (error "Bad `using' clause")) + (gensym)))) + (if (memq word '(key-binding key-bindings)) + (setq var (prog1 other (setq other var)))) + (setq loop-map-form + (list (if (memq word '(key-seq key-seqs)) + 'cl-map-keymap-recursively 'cl-map-keymap) + (list 'function (list* 'lambda (list var other) + '--cl-map)) map)))) + + ((memq word '(frame frames screen screens)) + (let ((temp (gensym))) + (cl-push (list var (if (eq cl-emacs-type 'lucid) + '(selected-screen) '(selected-frame))) + loop-for-bindings) + (cl-push (list temp nil) loop-for-bindings) + (cl-push (list 'prog1 (list 'not (list 'eq var temp)) + (list 'or temp (list 'setq temp var))) + loop-body) + (cl-push (list var (list (if (eq cl-emacs-type 'lucid) + 'next-screen 'next-frame) var)) + loop-for-steps))) + + ((memq word '(window windows)) + (let ((scr (and (memq (car args) '(in of)) (cl-pop2 args))) + (temp (gensym))) + (cl-push (list var (if scr + (list (if (eq cl-emacs-type 'lucid) + 'screen-selected-window + 'frame-selected-window) scr) + '(selected-window))) + loop-for-bindings) + (cl-push (list temp nil) loop-for-bindings) + (cl-push (list 'prog1 (list 'not (list 'eq var temp)) + (list 'or temp (list 'setq temp var))) + loop-body) + (cl-push (list var (list 'next-window var)) loop-for-steps))) + + (t + (let ((handler (and (symbolp word) + (get word 'cl-loop-for-handler)))) + (if handler + (funcall handler var) + (error "Expected a `for' preposition, found %s" word))))) + (eq (car args) 'and)) + (setq ands t) + (cl-pop args)) + (if (and ands loop-for-bindings) + (cl-push (nreverse loop-for-bindings) loop-bindings) + (setq loop-bindings (nconc (mapcar 'list loop-for-bindings) + loop-bindings))) + (if loop-for-sets + (cl-push (list 'progn + (cl-loop-let (nreverse loop-for-sets) 'setq ands) + t) loop-body)) + (if loop-for-steps + (cl-push (cons (if ands 'psetq 'setq) + (apply 'append (nreverse loop-for-steps))) + loop-steps)))) + + ((eq word 'repeat) + (let ((temp (gensym))) + (cl-push (list (list temp (cl-pop args))) loop-bindings) + (cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body))) + + ((eq word 'collect) + (let ((what (cl-pop args)) + (var (cl-loop-handle-accum nil 'nreverse))) + (if (eq var loop-accum-var) + (cl-push (list 'progn (list 'push what var) t) loop-body) + (cl-push (list 'progn + (list 'setq var (list 'nconc var (list 'list what))) + t) loop-body)))) + + ((memq word '(nconc nconcing append appending)) + (let ((what (cl-pop args)) + (var (cl-loop-handle-accum nil 'nreverse))) + (cl-push (list 'progn + (list 'setq var + (if (eq var loop-accum-var) + (list 'nconc + (list (if (memq word '(nconc nconcing)) + 'nreverse 'reverse) + what) + var) + (list (if (memq word '(nconc nconcing)) + 'nconc 'append) + var what))) t) loop-body))) + + ((memq word '(concat concating)) + (let ((what (cl-pop args)) + (var (cl-loop-handle-accum ""))) + (cl-push (list 'progn (list 'callf 'concat var what) t) loop-body))) + + ((memq word '(vconcat vconcating)) + (let ((what (cl-pop args)) + (var (cl-loop-handle-accum []))) + (cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body))) + + ((memq word '(sum summing)) + (let ((what (cl-pop args)) + (var (cl-loop-handle-accum 0))) + (cl-push (list 'progn (list 'incf var what) t) loop-body))) + + ((memq word '(count counting)) + (let ((what (cl-pop args)) + (var (cl-loop-handle-accum 0))) + (cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body))) + + ((memq word '(minimize minimizing maximize maximizing)) + (let* ((what (cl-pop args)) + (temp (if (cl-simple-expr-p what) what (gensym))) + (var (cl-loop-handle-accum nil)) + (func (intern (substring (symbol-name word) 0 3))) + (set (list 'setq var (list 'if var (list func var temp) temp)))) + (cl-push (list 'progn (if (eq temp what) set + (list 'let (list (list temp what)) set)) + t) loop-body))) + + ((eq word 'with) + (let ((bindings nil)) + (while (progn (cl-push (list (cl-pop args) + (and (eq (car args) '=) (cl-pop2 args))) + bindings) + (eq (car args) 'and)) + (cl-pop args)) + (cl-push (nreverse bindings) loop-bindings))) + + ((eq word 'while) + (cl-push (cl-pop args) loop-body)) + + ((eq word 'until) + (cl-push (list 'not (cl-pop args)) loop-body)) + + ((eq word 'always) + (or loop-finish-flag (setq loop-finish-flag (gensym))) + (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body) + (setq loop-result t)) + + ((eq word 'never) + (or loop-finish-flag (setq loop-finish-flag (gensym))) + (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args))) + loop-body) + (setq loop-result t)) + + ((eq word 'thereis) + (or loop-finish-flag (setq loop-finish-flag (gensym))) + (or loop-result-var (setq loop-result-var (gensym))) + (cl-push (list 'setq loop-finish-flag + (list 'not (list 'setq loop-result-var (cl-pop args)))) + loop-body)) + + ((memq word '(if when unless)) + (let* ((cond (cl-pop args)) + (then (let ((loop-body nil)) + (cl-parse-loop-clause) + (cl-loop-build-ands (nreverse loop-body)))) + (else (let ((loop-body nil)) + (if (eq (car args) 'else) + (progn (cl-pop args) (cl-parse-loop-clause))) + (cl-loop-build-ands (nreverse loop-body)))) + (simple (and (eq (car then) t) (eq (car else) t)))) + (if (eq (car args) 'end) (cl-pop args)) + (if (eq word 'unless) (setq then (prog1 else (setq else then)))) + (let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then)) + (if simple (nth 1 else) (list (nth 2 else)))))) + (if (cl-expr-contains form 'it) + (let ((temp (gensym))) + (cl-push (list temp) loop-bindings) + (setq form (list* 'if (list 'setq temp cond) + (subst temp 'it form)))) + (setq form (list* 'if cond form))) + (cl-push (if simple (list 'progn form t) form) loop-body)))) + + ((memq word '(do doing)) + (let ((body nil)) + (or (consp (car args)) (error "Syntax error on `do' clause")) + (while (consp (car args)) (cl-push (cl-pop args) body)) + (cl-push (cons 'progn (nreverse (cons t body))) loop-body))) + + ((eq word 'return) + (or loop-finish-flag (setq loop-finish-flag (gensym))) + (or loop-result-var (setq loop-result-var (gensym))) + (cl-push (list 'setq loop-result-var (cl-pop args) + loop-finish-flag nil) loop-body)) + + (t + (let ((handler (and (symbolp word) (get word 'cl-loop-handler)))) + (or handler (error "Expected a loop keyword, found %s" word)) + (funcall handler)))) + (if (eq (car args) 'and) + (progn (cl-pop args) (cl-parse-loop-clause))))) + + (defun cl-loop-let (specs body par) ; uses loop-* + (let ((p specs) (temps nil) (new nil)) + (while (and p (or (symbolp (car-safe (car p))) (null (cadar p)))) + (setq p (cdr p))) + (and par p + (progn + (setq par nil p specs) + (while p + (or (cl-const-expr-p (cadar p)) + (let ((temp (gensym))) + (cl-push (list temp (cadar p)) temps) + (setcar (cdar p) temp))) + (setq p (cdr p))))) + (while specs + (if (and (consp (car specs)) (listp (caar specs))) + (let* ((spec (caar specs)) (nspecs nil) + (expr (cadr (cl-pop specs))) + (temp (cdr (or (assq spec loop-destr-temps) + (car (cl-push (cons spec (or (last spec 0) + (gensym))) + loop-destr-temps)))))) + (cl-push (list temp expr) new) + (while (consp spec) + (cl-push (list (cl-pop spec) + (and expr (list (if spec 'pop 'car) temp))) + nspecs)) + (setq specs (nconc (nreverse nspecs) specs))) + (cl-push (cl-pop specs) new))) + (if (eq body 'setq) + (let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new))))) + (if temps (list 'let* (nreverse temps) set) set)) + (list* (if par 'let 'let*) + (nconc (nreverse temps) (nreverse new)) body)))) + + (defun cl-loop-handle-accum (def &optional func) ; uses args, loop-* + (if (eq (car args) 'into) + (let ((var (cl-pop2 args))) + (or (memq var loop-accum-vars) + (progn (cl-push (list (list var def)) loop-bindings) + (cl-push var loop-accum-vars))) + var) + (or loop-accum-var + (progn + (cl-push (list (list (setq loop-accum-var (gensym)) def)) + loop-bindings) + (setq loop-result (if func (list func loop-accum-var) + loop-accum-var)) + loop-accum-var)))) + + (defun cl-loop-build-ands (clauses) + (let ((ands nil) + (body nil)) + (while clauses + (if (and (eq (car-safe (car clauses)) 'progn) + (eq (car (last (car clauses))) t)) + (if (cdr clauses) + (setq clauses (cons (nconc (butlast (car clauses)) + (if (eq (car-safe (cadr clauses)) + 'progn) + (cdadr clauses) + (list (cadr clauses)))) + (cddr clauses))) + (setq body (cdr (butlast (cl-pop clauses))))) + (cl-push (cl-pop clauses) ands))) + (setq ands (or (nreverse ands) (list t))) + (list (if (cdr ands) (cons 'and ands) (car ands)) + body + (let ((full (if body + (append ands (list (cons 'progn (append body '(t))))) + ands))) + (if (cdr full) (cons 'and full) (car full)))))) + + + ;;; Other iteration control structures. + + (defmacro do (steps endtest &rest body) + "The Common Lisp `do' loop. + Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" + (cl-expand-do-loop steps endtest body nil)) + + (defmacro do* (steps endtest &rest body) + "The Common Lisp `do*' loop. + Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)" + (cl-expand-do-loop steps endtest body t)) + + (defun cl-expand-do-loop (steps endtest body star) + (list 'block nil + (list* (if star 'let* 'let) + (mapcar (function (lambda (c) + (if (consp c) (list (car c) (nth 1 c)) c))) + steps) + (list* 'while (list 'not (car endtest)) + (append body + (let ((sets (mapcar + (function + (lambda (c) + (and (consp c) (cdr (cdr c)) + (list (car c) (nth 2 c))))) + steps))) + (setq sets (delq nil sets)) + (and sets + (list (cons (if (or star (not (cdr sets))) + 'setq 'psetq) + (apply 'append sets))))))) + (or (cdr endtest) '(nil))))) + + (defmacro dolist (spec &rest body) + "(dolist (VAR LIST [RESULT]) BODY...): loop over a list. + Evaluate BODY with VAR bound to each `car' from LIST, in turn. + Then evaluate RESULT to get return value, default nil." + (let ((temp (gensym "--dolist-temp--"))) + (list 'block nil + (list* 'let (list (list temp (nth 1 spec)) (car spec)) + (list* 'while temp (list 'setq (car spec) (list 'car temp)) + (append body (list (list 'setq temp + (list 'cdr temp))))) + (if (cdr (cdr spec)) + (cons (list 'setq (car spec) nil) (cdr (cdr spec))) + '(nil)))))) + + (defmacro dotimes (spec &rest body) + "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. + Evaluate BODY with VAR bound to successive integers from 0, inclusive, + to COUNT, exclusive. Then evaluate RESULT to get return value, default + nil." + (let ((temp (gensym "--dotimes-temp--"))) + (list 'block nil + (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) + (list* 'while (list '< (car spec) temp) + (append body (list (list 'incf (car spec))))) + (or (cdr (cdr spec)) '(nil)))))) + + (defmacro do-symbols (spec &rest body) + "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols. + Evaluate BODY with VAR bound to each interned symbol, or to each symbol + from OBARRAY." + ;; Apparently this doesn't have an implicit block. + (list 'block nil + (list 'let (list (car spec)) + (list* 'mapatoms + (list 'function (list* 'lambda (list (car spec)) body)) + (and (cadr spec) (list (cadr spec)))) + (caddr spec)))) + + (defmacro do-all-symbols (spec &rest body) + (list* 'do-symbols (list (car spec) nil (cadr spec)) body)) + + + ;;; Assignments. + + (defmacro psetq (&rest args) + "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel. + This is like `setq', except that all VAL forms are evaluated (in order) + before assigning any symbols SYM to the corresponding values." + (cons 'psetf args)) + + + ;;; Binding control structures. + + (defmacro progv (symbols values &rest body) + "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY. + The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists. + Each SYMBOL in the first list is bound to the corresponding VALUE in the + second list (or made unbound if VALUES is shorter than SYMBOLS); then the + BODY forms are executed and their result is returned. This is much like + a `let' form, except that the list of symbols can be computed at run-time." + (list 'let '((cl-progv-save nil)) + (list 'unwind-protect + (list* 'progn (list 'cl-progv-before symbols values) body) + '(cl-progv-after)))) + + ;;; This should really have some way to shadow 'byte-compile properties, etc. + (defmacro flet (bindings &rest body) + "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns. + This is an analogue of `let' that operates on the function cell of FUNC + rather than its value cell. The FORMs are evaluated with the specified + function definitions in place, then the definitions are undone (the FUNCs + go back to their previous definitions, or lack thereof)." + (list* 'letf* + (mapcar + (function + (lambda (x) + (let ((func (list 'function* + (list 'lambda (cadr x) + (list* 'block (car x) (cddr x)))))) + (if (and (cl-compiling-file) + (boundp 'byte-compile-function-environment)) + (cl-push (cons (car x) (eval func)) + byte-compile-function-environment)) + (list (list 'symbol-function (list 'quote (car x))) func)))) + bindings) + body)) + + (defmacro labels (&rest args) (cons 'flet args)) + + ;; The following ought to have a better definition for use with newer + ;; byte compilers. + (defmacro macrolet (bindings &rest body) + "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns. + This is like `flet', but for macros instead of functions." + (if (cdr bindings) + (list 'macrolet + (list (car bindings)) (list* 'macrolet (cdr bindings) body)) + (if (null bindings) (cons 'progn body) + (let* ((name (caar bindings)) + (res (cl-transform-lambda (cdar bindings) name))) + (eval (car res)) + (cl-macroexpand-all (cons 'progn body) + (cons (list* name 'lambda (cdr res)) + cl-macro-environment)))))) + + (defmacro symbol-macrolet (bindings &rest body) + "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns. + Within the body FORMs, references to the variable NAME will be replaced + by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)." + (if (cdr bindings) + (list 'symbol-macrolet + (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body)) + (if (null bindings) (cons 'progn body) + (cl-macroexpand-all (cons 'progn body) + (cons (list (symbol-name (caar bindings)) + (cadar bindings)) + cl-macro-environment))))) + + (defvar cl-closure-vars nil) + (defmacro lexical-let (bindings &rest body) + "(lexical-let BINDINGS BODY...): like `let', but lexically scoped. + The main visible difference is that lambdas inside BODY will create + lexical closures as in Common Lisp." + (let* ((cl-closure-vars cl-closure-vars) + (vars (mapcar (function + (lambda (x) + (or (consp x) (setq x (list x))) + (cl-push (gensym (format "--%s--" (car x))) + cl-closure-vars) + (list (car x) (cadr x) (car cl-closure-vars)))) + bindings)) + (ebody + (cl-macroexpand-all + (cons 'progn body) + (nconc (mapcar (function (lambda (x) + (list (symbol-name (car x)) + (list 'symbol-value (caddr x)) + t))) vars) + (list '(defun . cl-defun-expander)) + cl-macro-environment)))) + (if (not (get (car (last cl-closure-vars)) 'used)) + (list 'let (mapcar (function (lambda (x) + (list (caddr x) (cadr x)))) vars) + (sublis (mapcar (function (lambda (x) + (cons (caddr x) + (list 'quote (caddr x))))) + vars) + ebody)) + (list 'let (mapcar (function (lambda (x) + (list (caddr x) + (list 'make-symbol + (format "--%s--" (car x)))))) + vars) + (apply 'append '(setf) + (mapcar (function + (lambda (x) + (list (list 'symbol-value (caddr x)) (cadr x)))) + vars)) + ebody)))) + + (defmacro lexical-let* (bindings &rest body) + "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped. + The main visible difference is that lambdas inside BODY will create + lexical closures as in Common Lisp." + (if (null bindings) (cons 'progn body) + (setq bindings (reverse bindings)) + (while bindings + (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body)))) + (car body))) + + (defun cl-defun-expander (func &rest rest) + (list 'progn + (list 'defalias (list 'quote func) + (list 'function (cons 'lambda rest))) + (list 'quote func))) + + + ;;; Multiple values. + + (defmacro multiple-value-bind (vars form &rest body) + "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values. + FORM must return a list; the BODY is then executed with the first N elements + of this list bound (`let'-style) to each of the symbols SYM in turn. This + is analogous to the Common Lisp `multiple-value-bind' macro, using lists to + simulate true multiple return values. For compatibility, (values A B C) is + a synonym for (list A B C)." + (let ((temp (gensym)) (n -1)) + (list* 'let* (cons (list temp form) + (mapcar (function + (lambda (v) + (list v (list 'nth (setq n (1+ n)) temp)))) + vars)) + body))) + + (defmacro multiple-value-setq (vars form) + "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values. + FORM must return a list; the first N elements of this list are stored in + each of the symbols SYM in turn. This is analogous to the Common Lisp + `multiple-value-setq' macro, using lists to simulate true multiple return + values. For compatibility, (values A B C) is a synonym for (list A B C)." + (cond ((null vars) (list 'progn form nil)) + ((null (cdr vars)) (list 'setq (car vars) (list 'car form))) + (t + (let* ((temp (gensym)) (n 0)) + (list 'let (list (list temp form)) + (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp)) + (cons 'setq (apply 'nconc + (mapcar (function + (lambda (v) + (list v (list + 'nth + (setq n (1+ n)) + temp)))) + vars))))))))) + + + ;;; Declarations. + + (defmacro locally (&rest body) (cons 'progn body)) + (defmacro the (type form) form) + + (defvar cl-proclaim-history t) ; for future compilers + (defvar cl-declare-stack t) ; for future compilers + + (defun cl-do-proclaim (spec hist) + (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history)) + (cond ((eq (car-safe spec) 'special) + (if (boundp 'byte-compile-bound-variables) + (setq byte-compile-bound-variables + (append (cdr spec) byte-compile-bound-variables)))) + + ((eq (car-safe spec) 'inline) + (while (setq spec (cdr spec)) + (or (memq (get (car spec) 'byte-optimizer) + '(nil byte-compile-inline-expand)) + (error "%s already has a byte-optimizer, can't make it inline" + (car spec))) + (put (car spec) 'byte-optimizer 'byte-compile-inline-expand))) + + ((eq (car-safe spec) 'notinline) + (while (setq spec (cdr spec)) + (if (eq (get (car spec) 'byte-optimizer) + 'byte-compile-inline-expand) + (put (car spec) 'byte-optimizer nil)))) + + ((eq (car-safe spec) 'optimize) + (let ((speed (assq (nth 1 (assq 'speed (cdr spec))) + '((0 nil) (1 t) (2 t) (3 t)))) + (safety (assq (nth 1 (assq 'safety (cdr spec))) + '((0 t) (1 t) (2 t) (3 nil))))) + (if speed (setq cl-optimize-speed (car speed) + byte-optimize (nth 1 speed))) + (if safety (setq cl-optimize-safety (car safety) + byte-compile-delete-errors (nth 1 safety))))) + + ((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings)) + (if (eq byte-compile-warnings t) + (setq byte-compile-warnings byte-compile-warning-types)) + (while (setq spec (cdr spec)) + (if (consp (car spec)) + (if (eq (cadar spec) 0) + (setq byte-compile-warnings + (delq (caar spec) byte-compile-warnings)) + (setq byte-compile-warnings + (adjoin (caar spec) byte-compile-warnings))))))) + nil) + + ;;; Process any proclamations made before cl-macs was loaded. + (defvar cl-proclaims-deferred) + (let ((p (reverse cl-proclaims-deferred))) + (while p (cl-do-proclaim (cl-pop p) t)) + (setq cl-proclaims-deferred nil)) + + (defmacro declare (&rest specs) + (if (cl-compiling-file) + (while specs + (if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack)) + (cl-do-proclaim (cl-pop specs) nil))) + nil) + + + + ;;; Generalized variables. + + (defmacro define-setf-method (func args &rest body) + "(define-setf-method NAME ARGLIST BODY...): define a `setf' method. + This method shows how to handle `setf's to places of the form (NAME ARGS...). + The argument forms ARGS are bound according to ARGLIST, as if NAME were + going to be expanded as a macro, then the BODY forms are executed and must + return a list of five elements: a temporary-variables list, a value-forms + list, a store-variables list (of length one), a store-form, and an access- + form. See `defsetf' for a simpler way to define most setf-methods." + (append '(eval-when (compile load eval)) + (if (stringp (car body)) + (list (list 'put (list 'quote func) '(quote setf-documentation) + (cl-pop body)))) + (list (cl-transform-function-property + func 'setf-method (cons args body))))) + + (defmacro defsetf (func arg1 &rest args) + "(defsetf NAME FUNC): define a `setf' method. + This macro is an easy-to-use substitute for `define-setf-method' that works + well for simple place forms. In the simple `defsetf' form, `setf's of + the form (setf (NAME ARGS...) VAL) are transformed to function or macro + calls of the form (FUNC ARGS... VAL). Example: (defsetf aref aset). + Alternate form: (defsetf NAME ARGLIST (STORE) BODY...). + Here, the above `setf' call is expanded by binding the argument forms ARGS + according to ARGLIST, binding the value form VAL to STORE, then executing + BODY, which must return a Lisp form that does the necessary `setf' operation. + Actually, ARGLIST and STORE may be bound to temporary variables which are + introduced automatically to preserve proper execution order of the arguments. + Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))." + (if (listp arg1) + (let* ((largs nil) (largsr nil) + (temps nil) (tempsr nil) + (restarg nil) (rest-temps nil) + (store-var (car (prog1 (car args) (setq args (cdr args))))) + (store-temp (intern (format "--%s--temp--" store-var))) + (lets1 nil) (lets2 nil) + (docstr nil) (p arg1)) + (if (stringp (car args)) + (setq docstr (prog1 (car args) (setq args (cdr args))))) + (while (and p (not (eq (car p) '&aux))) + (if (eq (car p) '&rest) + (setq p (cdr p) restarg (car p)) + (or (memq (car p) '(&optional &key &allow-other-keys)) + (setq largs (cons (if (consp (car p)) (car (car p)) (car p)) + largs) + temps (cons (intern (format "--%s--temp--" (car largs))) + temps)))) + (setq p (cdr p))) + (setq largs (nreverse largs) temps (nreverse temps)) + (if restarg + (setq largsr (append largs (list restarg)) + rest-temps (intern (format "--%s--temp--" restarg)) + tempsr (append temps (list rest-temps))) + (setq largsr largs tempsr temps)) + (let ((p1 largs) (p2 temps)) + (while p1 + (setq lets1 (cons (list (car p2) + (list 'gensym (format "--%s--" (car p1)))) + lets1) + lets2 (cons (list (car p1) (car p2)) lets2) + p1 (cdr p1) p2 (cdr p2)))) + (if restarg (setq lets2 (cons (list restarg rest-temps) lets2))) + (append (list 'define-setf-method func arg1) + (and docstr (list docstr)) + (list + (list 'let* + (nreverse + (cons (list store-temp + (list 'gensym (format "--%s--" store-var))) + (if restarg + (append + (list + (list rest-temps + (list 'mapcar '(quote gensym) + restarg))) + lets1) + lets1))) + (list 'list ; 'values + (cons (if restarg 'list* 'list) tempsr) + (cons (if restarg 'list* 'list) largsr) + (list 'list store-temp) + (cons 'let* + (cons (nreverse + (cons (list store-var store-temp) + lets2)) + args)) + (cons (if restarg 'list* 'list) + (cons (list 'quote func) tempsr))))))) + (list 'defsetf func '(&rest args) '(store) + (let ((call (list 'cons (list 'quote arg1) + '(append args (list store))))) + (if (car args) + (list 'list '(quote progn) call 'store) + call))))) + + ;;; Some standard place types from Common Lisp. + (defsetf aref aset) + (defsetf car setcar) + (defsetf cdr setcdr) + (defsetf elt (seq n) (store) + (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store) + (list 'aset seq n store))) + (defsetf get put) + (defsetf get* (x y &optional d) (store) (list 'put x y store)) + (defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h)) + (defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store)) + (defsetf subseq (seq start &optional end) (new) + (list 'progn (list 'replace seq new ':start1 start ':end1 end) new)) + (defsetf symbol-function fset) + (defsetf symbol-plist setplist) + (defsetf symbol-value set) + + ;;; Various car/cdr aliases. Note that `cadr' is handled specially. + (defsetf first setcar) + (defsetf second (x) (store) (list 'setcar (list 'cdr x) store)) + (defsetf third (x) (store) (list 'setcar (list 'cddr x) store)) + (defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store)) + (defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store)) + (defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store)) + (defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store)) + (defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store)) + (defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store)) + (defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store)) + (defsetf rest setcdr) + + ;;; Some more Emacs-related place types. + (defsetf buffer-file-name set-visited-file-name t) + (defsetf buffer-modified-p set-buffer-modified-p t) + (defsetf buffer-name rename-buffer t) + (defsetf buffer-string () (store) + (list 'progn '(erase-buffer) (list 'insert store))) + (defsetf buffer-substring cl-set-buffer-substring) + (defsetf current-buffer set-buffer) + (defsetf current-case-table set-case-table) + (defsetf current-column move-to-column t) + (defsetf current-global-map use-global-map t) + (defsetf current-input-mode () (store) + (list 'progn (list 'apply 'set-input-mode store) store)) + (defsetf current-local-map use-local-map t) + (defsetf current-window-configuration set-window-configuration t) + (defsetf default-file-modes set-default-file-modes t) + (defsetf default-value set-default) + (defsetf documentation-property put) + (defsetf extent-data set-extent-data) + (defsetf extent-face set-extent-face) + (defsetf extent-priority set-extent-priority) + (defsetf extent-end-position (ext) (store) + (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext) + store) store)) + (defsetf extent-start-position (ext) (store) + (list 'progn (list 'set-extent-endpoints store + (list 'extent-end-position ext)) store)) + (defsetf face-background (f &optional s) (x) (list 'set-face-background f x s)) + (defsetf face-background-pixmap (f &optional s) (x) + (list 'set-face-background-pixmap f x s)) + (defsetf face-font (f &optional s) (x) (list 'set-face-font f x s)) + (defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s)) + (defsetf face-underline-p (f &optional s) (x) + (list 'set-face-underline-p f x s)) + (defsetf file-modes set-file-modes t) + (defsetf frame-height set-screen-height t) + (defsetf frame-parameters modify-frame-parameters t) + (defsetf frame-visible-p cl-set-frame-visible-p) + (defsetf frame-width set-screen-width t) + (defsetf getenv setenv t) + (defsetf get-register set-register) + (defsetf global-key-binding global-set-key) + (defsetf keymap-parent set-keymap-parent) + (defsetf local-key-binding local-set-key) + (defsetf mark set-mark t) + (defsetf mark-marker set-mark t) + (defsetf marker-position set-marker t) + (defsetf match-data store-match-data t) + (defsetf mouse-position (scr) (store) + (list 'set-mouse-position scr (list 'car store) (list 'cadr store) + (list 'cddr store))) + (defsetf overlay-get overlay-put) + (defsetf overlay-start (ov) (store) + (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store)) + (defsetf overlay-end (ov) (store) + (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store)) + (defsetf point goto-char) + (defsetf point-marker goto-char t) + (defsetf point-max () (store) + (list 'progn (list 'narrow-to-region '(point-min) store) store)) + (defsetf point-min () (store) + (list 'progn (list 'narrow-to-region store '(point-max)) store)) + (defsetf process-buffer set-process-buffer) + (defsetf process-filter set-process-filter) + (defsetf process-sentinel set-process-sentinel) + (defsetf read-mouse-position (scr) (store) + (list 'set-mouse-position scr (list 'car store) (list 'cdr store))) + (defsetf screen-height set-screen-height t) + (defsetf screen-width set-screen-width t) + (defsetf selected-window select-window) + (defsetf selected-screen select-screen) + (defsetf selected-frame select-frame) + (defsetf standard-case-table set-standard-case-table) + (defsetf syntax-table set-syntax-table) + (defsetf visited-file-modtime set-visited-file-modtime t) + (defsetf window-buffer set-window-buffer t) + (defsetf window-display-table set-window-display-table t) + (defsetf window-dedicated-p set-window-dedicated-p t) + (defsetf window-height () (store) + (list 'progn (list 'enlarge-window (list '- store '(window-height))) store)) + (defsetf window-hscroll set-window-hscroll) + (defsetf window-point set-window-point) + (defsetf window-start set-window-start) + (defsetf window-width () (store) + (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store)) + (defsetf x-get-cutbuffer x-store-cutbuffer t) + (defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan. + (defsetf x-get-secondary-selection x-own-secondary-selection t) + (defsetf x-get-selection x-own-selection t) + + ;;; More complex setf-methods. + ;;; These should take &environment arguments, but since full arglists aren't + ;;; available while compiling cl-macs, we fake it by referring to the global + ;;; variable cl-macro-environment directly. + + (define-setf-method apply (func arg1 &rest rest) + (or (and (memq (car-safe func) '(quote function function*)) + (symbolp (car-safe (cdr-safe func)))) + (error "First arg to apply in setf is not (function SYM): %s" func)) + (let* ((form (cons (nth 1 func) (cons arg1 rest))) + (method (get-setf-method form cl-macro-environment))) + (list (car method) (nth 1 method) (nth 2 method) + (cl-setf-make-apply (nth 3 method) (cadr func) (car method)) + (cl-setf-make-apply (nth 4 method) (cadr func) (car method))))) + + (defun cl-setf-make-apply (form func temps) + (if (eq (car form) 'progn) + (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form)) + (or (equal (last form) (last temps)) + (error "%s is not suitable for use with setf-of-apply" func)) + (list* 'apply (list 'quote (car form)) (cdr form)))) + + (define-setf-method nthcdr (n place) + (let ((method (get-setf-method place cl-macro-environment)) + (n-temp (gensym "--nthcdr-n--")) + (store-temp (gensym "--nthcdr-store--"))) + (list (cons n-temp (car method)) + (cons n (nth 1 method)) + (list store-temp) + (list 'let (list (list (car (nth 2 method)) + (list 'cl-set-nthcdr n-temp (nth 4 method) + store-temp))) + (nth 3 method) store-temp) + (list 'nthcdr n-temp (nth 4 method))))) + + (define-setf-method getf (place tag &optional def) + (let ((method (get-setf-method place cl-macro-environment)) + (tag-temp (gensym "--getf-tag--")) + (def-temp (gensym "--getf-def--")) + (store-temp (gensym "--getf-store--"))) + (list (append (car method) (list tag-temp def-temp)) + (append (nth 1 method) (list tag def)) + (list store-temp) + (list 'let (list (list (car (nth 2 method)) + (list 'cl-set-getf (nth 4 method) + tag-temp store-temp))) + (nth 3 method) store-temp) + (list 'getf (nth 4 method) tag-temp def-temp)))) + + (define-setf-method substring (place from &optional to) + (let ((method (get-setf-method place cl-macro-environment)) + (from-temp (gensym "--substring-from--")) + (to-temp (gensym "--substring-to--")) + (store-temp (gensym "--substring-store--"))) + (list (append (car method) (list from-temp to-temp)) + (append (nth 1 method) (list from to)) + (list store-temp) + (list 'let (list (list (car (nth 2 method)) + (list 'cl-set-substring (nth 4 method) + from-temp to-temp store-temp))) + (nth 3 method) store-temp) + (list 'substring (nth 4 method) from-temp to-temp)))) + + ;;; Getting and optimizing setf-methods. + (defun get-setf-method (place &optional env) + "Return a list of five values describing the setf-method for PLACE. + PLACE may be any Lisp form which can appear as the PLACE argument to + a macro like `setf' or `incf'." + (if (symbolp place) + (let ((temp (gensym "--setf--"))) + (list nil nil (list temp) (list 'setq place temp) place)) + (or (and (symbolp (car place)) + (let* ((func (car place)) + (name (symbol-name func)) + (method (get func 'setf-method)) + (case-fold-search nil)) + (or (and method + (let ((cl-macro-environment env)) + (setq method (apply method (cdr place)))) + (if (and (consp method) (= (length method) 5)) + method + (error "Setf-method for %s returns malformed method" + func))) + (and (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name) + (get-setf-method (compiler-macroexpand place))) + (and (eq func 'edebug-after) + (get-setf-method (nth (1- (length place)) place) + env))))) + (if (eq place (setq place (macroexpand place env))) + (if (and (symbolp (car place)) (fboundp (car place)) + (symbolp (symbol-function (car place)))) + (get-setf-method (cons (symbol-function (car place)) + (cdr place)) env) + (error "No setf-method known for %s" (car place))) + (get-setf-method place env))))) + + (defun cl-setf-do-modify (place opt-expr) + (let* ((method (get-setf-method place cl-macro-environment)) + (temps (car method)) (values (nth 1 method)) + (lets nil) (subs nil) + (optimize (and (not (eq opt-expr 'no-opt)) + (or (and (not (eq opt-expr 'unsafe)) + (cl-safe-expr-p opt-expr)) + (cl-setf-simple-store-p (car (nth 2 method)) + (nth 3 method))))) + (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place))))) + (while values + (if (or simple (cl-const-expr-p (car values))) + (cl-push (cons (cl-pop temps) (cl-pop values)) subs) + (cl-push (list (cl-pop temps) (cl-pop values)) lets))) + (list (nreverse lets) + (cons (car (nth 2 method)) (sublis subs (nth 3 method))) + (sublis subs (nth 4 method))))) + + (defun cl-setf-do-store (spec val) + (let ((sym (car spec)) + (form (cdr spec))) + (if (or (cl-const-expr-p val) + (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1)) + (cl-setf-simple-store-p sym form)) + (subst val sym form) + (list 'let (list (list sym val)) form)))) + + (defun cl-setf-simple-store-p (sym form) + (and (consp form) (eq (cl-expr-contains form sym) 1) + (eq (nth (1- (length form)) form) sym) + (symbolp (car form)) (fboundp (car form)) + (not (eq (car-safe (symbol-function (car form))) 'macro)))) + + ;;; The standard modify macros. + (defmacro setf (&rest args) + "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL. + This is a generalized version of `setq'; the PLACEs may be symbolic + references such as (car x) or (aref x i), as well as plain symbols. + For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y). + The return value is the last VAL in the list." + (if (cdr (cdr args)) + (let ((sets nil)) + (while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets)) + (cons 'progn (nreverse sets))) + (if (symbolp (car args)) + (and args (cons 'setq args)) + (let* ((method (cl-setf-do-modify (car args) (nth 1 args))) + (store (cl-setf-do-store (nth 1 method) (nth 1 args)))) + (if (car method) (list 'let* (car method) store) store))))) + + (defmacro psetf (&rest args) + "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel. + This is like `setf', except that all VAL forms are evaluated (in order) + before assigning any PLACEs to the corresponding values." + (let ((p args) (simple t) (vars nil)) + (while p + (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars)) + (setq simple nil)) + (if (memq (car p) vars) + (error "Destination duplicated in psetf: %s" (car p))) + (cl-push (cl-pop p) vars) + (or p (error "Odd number of arguments to psetf")) + (cl-pop p)) + (if simple + (list 'progn (cons 'setf args) nil) + (setq args (reverse args)) + (let ((expr (list 'setf (cadr args) (car args)))) + (while (setq args (cddr args)) + (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr)))) + (list 'progn expr nil))))) + + (defun cl-do-pop (place) + (if (cl-simple-expr-p place) + (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place))) + (let* ((method (cl-setf-do-modify place t)) + (temp (gensym "--pop--"))) + (list 'let* + (append (car method) + (list (list temp (nth 2 method)))) + (list 'prog1 + (list 'car temp) + (cl-setf-do-store (nth 1 method) (list 'cdr temp))))))) + + (defmacro remf (place tag) + "(remf PLACE TAG): remove TAG from property list PLACE. + PLACE may be a symbol, or any generalized variable allowed by `setf'. + The form returns true if TAG was found and removed, nil otherwise." + (let* ((method (cl-setf-do-modify place t)) + (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--"))) + (val-temp (and (not (cl-simple-expr-p place)) + (gensym "--remf-place--"))) + (ttag (or tag-temp tag)) + (tval (or val-temp (nth 2 method)))) + (list 'let* + (append (car method) + (and val-temp (list (list val-temp (nth 2 method)))) + (and tag-temp (list (list tag-temp tag)))) + (list 'if (list 'eq ttag (list 'car tval)) + (list 'progn + (cl-setf-do-store (nth 1 method) (list 'cddr tval)) + t) + (list 'cl-do-remf tval ttag))))) + + (defmacro shiftf (place &rest args) + "(shiftf PLACE PLACE... VAL): shift left among PLACEs. + Example: (shiftf A B C) sets A to B, B to C, and returns the old A. + Each PLACE may be a symbol, or any generalized variable allowed by `setf'." + (if (not (memq nil (mapcar 'symbolp (butlast (cons place args))))) + (list* 'prog1 place + (let ((sets nil)) + (while args + (cl-push (list 'setq place (car args)) sets) + (setq place (cl-pop args))) + (nreverse sets))) + (let* ((places (reverse (cons place args))) + (form (cl-pop places))) + (while places + (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) + (setq form (list 'let* (car method) + (list 'prog1 (nth 2 method) + (cl-setf-do-store (nth 1 method) form)))))) + form))) + + (defmacro rotatef (&rest args) + "(rotatef PLACE...): rotate left among PLACEs. + Example: (rotatef A B C) sets A to B, B to C, and C to A. It returns nil. + Each PLACE may be a symbol, or any generalized variable allowed by `setf'." + (if (not (memq nil (mapcar 'symbolp args))) + (and (cdr args) + (let ((sets nil) + (first (car args))) + (while (cdr args) + (setq sets (nconc sets (list (cl-pop args) (car args))))) + (nconc (list 'psetf) sets (list (car args) first)))) + (let* ((places (reverse args)) + (temp (gensym "--rotatef--")) + (form temp)) + (while (cdr places) + (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe))) + (setq form (list 'let* (car method) + (list 'prog1 (nth 2 method) + (cl-setf-do-store (nth 1 method) form)))))) + (let ((method (cl-setf-do-modify (car places) 'unsafe))) + (list 'let* (append (car method) (list (list temp (nth 2 method)))) + (cl-setf-do-store (nth 1 method) form) nil))))) + + (defmacro letf (bindings &rest body) + "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. + This is the analogue of `let', but with generalized variables (in the + sense of `setf') for the PLACEs. Each PLACE is set to the corresponding + VALUE, then the BODY forms are executed. On exit, either normally or + because of a `throw' or error, the PLACEs are set back to their original + values. Note that this macro is *not* available in Common Lisp. + As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', + the PLACE is not modified before executing BODY." + (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings))) + (list* 'let bindings body) + (let ((lets nil) (sets nil) + (unsets nil) (rev (reverse bindings))) + (while rev + (let* ((place (if (symbolp (caar rev)) + (list 'symbol-value (list 'quote (caar rev))) + (caar rev))) + (value (cadar rev)) + (method (cl-setf-do-modify place 'no-opt)) + (save (gensym "--letf-save--")) + (bound (and (memq (car place) '(symbol-value symbol-function)) + (gensym "--letf-bound--"))) + (temp (and (not (cl-const-expr-p value)) (cdr bindings) + (gensym "--letf-val--")))) + (setq lets (nconc (car method) + (if bound + (list (list bound + (list (if (eq (car place) + 'symbol-value) + 'boundp 'fboundp) + (nth 1 (nth 2 method)))) + (list save (list 'and bound + (nth 2 method)))) + (list (list save (nth 2 method)))) + (and temp (list (list temp value))) + lets) + body (list + (list 'unwind-protect + (cons 'progn + (if (cdr (car rev)) + (cons (cl-setf-do-store (nth 1 method) + (or temp value)) + body) + body)) + (if bound + (list 'if bound + (cl-setf-do-store (nth 1 method) save) + (list (if (eq (car place) 'symbol-value) + 'makunbound 'fmakunbound) + (nth 1 (nth 2 method)))) + (cl-setf-do-store (nth 1 method) save)))) + rev (cdr rev)))) + (list* 'let* lets body)))) + + (defmacro letf* (bindings &rest body) + "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs. + This is the analogue of `let*', but with generalized variables (in the + sense of `setf') for the PLACEs. Each PLACE is set to the corresponding + VALUE, then the BODY forms are executed. On exit, either normally or + because of a `throw' or error, the PLACEs are set back to their original + values. Note that this macro is *not* available in Common Lisp. + As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)', + the PLACE is not modified before executing BODY." + (if (null bindings) + (cons 'progn body) + (setq bindings (reverse bindings)) + (while bindings + (setq body (list (list* 'letf (list (cl-pop bindings)) body)))) + (car body))) + + (defmacro callf (func place &rest args) + "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...). + FUNC should be an unquoted function name. PLACE may be a symbol, + or any generalized variable allowed by `setf'." + (let* ((method (cl-setf-do-modify place (cons 'list args))) + (rargs (cons (nth 2 method) args))) + (list 'let* (car method) + (cl-setf-do-store (nth 1 method) + (if (symbolp func) (cons func rargs) + (list* 'funcall (list 'function func) + rargs)))))) + + (defmacro callf2 (func arg1 place &rest args) + "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...). + Like `callf', but PLACE is the second argument of FUNC, not the first." + (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func)) + (list 'setf place (list* func arg1 place args)) + (let* ((method (cl-setf-do-modify place (cons 'list args))) + (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--"))) + (rargs (list* (or temp arg1) (nth 2 method) args))) + (list 'let* (append (and temp (list (list temp arg1))) (car method)) + (cl-setf-do-store (nth 1 method) + (if (symbolp func) (cons func rargs) + (list* 'funcall (list 'function func) + rargs))))))) + + (defmacro define-modify-macro (name arglist func &optional doc) + "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro. + If NAME is called, it combines its PLACE argument with the other arguments + from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)" + (if (memq '&key arglist) (error "&key not allowed in define-modify-macro")) + (let ((place (gensym "--place--"))) + (list 'defmacro* name (cons place arglist) doc + (list* (if (memq '&rest arglist) 'list* 'list) + '(quote callf) (list 'quote func) place + (cl-arglist-args arglist))))) + + + ;;; Structures. + + (defmacro defstruct (struct &rest descs) + "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type. + This macro defines a new Lisp data type called NAME, which contains data + stored in SLOTs. This defines a `make-NAME' constructor, a `copy-NAME' + copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors." + (let* ((name (if (consp struct) (car struct) struct)) + (opts (cdr-safe struct)) + (slots nil) + (defaults nil) + (conc-name (concat (symbol-name name) "-")) + (constructor (intern (format "make-%s" name))) + (constrs nil) + (copier (intern (format "copy-%s" name))) + (predicate (intern (format "%s-p" name))) + (print-func nil) (print-auto nil) + (safety (if (cl-compiling-file) cl-optimize-safety 3)) + (include nil) + (tag (intern (format "cl-struct-%s" name))) + (tag-symbol (intern (format "cl-struct-%s-tags" name))) + (include-descs nil) + (include-tag-symbol nil) + (side-eff nil) + (type nil) + (named nil) + (forms nil) + pred-form pred-check) + (if (stringp (car descs)) + (cl-push (list 'put (list 'quote name) '(quote structure-documentation) + (cl-pop descs)) forms)) + (setq descs (cons '(cl-tag-slot) + (mapcar (function (lambda (x) (if (consp x) x (list x)))) + descs))) + (while opts + (let ((opt (if (consp (car opts)) (caar opts) (car opts))) + (args (cdr-safe (cl-pop opts)))) + (cond ((eq opt ':conc-name) + (if args + (setq conc-name (if (car args) + (symbol-name (car args)) "")))) + ((eq opt ':constructor) + (if (cdr args) + (cl-push args constrs) + (if args (setq constructor (car args))))) + ((eq opt ':copier) + (if args (setq copier (car args)))) + ((eq opt ':predicate) + (if args (setq predicate (car args)))) + ((eq opt ':include) + (setq include (car args) + include-descs (mapcar (function + (lambda (x) + (if (consp x) x (list x)))) + (cdr args)) + include-tag-symbol (intern (format "cl-struct-%s-tags" + include)))) + ((eq opt ':print-function) + (setq print-func (car args))) + ((eq opt ':type) + (setq type (car args))) + ((eq opt ':named) + (setq named t)) + ((eq opt ':initial-offset) + (setq descs (nconc (make-list (car args) '(cl-skip-slot)) + descs))) + (t + (error "Slot option %s unrecognized" opt))))) + (if print-func + (setq print-func (list 'progn + (list 'funcall (list 'function print-func) + 'cl-x 'cl-s 'cl-n) t)) + (or type (and include (not (get include 'cl-struct-print))) + (setq print-auto t + print-func (and (or (not (or include type)) (null print-func)) + (list 'progn + (list 'princ (format "#S(%s" name) + 'cl-s)))))) + (if include + (let ((inc-type (get include 'cl-struct-type)) + (old-descs (get include 'cl-struct-slots))) + (or inc-type (error "%s is not a struct name" include)) + (and type (not (eq (car inc-type) type)) + (error ":type disagrees with :include for %s" name)) + (while include-descs + (setcar (memq (or (assq (caar include-descs) old-descs) + (error "No slot %s in included struct %s" + (caar include-descs) include)) + old-descs) + (cl-pop include-descs))) + (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs)) + type (car inc-type) + named (assq 'cl-tag-slot descs)) + (if (cadr inc-type) (setq tag name named t)) + (cl-push (list 'pushnew (list 'quote tag) include-tag-symbol) + forms)) + (if type + (progn + (or (memq type '(vector list)) + (error "Illegal :type specifier: %s" type)) + (if named (setq tag name))) + (setq type 'vector named 'true))) + (or named (setq descs (delq (assq 'cl-tag-slot descs) descs))) + (cl-push (list 'defvar tag-symbol) forms) + (setq pred-form (and named + (let ((pos (- (length descs) + (length (memq (assq 'cl-tag-slot descs) + descs))))) + (if (eq type 'vector) + (list 'and '(vectorp cl-x) + (list '>= '(length cl-x) (length descs)) + (list 'memq (list 'aref 'cl-x pos) + tag-symbol)) + (if (= pos 0) + (list 'memq '(car-safe cl-x) tag-symbol) + (list 'and '(consp cl-x) + (list 'memq (list 'nth pos 'cl-x) + tag-symbol)))))) + pred-check (and pred-form (> safety 0) + (if (and (eq (caadr pred-form) 'vectorp) + (= safety 1)) + (cons 'and (cdddr pred-form)) pred-form))) + (let ((pos 0) (descp descs)) + (while descp + (let* ((desc (cl-pop descp)) + (slot (car desc))) + (if (memq slot '(cl-tag-slot cl-skip-slot)) + (progn + (cl-push nil slots) + (cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag)) + defaults)) + (if (assq slot descp) + (error "Duplicate slots named %s in %s" slot name)) + (let ((accessor (intern (format "%s%s" conc-name slot)))) + (cl-push slot slots) + (cl-push (nth 1 desc) defaults) + (cl-push (list* + 'defsubst* accessor '(cl-x) + (append + (and pred-check + (list (list 'or pred-check + (list 'error + (format "%s accessing a non-%s" + accessor name) + 'cl-x)))) + (list (if (eq type 'vector) (list 'aref 'cl-x pos) + (if (= pos 0) '(car cl-x) + (list 'nth pos 'cl-x)))))) forms) + (cl-push (cons accessor t) side-eff) + (cl-push (list 'define-setf-method accessor '(cl-x) + (if (cadr (memq ':read-only (cddr desc))) + (list 'error (format "%s is a read-only slot" + accessor)) + (list 'cl-struct-setf-expander 'cl-x + (list 'quote name) (list 'quote accessor) + (and pred-check (list 'quote pred-check)) + pos))) + forms) + (if print-auto + (nconc print-func + (list (list 'princ (format " %s" slot) 'cl-s) + (list 'prin1 (list accessor 'cl-x) 'cl-s))))))) + (setq pos (1+ pos)))) + (setq slots (nreverse slots) + defaults (nreverse defaults)) + (and predicate pred-form + (progn (cl-push (list 'defsubst* predicate '(cl-x) + (if (eq (car pred-form) 'and) + (append pred-form '(t)) + (list 'and pred-form t))) forms) + (cl-push (cons predicate 'error-free) side-eff))) + (and copier + (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms) + (cl-push (cons copier t) side-eff))) + (if constructor + (cl-push (list constructor + (cons '&key (delq nil (copy-sequence slots)))) + constrs)) + (while constrs + (let* ((name (caar constrs)) + (args (cadr (cl-pop constrs))) + (anames (cl-arglist-args args)) + (make (mapcar* (function (lambda (s d) (if (memq s anames) s d))) + slots defaults))) + (cl-push (list 'defsubst* name + (list* '&cl-defs (list 'quote (cons nil descs)) args) + (cons type make)) forms) + (if (cl-safe-expr-p (cons 'progn (mapcar 'second descs))) + (cl-push (cons name t) side-eff)))) + (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) + (if print-func + (cl-push (list 'push + (list 'function + (list 'lambda '(cl-x cl-s cl-n) + (list 'and pred-form print-func))) + 'custom-print-functions) forms)) + (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms) + (cl-push (list* 'eval-when '(compile load eval) + (list 'put (list 'quote name) '(quote cl-struct-slots) + (list 'quote descs)) + (list 'put (list 'quote name) '(quote cl-struct-type) + (list 'quote (list type (eq named t)))) + (list 'put (list 'quote name) '(quote cl-struct-print) + print-auto) + (mapcar (function (lambda (x) + (list 'put (list 'quote (car x)) + '(quote side-effect-free) + (list 'quote (cdr x))))) + side-eff)) + forms) + (cons 'progn (nreverse (cons (list 'quote name) forms))))) + + (defun cl-struct-setf-expander (x name accessor pred-form pos) + (let* ((temp (gensym "--x--")) (store (gensym "--store--"))) + (list (list temp) (list x) (list store) + (append '(progn) + (and pred-form + (list (list 'or (subst temp 'cl-x pred-form) + (list 'error + (format + "%s storing a non-%s" accessor name) + temp)))) + (list (if (eq (car (get name 'cl-struct-type)) 'vector) + (list 'aset temp pos store) + (list 'setcar + (if (<= pos 5) + (let ((xx temp)) + (while (>= (setq pos (1- pos)) 0) + (setq xx (list 'cdr xx))) + xx) + (list 'nthcdr pos temp)) + store)))) + (list accessor temp)))) + + + ;;; Types and assertions. + + (defmacro deftype (name args &rest body) + "(deftype NAME ARGLIST BODY...): define NAME as a new data type. + The type name can then be used in `typecase', `check-type', etc." + (list 'eval-when '(compile load eval) + (cl-transform-function-property + name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body)))) + + (defun cl-make-type-test (val type) + (if (memq type '(character string-char)) (setq type '(integer 0 255))) + (if (symbolp type) + (cond ((get type 'cl-deftype-handler) + (cl-make-type-test val (funcall (get type 'cl-deftype-handler)))) + ((memq type '(nil t)) type) + ((eq type 'null) (list 'null val)) + ((eq type 'float) (list 'floatp-safe val)) + ((eq type 'real) (list 'numberp val)) + ((eq type 'fixnum) (list 'integerp val)) + (t + (let* ((name (symbol-name type)) + (namep (intern (concat name "p")))) + (if (fboundp namep) (list namep val) + (list (intern (concat name "-p")) val))))) + (cond ((get (car type) 'cl-deftype-handler) + (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler) + (cdr type)))) + ((memq (car-safe type) '(integer float real number)) + (delq t (list 'and (cl-make-type-test val (car type)) + (if (memq (cadr type) '(* nil)) t + (if (consp (cadr type)) (list '> val (caadr type)) + (list '>= val (cadr type)))) + (if (memq (caddr type) '(* nil)) t + (if (consp (caddr type)) (list '< val (caaddr type)) + (list '<= val (caddr type))))))) + ((memq (car-safe type) '(and or not)) + (cons (car type) + (mapcar (function (lambda (x) (cl-make-type-test val x))) + (cdr type)))) + ((memq (car-safe type) '(member member*)) + (list 'and (list 'member* val (list 'quote (cdr type))) t)) + ((eq (car-safe type) 'satisfies) (list (cadr type) val)) + (t (error "Bad type spec: %s" type))))) + + (defun typep (val type) ; See compiler macro below. + "Check that OBJECT is of type TYPE. + TYPE is a Common Lisp-style type specifier." + (eval (cl-make-type-test 'val type))) + + (defmacro check-type (form type &optional string) + "Verify that FORM is of type TYPE; signal an error if not. + STRING is an optional description of the desired type." + (and (or (not (cl-compiling-file)) + (< cl-optimize-speed 3) (= cl-optimize-safety 3)) + (let* ((temp (if (cl-simple-expr-p form 3) form (gensym))) + (body (list 'or (cl-make-type-test temp type) + (list 'signal '(quote wrong-type-argument) + (list 'list (or string (list 'quote type)) + temp (list 'quote form)))))) + (if (eq temp form) (list 'progn body nil) + (list 'let (list (list temp form)) body nil))))) + + (defmacro assert (form &optional show-args string &rest args) + "Verify that FORM returns non-nil; signal an error if not. + Second arg SHOW-ARGS means to include arguments of FORM in message. + Other args STRING and ARGS... are arguments to be passed to `error'. + They are not evaluated unless the assertion fails. If STRING is + omitted, a default message listing FORM itself is used." + (and (or (not (cl-compiling-file)) + (< cl-optimize-speed 3) (= cl-optimize-safety 3)) + (let ((sargs (and show-args (delq nil (mapcar + (function + (lambda (x) + (and (not (cl-const-expr-p x)) + x))) (cdr form)))))) + (list 'progn + (list 'or form + (if string + (list* 'error string (append sargs args)) + (list 'signal '(quote cl-assertion-failed) + (list* 'list (list 'quote form) sargs)))) + nil)))) + + (defmacro ignore-errors (&rest body) + "Execute FORMS; if an error occurs, return nil. + Otherwise, return result of last FORM." + (let ((err (gensym))) + (list 'condition-case err (cons 'progn body) '(error nil)))) + + + ;;; Some predicates for analyzing Lisp forms. These are used by various + ;;; macro expanders to optimize the results in certain common cases. + + (defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max + car-safe cdr-safe progn prog1 prog2)) + (defconst cl-safe-funcs '(* / % length memq list vector vectorp + < > <= >= = error)) + + ;;; Check if no side effects, and executes quickly. + (defun cl-simple-expr-p (x &optional size) + (or size (setq size 10)) + (if (and (consp x) (not (memq (car x) '(quote function function*)))) + (and (symbolp (car x)) + (or (memq (car x) cl-simple-funcs) + (get (car x) 'side-effect-free)) + (progn + (setq size (1- size)) + (while (and (setq x (cdr x)) + (setq size (cl-simple-expr-p (car x) size)))) + (and (null x) (>= size 0) size))) + (and (> size 0) (1- size)))) + + (defun cl-simple-exprs-p (xs) + (while (and xs (cl-simple-expr-p (car xs))) + (setq xs (cdr xs))) + (not xs)) + + ;;; Check if no side effects. + (defun cl-safe-expr-p (x) + (or (not (and (consp x) (not (memq (car x) '(quote function function*))))) + (and (symbolp (car x)) + (or (memq (car x) cl-simple-funcs) + (memq (car x) cl-safe-funcs) + (get (car x) 'side-effect-free)) + (progn + (while (and (setq x (cdr x)) (cl-safe-expr-p (car x)))) + (null x))))) + + ;;; Check if constant (i.e., no side effects or dependencies). + (defun cl-const-expr-p (x) + (cond ((consp x) + (or (eq (car x) 'quote) + (and (memq (car x) '(function function*)) + (or (symbolp (nth 1 x)) + (and (eq (car-safe (nth 1 x)) 'lambda) 'func))))) + ((symbolp x) (and (memq x '(nil t)) t)) + (t t))) + + (defun cl-const-exprs-p (xs) + (while (and xs (cl-const-expr-p (car xs))) + (setq xs (cdr xs))) + (not xs)) + + (defun cl-const-expr-val (x) + (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x))) + + (defun cl-expr-access-order (x v) + (if (cl-const-expr-p x) v + (if (consp x) + (progn + (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v))) + v) + (if (eq x (car v)) (cdr v) '(t))))) + + ;;; Count number of times X refers to Y. Return NIL for 0 times. + (defun cl-expr-contains (x y) + (cond ((equal y x) 1) + ((and (consp x) (not (memq (car-safe x) '(quote function function*)))) + (let ((sum 0)) + (while x + (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0)))) + (and (> sum 0) sum))) + (t nil))) + + (defun cl-expr-contains-any (x y) + (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y)) + y) + + ;;; Check whether X may depend on any of the symbols in Y. + (defun cl-expr-depends-p (x y) + (and (not (cl-const-expr-p x)) + (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y)))) + + + ;;; Compiler macros. + + (defmacro define-compiler-macro (func args &rest body) + "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro. + This is like `defmacro', but macro expansion occurs only if the call to + FUNC is compiled (i.e., not interpreted). Compiler macros should be used + for optimizing the way calls to FUNC are compiled; the form returned by + BODY should do the same thing as a call to the normal function called + FUNC, though possibly more efficiently. Note that, like regular macros, + compiler macros are expanded repeatedly until no further expansions are + possible. Unlike regular macros, BODY can decide to \"punt\" and leave the + original function call alone by declaring an initial `&whole foo' parameter + and then returning foo." + (let ((p (if (listp args) args (list '&rest args))) (res nil)) + (while (consp p) (cl-push (cl-pop p) res)) + (setq args (nreverse res)) (setcdr res (and p (list '&rest p)))) + (list 'eval-when '(compile load eval) + (cl-transform-function-property + func 'cl-compiler-macro + (cons (if (memq '&whole args) (delq '&whole args) + (cons '--cl-whole-arg-- args)) body)) + (list 'or (list 'get (list 'quote func) '(quote byte-compile)) + (list 'put (list 'quote func) '(quote byte-compile) + '(quote cl-byte-compile-compiler-macro))))) + + (defun compiler-macroexpand (form) + (while + (let ((func (car-safe form)) (handler nil)) + (while (and (symbolp func) + (not (setq handler (get func 'cl-compiler-macro))) + (fboundp func) + (or (not (eq (car-safe (symbol-function func)) 'autoload)) + (load (nth 1 (symbol-function func))))) + (setq func (symbol-function func))) + (and handler + (not (eq form (setq form (apply handler form (cdr form)))))))) + form) + + (defun cl-byte-compile-compiler-macro (form) + (if (eq form (setq form (compiler-macroexpand form))) + (byte-compile-normal-call form) + (byte-compile-form form))) + + (defmacro defsubst* (name args &rest body) + "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function. + Like `defun', except the function is automatically declared `inline', + ARGLIST allows full Common Lisp conventions, and BODY is implicitly + surrounded by (block NAME ...)." + (let* ((argns (cl-arglist-args args)) (p argns) + (pbody (cons 'progn body)) + (unsafe (not (cl-safe-expr-p pbody)))) + (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p)) + (list 'progn + (if p nil ; give up if defaults refer to earlier args + (list 'define-compiler-macro name + (list* '&whole 'cl-whole '&cl-quote args) + (list* 'cl-defsubst-expand (list 'quote argns) + (list 'quote (list* 'block name body)) + (not (or unsafe (cl-expr-access-order pbody argns))) + (and (memq '&key args) 'cl-whole) unsafe argns))) + (list* 'defun* name args body)))) + + (defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs) + (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole + (if (cl-simple-exprs-p argvs) (setq simple t)) + (let ((lets (delq nil + (mapcar* (function + (lambda (argn argv) + (if (or simple (cl-const-expr-p argv)) + (progn (setq body (subst argv argn body)) + (and unsafe (list argn argv))) + (list argn argv)))) + argns argvs)))) + (if lets (list 'let lets body) body)))) + + + ;;; Compile-time optimizations for some functions defined in this package. + ;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time, + ;;; mainly to make sure these macros will be present. + + (put 'eql 'byte-compile nil) + (define-compiler-macro eql (&whole form a b) + (cond ((eq (cl-const-expr-p a) t) + (let ((val (cl-const-expr-val a))) + (if (and (numberp val) (not (integerp val))) + (list 'equal a b) + (list 'eq a b)))) + ((eq (cl-const-expr-p b) t) + (let ((val (cl-const-expr-val b))) + (if (and (numberp val) (not (integerp val))) + (list 'equal a b) + (list 'eq a b)))) + ((cl-simple-expr-p a 5) + (list 'if (list 'numberp a) + (list 'equal a b) + (list 'eq a b))) + ((and (cl-safe-expr-p a) + (cl-simple-expr-p b 5)) + (list 'if (list 'numberp b) + (list 'equal a b) + (list 'eq a b))) + (t form))) + + (define-compiler-macro member* (&whole form a list &rest keys) + (let ((test (and (= (length keys) 2) (eq (car keys) ':test) + (cl-const-expr-val (nth 1 keys))))) + (cond ((eq test 'eq) (list 'memq a list)) + ((eq test 'equal) (list 'member a list)) + ((or (null keys) (eq test 'eql)) + (if (eq (cl-const-expr-p a) t) + (list (if (floatp-safe (cl-const-expr-val a)) 'member 'memq) + a list) + (if (eq (cl-const-expr-p list) t) + (let ((p (cl-const-expr-val list)) (mb nil) (mq nil)) + (if (not (cdr p)) + (and p (list 'eql a (list 'quote (car p)))) + (while p + (if (floatp-safe (car p)) (setq mb t) + (or (integerp (car p)) (symbolp (car p)) (setq mq t))) + (setq p (cdr p))) + (if (not mb) (list 'memq a list) + (if (not mq) (list 'member a list) form)))) + form))) + (t form)))) + + (define-compiler-macro assoc* (&whole form a list &rest keys) + (let ((test (and (= (length keys) 2) (eq (car keys) ':test) + (cl-const-expr-val (nth 1 keys))))) + (cond ((eq test 'eq) (list 'assq a list)) + ((eq test 'equal) (list 'assoc a list)) + ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql))) + (if (floatp-safe (cl-const-expr-val a)) + (list 'assoc a list) (list 'assq a list))) + (t form)))) + + (define-compiler-macro adjoin (&whole form a list &rest keys) + (if (and (cl-simple-expr-p a) (cl-simple-expr-p list) + (not (memq ':key keys))) + (list 'if (list* 'member* a list keys) list (list 'cons a list)) + form)) + + (define-compiler-macro list* (arg &rest others) + (let* ((args (reverse (cons arg others))) + (form (car args))) + (while (setq args (cdr args)) + (setq form (list 'cons (car args) form))) + form)) + + (define-compiler-macro get* (sym prop &optional def) + (if def + (list 'getf (list 'symbol-plist sym) prop def) + (list 'get sym prop))) + + (define-compiler-macro typep (&whole form val type) + (if (cl-const-expr-p type) + (let ((res (cl-make-type-test val (cl-const-expr-val type)))) + (if (or (memq (cl-expr-contains res val) '(nil 1)) + (cl-simple-expr-p val)) res + (let ((temp (gensym))) + (list 'let (list (list temp val)) (subst temp val res))))) + form)) + + + (mapcar (function + (lambda (y) + (put (car y) 'side-effect-free t) + (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro) + (put (car y) 'cl-compiler-macro + (list 'lambda '(w x) + (if (symbolp (cadr y)) + (list 'list (list 'quote (cadr y)) + (list 'list (list 'quote (caddr y)) 'x)) + (cons 'list (cdr y))))))) + '((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x) + (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x) + (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x) + (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0) + (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr) + (caaar car caar) (caadr car cadr) (cadar car cdar) + (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr) + (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar) + (caaadr car caadr) (caadar car cadar) (caaddr car caddr) + (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar) + (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr) + (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar) + (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) )) + + ;;; Things that are inline. + (proclaim '(inline floatp-safe acons map concatenate notany notevery + cl-set-elt revappend nreconc gethash)) + + ;;; Things that are side-effect-free. + (mapcar (function (lambda (x) (put x 'side-effect-free t))) + '(oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm + isqrt floor* ceiling* truncate* round* mod* rem* subseq + list-length get* getf gethash hash-table-count)) + + ;;; Things that are side-effect-and-error-free. + (mapcar (function (lambda (x) (put x 'side-effect-free 'error-free))) + '(eql floatp-safe list* subst acons equalp random-state-p + copy-tree sublis hash-table-p)) + + + (run-hooks 'cl-macs-load-hook) + + ;;; cl-macs.el ends here diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cl-seq.el emacs-19.18/lisp/cl-seq.el *** emacs-19.17/lisp/cl-seq.el --- emacs-19.18/lisp/cl-seq.el Fri Jul 30 16:14:26 1993 *************** *** 0 **** --- 1,920 ---- + ;; cl-seq.el --- Common Lisp extensions for GNU Emacs Lisp (part three) + + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Dave Gillespie + ;; Version: 2.02 + ;; Keywords: extensions + + ;; 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; Commentary: + + ;; These are extensions to Emacs Lisp that provide a degree of + ;; Common Lisp compatibility, beyond what is already built-in + ;; in Emacs Lisp. + ;; + ;; This package was written by Dave Gillespie; it is a complete + ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. + ;; + ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. + ;; + ;; Bug reports, comments, and suggestions are welcome! + + ;; This file contains the Common Lisp sequence and list functions + ;; which take keyword arguments. + + ;; See cl.el for Change Log. + + + ;; Code: + + (or (memq 'cl-19 features) + (error "Tried to load `cl-seq' before `cl'!")) + + + ;;; We define these here so that this file can compile without having + ;;; loaded the cl.el file already. + + (defmacro cl-push (x place) (list 'setq place (list 'cons x place))) + (defmacro cl-pop (place) + (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))) + + + ;;; Keyword parsing. This is special-cased here so that we can compile + ;;; this file independent from cl-macs. + + (defmacro cl-parsing-keywords (kwords other-keys &rest body) + (cons + 'let* + (cons (mapcar + (function + (lambda (x) + (let* ((var (if (consp x) (car x) x)) + (mem (list 'car (list 'cdr (list 'memq (list 'quote var) + 'cl-keys))))) + (if (eq var ':test-not) + (setq mem (list 'and mem (list 'setq 'cl-test mem) t))) + (if (eq var ':if-not) + (setq mem (list 'and mem (list 'setq 'cl-if mem) t))) + (list (intern + (format "cl-%s" (substring (symbol-name var) 1))) + (if (consp x) (list 'or mem (car (cdr x))) mem))))) + kwords) + (append + (and (not (eq other-keys t)) + (list + (list 'let '((cl-keys-temp cl-keys)) + (list 'while 'cl-keys-temp + (list 'or (list 'memq '(car cl-keys-temp) + (list 'quote + (mapcar + (function + (lambda (x) + (if (consp x) + (car x) x))) + (append kwords + other-keys)))) + '(car (cdr (memq (quote :allow-other-keys) + cl-keys))) + '(error "Bad keyword argument %s" + (car cl-keys-temp))) + '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) + body)))) + (put 'cl-parsing-keywords 'lisp-indent-function 2) + (put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) + + (defmacro cl-check-key (x) + (list 'if 'cl-key (list 'funcall 'cl-key x) x)) + + (defmacro cl-check-test-nokey (item x) + (list 'cond + (list 'cl-test + (list 'eq (list 'not (list 'funcall 'cl-test item x)) + 'cl-test-not)) + (list 'cl-if + (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not)) + (list 't (list 'if (list 'numberp item) + (list 'equal item x) (list 'eq item x))))) + + (defmacro cl-check-test (item x) + (list 'cl-check-test-nokey item (list 'cl-check-key x))) + + (defmacro cl-check-match (x y) + (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) + (list 'if 'cl-test + (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) + (list 'if (list 'numberp x) + (list 'equal x y) (list 'eq x y)))) + + (put 'cl-check-key 'edebug-form-spec 'edebug-forms) + (put 'cl-check-test 'edebug-form-spec 'edebug-forms) + (put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) + (put 'cl-check-match 'edebug-form-spec 'edebug-forms) + + (defvar cl-test) (defvar cl-test-not) + (defvar cl-if) (defvar cl-if-not) + (defvar cl-key) + + + (defun reduce (cl-func cl-seq &rest cl-keys) + "Reduce two-argument FUNCTION across SEQUENCE. + Keywords supported: :start :end :from-end :initial-value :key" + (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) () + (or (listp cl-seq) (setq cl-seq (append cl-seq nil))) + (setq cl-seq (subseq cl-seq cl-start cl-end)) + (if cl-from-end (setq cl-seq (nreverse cl-seq))) + (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value) + (cl-seq (cl-check-key (cl-pop cl-seq))) + (t (funcall cl-func))))) + (if cl-from-end + (while cl-seq + (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq)) + cl-accum))) + (while cl-seq + (setq cl-accum (funcall cl-func cl-accum + (cl-check-key (cl-pop cl-seq)))))) + cl-accum))) + + (defun fill (seq item &rest cl-keys) + "Fill the elements of SEQ with ITEM. + Keywords supported: :start :end" + (cl-parsing-keywords ((:start 0) :end) () + (if (listp seq) + (let ((p (nthcdr cl-start seq)) + (n (if cl-end (- cl-end cl-start) 8000000))) + (while (and p (>= (setq n (1- n)) 0)) + (setcar p item) + (setq p (cdr p)))) + (or cl-end (setq cl-end (length seq))) + (if (and (= cl-start 0) (= cl-end (length seq))) + (fillarray seq item) + (while (< cl-start cl-end) + (aset seq cl-start item) + (setq cl-start (1+ cl-start))))) + seq)) + + (defun replace (cl-seq1 cl-seq2 &rest cl-keys) + "Replace the elements of SEQ1 with the elements of SEQ2. + SEQ1 is destructively modified, then returned. + Keywords supported: :start1 :end1 :start2 :end2" + (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) () + (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1)) + (or (= cl-start1 cl-start2) + (let* ((cl-len (length cl-seq1)) + (cl-n (min (- (or cl-end1 cl-len) cl-start1) + (- (or cl-end2 cl-len) cl-start2)))) + (while (>= (setq cl-n (1- cl-n)) 0) + (cl-set-elt cl-seq1 (+ cl-start1 cl-n) + (elt cl-seq2 (+ cl-start2 cl-n)))))) + (if (listp cl-seq1) + (let ((cl-p1 (nthcdr cl-start1 cl-seq1)) + (cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000))) + (if (listp cl-seq2) + (let ((cl-p2 (nthcdr cl-start2 cl-seq2)) + (cl-n (min cl-n1 + (if cl-end2 (- cl-end2 cl-start2) 4000000)))) + (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0)) + (setcar cl-p1 (car cl-p2)) + (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))) + (setq cl-end2 (min (or cl-end2 (length cl-seq2)) + (+ cl-start2 cl-n1))) + (while (and cl-p1 (< cl-start2 cl-end2)) + (setcar cl-p1 (aref cl-seq2 cl-start2)) + (setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2))))) + (setq cl-end1 (min (or cl-end1 (length cl-seq1)) + (+ cl-start1 (- (or cl-end2 (length cl-seq2)) + cl-start2)))) + (if (listp cl-seq2) + (let ((cl-p2 (nthcdr cl-start2 cl-seq2))) + (while (< cl-start1 cl-end1) + (aset cl-seq1 cl-start1 (car cl-p2)) + (setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1)))) + (while (< cl-start1 cl-end1) + (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2)) + (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1)))))) + cl-seq1)) + + (defun remove* (cl-item cl-seq &rest cl-keys) + "Remove all occurrences of ITEM in SEQ. + This is a non-destructive function; it makes a copy of SEQ if necessary + to avoid corrupting the original SEQ. + Keywords supported: :test :test-not :key :count :start :end :from-end" + (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end + (:start 0) :end) () + (if (<= (or cl-count (setq cl-count 8000000)) 0) + cl-seq + (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000))) + (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end + cl-from-end))) + (if cl-i + (let ((cl-res (apply 'delete* cl-item (append cl-seq nil) + (append (if cl-from-end + (list ':end (1+ cl-i)) + (list ':start cl-i)) + cl-keys)))) + (if (listp cl-seq) cl-res + (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))) + cl-seq)) + (setq cl-end (- (or cl-end 8000000) cl-start)) + (if (= cl-start 0) + (while (and cl-seq (> cl-end 0) + (cl-check-test cl-item (car cl-seq)) + (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) + (> (setq cl-count (1- cl-count)) 0)))) + (if (and (> cl-count 0) (> cl-end 0)) + (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq) + (setq cl-end (1- cl-end)) (cdr cl-seq)))) + (while (and cl-p (> cl-end 0) + (not (cl-check-test cl-item (car cl-p)))) + (setq cl-p (cdr cl-p) cl-end (1- cl-end))) + (if (and cl-p (> cl-end 0)) + (nconc (ldiff cl-seq cl-p) + (if (= cl-count 1) (cdr cl-p) + (and (cdr cl-p) + (apply 'delete* cl-item + (copy-sequence (cdr cl-p)) + ':start 0 ':end (1- cl-end) + ':count (1- cl-count) cl-keys)))) + cl-seq)) + cl-seq))))) + + (defun remove-if (cl-pred cl-list &rest cl-keys) + "Remove all items satisfying PREDICATE in SEQ. + This is a non-destructive function; it makes a copy of SEQ if necessary + to avoid corrupting the original SEQ. + Keywords supported: :key :count :start :end :from-end" + (apply 'remove* nil cl-list ':if cl-pred cl-keys)) + + (defun remove-if-not (cl-pred cl-list &rest cl-keys) + "Remove all items not satisfying PREDICATE in SEQ. + This is a non-destructive function; it makes a copy of SEQ if necessary + to avoid corrupting the original SEQ. + Keywords supported: :key :count :start :end :from-end" + (apply 'remove* nil cl-list ':if-not cl-pred cl-keys)) + + (defun delete* (cl-item cl-seq &rest cl-keys) + "Remove all occurrences of ITEM in SEQ. + This is a destructive function; it reuses the storage of SEQ whenever possible. + Keywords supported: :test :test-not :key :count :start :end :from-end" + (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end + (:start 0) :end) () + (if (<= (or cl-count (setq cl-count 8000000)) 0) + cl-seq + (if (listp cl-seq) + (if (and cl-from-end (< cl-count 4000000)) + (let (cl-i) + (while (and (>= (setq cl-count (1- cl-count)) 0) + (setq cl-i (cl-position cl-item cl-seq cl-start + cl-end cl-from-end))) + (if (= cl-i 0) (setq cl-seq (cdr cl-seq)) + (let ((cl-tail (nthcdr (1- cl-i) cl-seq))) + (setcdr cl-tail (cdr (cdr cl-tail))))) + (setq cl-end cl-i)) + cl-seq) + (setq cl-end (- (or cl-end 8000000) cl-start)) + (if (= cl-start 0) + (progn + (while (and cl-seq + (> cl-end 0) + (cl-check-test cl-item (car cl-seq)) + (setq cl-end (1- cl-end) cl-seq (cdr cl-seq)) + (> (setq cl-count (1- cl-count)) 0))) + (setq cl-end (1- cl-end))) + (setq cl-start (1- cl-start))) + (if (and (> cl-count 0) (> cl-end 0)) + (let ((cl-p (nthcdr cl-start cl-seq))) + (while (and (cdr cl-p) (> cl-end 0)) + (if (cl-check-test cl-item (car (cdr cl-p))) + (progn + (setcdr cl-p (cdr (cdr cl-p))) + (if (= (setq cl-count (1- cl-count)) 0) + (setq cl-end 1))) + (setq cl-p (cdr cl-p))) + (setq cl-end (1- cl-end))))) + cl-seq) + (apply 'remove* cl-item cl-seq cl-keys))))) + + (defun delete-if (cl-pred cl-list &rest cl-keys) + "Remove all items satisfying PREDICATE in SEQ. + This is a destructive function; it reuses the storage of SEQ whenever possible. + Keywords supported: :key :count :start :end :from-end" + (apply 'delete* nil cl-list ':if cl-pred cl-keys)) + + (defun delete-if-not (cl-pred cl-list &rest cl-keys) + "Remove all items not satisfying PREDICATE in SEQ. + This is a destructive function; it reuses the storage of SEQ whenever possible. + Keywords supported: :key :count :start :end :from-end" + (apply 'delete* nil cl-list ':if-not cl-pred cl-keys)) + + (or (and (fboundp 'delete) (subrp (symbol-function 'delete))) + (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal))))) + (defun remove (x y) (remove* x y ':test 'equal)) + (defun remq (x y) (if (memq x y) (delq x (copy-list y)) y)) + + (defun remove-duplicates (cl-seq &rest cl-keys) + "Return a copy of SEQ with all duplicate elements removed. + Keywords supported: :test :test-not :key :start :end :from-end" + (cl-delete-duplicates cl-seq cl-keys t)) + + (defun delete-duplicates (cl-seq &rest cl-keys) + "Remove all duplicate elements from SEQ (destructively). + Keywords supported: :test :test-not :key :start :end :from-end" + (cl-delete-duplicates cl-seq cl-keys nil)) + + (defun cl-delete-duplicates (cl-seq cl-keys cl-copy) + (if (listp cl-seq) + (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if) + () + (if cl-from-end + (let ((cl-p (nthcdr cl-start cl-seq)) cl-i) + (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) + (while (> cl-end 1) + (setq cl-i 0) + (while (setq cl-i (cl-position (cl-check-key (car cl-p)) + (cdr cl-p) cl-i (1- cl-end))) + (if cl-copy (setq cl-seq (copy-sequence cl-seq) + cl-p (nthcdr cl-start cl-seq) cl-copy nil)) + (let ((cl-tail (nthcdr cl-i cl-p))) + (setcdr cl-tail (cdr (cdr cl-tail)))) + (setq cl-end (1- cl-end))) + (setq cl-p (cdr cl-p) cl-end (1- cl-end) + cl-start (1+ cl-start))) + cl-seq) + (setq cl-end (- (or cl-end (length cl-seq)) cl-start)) + (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1) + (cl-position (cl-check-key (car cl-seq)) + (cdr cl-seq) 0 (1- cl-end))) + (setq cl-seq (cdr cl-seq) cl-end (1- cl-end))) + (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq) + (setq cl-end (1- cl-end) cl-start 1) cl-seq))) + (while (and (cdr (cdr cl-p)) (> cl-end 1)) + (if (cl-position (cl-check-key (car (cdr cl-p))) + (cdr (cdr cl-p)) 0 (1- cl-end)) + (progn + (if cl-copy (setq cl-seq (copy-sequence cl-seq) + cl-p (nthcdr (1- cl-start) cl-seq) + cl-copy nil)) + (setcdr cl-p (cdr (cdr cl-p)))) + (setq cl-p (cdr cl-p))) + (setq cl-end (1- cl-end) cl-start (1+ cl-start))) + cl-seq))) + (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil))) + (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))) + + (defun substitute (cl-new cl-old cl-seq &rest cl-keys) + "Substitute NEW for OLD in SEQ. + This is a non-destructive function; it makes a copy of SEQ if necessary + to avoid corrupting the original SEQ. + Keywords supported: :test :test-not :key :count :start :end :from-end" + (cl-parsing-keywords (:test :test-not :key :if :if-not :count + (:start 0) :end :from-end) () + (if (or (eq cl-old cl-new) + (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0)) + cl-seq + (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end))) + (if (not cl-i) + cl-seq + (setq cl-seq (copy-sequence cl-seq)) + (or cl-from-end + (progn (cl-set-elt cl-seq cl-i cl-new) + (setq cl-i (1+ cl-i) cl-count (1- cl-count)))) + (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count + ':start cl-i cl-keys)))))) + + (defun substitute-if (cl-new cl-pred cl-list &rest cl-keys) + "Substitute NEW for all items satisfying PREDICATE in SEQ. + This is a non-destructive function; it makes a copy of SEQ if necessary + to avoid corrupting the original SEQ. + Keywords supported: :key :count :start :end :from-end" + (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys)) + + (defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys) + "Substitute NEW for all items not satisfying PREDICATE in SEQ. + This is a non-destructive function; it makes a copy of SEQ if necessary + to avoid corrupting the original SEQ. + Keywords supported: :key :count :start :end :from-end" + (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys)) + + (defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys) + "Substitute NEW for OLD in SEQ. + This is a destructive function; it reuses the storage of SEQ whenever possible. + Keywords supported: :test :test-not :key :count :start :end :from-end" + (cl-parsing-keywords (:test :test-not :key :if :if-not :count + (:start 0) :end :from-end) () + (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0) + (if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000))) + (let ((cl-p (nthcdr cl-start cl-seq))) + (setq cl-end (- (or cl-end 8000000) cl-start)) + (while (and cl-p (> cl-end 0) (> cl-count 0)) + (if (cl-check-test cl-old (car cl-p)) + (progn + (setcar cl-p cl-new) + (setq cl-count (1- cl-count)))) + (setq cl-p (cdr cl-p) cl-end (1- cl-end)))) + (or cl-end (setq cl-end (length cl-seq))) + (if cl-from-end + (while (and (< cl-start cl-end) (> cl-count 0)) + (setq cl-end (1- cl-end)) + (if (cl-check-test cl-old (elt cl-seq cl-end)) + (progn + (cl-set-elt cl-seq cl-end cl-new) + (setq cl-count (1- cl-count))))) + (while (and (< cl-start cl-end) (> cl-count 0)) + (if (cl-check-test cl-old (aref cl-seq cl-start)) + (progn + (aset cl-seq cl-start cl-new) + (setq cl-count (1- cl-count)))) + (setq cl-start (1+ cl-start)))))) + cl-seq)) + + (defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys) + "Substitute NEW for all items satisfying PREDICATE in SEQ. + This is a destructive function; it reuses the storage of SEQ whenever possible. + Keywords supported: :key :count :start :end :from-end" + (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys)) + + (defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys) + "Substitute NEW for all items not satisfying PREDICATE in SEQ. + This is a destructive function; it reuses the storage of SEQ whenever possible. + Keywords supported: :key :count :start :end :from-end" + (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys)) + + (defun find (cl-item cl-seq &rest cl-keys) + "Find the first occurrence of ITEM in LIST. + Return the matching ITEM, or nil if not found. + Keywords supported: :test :test-not :key :start :end :from-end" + (let ((cl-pos (apply 'position cl-item cl-seq cl-keys))) + (and cl-pos (elt cl-seq cl-pos)))) + + (defun find-if (cl-pred cl-list &rest cl-keys) + "Find the first item satisfying PREDICATE in LIST. + Return the matching ITEM, or nil if not found. + Keywords supported: :key :start :end :from-end" + (apply 'find nil cl-list ':if cl-pred cl-keys)) + + (defun find-if-not (cl-pred cl-list &rest cl-keys) + "Find the first item not satisfying PREDICATE in LIST. + Return the matching ITEM, or nil if not found. + Keywords supported: :key :start :end :from-end" + (apply 'find nil cl-list ':if-not cl-pred cl-keys)) + + (defun position (cl-item cl-seq &rest cl-keys) + "Find the first occurrence of ITEM in LIST. + Return the index of the matching item, or nil if not found. + Keywords supported: :test :test-not :key :start :end :from-end" + (cl-parsing-keywords (:test :test-not :key :if :if-not + (:start 0) :end :from-end) () + (cl-position cl-item cl-seq cl-start cl-end cl-from-end))) + + (defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end) + (if (listp cl-seq) + (let ((cl-p (nthcdr cl-start cl-seq))) + (or cl-end (setq cl-end 8000000)) + (let ((cl-res nil)) + (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end)) + (if (cl-check-test cl-item (car cl-p)) + (setq cl-res cl-start)) + (setq cl-p (cdr cl-p) cl-start (1+ cl-start))) + cl-res)) + (or cl-end (setq cl-end (length cl-seq))) + (if cl-from-end + (progn + (while (and (>= (setq cl-end (1- cl-end)) cl-start) + (not (cl-check-test cl-item (aref cl-seq cl-end))))) + (and (>= cl-end cl-start) cl-end)) + (while (and (< cl-start cl-end) + (not (cl-check-test cl-item (aref cl-seq cl-start)))) + (setq cl-start (1+ cl-start))) + (and (< cl-start cl-end) cl-start)))) + + (defun position-if (cl-pred cl-list &rest cl-keys) + "Find the first item satisfying PREDICATE in LIST. + Return the index of the matching item, or nil if not found. + Keywords supported: :key :start :end :from-end" + (apply 'position nil cl-list ':if cl-pred cl-keys)) + + (defun position-if-not (cl-pred cl-list &rest cl-keys) + "Find the first item not satisfying PREDICATE in LIST. + Return the index of the matching item, or nil if not found. + Keywords supported: :key :start :end :from-end" + (apply 'position nil cl-list ':if-not cl-pred cl-keys)) + + (defun count (cl-item cl-seq &rest cl-keys) + "Count the number of occurrences of ITEM in LIST. + Keywords supported: :test :test-not :key :start :end" + (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) () + (let ((cl-count 0) cl-x) + (or cl-end (setq cl-end (length cl-seq))) + (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) + (while (< cl-start cl-end) + (setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start))) + (if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count))) + (setq cl-start (1+ cl-start))) + cl-count))) + + (defun count-if (cl-pred cl-list &rest cl-keys) + "Count the number of items satisfying PREDICATE in LIST. + Keywords supported: :key :start :end" + (apply 'count nil cl-list ':if cl-pred cl-keys)) + + (defun count-if-not (cl-pred cl-list &rest cl-keys) + "Count the number of items not satisfying PREDICATE in LIST. + Keywords supported: :key :start :end" + (apply 'count nil cl-list ':if-not cl-pred cl-keys)) + + (defun mismatch (cl-seq1 cl-seq2 &rest cl-keys) + "Compare SEQ1 with SEQ2, return index of first mismatching element. + Return nil if the sequences match. If one sequence is a prefix of the + other, the return value indicates the end of the shorted sequence. + Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" + (cl-parsing-keywords (:test :test-not :key :from-end + (:start1 0) :end1 (:start2 0) :end2) () + (or cl-end1 (setq cl-end1 (length cl-seq1))) + (or cl-end2 (setq cl-end2 (length cl-seq2))) + (if cl-from-end + (progn + (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) + (cl-check-match (elt cl-seq1 (1- cl-end1)) + (elt cl-seq2 (1- cl-end2)))) + (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2))) + (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) + (1- cl-end1))) + (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1))) + (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2)))) + (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2) + (cl-check-match (if cl-p1 (car cl-p1) + (aref cl-seq1 cl-start1)) + (if cl-p2 (car cl-p2) + (aref cl-seq2 cl-start2)))) + (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2) + cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2))) + (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2)) + cl-start1))))) + + (defun search (cl-seq1 cl-seq2 &rest cl-keys) + "Search for SEQ1 as a subsequence of SEQ2. + Return the index of the leftmost element of the first match found; + return nil if there are no matches. + Keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end" + (cl-parsing-keywords (:test :test-not :key :from-end + (:start1 0) :end1 (:start2 0) :end2) () + (or cl-end1 (setq cl-end1 (length cl-seq1))) + (or cl-end2 (setq cl-end2 (length cl-seq2))) + (if (>= cl-start1 cl-end1) + (if cl-from-end cl-end2 cl-start2) + (let* ((cl-len (- cl-end1 cl-start1)) + (cl-first (cl-check-key (elt cl-seq1 cl-start1))) + (cl-if nil) cl-pos) + (setq cl-end2 (- cl-end2 (1- cl-len))) + (while (and (< cl-start2 cl-end2) + (setq cl-pos (cl-position cl-first cl-seq2 + cl-start2 cl-end2 cl-from-end)) + (apply 'mismatch cl-seq1 cl-seq2 + ':start1 (1+ cl-start1) ':end1 cl-end1 + ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len) + ':from-end nil cl-keys)) + (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos)))) + (and (< cl-start2 cl-end2) cl-pos))))) + + (defun sort* (cl-seq cl-pred &rest cl-keys) + "Sort the argument SEQUENCE according to PREDICATE. + This is a destructive function; it reuses the storage of SEQUENCE if possible. + Keywords supported: :key" + (if (nlistp cl-seq) + (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys)) + (cl-parsing-keywords (:key) () + (if (memq cl-key '(nil identity)) + (sort cl-seq cl-pred) + (sort cl-seq (function (lambda (cl-x cl-y) + (funcall cl-pred (funcall cl-key cl-x) + (funcall cl-key cl-y))))))))) + + (defun stable-sort (cl-seq cl-pred &rest cl-keys) + "Sort the argument SEQUENCE stably according to PREDICATE. + This is a destructive function; it reuses the storage of SEQUENCE if possible. + Keywords supported: :key" + (apply 'sort* cl-seq cl-pred cl-keys)) + + (defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys) + "Destructively merge the two sequences to produce a new sequence. + TYPE is the sequence type to return, SEQ1 and SEQ2 are the two + argument sequences, and PRED is a `less-than' predicate on the elements. + Keywords supported: :key" + (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil))) + (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil))) + (cl-parsing-keywords (:key) () + (let ((cl-res nil)) + (while (and cl-seq1 cl-seq2) + (if (funcall cl-pred (cl-check-key (car cl-seq2)) + (cl-check-key (car cl-seq1))) + (cl-push (cl-pop cl-seq2) cl-res) + (cl-push (cl-pop cl-seq1) cl-res))) + (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type)))) + + ;;; See compiler macro in cl-macs.el + (defun member* (cl-item cl-list &rest cl-keys) + "Find the first occurrence of ITEM in LIST. + Return the sublist of LIST whose car is ITEM. + Keywords supported: :test :test-not :key" + (if cl-keys + (cl-parsing-keywords (:test :test-not :key :if :if-not) () + (while (and cl-list (not (cl-check-test cl-item (car cl-list)))) + (setq cl-list (cdr cl-list))) + cl-list) + (if (and (numberp cl-item) (not (integerp cl-item))) + (member cl-item cl-list) + (memq cl-item cl-list)))) + + (defun member-if (cl-pred cl-list &rest cl-keys) + "Find the first item satisfying PREDICATE in LIST. + Return the sublist of LIST whose car matches. + Keywords supported: :key" + (apply 'member* nil cl-list ':if cl-pred cl-keys)) + + (defun member-if-not (cl-pred cl-list &rest cl-keys) + "Find the first item not satisfying PREDICATE in LIST. + Return the sublist of LIST whose car matches. + Keywords supported: :key" + (apply 'member* nil cl-list ':if-not cl-pred cl-keys)) + + (defun cl-adjoin (cl-item cl-list &rest cl-keys) + (if (cl-parsing-keywords (:key) t + (apply 'member* (cl-check-key cl-item) cl-list cl-keys)) + cl-list + (cons cl-item cl-list))) + + ;;; See compiler macro in cl-macs.el + (defun assoc* (cl-item cl-alist &rest cl-keys) + "Find the first item whose car matches ITEM in LIST. + Keywords supported: :test :test-not :key" + (if cl-keys + (cl-parsing-keywords (:test :test-not :key :if :if-not) () + (while (and cl-alist + (or (not (consp (car cl-alist))) + (not (cl-check-test cl-item (car (car cl-alist)))))) + (setq cl-alist (cdr cl-alist))) + (and cl-alist (car cl-alist))) + (if (and (numberp cl-item) (not (integerp cl-item))) + (assoc cl-item cl-alist) + (assq cl-item cl-alist)))) + + (defun assoc-if (cl-pred cl-list &rest cl-keys) + "Find the first item whose car satisfies PREDICATE in LIST. + Keywords supported: :key" + (apply 'assoc* nil cl-list ':if cl-pred cl-keys)) + + (defun assoc-if-not (cl-pred cl-list &rest cl-keys) + "Find the first item whose car does not satisfy PREDICATE in LIST. + Keywords supported: :key" + (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys)) + + (defun rassoc* (cl-item cl-alist &rest cl-keys) + "Find the first item whose cdr matches ITEM in LIST. + Keywords supported: :test :test-not :key" + (if (or cl-keys (numberp cl-item)) + (cl-parsing-keywords (:test :test-not :key :if :if-not) () + (while (and cl-alist + (or (not (consp (car cl-alist))) + (not (cl-check-test cl-item (cdr (car cl-alist)))))) + (setq cl-alist (cdr cl-alist))) + (and cl-alist (car cl-alist))) + (rassq cl-item cl-alist))) + + (defun rassoc (item alist) (rassoc* item alist ':test 'equal)) + + (defun rassoc-if (cl-pred cl-list &rest cl-keys) + "Find the first item whose cdr satisfies PREDICATE in LIST. + Keywords supported: :key" + (apply 'rassoc* nil cl-list ':if cl-pred cl-keys)) + + (defun rassoc-if-not (cl-pred cl-list &rest cl-keys) + "Find the first item whose cdr does not satisfy PREDICATE in LIST. + Keywords supported: :key" + (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys)) + + (defun union (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-union operation. + The result list contains all items that appear in either LIST1 or LIST2. + This is a non-destructive function; it makes a copy of the data if necessary + to avoid corrupting the original LIST1 and LIST2. + Keywords supported: :test :test-not :key" + (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) + ((equal cl-list1 cl-list2) cl-list1) + (t + (or (>= (length cl-list1) (length cl-list2)) + (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) + (while cl-list2 + (if (or cl-keys (numberp (car cl-list2))) + (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys)) + (or (memq (car cl-list2) cl-list1) + (cl-push (car cl-list2) cl-list1))) + (cl-pop cl-list2)) + cl-list1))) + + (defun nunion (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-union operation. + The result list contains all items that appear in either LIST1 or LIST2. + This is a destructive function; it reuses the storage of LIST1 and LIST2 + whenever possible. + Keywords supported: :test :test-not :key" + (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) + (t (apply 'union cl-list1 cl-list2 cl-keys)))) + + (defun intersection (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-intersection operation. + The result list contains all items that appear in both LIST1 and LIST2. + This is a non-destructive function; it makes a copy of the data if necessary + to avoid corrupting the original LIST1 and LIST2. + Keywords supported: :test :test-not :key" + (and cl-list1 cl-list2 + (if (equal cl-list1 cl-list2) cl-list1 + (cl-parsing-keywords (:key) (:test :test-not) + (let ((cl-res nil)) + (or (>= (length cl-list1) (length cl-list2)) + (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1)))) + (while cl-list2 + (if (if (or cl-keys (numberp (car cl-list2))) + (apply 'member* (cl-check-key (car cl-list2)) + cl-list1 cl-keys) + (memq (car cl-list2) cl-list1)) + (cl-push (car cl-list2) cl-res)) + (cl-pop cl-list2)) + cl-res))))) + + (defun nintersection (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-intersection operation. + The result list contains all items that appear in both LIST1 and LIST2. + This is a destructive function; it reuses the storage of LIST1 and LIST2 + whenever possible. + Keywords supported: :test :test-not :key" + (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys))) + + (defun set-difference (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-difference operation. + The result list contains all items that appear in LIST1 but not LIST2. + This is a non-destructive function; it makes a copy of the data if necessary + to avoid corrupting the original LIST1 and LIST2. + Keywords supported: :test :test-not :key" + (if (or (null cl-list1) (null cl-list2)) cl-list1 + (cl-parsing-keywords (:key) (:test :test-not) + (let ((cl-res nil)) + (while cl-list1 + (or (if (or cl-keys (numberp (car cl-list1))) + (apply 'member* (cl-check-key (car cl-list1)) + cl-list2 cl-keys) + (memq (car cl-list1) cl-list2)) + (cl-push (car cl-list1) cl-res)) + (cl-pop cl-list1)) + cl-res)))) + + (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-difference operation. + The result list contains all items that appear in LIST1 but not LIST2. + This is a destructive function; it reuses the storage of LIST1 and LIST2 + whenever possible. + Keywords supported: :test :test-not :key" + (if (or (null cl-list1) (null cl-list2)) cl-list1 + (apply 'set-difference cl-list1 cl-list2 cl-keys))) + + (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-exclusive-or operation. + The result list contains all items that appear in exactly one of LIST1, LIST2. + This is a non-destructive function; it makes a copy of the data if necessary + to avoid corrupting the original LIST1 and LIST2. + Keywords supported: :test :test-not :key" + (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) + ((equal cl-list1 cl-list2) nil) + (t (append (apply 'set-difference cl-list1 cl-list2 cl-keys) + (apply 'set-difference cl-list2 cl-list1 cl-keys))))) + + (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) + "Combine LIST1 and LIST2 using a set-exclusive-or operation. + The result list contains all items that appear in exactly one of LIST1, LIST2. + This is a destructive function; it reuses the storage of LIST1 and LIST2 + whenever possible. + Keywords supported: :test :test-not :key" + (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1) + ((equal cl-list1 cl-list2) nil) + (t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys) + (apply 'nset-difference cl-list2 cl-list1 cl-keys))))) + + (defun subsetp (cl-list1 cl-list2 &rest cl-keys) + "True if LIST1 is a subset of LIST2. + I.e., if every element of LIST1 also appears in LIST2. + Keywords supported: :test :test-not :key" + (cond ((null cl-list1) t) ((null cl-list2) nil) + ((equal cl-list1 cl-list2) t) + (t (cl-parsing-keywords (:key) (:test :test-not) + (while (and cl-list1 + (apply 'member* (cl-check-key (car cl-list1)) + cl-list2 cl-keys)) + (cl-pop cl-list1)) + (null cl-list1))))) + + (defun subst-if (cl-new cl-pred cl-tree &rest cl-keys) + "Substitute NEW for elements matching PREDICATE in TREE (non-destructively). + Return a copy of TREE with all matching elements replaced by NEW. + Keywords supported: :key" + (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) + + (defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys) + "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively). + Return a copy of TREE with all non-matching elements replaced by NEW. + Keywords supported: :key" + (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) + + (defun nsubst (cl-new cl-old cl-tree &rest cl-keys) + "Substitute NEW for OLD everywhere in TREE (destructively). + Any element of TREE which is `eql' to OLD is changed to NEW (via a call + to `setcar'). + Keywords supported: :test :test-not :key" + (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys)) + + (defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys) + "Substitute NEW for elements matching PREDICATE in TREE (destructively). + Any element of TREE which matches is changed to NEW (via a call to `setcar'). + Keywords supported: :key" + (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys)) + + (defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys) + "Substitute NEW for elements not matching PREDICATE in TREE (destructively). + Any element of TREE which matches is changed to NEW (via a call to `setcar'). + Keywords supported: :key" + (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys)) + + (defun sublis (cl-alist cl-tree &rest cl-keys) + "Perform substitutions indicated by ALIST in TREE (non-destructively). + Return a copy of TREE with all matching elements replaced. + Keywords supported: :test :test-not :key" + (cl-parsing-keywords (:test :test-not :key :if :if-not) () + (cl-sublis-rec cl-tree))) + + (defvar cl-alist) + (defun cl-sublis-rec (cl-tree) ; uses cl-alist/key/test*/if* + (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist)) + (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) + (setq cl-p (cdr cl-p))) + (if cl-p (cdr (car cl-p)) + (if (consp cl-tree) + (let ((cl-a (cl-sublis-rec (car cl-tree))) + (cl-d (cl-sublis-rec (cdr cl-tree)))) + (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree))) + cl-tree + (cons cl-a cl-d))) + cl-tree)))) + + (defun nsublis (cl-alist cl-tree &rest cl-keys) + "Perform substitutions indicated by ALIST in TREE (destructively). + Any matching element of TREE is changed via a call to `setcar'. + Keywords supported: :test :test-not :key" + (cl-parsing-keywords (:test :test-not :key :if :if-not) () + (let ((cl-hold (list cl-tree))) + (cl-nsublis-rec cl-hold) + (car cl-hold)))) + + (defun cl-nsublis-rec (cl-tree) ; uses cl-alist/temp/p/key/test*/if* + (while (consp cl-tree) + (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist)) + (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) + (setq cl-p (cdr cl-p))) + (if cl-p (setcar cl-tree (cdr (car cl-p))) + (if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree)))) + (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist) + (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp))) + (setq cl-p (cdr cl-p))) + (if cl-p + (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil)) + (setq cl-tree (cdr cl-tree)))))) + + (defun tree-equal (cl-x cl-y &rest cl-keys) + "T if trees X and Y have `eql' leaves. + Atoms are compared by `eql'; cons cells are compared recursively. + Keywords supported: :test :test-not :key" + (cl-parsing-keywords (:test :test-not :key) () + (cl-tree-equal-rec cl-x cl-y))) + + (defun cl-tree-equal-rec (cl-x cl-y) + (while (and (consp cl-x) (consp cl-y) + (cl-tree-equal-rec (car cl-x) (car cl-y))) + (setq cl-x (cdr cl-x) cl-y (cdr cl-y))) + (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y))) + + + (run-hooks 'cl-seq-load-hook) + + ;;; cl-seq.el ends here diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cl.el emacs-19.18/lisp/cl.el *** emacs-19.17/lisp/cl.el --- emacs-19.18/lisp/cl.el Fri Jul 30 16:14:08 1993 *************** *** 0 **** --- 1,757 ---- + ;; cl.el --- Common Lisp extensions for GNU Emacs Lisp + + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Dave Gillespie + ;; Version: 2.02 + ;; Keywords: extensions + + ;; 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 1, 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;; Commentary: + + ;; These are extensions to Emacs Lisp that provide a degree of + ;; Common Lisp compatibility, beyond what is already built-in + ;; in Emacs Lisp. + ;; + ;; This package was written by Dave Gillespie; it is a complete + ;; rewrite of Cesar Quiroz's original cl.el package of December 1986. + ;; + ;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19. + ;; + ;; Bug reports, comments, and suggestions are welcome! + + ;; This file contains the portions of the Common Lisp extensions + ;; package which should always be present. + + + ;; Future notes: + + ;; Once Emacs 19 becomes standard, many things in this package which are + ;; messy for reasons of compatibility can be greatly simplified. For now, + ;; I prefer to maintain one unified version. + + + ;; Change Log: + + ;; Version 2.02 (30 Jul 93): + ;; * Added "cl-compat.el" file, extra compatibility with old package. + ;; * Added `lexical-let' and `lexical-let*'. + ;; * Added `define-modify-macro', `callf', and `callf2'. + ;; * Added `ignore-errors'. + ;; * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero. + ;; * Merged `*gentemp-counter*' into `*gensym-counter*'. + ;; * Extended `subseq' to allow negative START and END like `substring'. + ;; * Added `in-ref', `across-ref', `elements of-ref' loop clauses. + ;; * Added `concat', `vconcat' loop clauses. + ;; * Cleaned up a number of compiler warnings. + + ;; Version 2.01 (7 Jul 93): + ;; * Added support for FSF version of Emacs 19. + ;; * Added `add-hook' for Emacs 18 users. + ;; * Added `defsubst*' and `symbol-macrolet'. + ;; * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'. + ;; * Added `map', `concatenate', `reduce', `merge'. + ;; * Added `revappend', `nreconc', `tailp', `tree-equal'. + ;; * Added `assert', `check-type', `typecase', `typep', and `deftype'. + ;; * Added destructuring and `&environment' support to `defmacro*'. + ;; * Added destructuring to `loop', and added the following clauses: + ;; `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'. + ;; * Renamed `delete' to `delete*' and `remove' to `remove*'. + ;; * Completed support for all keywords in `remove*', `substitute', etc. + ;; * Added `most-positive-float' and company. + ;; * Fixed hash tables to work with latest Lucid Emacs. + ;; * `proclaim' forms are no longer compile-time-evaluating; use `declaim'. + ;; * Syntax for `warn' declarations has changed. + ;; * Improved implementation of `random*'. + ;; * Moved most sequence functions to a new file, cl-seq.el. + ;; * Moved `eval-when' into cl-macs.el. + ;; * Moved `pushnew' and `adjoin' to cl.el for most common cases. + ;; * Moved `provide' forms down to ends of files. + ;; * Changed expansion of `pop' to something that compiles to better code. + ;; * Changed so that no patch is required for Emacs 19 byte compiler. + ;; * Made more things dependent on `optimize' declarations. + ;; * Added a partial implementation of struct print functions. + ;; * Miscellaneous minor changes. + + ;; Version 2.00: + ;; * First public release of this package. + + + ;; Code: + + (defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version) + (symbol-value 'epoch::version)) + (string-lessp emacs-version "19")) 18) + ((string-match "Lucid" emacs-version) 'lucid) + (t 19))) + + (or (fboundp 'defalias) (fset 'defalias 'fset)) + + (defvar cl-optimize-speed 1) + (defvar cl-optimize-safety 1) + + + ;;; Keywords used in this package. + + (defconst :test ':test) + (defconst :test-not ':test-not) + (defconst :key ':key) + (defconst :start ':start) + (defconst :start1 ':start1) + (defconst :start2 ':start2) + (defconst :end ':end) + (defconst :end1 ':end1) + (defconst :end2 ':end2) + (defconst :count ':count) + (defconst :initial-value ':initial-value) + (defconst :size ':size) + (defconst :from-end ':from-end) + (defconst :rehash-size ':rehash-size) + (defconst :rehash-threshold ':rehash-threshold) + (defconst :allow-other-keys ':allow-other-keys) + + + (defvar custom-print-functions nil + "This is a list of functions that format user objects for printing. + Each function is called in turn with three arguments: the object, the + stream, and the print level (currently ignored). If it is able to + print the object it returns true; otherwise it returns nil and the + printer proceeds to the next function on the list. + + This variable is not used at present, but it is defined in hopes that + a future Emacs interpreter will be able to use it.") + + + ;;; Predicates. + + (defun eql (a b) ; See compiler macro in cl-macs.el + "T if the two args are the same Lisp object. + Floating-point numbers of equal value are `eql', but they may not be `eq'." + (if (numberp a) + (equal a b) + (eq a b))) + + + ;;; Generalized variables. These macros are defined here so that they + ;;; can safely be used in .emacs files. + + (defmacro incf (place &optional x) + "(incf PLACE [X]): increment PLACE by X (1 by default). + PLACE may be a symbol, or any generalized variable allowed by `setf'. + The return value is the incremented value of PLACE." + (if (symbolp place) + (list 'setq place (if x (list '+ place x) (list '1+ place))) + (list 'callf '+ place (or x 1)))) + + (defmacro decf (place &optional x) + "(decf PLACE [X]): decrement PLACE by X (1 by default). + PLACE may be a symbol, or any generalized variable allowed by `setf'. + The return value is the decremented value of PLACE." + (if (symbolp place) + (list 'setq place (if x (list '- place x) (list '1- place))) + (list 'callf '- place (or x 1)))) + + (defmacro pop (place) + "(pop PLACE): remove and return the head of the list stored in PLACE. + Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more + careful about evaluating each argument only once and in the right order. + PLACE may be a symbol, or any generalized variable allowed by `setf'." + (if (symbolp place) + (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))) + (cl-do-pop place))) + + (defmacro push (x place) + "(push X PLACE): insert X at the head of the list stored in PLACE. + Analogous to (setf PLACE (cons X PLACE)), though more careful about + evaluating each argument only once and in the right order. PLACE may + be a symbol, or any generalized variable allowed by `setf'." + (if (symbolp place) (list 'setq place (list 'cons x place)) + (list 'callf2 'cons x place))) + + (defmacro pushnew (x place &rest keys) + "(pushnew X PLACE): insert X at the head of the list if not already there. + Like (push X PLACE), except that the list is unmodified if X is `eql' to + an element already on the list. + Keywords supported: :test :test-not :key" + (if (symbolp place) (list 'setq place (list* 'adjoin x place keys)) + (list* 'callf2 'adjoin x place keys))) + + (defun cl-set-elt (seq n val) + (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val))) + + (defun cl-set-nthcdr (n list x) + (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list)) + + (defun cl-set-buffer-substring (start end val) + (save-excursion (delete-region start end) + (goto-char start) + (insert val) + val)) + + (defun cl-set-substring (str start end val) + (if end (if (< end 0) (incf end (length str))) + (setq end (length str))) + (if (< start 0) (incf start str)) + (concat (and (> start 0) (substring str 0 start)) + val + (and (< end (length str)) (substring str end)))) + + + ;;; Control structures. + + ;;; These macros are so simple and so often-used that it's better to have + ;;; them all the time than to load them from cl-macs.el. + + (defmacro when (cond &rest body) + "(when COND BODY...): if COND yields non-nil, do BODY, else return nil." + (list 'if cond (cons 'progn body))) + + (defmacro unless (cond &rest body) + "(unless COND BODY...): if COND yields nil, do BODY, else return nil." + (cons 'if (cons cond (cons nil body)))) + + (defun cl-map-extents (&rest cl-args) + (if (fboundp 'next-overlay-at) (apply 'cl-map-overlays cl-args) + (if (fboundp 'map-extents) (apply 'map-extents cl-args)))) + + + ;;; Blocks and exits. + + (defalias 'cl-block-wrapper 'identity) + (defalias 'cl-block-throw 'throw) + + + ;;; Multiple values. True multiple values are not supported, or even + ;;; simulated. Instead, multiple-value-bind and friends simply expect + ;;; the target form to return the values as a list. + + (defalias 'values 'list) + (defalias 'values-list 'identity) + (defalias 'multiple-value-list 'identity) + (defalias 'multiple-value-call 'apply) ; only works for one arg + (defalias 'nth-value 'nth) + + + ;;; Macros. + + (defvar cl-macro-environment nil) + (defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand) + (defalias 'macroexpand 'cl-macroexpand))) + + (defun cl-macroexpand (cl-macro &optional cl-env) + (let ((cl-macro-environment cl-env)) + (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env)) + (and (symbolp cl-macro) + (cdr (assq (symbol-name cl-macro) cl-env)))) + (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env)))) + cl-macro)) + + + ;;; Declarations. + + (defvar cl-compiling-file nil) + (defun cl-compiling-file () + (or cl-compiling-file + (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer)) + (equal (buffer-name (symbol-value 'outbuffer)) + " *Compiler Output*")))) + + (defvar cl-proclaims-deferred nil) + + (defun proclaim (spec) + (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t) + (push spec cl-proclaims-deferred)) + nil) + + (defmacro declaim (&rest specs) + (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x)))) + specs))) + (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body) + (cons 'progn body)))) ; avoid loading cl-macs.el for eval-when + + + ;;; Symbols. + + (defun cl-random-time () + (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0)) + (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i)))) + v)) + + (defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100)) + + + ;;; Numbers. + + (defun floatp-safe (x) + "T if OBJECT is a floating point number. + On Emacs versions that lack floating-point support, this function + always returns nil." + (and (numberp x) (not (integerp x)))) + + (defun plusp (x) + "T if NUMBER is positive." + (> x 0)) + + (defun minusp (x) + "T if NUMBER is negative." + (< x 0)) + + (defun oddp (x) + "T if INTEGER is odd." + (eq (logand x 1) 1)) + + (defun evenp (x) + "T if INTEGER is even." + (eq (logand x 1) 0)) + + (defun cl-abs (x) + "Return the absolute value of ARG." + (if (>= x 0) x (- x))) + (or (fboundp 'abs) (defalias 'abs 'cl-abs)) ; This is built-in to Emacs 19 + + (defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time))) + + ;;; We use `eval' in case VALBITS differs from compile-time to load-time. + (defconst most-positive-fixnum (eval '(lsh -1 -1))) + (defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1)))) + + ;;; The following are actually set by cl-float-limits. + (defconst most-positive-float nil) + (defconst most-negative-float nil) + (defconst least-positive-float nil) + (defconst least-negative-float nil) + (defconst least-positive-normalized-float nil) + (defconst least-negative-normalized-float nil) + (defconst float-epsilon nil) + (defconst float-negative-epsilon nil) + + + ;;; Sequence functions. + + (defalias 'copy-seq 'copy-sequence) + + (defun mapcar* (cl-func cl-x &rest cl-rest) + "Apply FUNCTION to each element of SEQ, and make a list of the results. + If there are several SEQs, FUNCTION is called with that many arguments, + and mapping stops as soon as the shortest list runs out. With just one + SEQ, this is like `mapcar'. With several, it is like the Common Lisp + `mapcar' function extended to arbitrary sequence types." + (if cl-rest + (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) + (cl-mapcar-many cl-func (cons cl-x cl-rest)) + (let ((cl-res nil) (cl-y (car cl-rest))) + (while (and cl-x cl-y) + (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) + (nreverse cl-res))) + (mapcar cl-func cl-x))) + + + ;;; List functions. + + (defalias 'first 'car) + (defalias 'rest 'cdr) + (defalias 'endp 'null) + + (defun second (x) + "Return the second element of the list LIST." + (car (cdr x))) + + (defun third (x) + "Return the third element of the list LIST." + (car (cdr (cdr x)))) + + (defun fourth (x) + "Return the fourth element of the list LIST." + (nth 3 x)) + + (defun fifth (x) + "Return the fifth element of the list LIST." + (nth 4 x)) + + (defun sixth (x) + "Return the sixth element of the list LIST." + (nth 5 x)) + + (defun seventh (x) + "Return the seventh element of the list LIST." + (nth 6 x)) + + (defun eighth (x) + "Return the eighth element of the list LIST." + (nth 7 x)) + + (defun ninth (x) + "Return the ninth element of the list LIST." + (nth 8 x)) + + (defun tenth (x) + "Return the tenth element of the list LIST." + (nth 9 x)) + + (defun caar (x) + "Return the `car' of the `car' of X." + (car (car x))) + + (defun cadr (x) + "Return the `car' of the `cdr' of X." + (car (cdr x))) + + (defun cdar (x) + "Return the `cdr' of the `car' of X." + (cdr (car x))) + + (defun cddr (x) + "Return the `cdr' of the `cdr' of X." + (cdr (cdr x))) + + (defun caaar (x) + "Return the `car' of the `car' of the `car' of X." + (car (car (car x)))) + + (defun caadr (x) + "Return the `car' of the `car' of the `cdr' of X." + (car (car (cdr x)))) + + (defun cadar (x) + "Return the `car' of the `cdr' of the `car' of X." + (car (cdr (car x)))) + + (defun caddr (x) + "Return the `car' of the `cdr' of the `cdr' of X." + (car (cdr (cdr x)))) + + (defun cdaar (x) + "Return the `cdr' of the `car' of the `car' of X." + (cdr (car (car x)))) + + (defun cdadr (x) + "Return the `cdr' of the `car' of the `cdr' of X." + (cdr (car (cdr x)))) + + (defun cddar (x) + "Return the `cdr' of the `cdr' of the `car' of X." + (cdr (cdr (car x)))) + + (defun cdddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of X." + (cdr (cdr (cdr x)))) + + (defun caaaar (x) + "Return the `car' of the `car' of the `car' of the `car' of X." + (car (car (car (car x))))) + + (defun caaadr (x) + "Return the `car' of the `car' of the `car' of the `cdr' of X." + (car (car (car (cdr x))))) + + (defun caadar (x) + "Return the `car' of the `car' of the `cdr' of the `car' of X." + (car (car (cdr (car x))))) + + (defun caaddr (x) + "Return the `car' of the `car' of the `cdr' of the `cdr' of X." + (car (car (cdr (cdr x))))) + + (defun cadaar (x) + "Return the `car' of the `cdr' of the `car' of the `car' of X." + (car (cdr (car (car x))))) + + (defun cadadr (x) + "Return the `car' of the `cdr' of the `car' of the `cdr' of X." + (car (cdr (car (cdr x))))) + + (defun caddar (x) + "Return the `car' of the `cdr' of the `cdr' of the `car' of X." + (car (cdr (cdr (car x))))) + + (defun cadddr (x) + "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X." + (car (cdr (cdr (cdr x))))) + + (defun cdaaar (x) + "Return the `cdr' of the `car' of the `car' of the `car' of X." + (cdr (car (car (car x))))) + + (defun cdaadr (x) + "Return the `cdr' of the `car' of the `car' of the `cdr' of X." + (cdr (car (car (cdr x))))) + + (defun cdadar (x) + "Return the `cdr' of the `car' of the `cdr' of the `car' of X." + (cdr (car (cdr (car x))))) + + (defun cdaddr (x) + "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X." + (cdr (car (cdr (cdr x))))) + + (defun cddaar (x) + "Return the `cdr' of the `cdr' of the `car' of the `car' of X." + (cdr (cdr (car (car x))))) + + (defun cddadr (x) + "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X." + (cdr (cdr (car (cdr x))))) + + (defun cdddar (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X." + (cdr (cdr (cdr (car x))))) + + (defun cddddr (x) + "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X." + (cdr (cdr (cdr (cdr x))))) + + (defun last (x &optional n) + "Returns the last link in the list LIST. + With optional argument N, returns Nth-to-last link (default 1)." + (if n + (let ((m 0) (p x)) + (while (consp p) (incf m) (pop p)) + (if (<= n 0) p + (if (< n m) (nthcdr (- m n) x) x))) + (while (consp (cdr x)) (pop x)) + x)) + + (defun butlast (x &optional n) + "Returns a copy of LIST with the last N elements removed." + (if (and n (<= n 0)) x + (nbutlast (copy-sequence x) n))) + + (defun nbutlast (x &optional n) + "Modifies LIST to remove the last N elements." + (let ((m (length x))) + (or n (setq n 1)) + (and (< n m) + (progn + (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) + x)))) + + (defun list* (arg &rest rest) ; See compiler macro in cl-macs.el + "Return a new list with specified args as elements, cons'd to last arg. + Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to + `(cons A (cons B (cons C D)))'." + (cond ((not rest) arg) + ((not (cdr rest)) (cons arg (car rest))) + (t (let* ((n (length rest)) + (copy (copy-sequence rest)) + (last (nthcdr (- n 2) copy))) + (setcdr last (car (cdr last))) + (cons arg copy))))) + + (defun ldiff (list sublist) + "Return a copy of LIST with the tail SUBLIST removed." + (let ((res nil)) + (while (and (consp list) (not (eq list sublist))) + (push (pop list) res)) + (nreverse res))) + + (defun copy-list (list) + "Return a copy of a list, which may be a dotted list. + The elements of the list are not copied, just the list structure itself." + (if (consp list) + (let ((res nil)) + (while (consp list) (push (pop list) res)) + (prog1 (nreverse res) (setcdr res list))) + (car list))) + + (defun cl-maclisp-member (item list) + (while (and list (not (equal item (car list)))) (setq list (cdr list))) + list) + + ;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users. + (or (and (fboundp 'member) (subrp (symbol-function 'member))) + (defalias 'member 'cl-maclisp-member)) + + (defalias 'cl-member 'memq) ; for compatibility with old CL package + (defalias 'cl-floor 'floor*) + (defalias 'cl-ceiling 'ceiling*) + (defalias 'cl-truncate 'truncate*) + (defalias 'cl-round 'round*) + (defalias 'cl-mod 'mod*) + + (defun adjoin (cl-item cl-list &rest cl-keys) ; See compiler macro in cl-macs + "Return ITEM consed onto the front of LIST only if it's not already there. + Otherwise, return LIST unmodified. + Keywords supported: :test :test-not :key" + (cond ((or (equal cl-keys '(:test eq)) + (and (null cl-keys) (not (numberp cl-item)))) + (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) + ((or (equal cl-keys '(:test equal)) (null cl-keys)) + (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) + (t (apply 'cl-adjoin cl-item cl-list cl-keys)))) + + (defun subst (cl-new cl-old cl-tree &rest cl-keys) + "Substitute NEW for OLD everywhere in TREE (non-destructively). + Return a copy of TREE with all elements `eql' to OLD replaced by NEW. + Keywords supported: :test :test-not :key" + (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) + (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys) + (cl-do-subst cl-new cl-old cl-tree))) + + (defun cl-do-subst (cl-new cl-old cl-tree) + (cond ((eq cl-tree cl-old) cl-new) + ((consp cl-tree) + (let ((a (cl-do-subst cl-new cl-old (car cl-tree))) + (d (cl-do-subst cl-new cl-old (cdr cl-tree)))) + (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) + cl-tree (cons a d)))) + (t cl-tree))) + + (defun acons (a b c) (cons (cons a b) c)) + (defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c)) + + + ;;; Miscellaneous. + + (put 'cl-assertion-failed 'error-conditions '(error)) + (put 'cl-assertion-failed 'error-message "Assertion failed") + + ;;; This is defined in Emacs 19; define it here for Emacs 18 users. + (defun cl-add-hook (hook func &optional append) + "Add to hook variable HOOK the function FUNC. + FUNC is not added if it already appears on the list stored in HOOK." + (let ((old (and (boundp hook) (symbol-value hook)))) + (and (listp old) (not (eq (car old) 'lambda)) + (setq old (list old))) + (and (not (member func old)) + (set hook (if append (nconc old (list func)) (cons func old)))))) + (or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook)) + + + ;;; Autoload the other portions of the package. + (mapcar (function + (lambda (set) + (mapcar (function + (lambda (func) + (autoload func (car set) nil nil (nth 1 set)))) + (cddr set)))) + '(("cl-extra" nil + coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon + cl-map-keymap cl-map-keymap-recursively cl-map-intervals + cl-map-overlays cl-set-frame-visible-p cl-float-limits + gcd lcm isqrt expt floor* ceiling* truncate* round* + mod* rem* signum random* make-random-state random-state-p + subseq concatenate cl-mapcar-many map some every notany + notevery revappend nreconc list-length tailp copy-tree get* getf + cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup + gethash cl-puthash remhash clrhash maphash hash-table-p + hash-table-count cl-progv-before cl-prettyexpand + cl-macroexpand-all) + ("cl-seq" nil + reduce fill replace remq remove remove* remove-if remove-if-not + delete delete* delete-if delete-if-not remove-duplicates + delete-duplicates substitute substitute-if substitute-if-not + nsubstitute nsubstitute-if nsubstitute-if-not find find-if + find-if-not position position-if position-if-not count count-if + count-if-not mismatch search sort* stable-sort merge member* + member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not + rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection + nintersection set-difference nset-difference set-exclusive-or + nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if + nsubst-if-not sublis nsublis tree-equal) + ("cl-macs" nil + gensym gentemp typep cl-do-pop get-setf-method + cl-struct-setf-expander compiler-macroexpand cl-compile-time-init) + ("cl-macs" t + defun* defmacro* function* destructuring-bind eval-when + eval-when-compile load-time-value case ecase typecase etypecase + block return return-from loop do do* dolist dotimes do-symbols + do-all-symbols psetq progv flet labels macrolet symbol-macrolet + lexical-let lexical-let* multiple-value-bind multiple-value-setq + locally the declare define-setf-method defsetf define-modify-macro + setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct + check-type assert ignore-errors define-compiler-macro))) + + ;;; Define data for indentation and edebug. + (mapcar (function + (lambda (entry) + (mapcar (function + (lambda (func) + (put func 'lisp-indent-function (nth 1 entry)) + (put func 'lisp-indent-hook (nth 1 entry)) + (or (get func 'edebug-form-spec) + (put func 'edebug-form-spec (nth 2 entry))))) + (car entry)))) + '(((defun* defmacro*) 2) + ((function*) nil + (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form))) + ((eval-when) 1 (sexp &rest form)) + ((when unless) 1 (&rest form)) + ((declare) nil (&rest sexp)) + ((the) 1 (sexp &rest form)) + ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form))) + ((block return-from) 1 (sexp &rest form)) + ((return) nil (&optional form)) + ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form)) + (form &rest form) + &rest form)) + ((dolist dotimes) 1 ((symbolp form &rest form) &rest form)) + ((do-symbols) 1 ((symbolp form &optional form form) &rest form)) + ((do-all-symbols) 1 ((symbolp form &optional form) &rest form)) + ((psetq setf psetf) nil edebug-setq-form) + ((progv) 2 (&rest form)) + ((flet labels macrolet) 1 + ((&rest (sexp sexp &rest form)) &rest form)) + ((symbol-macrolet lexical-let lexical-let*) 1 + ((&rest &or symbolp (symbolp form)) &rest form)) + ((multiple-value-bind) 2 ((&rest symbolp) &rest form)) + ((multiple-value-setq) 1 ((&rest symbolp) &rest form)) + ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form)) + ((letf letf*) 1 ((&rest (&rest form)) &rest form)) + ((callf destructuring-bind) 2 (sexp form &rest form)) + ((callf2) 3 (sexp form form &rest form)) + ((loop) nil (&rest &or symbolp form)) + ((ignore-errors) 0 (&rest form)))) + + + ;;; This goes here so that cl-macs can find it if it loads right now. + (provide 'cl-19) ; usage: (require 'cl-19 "cl") + + + ;;; Things to do after byte-compiler is loaded. + ;;; As a side effect, we cause cl-macs to be loaded when compiling, so + ;;; that the compiler-macros defined there will be present. + + (defvar cl-hacked-flag nil) + (defun cl-hack-byte-compiler () + (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form)) + (progn + (cl-compile-time-init) ; in cl-macs.el + (setq cl-hacked-flag t)))) + + ;;; Try it now in case the compiler has already been loaded. + (cl-hack-byte-compiler) + + ;;; Also make a hook in case compiler is loaded after this file. + ;;; The compiler doesn't call any hooks when it loads or runs, but + ;;; we can take advantage of the fact that emacs-lisp-mode will be + ;;; called when the compiler reads in the file to be compiled. + ;;; BUG: If the first compilation is `byte-compile' rather than + ;;; `byte-compile-file', we lose. Oh, well. + (add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler) + + + ;;; The following ensures that packages which expect the old-style cl.el + ;;; will be happy with this one. + + (provide 'cl) + + (provide 'mini-cl) ; for Epoch + + (run-hooks 'cl-load-hook) + + ;;; cl.el ends here diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/comint.el emacs-19.18/lisp/comint.el *** emacs-19.17/lisp/comint.el Fri Jul 16 16:28:37 1993 --- emacs-19.18/lisp/comint.el Sun Aug 8 20:52:08 1993 *************** *** 283,287 **** (define-key comint-mode-map "\C-c\C-p" 'comint-prev-prompt) (define-key comint-mode-map "\C-c\C-d" 'comint-send-eof) - (define-key comint-mode-map "\C-c\C-y" 'comint-previous-input) ;v18 binding ) --- 283,286 ---- *************** *** 1170,1174 **** (ding)) ((eql completion t) ! (message "Unique completion")) (t ; this means a string was returned. (delete-region (match-beginning 0) (match-end 0)) --- 1169,1173 ---- (ding)) ((eql completion t) ! (message "Sole completion")) (t ; this means a string was returned. (delete-region (match-beginning 0) (match-end 0)) *************** *** 1182,1198 **** it just adds completion characters to the end of the filename." (interactive) ! (let* ((pathname (comint-match-partial-pathname)) ! (pathdir (file-name-directory pathname)) ! (pathnondir (file-name-nondirectory pathname)) ! (completion (file-name-completion pathnondir ! (or pathdir default-directory)))) ! (cond ((null completion) ! (message "No completions of %s" pathname) ! (ding)) ! ((eql completion t) ! (message "Unique completion")) ! (t ; this means a string was returned. ! (goto-char (match-end 0)) ! (insert (substring completion (length pathnondir))))))) (defun comint-dynamic-list-completions () --- 1181,1208 ---- it just adds completion characters to the end of the filename." (interactive) ! (if (and (interactive-p) ! (eq last-command this-command)) ! ;; If you hit TAB twice in a row, you get a completion list. ! (comint-dynamic-list-completions) ! (let* ((pathname (comint-match-partial-pathname)) ! (pathdir (file-name-directory pathname)) ! (pathnondir (file-name-nondirectory pathname)) ! (completion (file-name-completion ! pathnondir ! ;; It is important to expand PATHDIR because ! ;; default-directory might be a handled name, and the ! ;; unexpanded PATHDIR won't necessarily match the ! ;; handler regexp. ! (if pathdir ! (expand-file-name pathdir) ! default-directory)))) ! (cond ((null completion) ! (message "No completions of %s" pathname) ! (ding)) ! ((eql completion t) ! (message "Sole completion")) ! (t ; this means a string was returned. ! (goto-char (match-end 0)) ! (insert (substring completion (length pathnondir)))))))) (defun comint-dynamic-list-completions () *************** *** 1204,1208 **** (completions (file-name-all-completions pathnondir ! (or pathdir default-directory)))) (cond ((null completions) (message "No completions of %s" pathname) --- 1214,1220 ---- (completions (file-name-all-completions pathnondir ! (if pathdir ! (expand-file-name pathdir) ! default-directory)))) (cond ((null completions) (message "No completions of %s" pathname) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/compile.el emacs-19.18/lisp/compile.el *** emacs-19.17/lisp/compile.el Wed Jul 14 23:08:05 1993 --- emacs-19.18/lisp/compile.el Tue Aug 3 17:35:45 1993 *************** *** 40,49 **** (defvar compilation-error-list nil "List of error message descriptors for visiting erring functions. ! Each error descriptor is a cons (or nil). Its car is a marker ! pointing to an error message. If its cdr is a marker, it points to ! the text of the line the message is about. If its cdr is a cons, that ! cons's car is the name of the file the message is about, and its cdr ! is the number of the line the message is about. Or its cdr may be nil ! if that error is not interesting. The value may be t instead of a list; this means that the buffer of --- 40,49 ---- (defvar compilation-error-list nil "List of error message descriptors for visiting erring functions. ! Each error descriptor is a cons (or nil). Its car is a marker pointing to ! an error message. If its cdr is a marker, it points to the text of the ! line the message is about. If its cdr is a cons, that cons's car is a cons ! \(DIRECTORY . FILE\), specifying the file the message is about, and its cdr ! is the number of the line the message is about. Or its cdr may be nil if ! that error is not interesting. The value may be t instead of a list; this means that the buffer of *************** *** 138,142 **** ;; IBM RS6000: ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error. ! ("\"\\([^,\" \n\t]+\\)\", line \\([0-9]+\\)[:.]" 1 2) ;; MIPS RISC CC - the one distributed with Ultrix: --- 138,144 ---- ;; IBM RS6000: ;; "vvouch.c", line 19.5: 1506-046 (S) Syntax error. ! ;; Unknown compiler: ! ;; File "foobar.ml", lines 5-8, characters 20-155: blah blah ! ("\"\\([^,\" \n\t]+\\)\", lines? \\([0-9]+\\)[:.,-]" 1 2) ;; MIPS RISC CC - the one distributed with Ultrix: *************** *** 390,393 **** --- 392,396 ---- In this minor mode, all the error-parsing commands of the Compilation major mode are available.") + (make-variable-buffer-local 'compilation-minor-mode) (or (assq 'compilation-minor-mode minor-mode-alist) *************** *** 399,402 **** --- 402,406 ---- minor-mode-map-alist))) + ;;;###autoload (defun compilation-minor-mode (&optional arg) "Toggle compilation minor mode. *************** *** 508,517 **** ! (defun compile-file-of-error (data) (setq data (cdr data)) (if (markerp data) ! (buffer-file-name (marker-buffer data)) (car data))) (defun compilation-next-file (n) "Move point to the next error for a different file than the current one." --- 512,532 ---- ! ;; Given an elt of `compilation-error-list', return an object representing ! ;; the referenced file which is equal to (but not necessarily eq to) what ! ;; this function would return for another error in the same file. ! (defsubst compilation-error-filedata (data) (setq data (cdr data)) (if (markerp data) ! (marker-buffer data) (car data))) + ;; Return a string describing a value from compilation-error-filedata. + ;; This value is not necessarily useful as a file name, but should be + ;; indicative to the user of what file's errors are being referred to. + (defsubst compilation-error-filedata-file-name (filedata) + (if (bufferp filedata) + (buffer-file-name filedata) + (car filedata))) + (defun compilation-next-file (n) "Move point to the next error for a different file than the current one." *************** *** 522,526 **** (let ((reversed (< n 0)) ! errors file) (if (not reversed) --- 537,541 ---- (let ((reversed (< n 0)) ! errors filedata) (if (not reversed) *************** *** 540,556 **** (while (> n 0) ! (setq file (compile-file-of-error (car errors))) ! ;; Skip past the other errors for this file. ! (while (string= file ! (compile-file-of-error ! (car (or errors ! (if reversed ! (error "%s the first erring file" file) ! (let ((compilation-error-list nil)) ! ;; Parse some more. ! (compile-reinitialize-errors nil nil 2) ! (setq errors compilation-error-list))) ! (error "%s is the last erring file" file))))) (setq errors (cdr errors))) --- 555,575 ---- (while (> n 0) ! (setq filedata (compilation-error-filedata (car errors))) ! ;; Skip past the following errors for this file. ! (while (equal filedata ! (compilation-error-filedata ! (car (or errors ! (if reversed ! (error "%s the first erring file" ! (compilation-error-filedata-file-name ! filedata)) ! (let ((compilation-error-list nil)) ! ;; Parse some more. ! (compile-reinitialize-errors nil nil 2) ! (setq errors compilation-error-list))) ! (error "%s is the last erring file" ! (compilation-error-filedata-file-name ! filedata)))))) (setq errors (cdr errors))) *************** *** 742,749 **** ;; This error has a filename/lineno pair. ;; Find the file and turn it into a marker. ! (let* ((fileinfo ! (cons (file-name-directory (car (cdr next-error))) ! (file-name-nondirectory ! (car (cdr next-error))))) (buffer (compilation-find-file (cdr fileinfo) (car fileinfo) --- 761,765 ---- ;; This error has a filename/lineno pair. ;; Find the file and turn it into a marker. ! (let* ((fileinfo (car (cdr next-error))) (buffer (compilation-find-file (cdr fileinfo) (car fileinfo) *************** *** 1031,1040 **** (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes (filename ! (save-excursion ! (goto-char (match-end (nth 1 alist))) ! (skip-chars-backward " \t") ! (let ((name (buffer-substring (match-beginning (nth 1 alist)) ! (point)))) ! (expand-file-name name default-directory)))) (linenum (save-restriction (narrow-to-region --- 1047,1053 ---- (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes (filename ! (cons default-directory ! (buffer-substring (match-beginning (nth 1 alist)) ! (match-end (nth 1 alist))))) (linenum (save-restriction (narrow-to-region diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/completion.el emacs-19.18/lisp/completion.el *** emacs-19.17/lisp/completion.el Thu Jun 17 18:47:41 1993 --- emacs-19.18/lisp/completion.el Tue Aug 3 01:46:12 1993 *************** *** 1,69 **** ;;; completion.el --- dynamic word-completion code ;; Maintainer: FSF ;; Keywords: abbrev ! ;;; Commentary: ! ;;; This is a Completion system for GNU Emacs ! ;;; ! ;;; E-Mail: ! ;;; Internet: completion@think.com, bug-completion@think.com ! ;;; UUCP: {rutgers,harvard,mit-eddie}!think!completion ! ;;; ! ;;; If you are a new user, we'd appreciate knowing your site name and ! ;;; any comments you have. ! ;;; ! ;;; ! ;;; NO WARRANTY ! ;;; ! ;;; This software is distributed free of charge and is in the public domain. ! ;;; Anyone may use, duplicate or modify this program. Thinking Machines ! ;;; Corporation does not restrict in any way the use of this software by ! ;;; anyone. ! ;;; ! ;;; Thinking Machines Corporation provides absolutely no warranty of any kind. ! ;;; The entire risk as to the quality and performance of this program is with ! ;;; you. In no event will Thinking Machines Corporation be liable to you for ! ;;; damages, including any lost profits, lost monies, or other special, ! ;;; incidental or consequential damages arising out of the use of this program. ! ;;; ! ;;; You must not restrict the distribution of this software. ! ;;; ! ;;; Please keep this notice and author information in any copies you make. ! ;;; ! ;;; 4/90 ! ;;; ! ;;; ! ;;; Advertisement ! ;;;--------------- ! ;;; Try using this. If you are like most you will be happy you did. ;;; ;;; What to put in .emacs ;;;----------------------- ! ;;; (load "completion") ;; If it's not part of the standard band. ;;; (initialize-completions) - ;;; - ;;; For best results, be sure to byte-compile the file first. - ;;; - - ;;; Authors - ;;;--------- - ;;; Jim Salem {salem@think.com} - ;;; Brewster Kahle {brewster@think.com} - ;;; Thinking Machines Corporation - ;;; 245 First St., Cambridge MA 02142 (617) 876-1111 - ;;; - ;;; Mailing Lists - ;;;--------------- - ;;; - ;;; Bugs to bug-completion@think.com - ;;; Comments to completion@think.com - ;;; Requests to be added completion-request@think.com - ;;; - ;;; Availability - ;;;-------------- - ;;; Anonymous FTP from think.com - ;;; ;;;--------------------------------------------------------------------------- --- 1,32 ---- ;;; completion.el --- dynamic word-completion code + ;; Copyright (C) 1990, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: abbrev + ;; Author: Jim Salem and Brewster Kahle + ;; of Thinking Machines 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, 675 Mass Ave, Cambridge, MA 02139, USA. ! ! ;;; Commentary: ;;; ;;; What to put in .emacs ;;;----------------------- ! ;;; (load "completion") ;;; (initialize-completions) ;;;--------------------------------------------------------------------------- *************** *** 415,422 **** (window-minibuffer-p (selected-window))) (defmacro cmpl-read-time-eval (form) ! ;; Like the #. reader macro ! (eval form)) ! ;;;----------------------------------------------- --- 378,384 ---- (window-minibuffer-p (selected-window))) + ;; This used to be `(eval form)'. Eval FORM at run time now. (defmacro cmpl-read-time-eval (form) ! form) ;;;----------------------------------------------- *************** *** 482,487 **** (defun cmpl-hours-since-origin () (let ((time (current-time))) ! (+ (* (/ (car time) 3600.0) (lsh 1 16)) ! (/ (nth 2 time) 3600.0)))) ;;;--------------------------------------------------------------------------- --- 444,450 ---- (defun cmpl-hours-since-origin () (let ((time (current-time))) ! (truncate ! (+ (* (/ (car time) 3600.0) (lsh 1 16)) ! (/ (nth 2 time) 3600.0))))) ;;;--------------------------------------------------------------------------- *************** *** 1617,1621 **** (setq cmpl-starting-possibilities (cmpl-prefix-entry-head ! (find-cmpl-prefix-entry (downcase (substring string 0 3)))) cmpl-test-string string cmpl-test-regexp (concat (regexp-quote string) ".")) --- 1580,1585 ---- (setq cmpl-starting-possibilities (cmpl-prefix-entry-head ! (find-cmpl-prefix-entry ! (downcase (substring string 0 completion-prefix-min-length)))) cmpl-test-string string cmpl-test-regexp (concat (regexp-quote string) ".")) *************** *** 1868,1872 **** (setq completion-to-accept nil) ;; print message ! (if (and print-status-p (cmpl19-sit-for 0)) (message "No %scompletions." (if (eq this-command last-command) "more " ""))) --- 1832,1838 ---- (setq completion-to-accept nil) ;; print message ! ;; This used to call cmpl19-sit-for, an undefined function. ! ;; I hope that sit-for does the right thing; I don't know -- rms. ! (if (and print-status-p (sit-for 0)) (message "No %scompletions." (if (eq this-command last-command) "more " ""))) *************** *** 2219,2222 **** --- 2185,2193 ---- )) + ;; There is no point bothering to change this again + ;; unless the package changes so much that it matters + ;; for people that have saved completions. + (defconst completion-version "11") + (defconst saved-cmpl-file-header ";;; Completion Initialization file. *************** *** 2269,2273 **** (erase-buffer) ;; (/ 1 0) ! (insert (format saved-cmpl-file-header *completion-version*)) (dolist (completion (list-all-completions)) (setq total-in-db (1+ total-in-db)) --- 2240,2244 ---- (erase-buffer) ;; (/ 1 0) ! (insert (format saved-cmpl-file-header completion-version)) (dolist (completion (list-all-completions)) (setq total-in-db (1+ total-in-db)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cookie1.el emacs-19.18/lisp/cookie1.el *** emacs-19.17/lisp/cookie1.el Wed Jul 14 19:34:31 1993 --- emacs-19.18/lisp/cookie1.el Sun Aug 1 16:50:07 1993 *************** *** 31,36 **** ;; ;; The two entry points are `cookie' and `cookie-insert'. The helper ! ;; functions `pick-random' and `shuffle-vector' may be of interest to ! ;; programmers. ;; ;; The code expects phrase files to be in one of two formats: --- 31,35 ---- ;; ;; The two entry points are `cookie' and `cookie-insert'. The helper ! ;; function `shuffle-vector' may be of interest to programmers. ;; ;; The code expects phrase files to be in one of two formats: *************** *** 64,67 **** --- 63,67 ---- "Cache of cookie files that have already been snarfed.") + ;;;###autoload (defun cookie (phrase-file startmsg endmsg) "Return a random phrase from PHRASE-FILE. When the phrase file *************** *** 71,74 **** --- 71,75 ---- (aref cookie-vector 1))) + ;;;###autoload (defun cookie-insert (phrase-file &optional count startmsg endmsg) "Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file *************** *** 89,92 **** --- 90,94 ---- (cookie1 (1- arg) cookie-vec)))) + ;;;###autoload (defun cookie-snarf (phrase-file startmsg endmsg) "Reads in the PHRASE-FILE, returns it as a vector of strings. Emit *************** *** 119,126 **** (set sym (apply 'vector result))))))) - (defun pick-random (n) - "Returns a random number from 0 to N-1 inclusive." - (% (logand 0777777 (random)) n)) - ; Thanks to Ian G Batten ; [of the University of Birmingham Computer Science Department] --- 121,124 ---- *************** *** 127,130 **** --- 125,129 ---- ; for the iterative version of this shuffle. ; + ;;;###autoload (defun shuffle-vector (vector) "Randomly permute the elements of VECTOR (all permutations equally likely)" *************** *** 134,138 **** (len (length vector))) (while (< i len) ! (setq j (+ i (pick-random (- len i)))) (setq temp (aref vector i)) (aset vector i (aref vector j)) --- 133,137 ---- (len (length vector))) (while (< i len) ! (setq j (+ i (random (- len i)))) (setq temp (aref vector i)) (aset vector i (aref vector j)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/cplus-md.el emacs-19.18/lisp/cplus-md.el *** emacs-19.17/lisp/cplus-md.el Thu Jun 17 03:02:49 1993 --- emacs-19.18/lisp/cplus-md.el Tue Jul 27 12:55:03 1993 *************** *** 124,130 **** () (setq c++-mode-syntax-table (copy-syntax-table c-mode-syntax-table)) ! (modify-syntax-entry ?/ ". 12" c++-mode-syntax-table) ! (modify-syntax-entry ?\n ">" c++-mode-syntax-table) ! (modify-syntax-entry ?\' "." c++-mode-syntax-table)) (defvar c++-continued-member-init-offset nil --- 124,130 ---- () (setq c++-mode-syntax-table (copy-syntax-table c-mode-syntax-table)) ! (modify-syntax-entry ?* ". 23b" c++-mode-syntax-table) ! (modify-syntax-entry ?/ ". 124" c++-mode-syntax-table) ! (modify-syntax-entry ?\n ">" c++-mode-syntax-table)) (defvar c++-continued-member-init-offset nil diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/diary.el emacs-19.18/lisp/diary.el *** emacs-19.17/lisp/diary.el Sun Jun 20 13:17:29 1993 --- emacs-19.18/lisp/diary.el Wed Aug 4 19:00:25 1993 *************** *** 43,47 **** If no argument is provided, the number of days of diary entries is governed by the variable `number-of-diary-entries'. This function is suitable for ! execution in a .emacs file." (interactive "P") (let ((d-file (substitute-in-file-name diary-file)) --- 43,47 ---- If no argument is provided, the number of days of diary entries is governed by the variable `number-of-diary-entries'. This function is suitable for ! execution in a `.emacs' file." (interactive "P") (let ((d-file (substitute-in-file-name diary-file)) *************** *** 61,67 **** (defun view-diary-entries (arg) "Prepare and display a buffer with diary entries. ! Searches the file diary-file for entries that match ARG days starting with ! the date indicated by the cursor position in the displayed three-month ! calendar." (interactive "p") (let ((d-file (substitute-in-file-name diary-file))) --- 61,67 ---- (defun view-diary-entries (arg) "Prepare and display a buffer with diary entries. ! Searches the file named in `diary-file' for entries that ! match ARG days starting with the date indicated by the cursor position ! in the displayed three-month calendar." (interactive "p") (let ((d-file (substitute-in-file-name diary-file))) *************** *** 77,81 **** "Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. ! The holidays are those in the list calendar-holidays." t) --- 77,81 ---- "Check the list of holidays for any that occur on DATE. The value returned is a list of strings of relevant holiday descriptions. ! The holidays are those in the list `calendar-holidays'." t) *************** *** 83,87 **** (autoload 'calendar-holiday-list "holidays" "Form the list of holidays that occur on dates in the calendar window. ! The holidays are those in the list calendar-holidays." t) --- 83,87 ---- (autoload 'calendar-holiday-list "holidays" "Form the list of holidays that occur on dates in the calendar window. ! The holidays are those in the list `calendar-holidays'." t) *************** *** 125,130 **** After the list is prepared, the hooks `nongregorian-diary-listing-hook', ! `list-diary-entries-hook', and `diary-display-hook' are run. These hooks ! have the following distinct roles: `nongregorian-diary-listing-hook' can cull dates from the diary --- 125,130 ---- After the list is prepared, the hooks `nongregorian-diary-listing-hook', ! `list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run. ! These hooks have the following distinct roles: `nongregorian-diary-listing-hook' can cull dates from the diary *************** *** 134,142 **** `list-diary-entries-hook' adds or manipulates diary entries from external sources. Used, for example, to include diary entries ! from other files or to sort the diary entries. Invoked *once* only. ! `diary-display-hook' does the actual display of information. Could be ! used also for an appointment notification function." (if (< 0 number) (let* ((original-date date);; save for possible use in the hooks --- 134,148 ---- `list-diary-entries-hook' adds or manipulates diary entries from external sources. Used, for example, to include diary entries ! from other files or to sort the diary entries. Invoked *once* only, ! before the display hook is run. ! `diary-display-hook' does the actual display of information. If this is ! nil, simple-diary-display will be used. Use add-hook to set this to ! fancy-diary-display, if desired. If you want no diary display, use ! add-hook to set this to ignore. + `diary-hook' is run last. This can be used for an appointment + notification function." + (if (< 0 number) (let* ((original-date date);; save for possible use in the hooks *************** *** 240,245 **** (goto-char (point-min)) (run-hooks 'nongregorian-diary-listing-hook ! 'list-diary-entries-hook ! 'diary-display-hook) diary-entries-list)))) --- 246,254 ---- (goto-char (point-min)) (run-hooks 'nongregorian-diary-listing-hook ! 'list-diary-entries-hook) ! (if diary-display-hook ! (run-hooks 'diary-display-hook) ! (simple-diary-display)) ! (run-hooks 'diary-hook) diary-entries-list)))) *************** *** 246,256 **** (defun include-other-diary-files () "Include the diary entries from other diary files with those of diary-file. ! This function is suitable for use just before fancy-diary-display as the ! list-diary-entries-hook; it enables you to use shared diary files together ! with your own. The files included are specified in the diary-file by lines of ! the form #include \"filename\" This is recursive; that is, #include directives in diary files thus included ! are obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'." (goto-char (point-min)) --- 255,264 ---- (defun include-other-diary-files () "Include the diary entries from other diary files with those of diary-file. ! This function is suitable for use in `list-diary-entries-hook'; ! it enables you to use shared diary files together with your own. ! The files included are specified in the diaryfile by lines of this form: #include \"filename\" This is recursive; that is, #include directives in diary files thus included ! are obeyed. You can change the `#include' to some other string by changing the variable `diary-include-string'." (goto-char (point-min)) *************** *** 265,269 **** (diary-list-include-blanks nil) (list-diary-entries-hook 'include-other-diary-files) ! (diary-display-hook nil)) (if (file-exists-p diary-file) (if (file-readable-p diary-file) --- 273,278 ---- (diary-list-include-blanks nil) (list-diary-entries-hook 'include-other-diary-files) ! (diary-display-hook 'ignore) ! (diary-hook nil)) (if (file-exists-p diary-file) (if (file-readable-p diary-file) *************** *** 312,316 **** (defun fancy-diary-display () "Prepare a diary buffer with relevant entries in a fancy, noneditable form. ! This function is provided for optional use as the `list-diary-entries-hook'." (if (or (not diary-entries-list) (and (not (cdr diary-entries-list)) --- 321,325 ---- (defun fancy-diary-display () "Prepare a diary buffer with relevant entries in a fancy, noneditable form. ! This function is provided for optional use as the `diary-display-hook'." (if (or (not diary-entries-list) (and (not (cdr diary-entries-list)) *************** *** 443,448 **** (defun show-all-diary-entries () ! "Show all of the diary entries in the diary-file. ! This function gets rid of the selective display of the diary-file so that all entries, not just some, are visible. If there is no diary buffer, one is created." --- 452,457 ---- (defun show-all-diary-entries () ! "Show all of the diary entries in the diary file. ! This function gets rid of the selective display of the diary file so that all entries, not just some, are visible. If there is no diary buffer, one is created." *************** *** 489,494 **** (defun mark-diary-entries () "Mark days in the calendar window that have diary entries. ! Each entry in diary-file visible in the calendar window is marked. After the ! entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) --- 498,503 ---- (defun mark-diary-entries () "Mark days in the calendar window that have diary entries. ! Each entry in the diary file visible in the calendar window is marked. ! After the entries are marked, the hooks `nongregorian-diary-marking-hook' and `mark-diary-entries-hook' are run." (interactive) *************** *** 609,613 **** (defun mark-sexp-diary-entries () "Mark days in the calendar window that have sexp diary entries. ! Each entry in diary-file (or included files) visible in the calendar window is marked. See the documentation for the function `list-sexp-diary-entries'." (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) --- 618,622 ---- (defun mark-sexp-diary-entries () "Mark days in the calendar window that have sexp diary entries. ! Each entry in the diary file (or included files) visible in the calendar window is marked. See the documentation for the function `list-sexp-diary-entries'." (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol)) *************** *** 663,673 **** (defun mark-included-diary-files () ! "Mark the diary entries from other diary files with those of diary-file. ! This function is suitable for use as the mark-diary-entries-hook; it enables you to use shared diary files together with your own. The files included are ! specified in the diary-file by lines of the form #include \"filename\" This is recursive; that is, #include directives in diary files thus included ! are obeyed. You can change the \"#include\" to some other string by changing the variable `diary-include-string'." (goto-char (point-min)) --- 672,682 ---- (defun mark-included-diary-files () ! "Mark the diary entries from other diary files with those of the diary file. ! This function is suitable for use as the `mark-diary-entries-hook'; it enables you to use shared diary files together with your own. The files included are ! specified in the diary-file by lines of this form: #include \"filename\" This is recursive; that is, #include directives in diary files thus included ! are obeyed. You can change the `#include' to some other string by changing the variable `diary-include-string'." (goto-char (point-min)) *************** *** 717,721 **** (defun mark-calendar-date-pattern (month day year) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. ! A value of 0 in any position is a wild-card." (save-excursion (set-buffer calendar-buffer) --- 726,730 ---- (defun mark-calendar-date-pattern (month day year) "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR. ! A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) *************** *** 729,733 **** (defun mark-calendar-month (month year p-month p-day p-year) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. ! A value of 0 in any position of the pattern is a wild-card." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) --- 738,742 ---- (defun mark-calendar-month (month year p-month p-day p-year) "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR. ! A value of 0 in any position of the pattern is a wildcard." (if (or (and (= month p-month) (or (= p-year 0) (= year p-year))) *************** *** 781,787 **** (defun list-hebrew-diary-entries () ! "Add any Hebrew date entries from the diary-file to diary-entries-list. ! Hebrew date diary entries must be prefaced by a hebrew-diary-entry-symbol ! (normally an `H'). The same diary-date-forms govern the style of the Hebrew calendar entries, except that the Hebrew month names must be spelled in full. The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being --- 790,796 ---- (defun list-hebrew-diary-entries () ! "Add any Hebrew date entries from the diary file to `diary-entries-list'. ! Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol' ! (normally an `H'). The same diary date forms govern the style of the Hebrew calendar entries, except that the Hebrew month names must be spelled in full. The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being *************** *** 788,794 **** Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a common Hebrew year. If a Hebrew date diary entry begins with a ! diary-nonmarking-symbol the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with the ! nongregorian-diary-listing-hook." (if (< 0 number) (let ((buffer-read-only nil) --- 797,803 ---- Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a common Hebrew year. If a Hebrew date diary entry begins with a ! `diary-nonmarking-symbol', the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with the ! `nongregorian-diary-listing-hook'." (if (< 0 number) (let ((buffer-read-only nil) *************** *** 974,978 **** (defun mark-hebrew-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. ! A value of 0 in any position is a wild-card." (save-excursion (set-buffer calendar-buffer) --- 983,987 ---- (defun mark-hebrew-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR. ! A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) *************** *** 1047,1055 **** (defun list-sexp-diary-entries (date) ! "Add sexp entries for DATE from the diary-file to diary-entries-list. Also, Make them visible in the diary file. Returns t if any entries were found. ! Sexp diary entries must be prefaced by a sexp-diary-entry-symbol (normally `%%'). The form of a sexp diary entry is --- 1056,1064 ---- (defun list-sexp-diary-entries (date) ! "Add sexp entries for DATE from the diary file to `diary-entries-list'. Also, Make them visible in the diary file. Returns t if any entries were found. ! Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally `%%'). The form of a sexp diary entry is *************** *** 1405,1409 **** to be the name of the person. Date of death is on the *civil* calendar; although the date of death is specified by the civil calendar, the proper ! Hebrew calendar yahrzeit is determined. If european-calendar-style is t, the order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR." (let* ((h-date (calendar-hebrew-from-absolute --- 1414,1418 ---- to be the name of the person. Date of death is on the *civil* calendar; although the date of death is specified by the civil calendar, the proper ! Hebrew calendar yahrzeit is determined. If `european-calendar-style' is t, the order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR." (let* ((h-date (calendar-hebrew-from-absolute *************** *** 1526,1530 **** (defun add-to-diary-list (date string) ! "Add the entry (DATE STRING) to the diary-entries-list. Do nothing if DATE or STRING is nil." (and date string --- 1535,1539 ---- (defun add-to-diary-list (date string) ! "Add the entry (DATE STRING) to `diary-entries-list'. Do nothing if DATE or STRING is nil." (and date string *************** *** 1672,1684 **** (defun list-islamic-diary-entries () ! "Add any Islamic date entries from the diary-file to diary-entries-list. ! Islamic date diary entries must be prefaced by an islamic-diary-entry-symbol ! (normally an `I'). The same diary-date-forms govern the style of the Islamic calendar entries, except that the Islamic month names must be spelled in full. The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. If an Islamic date diary entry begins with a ! diary-nonmarking-symbol the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with the ! nongregorian-diary-listing-hook." (if (< 0 number) (let ((buffer-read-only nil) --- 1681,1693 ---- (defun list-islamic-diary-entries () ! "Add any Islamic date entries from the diary file to `diary-entries-list'. ! Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol' ! (normally an `I'). The same diary date forms govern the style of the Islamic calendar entries, except that the Islamic month names must be spelled in full. The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being Dhu al-Hijjah. If an Islamic date diary entry begins with a ! `diary-nonmarking-symbol', the entry will appear in the diary listing, but will not be marked in the calendar. This function is provided for use with the ! `nongregorian-diary-listing-hook'." (if (< 0 number) (let ((buffer-read-only nil) *************** *** 1861,1865 **** (defun mark-islamic-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. ! A value of 0 in any position is a wild-card." (save-excursion (set-buffer calendar-buffer) --- 1870,1874 ---- (defun mark-islamic-calendar-date-pattern (month day year) "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR. ! A value of 0 in any position is a wildcard." (save-excursion (set-buffer calendar-buffer) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/dired-aux.el emacs-19.18/lisp/dired-aux.el *** emacs-19.17/lisp/dired-aux.el Thu Jul 1 20:14:30 1993 --- emacs-19.18/lisp/dired-aux.el Sun Aug 8 00:54:29 1993 *************** *** 44,48 **** "Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. ! The prompted-for file is the first file given to `diff'." (interactive (let ((default (if (mark t) --- 44,50 ---- "Compare file at point with file FILE using `diff'. FILE defaults to the file at the mark. ! The prompted-for file is the first file given to `diff'. ! With prefix arg, prompt for second argument SWITCHES, ! which is options for `diff'." (interactive (let ((default (if (mark t) *************** *** 55,63 **** "")) (dired-current-directory) default t) ! (if (fboundp 'diff-read-switches) ! (diff-read-switches "Options for diff: "))))) ! (if switches ; Emacs 19's diff has but two ! (diff file (dired-get-filename t) switches) ; args (yet ;-) ! (diff file (dired-get-filename t)))) ;;;###autoload --- 57,66 ---- "")) (dired-current-directory) default t) ! (if current-prefix-arg ! (read-string "Options for diff: " ! (if (stringp diff-switches) ! diff-switches ! (mapconcat 'identity diff-switches " "))))))) ! (diff file (dired-get-filename t) switches)) ;;;###autoload *************** *** 66,75 **** Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. ! The backup file is the first file given to `diff'." ! (interactive (list (if (fboundp 'diff-read-switches) ! (diff-read-switches "Diff with switches: ")))) ! (if switches ! (diff-backup (dired-get-filename) switches) ! (diff-backup (dired-get-filename)))) (defun dired-do-chxxx (attribute-name program op-symbol arg) --- 69,82 ---- Uses the latest backup, if there are several numerical backups. If this file is a backup, diff it with its original. ! The backup file is the first file given to `diff'. ! With prefix arg, prompt for argument SWITCHES which is options for `diff'." ! (interactive ! (if current-prefix-arg ! (list (read-string "Options for diff: " ! (if (stringp diff-switches) ! diff-switches ! (mapconcat 'identity diff-switches " ")))) ! nil)) ! (diff-backup (dired-get-filename) switches)) (defun dired-do-chxxx (attribute-name program op-symbol arg) *************** *** 474,478 **** (new-file (dired-compress-file from-file))) (if new-file ! (progn (dired-update-file-line new-file) nil) (dired-log (concat "Failed to compress" from-file)) from-file))) --- 481,492 ---- (new-file (dired-compress-file from-file))) (if new-file ! (let ((start (point))) ! ;; Remove any preexisting entry for the name NEW-FILE. ! (condition-case nil ! (dired-remove-entry new-file) ! (error nil)) ! (goto-char start) ! ;; Now replace the current line with an entry for NEW-FILE. ! (dired-update-file-line new-file) nil) (dired-log (concat "Failed to compress" from-file)) from-file))) *************** *** 497,500 **** --- 511,522 ---- "gunzip" file)) (substring file 0 -3))) + ;; For .z, try gunzip. It might be an old gzip file, + ;; or it might be from compact? pack? (which?) but gunzip handles + ;; both. + ((let (case-fold-search) + (string-match "\\.z$" file)) + (if (not (dired-check-process (concat "Uncompressing " file) + "gunzip" file)) + (substring file 0 -3))) (t ;;; Try gzip; if we don't have that, use compress. *************** *** 502,506 **** (if (not (dired-check-process (concat "Compressing " file) "gzip" "-f" file)) ! (concat file ".gz")) (file-error (if (not (dired-check-process (concat "Compressing " file) --- 524,530 ---- (if (not (dired-check-process (concat "Compressing " file) "gzip" "-f" file)) ! (cond ((file-exists-p (concat file ".gz")) ! (concat file ".gz")) ! (t (concat file ".z")))) (file-error (if (not (dired-check-process (concat "Compressing " file) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/dired.el emacs-19.18/lisp/dired.el *** emacs-19.17/lisp/dired.el Mon Jul 12 23:57:11 1993 --- emacs-19.18/lisp/dired.el Sun Aug 1 07:54:17 1993 *************** *** 1,5 **** ;;; dired.el --- directory-browsing commands ! ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. ;; Author: Sebastian Kremer . --- 1,5 ---- ;;; dired.el --- directory-browsing commands ! ;; Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. ;; Author: Sebastian Kremer . *************** *** 490,494 **** (setq dirname (car dir-or-list)) (setq dirname dir-or-list)) ! (if (equal default-directory dirname) ;; i.e., (file-directory-p dirname) (dired-insert-directory dir-or-list dired-actual-switches nil t) (if (not (file-readable-p --- 490,496 ---- (setq dirname (car dir-or-list)) (setq dirname dir-or-list)) ! (if (and (equal default-directory dirname) ! (not (consp dir-or-list))) ! ;; If we are reading a whole single directory... (dired-insert-directory dir-or-list dired-actual-switches nil t) (if (not (file-readable-p *************** *** 495,500 **** (directory-file-name (file-name-directory dirname)))) (error "Directory %s inaccessible or nonexistent" dirname) ! ;; else assume it contains wildcards: ! (dired-insert-directory dir-or-list dired-actual-switches t) (save-excursion ;; insert wildcard instead of total line: (goto-char (point-min)) --- 497,504 ---- (directory-file-name (file-name-directory dirname)))) (error "Directory %s inaccessible or nonexistent" dirname) ! ;; Else assume it contains wildcards, ! ;; unless it is an explicit list of files. ! (dired-insert-directory dir-or-list dired-actual-switches ! (not (listp dir-or-list))) (save-excursion ;; insert wildcard instead of total line: (goto-char (point-min)) *************** *** 507,513 **** (if (consp dir-or-list) (progn ! (mapcar ! (function (lambda (x) (insert-directory x switches wildcard full-p))) ! (cdr dir-or-list))) (insert-directory dir-or-list switches wildcard full-p)) (setq dired-directory dir-or-list)) --- 511,517 ---- (if (consp dir-or-list) (progn ! (mapcar ! (function (lambda (x) (insert-directory x switches wildcard full-p))) ! (cdr dir-or-list))) (insert-directory dir-or-list switches wildcard full-p)) (setq dired-directory dir-or-list)) *************** *** 723,734 **** (define-key dired-mode-map "\C-xu" 'dired-undo) ) - - (or (member '(dired-sort-mode dired-sort-mode) minor-mode-alist) - ;; Test whether this has already been done in case dired is reloaded - ;; There may be several elements with dired-sort-mode as car. - (setq minor-mode-alist - (cons '(dired-sort-mode dired-sort-mode) - ;; dired-sort-mode is nil outside dired - minor-mode-alist))) ;; Make menu bar items. --- 727,730 ---- *************** *** 808,811 **** --- 804,809 ---- (define-key dired-mode-map [menu-bar mark marks] '("Change Marks..." . dired-change-marks)) + (define-key dired-mode-map [menu-bar mark unmark-all] + '("Unmark All" . dired-unmark-all-files-no-query)) (define-key dired-mode-map [menu-bar mark symlinks] '("Mark Symlinks" . dired-mark-symlinks)) *************** *** 816,824 **** (define-key dired-mode-map [menu-bar mark executables] '("Mark Executables" . dired-mark-executables)) ! (define-key dired-mode-map [menu-bar mark unmark-all] ! '("Unmark All" . dired-unmark-all-files)) ! (define-key dired-mode-map [menu-bar mark files] '("Flag Backup Files" . dired-flag-backup-files)) ! (define-key dired-mode-map [menu-bar mark files] '("Flag Auto-save Files" . dired-flag-auto-save-files)) (define-key dired-mode-map [menu-bar mark deletion] --- 814,820 ---- (define-key dired-mode-map [menu-bar mark executables] '("Mark Executables" . dired-mark-executables)) ! (define-key dired-mode-map [menu-bar mark backup-files] '("Flag Backup Files" . dired-flag-backup-files)) ! (define-key dired-mode-map [menu-bar mark auto-save-files] '("Flag Auto-save Files" . dired-flag-auto-save-files)) (define-key dired-mode-map [menu-bar mark deletion] *************** *** 948,952 **** (set (make-local-variable 'dired-actual-switches) (or switches dired-listing-switches)) - (make-local-variable 'dired-sort-mode) (dired-sort-other dired-actual-switches t) (run-hooks 'dired-mode-hook)) --- 944,947 ---- *************** *** 1912,1915 **** --- 1907,1915 ---- (match-end 0) old new)))))) + (defun dired-unmark-all-files-no-query () + "Remove all marks from all files in the Dired buffer." + (interactive) + (dired-unmark-all-files ?\r)) + (defun dired-unmark-all-files (mark &optional arg) "Remove a specific mark (or any mark) from every file. *************** *** 2008,2015 **** "Regexp recognized by dired to set `by name' mode.") - (defvar dired-sort-mode nil - "Whether Dired sorts by name, date etc. (buffer-local).") - ;; This is nil outside dired buffers so it can be used in the modeline - (defun dired-sort-set-modeline () ;; Set modeline display according to dired-actual-switches. --- 2008,2011 ---- *************** *** 2017,2028 **** ;; match with the corresponding regexps. Non-matching switches are ;; shown literally. ! (setq dired-sort-mode (let (case-fold-search) (cond ((string-match dired-sort-by-name-regexp dired-actual-switches) ! " by name") ((string-match dired-sort-by-date-regexp dired-actual-switches) ! " by date") (t ! (concat " " dired-actual-switches))))) ;; update mode line: (set-buffer-modified-p (buffer-modified-p))) --- 2013,2024 ---- ;; match with the corresponding regexps. Non-matching switches are ;; shown literally. ! (setq mode-name (let (case-fold-search) (cond ((string-match dired-sort-by-name-regexp dired-actual-switches) ! "Dired by name") ((string-match dired-sort-by-date-regexp dired-actual-switches) ! "Dired by date") (t ! (concat "Dired " dired-actual-switches))))) ;; update mode line: (set-buffer-modified-p (buffer-modified-p))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/dired.todo emacs-19.18/lisp/dired.todo *** emacs-19.17/lisp/dired.todo --- emacs-19.18/lisp/dired.todo Fri May 15 10:19:12 1992 *************** *** 0 **** --- 1,330 ---- + # file dired.todo -*-Outline-*- + + * Sandy's (sandy@itp.ethz.ch) main point is slowness when omitting + (which I use only on demand, and simply don't use if it'd be too + slow), so a transaction-free, reversible way of omitting by stashing + away the filenames would be good. + + Hiding could be used, but probably selective-display-ellipses should + be nil for omitting files, but t for hiding subdirectories, excluding + simultaneous use of hiding and omitting. This would not be a problem + if all subdirs had to be hidden together, but one subdir may be hidden + while in another the are files to be omitted. + + * REALLY have to split large shell commands. + + * Try to cope with ls -lF format like this: + + lrwxrwxrwx 1 dsmith 0 Mar 30 16:44 root@ + + Note the missing " -> ". + + * In dired shell command, provide a way to pass a `*' to the shell, + e.g., for grep. + + * kpc> well, here's an example. i'll have done a recursive find and grep, so + kpc> i'll have, say, 61 files out of 450 possible files in the buffer. if + kpc> i want to get them in time order and they are in size or name order, + kpc> what do i do? if i use s, i'll get 450 files! so much for the + kpc> grep.... on the other hand i can't see hitting l or c-u l 61 + kpc> times.... + + I see why you need this. And `l' or `C-u l' would be no good since it + always relists a complete subdirectory. + + kpc> redoing the ls with just the displayed files, if it works, would seem + kpc> to be the best. though i don't know if anytuhing can be done about + kpc> the consing. + + Well, if it only happens on demand, it's up to the user to decide + whether it's worth an additional garbarge collection or two. And for + your application of find-dired buffers, the list would not be very + big. + + * >>> On Tue, 24 Mar 92 09:37:17 EST, + >>> pinard%icule.UUCP@Larry.McRCIM.McGill.EDU (Francois Pinard) said: + + F> All the lines but the last have been hidden by dired-hide-all, while + F> the last was first added by dired-maybe-insert-subdir, then hidden by + F> dired-hide-subdir. It seems that dired-hide-all properly removes and + F> reinserts white lines when it hides or unhide directories, while + F> dired-hide-subdir does nothing about them. So, let me suggest that + F> dired-hide-subdir removes white lines which preceedes a directory + F> while hiding it, and that dired-hide-subdir insures one white line + F> before any hidden directory it expands. + + I think the problem rather lies with the insertion than the hiding. A + subdirectory extends from column zero of its headerline to just before + the next headerline or end-of-buffer*. This is the region where \r to + \n conversion must be done for hiding/unhiding**. The problem is that + when `i' appends something (call it DIR-NEW) after a hidden dir (call + it DIR-OLD) at the end of the buffer, that old dir does not end in a + blank line like all others do. So in the process of inserting the + contents of DIR-NEW it inserts an additional \n actually belonging to + DIR-OLD (that would have been converted to a \r had it been present + already when DIR-OLD was hidden). + + So a better fix is to have inserted dirs always end in a blank line, + even the one at the end of the buffer. This will perhaps also fix + some problems with nested dired format. Thank you for bringing this + to my attention. I would appreciate any further comments you have on + this. + + -Sebastian + + ---- + * This is an axiom. I programmed dired so that it would be that way, + so that the whole buffer would be a disjoint partition of + subdirectories. + + ** Minus the last character (a newline) --- or several hidden subdir + headerlines would all be in one hidden line. + + + * dired-visit-hooks each time when a dired buffer is visited. Could + be used to revert buffer each time if so desired. + + * let shell-command guessing based on regexps just be a special case + of classes of files. Classes would in general be defined by lisp + predicates evaluated on the file line in the dired buffer. Probably + they will call dired-get-filename, but they need not. A class + `directory' would be easy, for example. + + With a file class, not only a predicate (for deciding whether this + file line belongs to the class) but perhaps also a finder method (to + find all files of the class in this buffer) should be associated. + + File classes could be symbols (=names of boolean functions, or + rather objects with predicate as one associated method of the + object) or strings (regexps). Symbols should probably be of the + form `dired-file-class-*'. + + `File Classes' should perhaps also work in non-dired buffers + (->hyperbole!). + + `File Classes' could be a concept unifying omitting, shell command + guessing and coloring/highlighting of file names under X11. + + * let C-u C-u i prompt for the dir to be inserted (?) + + * let `0 ESC (' simply run PREDICATE witout parsing each marked line, + in case PREDICATE doesn't need this kind of extra information. + + * dired-between-files is not really safe, especially since it doesn't + know about find-dired.el's `find' line. + + * From: eggert@twinsun.com (Paul Eggert) + Subject: vc errors and nulldiff + Date: Tue, 14 Jan 92 15:00:54 PST + To: vc-friends@snark.thyrsus.com + + There are two questions attached to this topic. (1) Has anybody come up + with a simple robust way to retrieve the status of an Emacs 18 subprocess? + + Instead of invoking a command FOO ARG1 ... ARGn, you could invoke the command + + /bin/sh -c '"$0" ${1+"$@"}; echo \ + $?' FOO ARG1 ... ARGn + + This behaves just like FOO ARG1 ... ARGn, except instead of exiting with the + true exit status, it appends the exit status as text to the standard output. + The backslash-newline covers the case when the command's output does not end + in newline. + + * dired*.texi: use `selected files' for marked or next N files + + * get rid of rcs in dired-x, dired-rcs is much faster. + + * let dired-current-directory return default-directory if + dired-subdir-alist is nil (e.g. outside dired buffers, or in a not + yet completed find-dired buffer). + + * wildcards are not well integrated with dired, e.g. entries are added + to inappropriate buffers. + + * Use zero arg to `!' to just toggle a new dired-shell-command-on-each + variable for consistency? + + * [rms] Put everything for copying, renaming, etc. into a separate file again. + + Put just autoloads in this file for that stuff. + + Likewise, put everything concerned with inserting, killing, and + hiding subdirs into a separate file. For example, dired-tree-lessp + and dired-split can go there. + + These separate files are to make plain dired smaller for most people. + + * use map-ynp instead of dired-query. + + * + (defun dired-advertise () + ;;"Advertise in variable `dired-buffers' what directory we dired." + ;; With wildcards we actually advertise too much. + +;; @@ There is no need to do this. + +;; @@ Just check the subdir alist of the current buffer, + +;; @@ and verify the current buffer is in dired-buffers. + (if (memq (current-buffer) (dired-buffers-for-dir default-directory)) + + * [rms] I have an idea that might simplify dired. + + Suppose all nonempty non-file lines start with a particular character. + A character one would never use as a mark. + Then it would be very fast and simple to check for file lines. + No need for the slowness of looking for the filename. + + I suggest the character * or > or #. + + Thus, inserting a subdir would install this marker on the non-file + lines created. + + * shell command on several sets of markers: "diff A Z" Need quoting + then, and better recognize marker only when embedded in space? + + Separate from `!'? + + * let `[' enter a mode where the permission bits can be edited, and + let `]' exit that mode. Recursive edit? Keep list of filenames + where perms were edited? Or just one file at a time? + + * dired-tree-lessp should use file-newer-than-file-p instead of + string-lessp if sort on time? + + * dired-x: dired-mark-sexp (predicate &optional unflag-p) + + ;; As PREDICATE usually refers to only one or two fields, compiling + ;; it instead of computing all fields could be worth while. + + * dired-ls should perhaps do file-name-nondirectory by itself, as in + the only place where it lists a single file (in dired-add-entry) the + basename is constructed afterwards. + + * dired-string-replace-match should have a GLOBAL replace flag. + + * dired-view-file-other-window? dired-find-file-read-only ? + + * Use diff-backup from emacs-19. Move latest-backup-file into + emacs-19. + + * emacs-19.el's mkdir/rmdir commands should optionally accept a + log-buffer argument. + + * [davida%puma@sunic.sunet.se (David Axmark)] + + The things I want most in dired is a way to skip selective parts of + the -l listing (I use *long* filenames) from the listing swiches. As + think this would require a special 'ls' (a hotted up GNU ls?) and some + hacking of the buffer parsing code. It would be very nice to be able + to have a format with just date or size or ... + + Yes, I'd like that too (I use **very long** filenames). Accepting + ls switches without -l should not be too hard to implement. Hmm, no + permission bits at the beginning of each line might break some parts + of the code... But "just date" etc. would mean to prefobnicate ls + output each time it is inserted...though that might me done + efficiently if based on columns instead of regexps. I'll think + about it.. + + + * ls switches without -l shouldn't be that hard, though with loss of certain + features (like *@/ marking). + + It would clean the screen tremendously. + + [This is possible now, but not documented since not everything works + without -l, sk 14-May-1992 14:10] + + * move VM and RMAIL back into dired.el + + * `^' fails to find hidden parent dirlines. Other cmds too, probably. + Perhaps the goto cmds should optionally unhide their targets. + + * M-DEL should mention in the prompt if there are no flags to remove, + so it can be used for testing, too. + + + Musings + ======= + + * + From: jbw@maverick.uswest.com (Joe Wells) + Newsgroups: gnu.emacs.help,comp.emacs + Subject: Re: stupid (probably) elisp question + Date: 2 Aug 91 01:38:08 GMT + Organization: U S West Advanced Technologies + In-Reply-To: acevedo@athena.mit.edu's message of Wed, 31 Jul 91 14: 46:22 GMT + + (Gabriel) writes: + + | > [I would like to perform a regexp replacement on a string. + | > How is this possible short of using an intermediate buffer?] + | + | It's not. Silly, ain't it? After all, buffers are just big + | strings, albeit with a lot of state information attached. + + You could use string-match and concat to do the same thing, + without using buffers: + + Don't do this. Using a scratch buffer is much more efficient, and + results in less garbage collection later. + + Really? Why is this? + + 1. Replacing a substring in the middle of a string involves generating at + least three strings, possibly more if you're doing something really fancy + with regexps. Generating strings is expensive, both at the time they are + generated and later when they're garbage collected. Since these strings + are temporary, they are destined to be garbage collected. + + 2. Buffers are really fast. Once the gap is moved to the correct + location in the buffer, the replacement involves simply writing the new + bytes on top of the old bytes, even if the number of bytes changes. + Moving the gap is actually pretty cheap, especially if the contents of the + buffer are pretty small, like in this case. + + Just don't kill the buffer after you're done with it. Erase its contents + instead and leave it around for the next time your function is called. + + -- + Enjoy, + + Joe Wells + + + + + * [jwz] One thing I miss about Lispms is a function called + BALANCE-DIRECTORIES. What this would do is get a listing of two + directories (possibly on different machines) and compare + directories' contents and the files' write-dates, and copy files + around until both directories were in synch. There was also an + option to tell it to only copy in one direction instead of both, and + you could run it on one file (a trivial case) that would copy that + file if and only if the destination was not the same or newer. + + I think this would be a terribly useful feature, though you'd have + to do it by comparing the textual representation of the date, since + ange-ftp doesn't return correct numeric dates. + + [A subset of this is possible with copy-dir.el, sk 14-May-1992 14:11] + + * Actually, there are different meaning of prefix args: + + - with m, u and M-m, F: include even directories + - with *@/~# : unmark instead mark + - with mark-using (instead mark-setting) commands: use current file + instead of marked files + - with diff commands, it lets you edit the commandline + + * + Perhaps the failed files should be given another mark, e.g. `!'. Then + I would have to include the code from dired-x.el (just 40 lines) + into dired.el to make it possible to switch the current marker + character. One could then switch to `!', do something on the `!' + files, and pop the old marker character off the stack. + + * dired-marker-regexp could use "\n" instead "^", is it used in + re-search only, never in looking-at. But the speedup is not + measurable (below 5%). + + * < and > should skip "." and "..". [No, use -A in switches instead!] diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/dissociate.el emacs-19.18/lisp/dissociate.el *** emacs-19.17/lisp/dissociate.el Wed Jun 9 07:22:07 1993 --- emacs-19.18/lisp/dissociate.el Sun Aug 1 16:50:07 1993 *************** *** 89,95 **** (- move-amount))) (point)))) ! (let (ranval) ! (while (< (setq ranval (random)) 0)) ! (goto-char (1+ (% ranval (1- (point-max)))))) (or (funcall search-function overlap nil t) (let ((opoint (point))) --- 89,93 ---- (- move-amount))) (point)))) ! (goto-char (1+ (random (1- (point-max))))) (or (funcall search-function overlap nil t) (let ((opoint (point))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/doctor.el emacs-19.18/lisp/doctor.el *** emacs-19.17/lisp/doctor.el Wed Jun 9 07:22:14 1993 --- emacs-19.18/lisp/doctor.el Fri Jul 23 14:31:43 1993 *************** *** 1377,1382 **** (insert word)) (t (insert ?\ word))) ! (if (> (current-column) fill-column) ! (apply auto-fill-function nil)) (setq *print-upcase* (string-match "[.?!]$" word) *print-space* t)) --- 1377,1383 ---- (insert word)) (t (insert ?\ word))) ! (and auto-fill-function ! (> (current-column) fill-column) ! (apply auto-fill-function nil)) (setq *print-upcase* (string-match "[.?!]$" word) *print-space* t)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/dunnet.el emacs-19.18/lisp/dunnet.el *** emacs-19.17/lisp/dunnet.el Tue Jul 13 16:44:02 1993 --- emacs-19.18/lisp/dunnet.el Sun Aug 1 16:50:07 1993 *************** *** 133,137 **** (defun dun-special-object () - (if (= dun-current-room computer-room) (if dun-computer --- 133,136 ---- *************** *** 150,156 **** (if (and (= dun-current-room fourth-vermont-intersection) dun-hole) (progn ! (dun-mprincl"You fall into a hole in the ground.") ! (setq dun-current-room vermont-station) ! (dun-describe-room vermont-station))) (if (> dun-current-room endgame-computer-room) --- 149,161 ---- (if (and (= dun-current-room fourth-vermont-intersection) dun-hole) (progn ! (if (not dun-inbus) ! (progn ! (dun-mprincl"You fall into a hole in the ground.") ! (setq dun-current-room vermont-station) ! (dun-describe-room vermont-station)) ! (progn ! (dun-mprincl ! "The bus falls down a hole in the ground and explodes.") ! (dun-die "burning"))))) (if (> dun-current-room endgame-computer-room) *************** *** 1034,1038 **** (setq i 0) (setq newques nil) ! (setq which (% (abs (random)) (length dun-endgame-questions))) (dun-mprincl "Your question is:") (dun-mprincl (setq dun-endgame-question (car --- 1039,1043 ---- (setq i 0) (setq newques nil) ! (setq which (random (length dun-endgame-questions))) (dun-mprincl "Your question is:") (dun-mprincl (setq dun-endgame-question (car *************** *** 2986,2994 **** (random t) ! (setq tloc (+ 60 (% (abs (random)) 18))) (dun-replace dun-room-objects tloc (append (nth tloc dun-room-objects) (list 18))) ! (setq tcomb (+ 100 (% (abs (random)) 899))) (setq dun-combination (prin1-to-string tcomb)) --- 2991,2999 ---- (random t) ! (setq tloc (+ 60 (random 18))) (dun-replace dun-room-objects tloc (append (nth tloc dun-room-objects) (list 18))) ! (setq tcomb (+ 100 (random 899))) (setq dun-combination (prin1-to-string tcomb)) *************** *** 3327,3328 **** --- 3332,3335 ---- (setq dun-batch-mode t) (dun-batch-loop)) + + diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/edt.el emacs-19.18/lisp/edt.el *** emacs-19.17/lisp/edt.el Wed Jun 9 07:22:27 1993 --- emacs-19.18/lisp/edt.el Fri Jul 23 14:15:12 1993 *************** *** 291,295 **** (interactive) (setq edt-direction-string " ADVANCE") ! (global-set-key [kp-f1] 'isearch-forward) (global-set-key [kp-8] 'scroll-window-up) (global-set-key [kp-7] 'next-paragraph) --- 291,295 ---- (interactive) (setq edt-direction-string " ADVANCE") ! (global-set-key [kp-f3] 'isearch-forward) (global-set-key [kp-8] 'scroll-window-up) (global-set-key [kp-7] 'next-paragraph) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/ehelp.el emacs-19.18/lisp/ehelp.el *** emacs-19.17/lisp/ehelp.el Wed Jun 2 23:49:45 1993 --- emacs-19.18/lisp/ehelp.el Sat Aug 7 20:20:14 1993 *************** *** 27,31 **** ;; browsing on-line help screens. There is one entry point, ;; `with-electric-help'; All you have to give it is a no-argument ! ;; function that generates the actual text of the help into the urrent ;; buffer. --- 27,31 ---- ;; browsing on-line help screens. There is one entry point, ;; `with-electric-help'; All you have to give it is a no-argument ! ;; function that generates the actual text of the help into the current ;; buffer. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/emerge.el emacs-19.18/lisp/emerge.el *** emacs-19.17/lisp/emerge.el Mon Jun 14 17:44:18 1993 --- emacs-19.18/lisp/emerge.el Sun Aug 1 16:48:43 1993 *************** *** 1799,1803 **** (aset diff-vector 6 'default-A)))) (setq n (1+ n)) ! (if (= (* (/ n 10) 10) n) (message "Setting default to A...%d" n))) (emerge-unselect-and-select-difference selected-difference))) --- 1799,1803 ---- (aset diff-vector 6 'default-A)))) (setq n (1+ n)) ! (if (zerop (% n 10)) (message "Setting default to A...%d" n))) (emerge-unselect-and-select-difference selected-difference))) *************** *** 1821,1825 **** (aset diff-vector 6 'default-B)))) (setq n (1+ n)) ! (if (= (* (/ n 10) 10) n) (message "Setting default to B...%d" n))) (emerge-unselect-and-select-difference selected-difference))) --- 1821,1825 ---- (aset diff-vector 6 'default-B)))) (setq n (1+ n)) ! (if (zerop (% n 10)) (message "Setting default to B...%d" n))) (emerge-unselect-and-select-difference selected-difference))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/etags.el emacs-19.18/lisp/etags.el *** emacs-19.17/lisp/etags.el Fri Jun 11 12:25:01 1993 --- emacs-19.18/lisp/etags.el Sun Aug 8 03:20:25 1993 *************** *** 260,263 **** --- 260,267 ---- list) + ;; Local var in visit-tags-table-buffer-cont + ;; which is set by tags-table-including. + (defvar visit-tags-table-buffer-cont) + ;; Subroutine of visit-tags-table-buffer. Frobs its local vars. ;; Search TABLES for one that has tags for THIS-FILE. Recurses on *************** *** 313,320 **** tags-table-list-pointer found tags-table-list-started-at found ! ;; CONT is a local variable of ;; our caller, visit-tags-table-buffer. ;; Set it so we won't frob lists later. ! cont 'included))) (or recursing ;; tags-table-parent-pointer-list now describes --- 317,325 ---- tags-table-list-pointer found tags-table-list-started-at found ! ;; Set a local variable of ;; our caller, visit-tags-table-buffer. ;; Set it so we won't frob lists later. ! visit-tags-table-buffer-cont ! 'included))) (or recursing ;; tags-table-parent-pointer-list now describes *************** *** 344,501 **** ;; Set tags-file-name to the tags table file we want to visit. ! (cond ((eq cont 'same) ! ;; Use the ambient value of tags-file-name. ! (or tags-file-name ! (error (substitute-command-keys ! (concat "No tags table in use! " ! "Use \\[visit-tags-table] to select one.")))) ! ;; Set CONT to nil so the code below will make sure tags-file-name ! ;; is in tags-table-list. ! (setq cont nil)) ! ! (cont ! ;; Find the next table. ! (if (tags-next-table) ! ;; Skip over nonexistent files. ! (while (and (let ((file (tags-expand-table-name tags-file-name))) ! (not (or (get-file-buffer file) ! (file-exists-p file)))) ! (tags-next-table))))) ! ! (t ! ;; Pick a table out of our hat. ! (setq tags-file-name ! (or ! ;; First, try a local variable. ! (cdr (assq 'tags-file-name (buffer-local-variables))) ! ;; Second, try a user-specified function to guess. ! (and default-tags-table-function ! (funcall default-tags-table-function)) ! ;; Third, look for a tags table that contains ! ;; tags for the current buffer's file. ! ;; If one is found, the lists will be frobnicated, ! ;; and CONT will be set non-nil so we don't do it below. ! (car (or ! ;; First check only tables already in buffers. ! (save-excursion (tags-table-including buffer-file-name ! tags-table-list ! t)) ! ;; Since that didn't find any, now do the ! ;; expensive version: reading new files. ! (save-excursion (tags-table-including buffer-file-name ! tags-table-list ! nil)))) ! ;; Fourth, use the user variable tags-file-name, if it is not ! ;; already in tags-table-list. ! (and tags-file-name ! (not (tags-table-list-member tags-file-name)) ! tags-file-name) ! ;; Fifth, use the user variable giving the table list. ! ;; Find the first element of the list that actually exists. ! (let ((list tags-table-list) ! file) ! (while (and list ! (setq file (tags-expand-table-name (car list))) ! (not (get-file-buffer file)) ! (not (file-exists-p file))) ! (setq list (cdr list))) ! (car list)) ! ;; Finally, prompt the user for a file name. ! (expand-file-name ! (read-file-name "Visit tags table: (default TAGS) " ! default-directory ! "TAGS" ! t)))))) ! ! ;; Expand the table name into a full file name. ! (setq tags-file-name (tags-expand-table-name tags-file-name)) ! ! (if (and (eq cont t) (null tags-table-list-pointer)) ! ;; All out of tables. ! nil ! ! ;; Verify that tags-file-name is a valid tags table. ! (if (if (get-file-buffer tags-file-name) ! ;; The file is already in a buffer. Check for the visited file ! ;; having changed since we last used it. ! (let (win) ! (set-buffer (get-file-buffer tags-file-name)) ! (setq win (or verify-tags-table-function ! (initialize-new-tags-table))) ! (if (or (verify-visited-file-modtime (current-buffer)) ! (not (yes-or-no-p ! "Tags file has changed, read new contents? "))) ! (and win (funcall verify-tags-table-function)) ! (revert-buffer t t) ! (initialize-new-tags-table))) ! (set-buffer (find-file-noselect tags-file-name)) ! (or (string= tags-file-name buffer-file-name) ! ;; find-file-noselect has changed the file name. ! ;; Propagate the change to tags-file-name and tags-table-list. ! (let ((tail (member tags-file-name tags-table-list))) ! (if tail ! (setcar tail buffer-file-name)) ! (setq tags-file-name buffer-file-name))) ! (initialize-new-tags-table)) ! ! ;; We have a valid tags table. ! (progn ! ;; Bury the tags table buffer so it ! ;; doesn't get in the user's way. ! (bury-buffer (current-buffer)) ! ! (if cont ! ;; No list frobbing required. ! nil ! ! ;; Look in the list for the table we chose. ! (let ((elt (tags-table-list-member tags-file-name))) ! (or elt ! ;; The table is not in the current set. ! ;; Try to find it in another previously used set. ! (let ((sets tags-table-set-list)) ! (while (and sets ! (not (setq elt (tags-table-list-member ! tags-file-name (car sets))))) ! (setq sets (cdr sets))) ! (if sets ! ;; Found in some other set. Switch to that set. ! (progn (or (memq tags-table-list tags-table-set-list) - ;; Save the current list. (setq tags-table-set-list ! (cons tags-table-list ! tags-table-set-list))) ! (setq tags-table-list (car sets))) ! ! ;; Not found in any existing set. ! (if (and tags-table-list ! (y-or-n-p (concat "Add " tags-file-name ! " to current list" ! " of tags tables? "))) ! ;; Add it to the current list. ! (setq tags-table-list (cons tags-file-name ! tags-table-list)) ! ;; Make a fresh list, and store the old one. ! (or (memq tags-table-list tags-table-set-list) ! (setq tags-table-set-list ! (cons tags-table-list tags-table-set-list))) ! (setq tags-table-list (list tags-file-name))) ! (setq elt tags-table-list)))) ! ! ;; Set the tags table list state variables to point at the table ! ;; we want to use first. ! (setq tags-table-list-started-at elt ! tags-table-list-pointer elt))) ! ! ;; Return of t says the tags table is valid. ! t) ! ! ;; The buffer was not valid. Don't use it again. ! (let ((file tags-file-name)) ! (kill-local-variable 'tags-file-name) ! (if (eq file tags-file-name) ! (setq tags-file-name nil))) ! (error "File %s is not a valid tags table" buffer-file-name)))) (defun file-of-tag () --- 349,509 ---- ;; Set tags-file-name to the tags table file we want to visit. ! (let ((visit-tags-table-buffer-cont cont)) ! (cond ((eq visit-tags-table-buffer-cont 'same) ! ;; Use the ambient value of tags-file-name. ! (or tags-file-name ! (error (substitute-command-keys ! (concat "No tags table in use! " ! "Use \\[visit-tags-table] to select one.")))) ! ;; Set VISIT-TAGS-TABLE-BUFFER-CONT to nil ! ;; so the code below will make sure tags-file-name ! ;; is in tags-table-list. ! (setq visit-tags-table-buffer-cont nil)) ! ! (visit-tags-table-buffer-cont ! ;; Find the next table. ! (if (tags-next-table) ! ;; Skip over nonexistent files. ! (while (and (let ((file (tags-expand-table-name tags-file-name))) ! (not (or (get-file-buffer file) ! (file-exists-p file)))) ! (tags-next-table))))) ! ! (t ! ;; Pick a table out of our hat. ! (setq tags-file-name ! (or ! ;; First, try a local variable. ! (cdr (assq 'tags-file-name (buffer-local-variables))) ! ;; Second, try a user-specified function to guess. ! (and default-tags-table-function ! (funcall default-tags-table-function)) ! ;; Third, look for a tags table that contains ! ;; tags for the current buffer's file. ! ;; If one is found, the lists will be frobnicated, ! ;; and VISIT-TAGS-TABLE-BUFFER-CONT ! ;; will be set non-nil so we don't do it below. ! (car (or ! ;; First check only tables already in buffers. ! (save-excursion (tags-table-including buffer-file-name ! tags-table-list ! t)) ! ;; Since that didn't find any, now do the ! ;; expensive version: reading new files. ! (save-excursion (tags-table-including buffer-file-name ! tags-table-list ! nil)))) ! ;; Fourth, use the user variable tags-file-name, if it is not ! ;; already in tags-table-list. ! (and tags-file-name ! (not (tags-table-list-member tags-file-name)) ! tags-file-name) ! ;; Fifth, use the user variable giving the table list. ! ;; Find the first element of the list that actually exists. ! (let ((list tags-table-list) ! file) ! (while (and list ! (setq file (tags-expand-table-name (car list))) ! (not (get-file-buffer file)) ! (not (file-exists-p file))) ! (setq list (cdr list))) ! (car list)) ! ;; Finally, prompt the user for a file name. ! (expand-file-name ! (read-file-name "Visit tags table: (default TAGS) " ! default-directory ! "TAGS" ! t)))))) ! ! ;; Expand the table name into a full file name. ! (setq tags-file-name (tags-expand-table-name tags-file-name)) ! ! (if (and (eq visit-tags-table-buffer-cont t) (null tags-table-list-pointer)) ! ;; All out of tables. ! nil ! ! ;; Verify that tags-file-name is a valid tags table. ! (if (if (get-file-buffer tags-file-name) ! ;; The file is already in a buffer. Check for the visited file ! ;; having changed since we last used it. ! (let (win) ! (set-buffer (get-file-buffer tags-file-name)) ! (setq win (or verify-tags-table-function ! (initialize-new-tags-table))) ! (if (or (verify-visited-file-modtime (current-buffer)) ! (not (yes-or-no-p ! "Tags file has changed, read new contents? "))) ! (and win (funcall verify-tags-table-function)) ! (revert-buffer t t) ! (initialize-new-tags-table))) ! (set-buffer (find-file-noselect tags-file-name)) ! (or (string= tags-file-name buffer-file-name) ! ;; find-file-noselect has changed the file name. ! ;; Propagate the change to tags-file-name and tags-table-list. ! (let ((tail (member tags-file-name tags-table-list))) ! (if tail ! (setcar tail buffer-file-name)) ! (setq tags-file-name buffer-file-name))) ! (initialize-new-tags-table)) ! ! ;; We have a valid tags table. ! (progn ! ;; Bury the tags table buffer so it ! ;; doesn't get in the user's way. ! (bury-buffer (current-buffer)) ! ! (if visit-tags-table-buffer-cont ! ;; No list frobbing required. ! nil ! ! ;; Look in the list for the table we chose. ! (let ((elt (tags-table-list-member tags-file-name))) ! (or elt ! ;; The table is not in the current set. ! ;; Try to find it in another previously used set. ! (let ((sets tags-table-set-list)) ! (while (and sets ! (not (setq elt (tags-table-list-member ! tags-file-name (car sets))))) ! (setq sets (cdr sets))) ! (if sets ! ;; Found in some other set. Switch to that set. ! (progn ! (or (memq tags-table-list tags-table-set-list) ! ;; Save the current list. ! (setq tags-table-set-list ! (cons tags-table-list ! tags-table-set-list))) ! (setq tags-table-list (car sets))) ! ! ;; Not found in any existing set. ! (if (and tags-table-list ! (y-or-n-p (concat "Add " tags-file-name ! " to current list" ! " of tags tables? "))) ! ;; Add it to the current list. ! (setq tags-table-list (cons tags-file-name ! tags-table-list)) ! ;; Make a fresh list, and store the old one. (or (memq tags-table-list tags-table-set-list) (setq tags-table-set-list ! (cons tags-table-list tags-table-set-list))) ! (setq tags-table-list (list tags-file-name))) ! (setq elt tags-table-list)))) ! ! ;; Set the tags table list state variables to point at the table ! ;; we want to use first. ! (setq tags-table-list-started-at elt ! tags-table-list-pointer elt))) ! ! ;; Return of t says the tags table is valid. ! t) ! ! ;; The buffer was not valid. Don't use it again. ! (let ((file tags-file-name)) ! (kill-local-variable 'tags-file-name) ! (if (eq file tags-file-name) ! (setq tags-file-name nil))) ! (error "File %s is not a valid tags table" buffer-file-name))))) (defun file-of-tag () *************** *** 911,926 **** ;; \2 is not interesting; ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN ! ;; \4 is the char to start searching at; ! ;; \5 is the line to start searching at; ! ;; \6 is not interesting; ! ;; \7 is the explicitly-specified tag name. (while (re-search-forward "^\\(\\(.+[^-a-zA-Z0-9_$]+\\)?\\([-a-zA-Z0-9_$]+\\)\ ! \[^-a-zA-Z0-9_$]*\\)\177\ ! \\([0-9]+\\),\\([0-9]+\\)\\(,\001\\([^\n]+\\)\\)?\n" nil t) ! (intern (if (match-beginning 6) ;; There is an explicit tag name. ! (buffer-substring (match-beginning 6) (match-end 6)) ;; No explicit tag name. Best guess. (buffer-substring (match-beginning 3) (match-end 3))) --- 919,933 ---- ;; \2 is not interesting; ;; \3 is the guessed tag name; XXX guess should be better eg DEFUN ! ;; \4 is not interesting; ! ;; \5 is the explicitly-specified tag name. ! ;; \6 is the line to start searching at; ! ;; \7 is the char to start searching at. (while (re-search-forward "^\\(\\(.+[^-a-zA-Z0-9_$]+\\)?\\([-a-zA-Z0-9_$]+\\)\ ! \[^-a-zA-Z0-9_$]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\\([0-9]+\\),\\([0-9]+\\)\n" nil t) ! (intern (if (match-beginning 5) ;; There is an explicit tag name. ! (buffer-substring (match-beginning 5) (match-end 5)) ;; No explicit tag name. Best guess. (buffer-substring (match-beginning 3) (match-end 3))) *************** *** 934,937 **** --- 941,946 ---- (save-excursion (beginning-of-line) (point)))) + ;; Skip explicit tag name if present. + (search-forward "\001" (save-excursion (forward-line 1) (point)) t) (search-forward ",") (setq startpos (string-to-int (buffer-substring *************** *** 951,955 **** (offset 1000) (found nil) ! (pat (concat "^" (regexp-quote (car tag-info))))) (or startpos (setq startpos (point-min))) --- 960,966 ---- (offset 1000) (found nil) ! (pat (concat (if (eq selective-display t) ! "\\(^\\|\^m\\)" "^") ! (regexp-quote (car tag-info))))) (or startpos (setq startpos (point-min))) *************** *** 965,968 **** --- 976,984 ---- (error "`%s' not found in %s; time to rerun etags" pat buffer-file-name))) + ;; Position point at the right place + ;; if the search string matched an extra Ctrl-m at the beginning. + (and (eq selective-display t) + (looking-at "\^m") + (forward-char 1)) (beginning-of-line)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/faces.el emacs-19.18/lisp/faces.el *** emacs-19.17/lisp/faces.el Sun Jul 18 02:19:04 1993 --- emacs-19.18/lisp/faces.el Tue Aug 3 03:12:02 1993 *************** *** 51,55 **** "Return the font name of face FACE, or nil if it is unspecified. If the optional argument FRAME is given, report on face FACE in that frame. ! Otherwise report on the defaults for face FACE (for new frames)." (aref (internal-get-face face frame) 3)) --- 51,58 ---- "Return the font name of face FACE, or nil if it is unspecified. If the optional argument FRAME is given, report on face FACE in that frame. ! If FRAME is t, report on the defaults for face FACE (for new frames). ! The font default for a face is either nil, or a list ! of the form (bold), (italic) or (bold italic). ! If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 3)) *************** *** 57,61 **** "Return the foreground color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. ! Otherwise report on the defaults for face FACE (for new frames)." (aref (internal-get-face face frame) 4)) --- 60,65 ---- "Return the foreground color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. ! If FRAME is t, report on the defaults for face FACE (for new frames). ! If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 4)) *************** *** 63,67 **** "Return the background color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. ! Otherwise report on the defaults for face FACE (for new frames)." (aref (internal-get-face face frame) 5)) --- 67,72 ---- "Return the background color name of face FACE, or nil if unspecified. If the optional argument FRAME is given, report on face FACE in that frame. ! If FRAME is t, report on the defaults for face FACE (for new frames). ! If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 5)) *************** *** 75,79 **** "Return t if face FACE is underlined. If the optional argument FRAME is given, report on face FACE in that frame. ! Otherwise report on the defaults for face FACE (for new frames)." (aref (internal-get-face face frame) 7)) --- 80,85 ---- "Return t if face FACE is underlined. If the optional argument FRAME is given, report on face FACE in that frame. ! If FRAME is t, report on the defaults for face FACE (for new frames). ! If FRAME is omitted or nil, use the selected frame." (aref (internal-get-face face frame) 7)) *************** *** 463,495 **** (defun x-make-font-bold (font) ! "Given an X font specification, this attempts to make a `bold' version ! of it. If it fails, it returns nil." (x-frob-font-weight font "bold")) (defun x-make-font-demibold (font) ! "Given an X font specification, this attempts to make a `demibold' version ! of it. If it fails, it returns nil." (x-frob-font-weight font "demibold")) (defun x-make-font-unbold (font) ! "Given an X font specification, this attempts to make a non-bold version ! of it. If it fails, it returns nil." (x-frob-font-weight font "medium")) (defun x-make-font-italic (font) ! "Given an X font specification, this attempts to make an `italic' version ! of it. If it fails, it returns nil." (x-frob-font-slant font "i")) (defun x-make-font-oblique (font) ; you say tomayto... ! "Given an X font specification, this attempts to make an `italic' version ! of it. If it fails, it returns nil." (x-frob-font-slant font "o")) (defun x-make-font-unitalic (font) ! "Given an X font specification, this attempts to make a non-italic version ! of it. If it fails, it returns nil." (x-frob-font-slant font "r")) - ;;; non-X-specific interface --- 469,500 ---- (defun x-make-font-bold (font) ! "Given an X font specification, make a bold version of it. ! If that can't be done, return nil." (x-frob-font-weight font "bold")) (defun x-make-font-demibold (font) ! "Given an X font specification, make a demibold version of it. ! If that can't be done, return nil." (x-frob-font-weight font "demibold")) (defun x-make-font-unbold (font) ! "Given an X font specification, make a non-bold version of it. ! If that can't be done, return nil." (x-frob-font-weight font "medium")) (defun x-make-font-italic (font) ! "Given an X font specification, make an italic version of it. ! If that can't be done, return nil." (x-frob-font-slant font "i")) (defun x-make-font-oblique (font) ; you say tomayto... ! "Given an X font specification, make an oblique version of it. ! If that can't be done, return nil." (x-frob-font-slant font "o")) (defun x-make-font-unitalic (font) ! "Given an X font specification, make a non-italic version of it. ! If that can't be done, return nil." (x-frob-font-slant font "r")) ;;; non-X-specific interface *************** *** 499,521 **** If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face bold: "))) ! (let ((ofont (face-font face frame)) ! font f2) ! (if (null frame) ! (let ((frames (frame-list))) ! (while frames ! (make-face-bold face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font (or (face-font face frame) ! (face-font face t) ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (or (and (setq f2 (x-make-font-bold font)) ! (internal-try-face-font face f2 frame)) ! (and (setq f2 (x-make-font-demibold font)) ! (internal-try-face-font face f2 frame)))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No bold version of %S" font))))) (defun make-face-italic (face &optional frame noerror) --- 504,539 ---- If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face bold: "))) ! (if (eq frame t) ! (set-face-font face (if (memq 'italic (face-font face t)) ! '(bold italic) '(bold)) ! t) ! (let ((ofont (face-font face frame)) ! font f2) ! (if (null frame) ! (let ((frames (frame-list))) ! ;; Make this face bold in global-face-data. ! (make-face-bold face t noerror) ! ;; Make this face bold in each frame. ! (while frames ! (make-face-bold face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font (or (face-font face frame) ! (face-font face t))) ! (if (listp font) ! (setq font nil)) ! (setq font (or font ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (make-face-bold-internal face frame)) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No bold version of %S" font)))))) ! ! (defun make-face-bold-internal (face frame) ! (or (and (setq f2 (x-make-font-bold font)) ! (internal-try-face-font face f2 frame)) ! (and (setq f2 (x-make-font-demibold font)) ! (internal-try-face-font face f2 frame)))) (defun make-face-italic (face &optional frame noerror) *************** *** 523,545 **** If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face italic: "))) ! (let ((ofont (face-font face frame)) ! font f2) ! (if (null frame) ! (let ((frames (frame-list))) ! (while frames ! (make-face-italic face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font (or (face-font face frame) ! (face-font face t) ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (or (and (setq f2 (x-make-font-italic font)) ! (internal-try-face-font face f2 frame)) ! (and (setq f2 (x-make-font-oblique font)) ! (internal-try-face-font face f2 frame)))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No italic version of %S" font))))) (defun make-face-bold-italic (face &optional frame noerror) --- 541,576 ---- If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face italic: "))) ! (if (eq frame t) ! (set-face-font face (if (memq 'bold (face-font face t)) ! '(bold italic) '(italic)) ! t) ! (let ((ofont (face-font face frame)) ! font f2) ! (if (null frame) ! (let ((frames (frame-list))) ! ;; Make this face italic in global-face-data. ! (make-face-italic face t noerror) ! ;; Make this face italic in each frame. ! (while frames ! (make-face-italic face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font (or (face-font face frame) ! (face-font face t))) ! (if (listp font) ! (setq font nil)) ! (setq font (or font ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (make-face-italic-internal face frame)) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No italic version of %S" font)))))) ! ! (defun make-face-italic-internal (face frame) ! (or (and (setq f2 (x-make-font-italic font)) ! (internal-try-face-font face f2 frame)) ! (and (setq f2 (x-make-font-oblique font)) ! (internal-try-face-font face f2 frame)))) (defun make-face-bold-italic (face &optional frame noerror) *************** *** 547,585 **** If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face bold-italic: "))) ! (let ((ofont (face-font face frame)) ! font f2 f3) ! (if (null frame) ! (let ((frames (frame-list))) ! (while frames ! (make-face-bold-italic face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font (or (face-font face frame) ! (face-font face t) ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (or (and (setq f2 (x-make-font-italic font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-bold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)) ! (and (setq f2 (x-make-font-oblique font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-bold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)) ! (and (setq f2 (x-make-font-italic font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-demibold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)) ! (and (setq f2 (x-make-font-oblique font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-demibold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No bold italic version of %S" font))))) (defun make-face-unbold (face &optional frame noerror) --- 578,628 ---- If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face bold-italic: "))) ! (if (eq frame t) ! (set-face-font face '(bold italic) t) ! (let ((ofont (face-font face frame)) ! font) ! (if (null frame) ! (let ((frames (frame-list))) ! ;; Make this face bold-italic in global-face-data. ! (make-face-bold-italic face t noerror) ! ;; Make this face bold in each frame. ! (while frames ! (make-face-bold-italic face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font (or (face-font face frame) ! (face-font face t))) ! (if (listp font) ! (setq font nil)) ! (setq font (or font ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (make-face-bold-italic-internal face frame)) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No bold italic version of %S" font)))))) ! ! (defun make-face-bold-italic-internal (face frame) ! (let (f2 f3) ! (or (and (setq f2 (x-make-font-italic font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-bold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)) ! (and (setq f2 (x-make-font-oblique font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-bold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)) ! (and (setq f2 (x-make-font-italic font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-demibold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame)) ! (and (setq f2 (x-make-font-oblique font)) ! (not (equal font f2)) ! (setq f3 (x-make-font-demibold f2)) ! (not (equal f2 f3)) ! (internal-try-face-font face f3 frame))))) (defun make-face-unbold (face &optional frame noerror) *************** *** 587,607 **** If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face non-bold: "))) ! (let ((ofont (face-font face frame)) ! font font1) ! (if (null frame) ! (let ((frames (frame-list))) ! (while frames ! (make-face-unbold face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font1 (or (face-font face frame) ! (face-font face t) ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (setq font (x-make-font-unbold font1)) ! (if font (internal-try-face-font face font frame))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No unbold version of %S" font1))))) (defun make-face-unitalic (face &optional frame noerror) --- 630,660 ---- If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face non-bold: "))) ! (if (eq frame t) ! (set-face-font face (if (memq 'italic (face-font face t)) ! '(italic) nil) ! t) ! (let ((ofont (face-font face frame)) ! font font1) ! (if (null frame) ! (let ((frames (frame-list))) ! ;; Make this face unbold in global-face-data. ! (make-face-unbold face t noerror) ! ;; Make this face unbold in each frame. ! (while frames ! (make-face-unbold face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font1 (or (face-font face frame) ! (face-font face t))) ! (if (listp font1) ! (setq font1 nil)) ! (setq font1 (or font1 ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (setq font (x-make-font-unbold font1)) ! (if font (internal-try-face-font face font frame))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No unbold version of %S" font1)))))) (defun make-face-unitalic (face &optional frame noerror) *************** *** 609,629 **** If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face non-italic: "))) ! (let ((ofont (face-font face frame)) ! font font1) ! (if (null frame) ! (let ((frames (frame-list))) ! (while frames ! (make-face-unitalic face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font1 (or (face-font face frame) ! (face-font face t) ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (setq font (x-make-font-unitalic font1)) ! (if font (internal-try-face-font face font frame))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No unitalic version of %S" font1))))) (defvar list-faces-sample-text --- 662,692 ---- If NOERROR is non-nil, return nil on failure." (interactive (list (read-face-name "Make which face non-italic: "))) ! (if (eq frame t) ! (set-face-font face (if (memq 'bold (face-font face t)) ! '(bold) nil) ! t) ! (let ((ofont (face-font face frame)) ! font font1) ! (if (null frame) ! (let ((frames (frame-list))) ! ;; Make this face unitalic in global-face-data. ! (make-face-unitalic face t noerror) ! ;; Make this face unitalic in each frame. ! (while frames ! (make-face-unitalic face (car frames) noerror) ! (setq frames (cdr frames)))) ! (setq face (internal-get-face face frame)) ! (setq font1 (or (face-font face frame) ! (face-font face t))) ! (if (listp font1) ! (setq font1 nil)) ! (setq font1 (or font1 ! (face-font 'default frame) ! (cdr (assq 'font (frame-parameters frame))))) ! (setq font (x-make-font-unitalic font1)) ! (if font (internal-try-face-font face font frame))) ! (or (not (equal ofont (face-font face))) ! (and (not noerror) ! (error "No unitalic version of %S" font1)))))) (defvar list-faces-sample-text *************** *** 828,831 **** --- 891,903 ---- (while rest (setcdr (car rest) (copy-sequence (cdr (car rest)))) + (if (listp (face-font (cdr (car rest)))) + (let ((bold (memq 'bold (face-font (cdr (car rest))))) + (italic (memq 'italic (face-font (cdr (car rest)))))) + (if (and bold italic) + (make-face-bold-italic (car (car rest)) frame) + (if bold + (make-face-bold (car (car rest)) frame) + (if italic + (make-face-italic (car (car rest)) frame)))))) (make-face-x-resource-internal (cdr (car rest)) frame t) (setq rest (cdr rest))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/files.el emacs-19.18/lisp/files.el *** emacs-19.17/lisp/files.el Sun Jul 18 02:40:06 1993 --- emacs-19.18/lisp/files.el Fri Aug 6 14:01:58 1993 *************** *** 230,233 **** --- 230,243 ---- (or (fboundp 'unlock-buffer) (defalias 'unlock-buffer 'ignore)) + + ;; This hook function provides support for ange-ftp host name + ;; completion. It runs the usual ange-ftp hook, but only for + ;; completion operations. Having this here avoids the need + ;; to load ange-ftp when it's not really in use. + (defun ange-ftp-completion-hook-function (op &rest args) + (if (memq op '(file-name-completion file-name-all-completions)) + (apply 'ange-ftp-hook-function op args) + (let (file-name-handler-alist) + (apply op args)))) (defun pwd () *************** *** 248,254 **** (setq cd-list (nconc cd-list ! (list (substitute-in-file-name ! (file-name-as-directory ! (substring cd-path cd-start cd-colon)))))) (setq cd-start (+ cd-colon 1))) cd-list))) --- 258,266 ---- (setq cd-list (nconc cd-list ! (list (if (= cd-start cd-colon) ! nil ! (substitute-in-file-name ! (file-name-as-directory ! (substring cd-path cd-start cd-colon))))))) (setq cd-start (+ cd-colon 1))) cd-list))) *************** *** 683,687 **** (cond ((and error (file-attributes buffer-file-name)) (setq buffer-read-only t) ! "File exists, but is read-protected.") ((not buffer-read-only) (if (and warn --- 695,699 ---- (cond ((and error (file-attributes buffer-file-name)) (setq buffer-read-only t) ! "File exists, but cannot be read.") ((not buffer-read-only) (if (and warn *************** *** 822,831 **** ;; Don't look for -*- if this file name matches any ;; of the regexps in inhibit-local-variables-regexps. ! (not (let ((temp inhibit-local-variables-regexps)) ! (while (and temp ! (not (string-match (car temp) ! buffer-file-name))) ! (setq temp (cdr temp))) ! (not temp))) (search-forward "-*-" (save-excursion ;; If the file begins with "#!" --- 834,843 ---- ;; Don't look for -*- if this file name matches any ;; of the regexps in inhibit-local-variables-regexps. ! (let ((temp inhibit-local-variables-regexps)) ! (while (and temp ! (not (string-match (car temp) ! buffer-file-name))) ! (setq temp (cdr temp))) ! (not temp)) (search-forward "-*-" (save-excursion ;; If the file begins with "#!" *************** *** 1392,1401 **** ;; If buffer has no file name, ask user for one. (or buffer-file-name ! (progn ! (setq buffer-file-name ! (expand-file-name (read-file-name "File to save in: ") nil) ! default-directory (file-name-directory buffer-file-name)) ! (and auto-save-default (not buffer-auto-save-file-name) ! (auto-save-mode t)))) (or (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) --- 1404,1409 ---- ;; If buffer has no file name, ask user for one. (or buffer-file-name ! (set-visited-file-name ! (expand-file-name (read-file-name "File to save in: ") nil))) (or (verify-visited-file-modtime (current-buffer)) (not (file-exists-p buffer-file-name)) *************** *** 1869,1873 **** (vms-read-directory file switches (current-buffer)) (if wildcard ! (let ((default-directory (file-name-directory file))) (call-process shell-file-name nil t nil "-c" (concat insert-directory-program --- 1877,1885 ---- (vms-read-directory file switches (current-buffer)) (if wildcard ! ;; Run ls in the directory of the file pattern we asked for. ! (let ((default-directory ! (if (file-name-absolute-p file) ! (file-name-directory file) ! (file-name-directory (expand-file-name file))))) (call-process shell-file-name nil t nil "-c" (concat insert-directory-program diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/fill.el emacs-19.18/lisp/fill.el *** emacs-19.17/lisp/fill.el Wed Apr 7 17:45:43 1993 --- emacs-19.18/lisp/fill.el Sat Jul 31 15:26:57 1993 *************** *** 162,176 **** (while (and (> (point) (+ linebeg 2)) (eq (preceding-char) ?\ ) (eq (char-after (- (point) 2)) ?\.)) (forward-char -2) (skip-chars-backward "^ \n" linebeg)) ! (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) ;; Keep at least one word even if fill prefix exceeds margin. ;; This handles all but the first line of the paragraph. ! (progn ! (skip-chars-forward " ") ! (skip-chars-forward "^ \n")) ;; Normally, move back over the single space between the words. ! (forward-char -1))) (if (and fill-prefix (zerop prefixcol) (< (- (point) (point-min)) (length fill-prefix)) --- 162,189 ---- (while (and (> (point) (+ linebeg 2)) (eq (preceding-char) ?\ ) + (not (eq (following-char) ?\ )) (eq (char-after (- (point) 2)) ?\.)) (forward-char -2) (skip-chars-backward "^ \n" linebeg)) ! (if (if (zerop prefixcol) ! (save-excursion ! (skip-chars-backward " " linebeg) ! (bolp)) ! (>= prefixcol (current-column))) ;; Keep at least one word even if fill prefix exceeds margin. ;; This handles all but the first line of the paragraph. ! ;; Meanwhile, don't stop at a period followed by one space. ! (let ((first t)) ! (move-to-column prefixcol) ! (while (and (not (eobp)) ! (or first ! (and (not (bobp)) ! (save-excursion (forward-char -1) ! (looking-at "\\. "))))) ! (skip-chars-forward " ") ! (skip-chars-forward "^ \n") ! (setq first nil))) ;; Normally, move back over the single space between the words. ! (forward-char -1)) (if (and fill-prefix (zerop prefixcol) (< (- (point) (point-min)) (length fill-prefix)) *************** *** 179,185 **** ;; Keep at least one word even if fill prefix exceeds margin. ;; This handles the first line of the paragraph. ! (progn ! (skip-chars-forward " ") ! (skip-chars-forward "^ \n"))) ;; Replace all whitespace here with one newline. ;; Insert before deleting, so we don't forget which side of --- 192,205 ---- ;; Keep at least one word even if fill prefix exceeds margin. ;; This handles the first line of the paragraph. ! ;; Don't stop at a period followed by just one space. ! (let ((first t)) ! (while (and (not (eobp)) ! (or first ! (and (not (bobp)) ! (save-excursion (forward-char -1) ! (looking-at "\\. "))))) ! (skip-chars-forward " ") ! (skip-chars-forward "^ \n") ! (setq first nil))))) ;; Replace all whitespace here with one newline. ;; Insert before deleting, so we don't forget which side of diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/font-lock.el emacs-19.18/lisp/font-lock.el *** emacs-19.17/lisp/font-lock.el Fri Jul 9 16:28:05 1993 --- emacs-19.18/lisp/font-lock.el Thu Aug 5 16:47:01 1993 *************** *** 71,75 **** "Face to use for string constants.") ! (defvar font-lock-function-face 'bold-italic "Face to use for function names.") --- 71,75 ---- "Face to use for string constants.") ! (defvar font-lock-function-name-face 'bold-italic "Face to use for function names.") *************** *** 128,132 **** (beginning-of-line) (setq end (min end (point-max))) ! (let (state startline prev prevstate) ;; Find the state at the line-beginning before START. (setq startline (point)) --- 128,134 ---- (beginning-of-line) (setq end (min end (point-max))) ! (let ((buffer-read-only nil) ! state startline prev prevstate ! (modified (buffer-modified-p))) ;; Find the state at the line-beginning before START. (setq startline (point)) *************** *** 165,169 **** (while (and (< (point) end) (setq prev (point) prevstate state) ! (re-search-forward (concat "\\s\"\\|" (regexp-quote comment-start)) end t) ;; Clear out the fonts of what we skip over. (progn (remove-text-properties prev (point) '(face nil)) t) --- 167,174 ---- (while (and (< (point) end) (setq prev (point) prevstate state) ! (re-search-forward (if comment-start-skip ! (concat "\\s\"\\|" comment-start-skip) ! "\\s\"") ! end t) ;; Clear out the fonts of what we skip over. (progn (remove-text-properties prev (point) '(face nil)) t) *************** *** 200,204 **** (setq prev nil)) (and prev ! (remove-text-properties prev end '(face nil)))))) ;; This code used to be used to show a string on reaching the end of it. --- 205,210 ---- (setq prev nil)) (and prev ! (remove-text-properties prev end '(face nil))) ! (set-buffer-modified-p modified)))) ;; This code used to be used to show a string on reaching the end of it. *************** *** 225,229 **** (defun font-lock-unfontify-region (beg end) ! (remove-text-properties beg end '(face nil))) ;; Called when any modification is made to buffer text. --- 231,238 ---- (defun font-lock-unfontify-region (beg end) ! (let ((modified (buffer-modified-p)) ! (buffer-read-only nil)) ! (remove-text-properties beg end '(face nil)) ! (set-buffer-modified-p modified))) ;; Called when any modification is made to buffer text. *************** *** 240,248 **** (end-of-line) (setq end (point)) - ;; First scan for strings and comments. - (font-lock-fontify-region beg (1+ end)) (goto-char beg) (beginning-of-line) (setq beg (point)) ;; Now scan for keywords. (font-lock-hack-keywords beg end)))) --- 249,259 ---- (end-of-line) (setq end (point)) (goto-char beg) (beginning-of-line) (setq beg (point)) + ;; First scan for strings and comments. + ;; Must scan from line start in case of + ;; inserting space into `intfoo () {}'. + (font-lock-fontify-region beg (1+ end)) ;; Now scan for keywords. (font-lock-hack-keywords beg end)))) *************** *** 260,263 **** --- 271,276 ---- (rest font-lock-keywords) (count 0) + (buffer-read-only nil) + (modified (buffer-modified-p)) first str match face s e allow-overlap-p) (while rest *************** *** 268,276 **** (cond ((consp (cdr first)) (setq match (nth 1 first) ! face (nth 2 first) allow-overlap-p (nth 3 first))) ((symbolp (cdr first)) (setq match 0 allow-overlap-p nil ! face (cdr first))) (t (setq match (cdr first) --- 281,289 ---- (cond ((consp (cdr first)) (setq match (nth 1 first) ! face (eval (nth 2 first)) allow-overlap-p (nth 3 first))) ((symbolp (cdr first)) (setq match 0 allow-overlap-p nil ! face (eval (cdr first)))) (t (setq match (cdr first) *************** *** 291,296 **** (if loudly (message "Fontifying %s... (regexps...%s)" (buffer-name) ! (make-string (setq count (1+ count)) ?.)))))) ! ;; The user level functions --- 304,309 ---- (if loudly (message "Fontifying %s... (regexps...%s)" (buffer-name) ! (make-string (setq count (1+ count)) ?.)))) ! (set-buffer-modified-p modified))) ;; The user level functions *************** *** 478,482 **** "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? "\\(" ctoken "[ \t]+\\)?" ! "\\(\\*+[ \t]*\\)?" ; pointer "\\(" ctoken "\\)[ \t]*(") ; name 5 'font-lock-function-name-face) --- 491,495 ---- "\\(" ctoken "[ \t]+\\)?" ; more than 3 tokens, right? "\\(" ctoken "[ \t]+\\)?" ! "\\([*&]+[ \t]*\\)?" ; pointer "\\(" ctoken "\\)[ \t]*(") ; name 5 'font-lock-function-name-face) *************** *** 541,551 **** (defvar perl-font-lock-keywords (list ! (concat "[ \n\t{]*\\(" ! (mapconcat 'identity ! '("if" "until" "while" "elsif" "else" "unless" "for" ! "foreach" "continue" "exit" "die" "last" "goto" "next" ! "redo" "return" "local" "exec") ! "\\|") ! "\\)[ \n\t;(]") (mapconcat 'identity '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" --- 554,564 ---- (defvar perl-font-lock-keywords (list ! (cons (concat "[ \n\t{]*\\(" ! (mapconcat 'identity ! '("if" "until" "while" "elsif" "else" "unless" "for" ! "foreach" "continue" "exit" "die" "last" "goto" "next" ! "redo" "return" "local" "exec") ! "\\|") ! "\\)[ \n\t;(]") 1) (mapconcat 'identity '("#endif" "#else" "#ifdef" "#ifndef" "#if" "#include" *************** *** 552,557 **** "#define" "#undef") "\\|") ! '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)\\{" . font-lock-function-name-face) ! '("[ \n\t{]*\\(eval\\)[ \n\t(;]" . font-lock-function-name-face) '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face) ) --- 565,570 ---- "#define" "#undef") "\\|") ! '("^[ \n\t]*sub[ \t]+\\([^ \t{]+\\)[ \t]*[{]" 1 font-lock-function-name-face) ! '("[ \n\t{]*\\(eval\\)[ \n\t(;]" 1 font-lock-function-name-face) '("\\(--- .* ---\\|=== .* ===\\)" . font-lock-doc-string-face) ) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/frame.el emacs-19.18/lisp/frame.el *** emacs-19.17/lisp/frame.el Sat Jul 3 22:18:42 1993 --- emacs-19.18/lisp/frame.el Mon Aug 2 23:32:36 1993 *************** *** 82,85 **** --- 82,88 ---- (defvar frame-initial-frame nil) + ;; Record the parameters used in frame-initialize to make the initial frame. + (defvar frame-initial-frame-alist) + ;;; startup.el calls this function before loading the user's init ;;; file - if there is no frame with a minibuffer open now, create *************** *** 96,99 **** --- 99,104 ---- (or (delq terminal-frame (minibuffer-frame-list)) (progn + (setq frame-initial-frame-alist + (append initial-frame-alist default-frame-alist)) (setq default-minibuffer-frame (setq frame-initial-frame *************** *** 225,235 **** ;; Finally, get rid of the old frame. ! (delete-frame frame-initial-frame)) ;; Otherwise, we don't need all that rigamarole; just apply ;; the new parameters. ! (modify-frame-parameters frame-initial-frame ! (append initial-frame-alist ! default-frame-alist)))) ;; Restore the original buffer. --- 230,259 ---- ;; Finally, get rid of the old frame. ! (delete-frame frame-initial-frame t)) ;; Otherwise, we don't need all that rigamarole; just apply ;; the new parameters. ! (let (newparms allparms tail) ! (setq allparms (append initial-frame-alist ! default-frame-alist)) ! (setq tail allparms) ! ;; Find just the parms that have changed since we first ! ;; made this frame. Those are the ones actually set by ! ;; the init file. For those parms whose values we already knew ! ;; (such as those spec'd by command line options) ! ;; it is undesirable to specify the parm again ! ;; once the user has seen the frame and been able to alter it ! ;; manually. ! (while tail ! (let (newval oldval) ! (setq oldval (cdr (assq (car (car tail)) ! frame-initial-frame-alist))) ! (setq newval (cdr (assq (car (car tail)) allparms))) ! (or (eq oldval newval) ! (setq newparms ! (cons (cons (car (car tail)) newval) newparms)))) ! (setq tail (cdr tail))) ! (modify-frame-parameters frame-initial-frame ! (nreverse newparms))))) ;; Restore the original buffer. *************** *** 327,330 **** --- 351,373 ---- + (defun other-frame (arg) + "Select the ARG'th different visible frame, and raise it. + All frames are arranged in a cyclic order. + This command selects the frame ARG steps away in that order. + A negative ARG moves in the opposite order." + (interactive "p") + (let ((frame (selected-frame))) + (while (> arg 0) + (setq frame (next-frame frame)) + (while (not (eq (frame-visible-p frame) t)) + (setq frame (next-frame frame))) + (setq arg (1- arg))) + (while (< arg 0) + (setq frame (previous-frame frame)) + (while (not (eq (frame-visible-p frame) t)) + (setq frame (previous-frame frame))) + (setq arg (1- arg))) + (raise-frame frame) + (select-frame frame))) ;;;; Frame configurations *************** *** 512,515 **** --- 555,559 ---- (define-key ctl-x-5-map "2" 'new-frame) (define-key ctl-x-5-map "0" 'delete-frame) + (define-key ctl-x-5-map "o" 'other-frame) (provide 'frame) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/gnus.el emacs-19.18/lisp/gnus.el *** emacs-19.17/lisp/gnus.el Sat Jul 17 14:56:18 1993 --- emacs-19.18/lisp/gnus.el Wed Jul 28 04:35:48 1993 *************** *** 1,6 **** ;;; GNUS: an NNTP-based News Reader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993 Free Software Foundation, Inc. - ;; $Header: /home/fsf/rms/e19/lisp/RCS/gnus.el,v 1.23 1993/07/17 18:56:09 rms Exp $ ;; This file is part of GNU Emacs. --- 1,9 ---- ;;; GNUS: an NNTP-based News Reader for GNU Emacs ;; Copyright (C) 1987, 1988, 1989, 1990, 1993 Free Software Foundation, Inc. + ;; Author: Masanobu UMEDA + ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/gnus.el,v 1.26 1993/07/28 08:35:38 rms Exp $ + ;; Keywords: news + ;; This file is part of GNU Emacs. *************** *** 81,113 **** ;; Info-directory, create it in your private directory and set the ;; variable gnus-info-directory to that directory. - - ;; GNUS Mailing List: - ;; There are two mailing lists for GNUS lovers in the world: - ;; - ;; info-gnus@flab.fujitsu.co.jp, and - ;; info-gnus-english@tut.cis.ohio-state.edu. - ;; - ;; They are intended to exchange useful information about GNUS, such - ;; as bug fixes, useful hooks, and extensions. The major difference - ;; between the lists is what the official language is. Both Japanese - ;; and English are available in info-gnus, while English is only - ;; available in info-gnus-english. There is no need to subscribe to - ;; info-gnus if you cannot read Japanese messages, because most of the - ;; discussion and important announcements will be sent to - ;; info-gnus-english. Moreover, if you can read gnu.emacs.gnus - ;; newsgroup of USENET, you need not, either. info-gnus-english and - ;; gnu.emacs.gnus are linked each other. - ;; - ;; Please send subscription request to: ;; ! ;; info-gnus-request@flab.fujitsu.co.jp, or ! ;; info-gnus-english-request@cis.ohio-state.edu ;; TO DO: ;; (1) Incremental update of active info. ! ;; (2) GNUS own poster. ! ;; (3) Multi-GNUS (Talking to many hosts same time). ! ;; (4) Asynchronous transmission of large messages. (provide 'gnus) (require 'nntp) --- 84,97 ---- ;; Info-directory, create it in your private directory and set the ;; variable gnus-info-directory to that directory. ;; ! ;; For getting more information about GNUS, consult USENET newsgorup ! ;; gnu.emacs.gnus. ;; TO DO: ;; (1) Incremental update of active info. ! ;; (2) Asynchronous transmission of large messages. + ;;; Code: + (provide 'gnus) (require 'nntp) *************** *** 114,117 **** --- 98,105 ---- (require 'mail-utils) + (defvar gnus-default-nntp-server nil + "*Specify default NNTP server. + This variable should be defined in paths.el.") + (defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server) "*The name of the host running NNTP server. *************** *** 125,132 **** (defvar gnus-startup-file "~/.newsrc" ! "*Your .newsrc file. Use `.newsrc-SERVER' instead if exists.") (defvar gnus-signature-file "~/.signature" ! "*Your .signature file. Use `.signature-DISTRIBUTION' instead if exists.") (defvar gnus-use-cross-reference t --- 113,120 ---- (defvar gnus-startup-file "~/.newsrc" ! "*Your `.newsrc' file. Use `.newsrc-SERVER' instead if exists.") (defvar gnus-signature-file "~/.signature" ! "*Your `.signature' file. Use `.signature-DISTRIBUTION' instead if exists.") (defvar gnus-use-cross-reference t *************** *** 151,155 **** Articles are saved using a function specified by the the variable ! gnus-author-copy-saver (rmail-output is default) if a file name is given. Instead, if the first character of the name is `|', the contents of the article is piped out to the named program. It is --- 139,143 ---- Articles are saved using a function specified by the the variable ! `gnus-author-copy-saver' (`rmail-output' is default) if a file name is given. Instead, if the first character of the name is `|', the contents of the article is piped out to the named program. It is *************** *** 203,208 **** (defvar gnus-novice-user t ! "*Non-nil means that you are a novice to USENET. If non-nil, ! verbose messages may be displayed or your confirmations may be required.") (defvar gnus-interactive-catchup t --- 191,197 ---- (defvar gnus-novice-user t ! "*Non-nil means that you are a novice to USENET. ! If non-nil, verbose messages may be displayed ! or your confirmations may be required.") (defvar gnus-interactive-catchup t *************** *** 213,217 **** (defvar gnus-interactive-exit t ! "*Require your confirmation when exiting gnus if non-nil.") (defvar gnus-user-login-name nil --- 202,206 ---- (defvar gnus-interactive-exit t ! "*Require your confirmation when exiting GNUS if non-nil.") (defvar gnus-user-login-name nil *************** *** 234,239 **** (defvar gnus-thread-hide-subtree nil "*Non-nil means hide thread subtrees initially. ! If non-nil, you have to run the command gnus-summary-show-thread by ! hand or by using gnus-select-article-hook to show hidden threads.") (defvar gnus-thread-hide-killed t --- 223,228 ---- (defvar gnus-thread-hide-subtree nil "*Non-nil means hide thread subtrees initially. ! If non-nil, you have to run the command `gnus-summary-show-thread' by ! hand or by using `gnus-select-article-hook' to show hidden threads.") (defvar gnus-thread-hide-killed t *************** *** 248,252 **** (defvar gnus-ignored-newsgroups "^to\\..*$" ! "*A regular expression used to ignore uninterested newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, --- 237,241 ---- (defvar gnus-ignored-newsgroups "^to\\..*$" ! "*A regexp to match uninteresting newsgroups in the active file. Any lines in the active file matching this regular expression are removed from the newsgroup list before anything else is done to it, *************** *** 282,287 **** "*Select the first unread article automagically if non-nil. 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 ! or gnus-apply-kill-hook.") (defvar gnus-auto-select-next t --- 271,276 ---- "*Select the first unread article automagically if non-nil. 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' ! or `gnus-apply-kill-hook'.") (defvar gnus-auto-select-next t *************** *** 289,293 **** 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. Especially, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations.") --- 278,282 ---- 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. Especially, if the value is the symbol `quietly', the next unread newsgroup will be selected without any confirmations.") *************** *** 302,306 **** "*Insert `To: author' of the article when following up if non-nil. Mail is sent using the function specified by the variable ! gnus-mail-send-method.") (defvar gnus-break-pages t --- 291,295 ---- "*Insert `To: author' of the article when following up if non-nil. Mail is sent using the function specified by the variable ! `gnus-mail-send-method'.") (defvar gnus-break-pages t *************** *** 336,341 **** (function gnus-mail-reply-using-mail) "*Function to compose reply mail. ! The function gnus-mail-reply-using-mail uses usual sendmail mail ! program. The function gnus-mail-reply-using-mhe uses mh-e mail program. You can use yet another program by customizing this variable.") --- 325,330 ---- (function gnus-mail-reply-using-mail) "*Function to compose reply mail. ! The function `gnus-mail-reply-using-mail' uses usual sendmail mail ! program. The function `gnus-mail-reply-using-mhe' uses the MH-E mail program. You can use yet another program by customizing this variable.") *************** *** 343,348 **** (function gnus-mail-forward-using-mail) "*Function to forward current message to another user. ! The function gnus-mail-reply-using-mail uses usual sendmail mail ! program. You can use yet another program by customizing this variable.") (defvar gnus-mail-other-window-method --- 332,337 ---- (function gnus-mail-forward-using-mail) "*Function to forward current message to another user. ! The function `gnus-mail-reply-using-mail' uses usual sendmail mail ! program. You can use yet another program by customizing this variable.") (defvar gnus-mail-other-window-method *************** *** 349,354 **** (function gnus-mail-other-window-using-mail) "*Function to compose mail in other window. ! The function gnus-mail-other-window-using-mail uses usual sendmail ! mail program. The function gnus-mail-other-window-using-mhe uses mh-e mail program. You can use yet another program by customizing this variable.") --- 338,343 ---- (function gnus-mail-other-window-using-mail) "*Function to compose mail in other window. ! The function `gnus-mail-other-window-using-mail' uses the usual sendmail ! mail program. The function `gnus-mail-other-window-using-mhe' uses the MH-E mail program. You can use yet another program by customizing this variable.") *************** *** 355,361 **** (defvar gnus-mail-send-method send-mail-function "*Function to mail a message too which is being posted as an article. ! The message must have To: or Cc: field. The value of the variable ! send-mail-function is the default function which uses sendmail mail ! program.") (defvar gnus-subscribe-newsgroup-method --- 344,349 ---- (defvar gnus-mail-send-method send-mail-function "*Function to mail a message too which is being posted as an article. ! The message must have To: or Cc: field. The default is copied from ! the variable `send-mail-function'.") (defvar gnus-subscribe-newsgroup-method *************** *** 362,370 **** (function gnus-subscribe-alphabetically) "*Function called with a newsgroup name when new newsgroup is found. ! The function gnus-subscribe-randomly inserts a new newsgroup a the ! beginning of newsgroups. The function gnus-subscribe-alphabetically inserts it in strict alphabetic order. The function ! gnus-subscribe-hierarchically inserts it in hierarchical newsgroup ! order. The function gnus-subscribe-interactively asks for your decision.") (defvar gnus-group-mode-hook nil --- 350,358 ---- (function gnus-subscribe-alphabetically) "*Function called with a newsgroup name when new newsgroup is found. ! The function `gnus-subscribe-randomly' inserts a new newsgroup a the ! beginning of newsgroups. The function `gnus-subscribe-alphabetically' inserts it in strict alphabetic order. The function ! `gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup ! order. The function `gnus-subscribe-interactively' asks for your decision.") (defvar gnus-group-mode-hook nil *************** *** 406,428 **** can use the following hook: ! (setq gnus-select-group-hook ! (function ! (lambda () ! ;; First of all, sort by date. ! (gnus-keysort-headers ! (function string-lessp) ! (function ! (lambda (a) ! (gnus-sortable-date (gnus-header-date a))))) ! ;; Then sort by subject string ignoring `Re:'. ! ;; If case-fold-search is non-nil, case of letters is ignored. ! (gnus-keysort-headers ! (function string-lessp) ! (function ! (lambda (a) ! (if case-fold-search ! (downcase (gnus-simplify-subject (gnus-header-subject a) t)) ! (gnus-simplify-subject (gnus-header-subject a) t))))) ! ))) If you'd like to simplify subjects like the --- 394,417 ---- can use the following hook: ! \(setq gnus-select-group-hook ! (list ! (function ! (lambda () ! ;; First of all, sort by date. ! (gnus-keysort-headers ! (function string-lessp) ! (function ! (lambda (a) ! (gnus-sortable-date (gnus-header-date a))))) ! ;; Then sort by subject string ignoring `Re:'. ! ;; If case-fold-search is non-nil, case of letters is ignored. ! (gnus-keysort-headers ! (function string-lessp) ! (function ! (lambda (a) ! (if case-fold-search ! (downcase (gnus-simplify-subject (gnus-header-subject a) t)) ! (gnus-simplify-subject (gnus-header-subject a) t))))) ! )))) If you'd like to simplify subjects like the *************** *** 430,443 **** following hook: ! (setq gnus-select-group-hook ! (function ! (lambda () ! (mapcar (function ! (lambda (header) ! (nntp-set-header-subject ! header ! (gnus-simplify-subject ! (gnus-header-subject header) 're-only)))) ! gnus-newsgroup-headers)))) In some newsgroups author name is meaningless. It is possible to --- 419,433 ---- following hook: ! \(setq gnus-select-group-hook ! (list ! (function ! (lambda () ! (mapcar (function ! (lambda (header) ! (nntp-set-header-subject ! header ! (gnus-simplify-subject ! (gnus-header-subject header) 're-only)))) ! gnus-newsgroup-headers))))) In some newsgroups author name is meaningless. It is possible to *************** *** 444,467 **** prevent listing author names in GNUS Summary buffer as follows: ! (setq gnus-select-group-hook ! (function ! (lambda () ! (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name) ! (setq gnus-optional-headers ! (function gnus-optional-lines))) ! (t ! (setq gnus-optional-headers ! (function gnus-optional-lines-and-from)))))))") (defvar gnus-select-article-hook ! (function (lambda () (gnus-summary-show-thread))) "*A hook called when an article is selected. The default hook shows conversation thread subtrees of the selected ! article automatically as follows: ! ! (setq gnus-select-article-hook ! (function ! (lambda () ! (gnus-summary-show-thread)))) If you'd like to run RMAIL on a digest article automagically, you can --- 434,453 ---- prevent listing author names in GNUS Summary buffer as follows: ! \(setq gnus-select-group-hook ! (list ! (function ! (lambda () ! (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name) ! (setq gnus-optional-headers ! (function gnus-optional-lines))) ! (t ! (setq gnus-optional-headers ! (function gnus-optional-lines-and-from))))))))") (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'. If you'd like to run RMAIL on a digest article automagically, you can *************** *** 468,503 **** use the following hook: ! (setq gnus-select-article-hook ! (function ! (lambda () ! (gnus-summary-show-thread) ! (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name) ! (gnus-summary-rmail-digest)) ! ((and (string-equal \"comp.text\" gnus-newsgroup-name) ! (string-match \"^TeXhax Digest\" ! (gnus-header-subject gnus-current-headers))) ! (gnus-summary-rmail-digest) ! )))))") (defvar gnus-select-digest-hook ! (function ! (lambda () ! ;; Reply-To: is required by `undigestify-rmail-message'. ! (or (mail-position-on-field "Reply-to" t) ! (progn ! (mail-position-on-field "Reply-to") ! (insert (gnus-fetch-field "From")))))) "*A hook called when reading digest messages using Rmail. This hook can be used to modify incomplete digest articles as follows ! (this is the default): ! (setq gnus-select-digest-hook ! (function ! (lambda () ! ;; Reply-To: is required by `undigestify-rmail-message'. ! (or (mail-position-on-field \"Reply-to\" t) ! (progn ! (mail-position-on-field \"Reply-to\") ! (insert (gnus-fetch-field \"From\")))))))") (defvar gnus-rmail-digest-hook nil --- 454,492 ---- use the following hook: ! \(setq gnus-select-article-hook ! (list ! (function ! (lambda () ! (gnus-summary-show-thread) ! (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name) ! (gnus-summary-rmail-digest)) ! ((and (string-equal \"comp.text\" gnus-newsgroup-name) ! (string-match \"^TeXhax Digest\" ! (gnus-header-subject gnus-current-headers))) ! (gnus-summary-rmail-digest) ! ))))))") (defvar gnus-select-digest-hook ! (list ! (function ! (lambda () ! ;; Reply-To: is required by `undigestify-rmail-message'. ! (or (mail-position-on-field "Reply-to" t) ! (progn ! (mail-position-on-field "Reply-to") ! (insert (gnus-fetch-field "From"))))))) "*A hook called when reading digest messages using Rmail. This hook can be used to modify incomplete digest articles as follows ! \(this is the default): ! \(setq gnus-select-digest-hook ! (list ! (function ! (lambda () ! ;; Reply-To: is required by `undigestify-rmail-message'. ! (or (mail-position-on-field \"Reply-to\" t) ! (progn ! (mail-position-on-field \"Reply-to\") ! (insert (gnus-fetch-field \"From\"))))))))") (defvar gnus-rmail-digest-hook nil *************** *** 505,512 **** This hook is intended to customize Rmail mode for reading digest articles.") ! (defvar gnus-apply-kill-hook (function gnus-apply-kill-file) "*A hook called when a newsgroup is selected and summary list is prepared. This hook is intended to apply a KILL file to the selected newsgroup. ! The function `gnus-apply-kill-file' is called defaultly. Since a general KILL file is too heavy to use only for a few --- 494,501 ---- This hook is intended to customize Rmail mode for reading digest articles.") ! (defvar gnus-apply-kill-hook '(gnus-apply-kill-file) "*A hook called when a newsgroup is selected and summary list is prepared. This hook is intended to apply a KILL file to the selected newsgroup. ! The function `gnus-apply-kill-file' is called by default. Since a general KILL file is too heavy to use only for a few *************** *** 516,532 **** following hook: ! (setq gnus-apply-kill-hook ! (function ! (lambda () ! (cond ((string-match \"control\" gnus-newsgroup-name) ! (gnus-kill \"Subject\" \"rmgroup\") ! (gnus-expunge \"X\"))))))") (defvar gnus-mark-article-hook ! (function ! (lambda () ! (or (memq gnus-current-article gnus-newsgroup-marked) ! (gnus-summary-mark-as-read gnus-current-article)) ! (gnus-summary-set-current-mark "+"))) "*A hook called when an article is selected at the first time. The hook is intended to mark an article as read (or unread) --- 505,523 ---- following hook: ! \(setq gnus-apply-kill-hook ! (list ! (function ! (lambda () ! (cond ((string-match \"control\" gnus-newsgroup-name) ! (gnus-kill \"Subject\" \"rmgroup\") ! (gnus-expunge \"X\")))))))") (defvar gnus-mark-article-hook ! (list ! (function ! (lambda () ! (or (memq gnus-current-article gnus-newsgroup-marked) ! (gnus-summary-mark-as-read gnus-current-article)) ! (gnus-summary-set-current-mark "+")))) "*A hook called when an article is selected at the first time. The hook is intended to mark an article as read (or unread) *************** *** 535,543 **** If you'd like to mark as unread (-) instead, use the following hook: ! (setq gnus-mark-article-hook ! (function ! (lambda () ! (gnus-summary-mark-as-unread gnus-current-article) ! (gnus-summary-set-current-mark \"+\"))))") (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature)) --- 526,535 ---- If you'd like to mark as unread (-) instead, use the following hook: ! \(setq gnus-mark-article-hook ! (list ! (function ! (lambda () ! (gnus-summary-mark-as-unread gnus-current-article) ! (gnus-summary-set-current-mark \"+\")))))") (defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature)) *************** *** 606,612 **** ;; Internal variables. ! (defconst gnus-version "GNUS 3.15" "Version numbers of this version of GNUS.") (defvar gnus-info-nodes '((gnus-group-mode "(gnus)Newsgroup Commands") --- 598,611 ---- ;; Internal variables. ! (defconst gnus-version "GNUS 4.1" "Version numbers of this version of GNUS.") + (defconst gnus-emacs-version + (progn + (string-match "[0-9]*" emacs-version) + (string-to-int (substring emacs-version + (match-beginning 0) (match-end 0)))) + "Major version number of this emacs.") + (defvar gnus-info-nodes '((gnus-group-mode "(gnus)Newsgroup Commands") *************** *** 1212,1217 **** "Insert startup message in current buffer." ;; Insert the message. ! (insert " ! GNUS Version 3.15 NNTP-based News Reader for GNU Emacs --- 1211,1217 ---- "Insert startup message in current buffer." ;; Insert the message. ! (insert ! (format " ! %s NNTP-based News Reader for GNU Emacs *************** *** 1224,1228 **** Masanobu UMEDA ! umerin@mse.kyutech.ac.jp") ;; And then hack it. ;; 57 is the longest line. --- 1224,1228 ---- Masanobu UMEDA ! umerin@mse.kyutech.ac.jp" gnus-version)) ;; And then hack it. ;; 57 is the longest line. *************** *** 6570,6576 **** ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem) ;; but no longer viable because of extensive backtracking in Emacs 19: ! ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" nil t) (while (re-search-forward ! "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\|[^ \t\n].*\\)$" nil t) (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1))) ;; Check duplications of newsgroups. --- 6570,6581 ---- ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem) ;; but no longer viable because of extensive backtracking in Emacs 19: ! ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" ! ;; but, the following causes trouble on some case: ! ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\|[^ \t\n].*\\)$" (while (re-search-forward ! (if (= gnus-emacs-version 18) ! "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$" ! "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$") ! nil t) (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1))) ;; Check duplications of newsgroups. *************** *** 6944,6945 **** --- 6949,6952 ---- ;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1) ;;end: + + ;;; gnus.el ends here diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/gnuspost.el emacs-19.18/lisp/gnuspost.el *** emacs-19.17/lisp/gnuspost.el Sat Jun 5 16:01:26 1993 --- emacs-19.18/lisp/gnuspost.el Tue Jul 20 00:25:06 1993 *************** *** 4,7 **** --- 4,8 ---- ;; Author: Masanobu UMEDA + ;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/gnuspost.el,v 1.14 1993/07/20 04:25:04 rms Exp $ ;; Keywords: news *************** *** 694,698 **** (defun gnus-current-time-zone (time) "The local time zone in effect at TIME, or nil if not known." ! (let ((z (and (fboundp 'current-time-zone) (current-time-zone now)))) (if (and z (car z)) z gnus-local-timezone))) --- 695,699 ---- (defun gnus-current-time-zone (time) "The local time zone in effect at TIME, or nil if not known." ! (let ((z (and (fboundp 'current-time-zone) (current-time-zone time)))) (if (and z (car z)) z gnus-local-timezone))) *************** *** 759,762 **** --- 760,764 ---- private-file))) (and (stringp organization) + (> (length organization) 0) (string-equal (substring organization 0 1) "/") ;; Get it from the user and system file. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/gomoku.el emacs-19.18/lisp/gomoku.el *** emacs-19.17/lisp/gomoku.el Sat Sep 26 17:31:14 1992 --- emacs-19.18/lisp/gomoku.el Sun Aug 1 16:50:07 1993 *************** *** 320,324 **** ((not (zerop (aref gomoku-board square))) (aset gomoku-score-table square -1)) ! ((= count (random-number (setq count (1+ count)))) (setq best-square square score-max score))) --- 320,324 ---- ((not (zerop (aref gomoku-board square))) (aset gomoku-score-table square -1)) ! ((zerop (random (setq count (1+ count)))) (setq best-square square score-max score))) *************** *** 325,333 **** (setq square (1+ square))) ; try next square best-square)) - - (defun random-number (n) - "Return a random integer between 0 and N-1 inclusive." - (setq n (% (random) n)) - (if (< n 0) (- n) n)) ;;; --- 325,328 ---- diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/gud.el emacs-19.18/lisp/gud.el *** emacs-19.17/lisp/gud.el Wed Jul 14 21:48:47 1993 --- emacs-19.18/lisp/gud.el Mon Aug 9 00:36:17 1993 *************** *** 85,89 **** are interpreted specially if present. These are: ! %f name of current source file. %l number of current source line %e text of the C lvalue or function-call expression surrounding point. --- 85,90 ---- are interpreted specially if present. These are: ! %f name (without directory) of current source file. ! %d directory of current source file. %l number of current source line %e text of the C lvalue or function-call expression surrounding point. *************** *** 120,124 **** ;; the last frame, even if it's been called before and gud-last-frame has ;; been set to nil. ! (defvar gud-last-last-frame) ;; All debugger-specific information is collected here. --- 121,125 ---- ;; the last frame, even if it's been called before and gud-last-frame has ;; been set to nil. ! (defvar gud-last-last-frame nil) ;; All debugger-specific information is collected here. *************** *** 156,174 **** (cons "-fullname" (cons file args))) (defun gud-gdb-marker-filter (string) ! (if (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" string) ! (progn ! (setq gud-last-frame ! (cons ! (substring string (match-beginning 1) (match-end 1)) ! (string-to-int ! (substring string (match-beginning 2) (match-end 2))))) ! ;; this computation means the ^Z^Z-initiated marker in the ! ;; input string is never emitted. ! (concat ! (substring string 0 (match-beginning 0)) ! (substring string (match-end 0)) ! )) ! string)) (defun gud-gdb-find-file (f) --- 157,212 ---- (cons "-fullname" (cons file args))) + ;; There's no guarantee that Emacs will hand the filter the entire + ;; marker at once; it could be broken up across several strings. We + ;; might even receive a big chunk with several markers in it. If we + ;; receive a chunk of text which looks like it might contain the + ;; beginning of a marker, we save it here between calls to the + ;; filter. + (defvar gud-gdb-marker-acc "") + (defun gud-gdb-marker-filter (string) ! (save-match-data ! (setq gud-gdb-marker-acc (concat gud-gdb-marker-acc string)) ! (let ((output "")) ! ! ;; Process all the complete markers in this chunk. ! (while (string-match "^\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" ! gud-gdb-marker-acc) ! (setq ! ! ;; Extract the frame position from the marker. ! gud-last-frame ! (cons (substring gud-gdb-marker-acc (match-beginning 1) (match-end 1)) ! (string-to-int (substring gud-gdb-marker-acc ! (match-beginning 2) ! (match-end 2)))) ! ! ;; Append any text before the marker to the output we're going ! ;; to return - we don't include the marker in this text. ! output (concat output ! (substring gud-gdb-marker-acc 0 (match-beginning 0))) ! ! ;; Set the accumulator to the remaining text. ! gud-gdb-marker-acc (substring gud-gdb-marker-acc (match-end 0)))) ! ! ;; Does the remaining text look like it might end with the ! ;; beginning of another marker? If it does, then keep it in ! ;; gud-gdb-marker-acc until we receive the rest of it. Since we ! ;; know the full marker regexp above failed, it's pretty simple to ! ;; test for marker starts. ! (if (string-match "^\032.*\\'" gud-gdb-marker-acc) ! (progn ! ;; Everything before the potential marker start can be output. ! (setq output (concat output (substring gud-gdb-marker-acc ! 0 (match-beginning 0)))) ! ! ;; Everything after, we save, to combine with later input. ! (setq gud-gdb-marker-acc ! (substring gud-gdb-marker-acc (match-beginning 0)))) ! ! (setq output (concat output gud-gdb-marker-acc) ! gud-gdb-marker-acc "")) ! ! output))) (defun gud-gdb-find-file (f) *************** *** 300,305 **** (defun gud-dbx-marker-filter (string) ! (if (string-match ! "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" string) (setq gud-last-frame (cons --- 338,347 ---- (defun gud-dbx-marker-filter (string) ! (if (or (string-match ! "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" ! string) ! (string-match ! "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" ! string)) (setq gud-last-frame (cons *************** *** 331,336 **** (gud-common-init command-line) ! (gud-def gud-break "stop at \"%f\":%l" "\C-b" "Set breakpoint at current line.") (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "step %p" "\C-s" "Step one line with display.") --- 373,380 ---- (gud-common-init command-line) ! (gud-def gud-break "file \"%d%f\"\nstop at %l" "\C-b" "Set breakpoint at current line.") + ;; (gud-def gud-break "stop at \"%f\":%l" + ;; "\C-b" "Set breakpoint at current line.") (gud-def gud-remove "clear %l" "\C-d" "Remove breakpoint at current line") (gud-def gud-step "step %p" "\C-s" "Step one line with display.") *************** *** 722,761 **** (let ((insource (not (eq (current-buffer) gud-comint-buffer)))) (if (string-match "\\(.*\\)%f\\(.*\\)" str) ! (progn ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (file-name-nondirectory (if insource ! (buffer-file-name) ! (car gud-last-frame))) ! (substring str (match-beginning 2) (match-end 2)))))) (if (string-match "\\(.*\\)%l\\(.*\\)" str) ! (progn ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (if insource ! (save-excursion ! (beginning-of-line) ! (save-restriction (widen) ! (1+ (count-lines 1 (point))))) ! (cdr gud-last-frame)) ! (substring str (match-beginning 2) (match-end 2)))))) (if (string-match "\\(.*\\)%e\\(.*\\)" str) ! (progn ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (find-c-expr) ! (substring str (match-beginning 2) (match-end 2)))))) (if (string-match "\\(.*\\)%a\\(.*\\)" str) ! (progn ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (gud-read-address) ! (substring str (match-beginning 2) (match-end 2)))))) (if (string-match "\\(.*\\)%p\\(.*\\)" str) ! (progn ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (if arg (int-to-string arg) "") ! (substring str (match-beginning 2) (match-end 2)))))) ) str --- 766,807 ---- (let ((insource (not (eq (current-buffer) gud-comint-buffer)))) (if (string-match "\\(.*\\)%f\\(.*\\)" str) ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (file-name-nondirectory (if insource ! (buffer-file-name) ! (car gud-last-frame))) ! (substring str (match-beginning 2) (match-end 2))))) ! (if (string-match "\\(.*\\)%d\\(.*\\)" str) ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (file-name-directory (if insource ! (buffer-file-name) ! (car gud-last-frame))) ! (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%l\\(.*\\)" str) ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (if insource ! (save-excursion ! (beginning-of-line) ! (save-restriction (widen) ! (1+ (count-lines 1 (point))))) ! (cdr gud-last-frame)) ! (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%e\\(.*\\)" str) ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (find-c-expr) ! (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%a\\(.*\\)" str) ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (gud-read-address) ! (substring str (match-beginning 2) (match-end 2))))) (if (string-match "\\(.*\\)%p\\(.*\\)" str) ! (setq str (concat ! (substring str (match-beginning 1) (match-end 1)) ! (if arg (int-to-string arg) "") ! (substring str (match-beginning 2) (match-end 2))))) ) str diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/help.el emacs-19.18/lisp/help.el *** emacs-19.17/lisp/help.el Sun Jul 4 17:29:37 1993 --- emacs-19.18/lisp/help.el Fri Aug 6 16:22:43 1993 *************** *** 246,265 **** (make-help-screen help-for-help ! "a b c f i k l m n p s t v w C-c C-d C-n C-w. Type \\[help-for-help] again for more help: " "You have typed \\[help-for-help], the help character. Type a Help option: ! a command-apropos. Give a substring, and see a list of commands ! (functions interactively callable) that contain ! that substring. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; ! it prints the function name that sequence runs. f describe-function. Type a function name and get documentation of it. i info. The info documentation reader. k describe-key. Type a command key sequence; ! it displays the full documentation. l view-lossage. Shows last 100 characters you typed. m describe-mode. Print documentation of current major mode, ! which describes the commands peculiar to it. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. --- 246,269 ---- (make-help-screen help-for-help ! "a b c f C-f i k C-k l m n p s t v w C-c C-d C-n C-w. Type \\[help-for-help] again for more help: " "You have typed \\[help-for-help], the help character. Type a Help option: ! a command-apropos. Give a substring, and see a list of commands ! (functions interactively callable) that contain ! that substring. See also the apropos command. b describe-bindings. Display table of all key bindings. c describe-key-briefly. Type a command key sequence; ! it prints the function name that sequence runs. f describe-function. Type a function name and get documentation of it. + C-f Info-goto-emacs-command-node. Type a function name; + it takes you to the Info node for that command. i info. The info documentation reader. k describe-key. Type a command key sequence; ! it displays the full documentation. ! C-k Info-goto-emacs-key-command-node. Type a command key sequence; ! it takes you to the Info node for the command bound to that key. l view-lossage. Shows last 100 characters you typed. m describe-mode. Print documentation of current major mode, ! which describes the commands peculiar to it. n view-emacs-news. Shows emacs news file. p finder-by-keyword. Find packages matching a given topic keyword. *************** *** 267,273 **** t help-with-tutorial. Select the Emacs learn-by-doing tutorial. v describe-variable. Type name of a variable; ! it displays the variable's documentation and value. w where-is. Type command name; it prints which keystrokes ! invoke that command. C-c print Emacs copying permission (General Public License). C-d print Emacs ordering information. --- 271,277 ---- t help-with-tutorial. Select the Emacs learn-by-doing tutorial. v describe-variable. Type name of a variable; ! it displays the variable's documentation and value. w where-is. Type command name; it prints which keystrokes ! invoke that command. C-c print Emacs copying permission (General Public License). C-d print Emacs ordering information. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/hilit19.el emacs-19.18/lisp/hilit19.el *** emacs-19.17/lisp/hilit19.el --- emacs-19.18/lisp/hilit19.el Fri Jul 30 02:32:25 1993 *************** *** 0 **** --- 1,1302 ---- + ;; hilit19.el (Release 2.7) -- customizable highlighting for Emacs19. + ;; Copyright (c) 1993 Free Software Foundation, Inc. + ;; + ;; Author: Jonathan Stigelman + ;; Keywords: faces + ;; + ;; This program is free software; you can redistribute it and/or modify + ;; it under the terms of the GNU General Public License as published by + ;; the Free Software Foundation; either version 2 of the License, or + ;; (at your option) any later version. + ;; + ;; This program is distributed in the hope that it will be useful, + ;; but WITHOUT ANY WARRANTY; without even the implied warranty of + ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + ;; GNU General Public License for more details. + ;; + ;; You should have received a copy of the GNU General Public License + ;; along with this program; if not, write to the Free Software + ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + ;; + + ;;; Commentary: + + ;; Hilit19.el is a customizable highlighting package for Emacs19. It supports + ;; not only source code highlighting, but also Info, RMAIL, VM, gnus... + ;; Hilit19 knows (or thinks it knows) how to highlight emacs buffers in + ;; about 25 different modes. + ;; + ;; WHERE TO GET THE LATEST VERSIONS OF HILIT19.EL (beta and release), + ;; PLUS LOTS OF OTHER *WAY COOL* STUFF VIA ANONYMOUS FTP: + ;; + ;; netcom.com:/pub/stig/src/{Beta,Release}/hilit19.el.gz + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; TO SUBMIT BUG REPORTS (or feedback of any sort)... + ;; + ;; M-x hilit-submit-feedback RET + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; hilit19.el,v 2.7 1993/07/30 02:43:01 stig Release + ;; + ;; LCD Archive Entry: + ;; hilit19|Jonathan Stigelman|Stig@netcom.com| + ;; Comprehensive (and comparatively fast) regex-based highlighting for Emacs 19| + ;; 1993/07/30 02:43:01|Release 2.7|~/packages/hilit19.el.Z| + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; GENERAL OVERVIEW + ;; + ;; This package installs numerous hooks to colorfully highlight your + ;; source code buffers as well as mail and news buffers. Most + ;; programming languages have predefined highlighting patterns. + ;; Just load hilit19 and files will be automatically highlighted as + ;; they're loaded. + ;; + ;; Rehighlight a buffer by typing C-S-l (control-shift-lowercase-L). + ;; + ;; If, when you edit the buffer, the coloring gets messed up, just + ;; redraw and the coloring will be adjusted. If automatic highlighting + ;; in the current buffer has been turned off, then typing C-u C-S-l will + ;; force a rehighlight of the entire buffer. + ;; + ;; Hilit19 can build faces by examining the names that you give to them + ;; For example, green/black-bold-italic-underline would be created as + ;; a face with a green foreground, and a black background, using a + ;; bold-italic font...with underlining for good measure. + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; SETUP -- In your .emacs: + ;; + ;; + ;; (cond (window-system + ;; (setq hilit-mode-enable-list '(not text-mode) + ;; hilit-background-mode 'light + ;; hilit-inhibit-hooks nil + ;; hilit-inhibit-rebinding nil) + ;; + ;; (require 'hilit19) + ;; )) + ;; + ;; If you like font-lock-mode and want to use both packages, then you can + ;; disable hilit for the modes in which you want to use font-lock by listing + ;; said modes in hilit-mode-enable-list. + ;; + ;; (hilit-translate type 'RoyalBlue ; enable highlighting in C/C++ + ;; string nil) ; disable string highlighting + ;; + ;; To get 100% of the utility of hilit19, you may also have to apply the + ;; patches below for info.el and vm5.33L_19/vm-summary.el + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; SETUP -- Are you using the right font for Emacs? + ;; + ;; Emacs cannot properly find bold and italic fonts unless you specify a + ;; verbose X11 font name. Here's a good font menu: + ;; + ;; (setq + ;; x-fixed-font-alist + ;; '("Font Menu" + ;; ("Fonts" + ;; ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1") + ;; ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1") + ;; ("lucida 13" + ;; "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1") + ;; ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1") + ;; ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1") + ;; ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1") + ;; ("") + ;; ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1") + ;; ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1") + ;; ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1") + ;; ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1") + ;; ("") + ;; ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1") + ;; ("") + ;; ("-- Courier --") + ;; ("Courier 10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-*-1") + ;; ("Courier 12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-*-1") + ;; ("Courier 14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-*-1") + ;; ("Courier 18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-*-1") + ;; ("Courier 18-b" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-*-1") + ;; ))) + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; KNOWN BUGS/TO DO LIST/HELP WANTED/APPLY WITHIN + ;; + ;; * When more than one size of font is used in different frames, only one + ;; font size can have bold & italic properties. + ;; + ;; * When identifiers such as remove_switch_entry, ar highlighted in C/C++, + ;; imbedded keywords--"switch" in this case--are highlighted. I don't + ;; personally see this problem because I modify the syntax for C/C++ so that + ;; ?_ is a word character "w". This also means that forward-word skips over + ;; entire variables. This will be fixed when I generalize the highlighting + ;; patterns. + ;; + ;; * unbalanced, unescaped double quote characters can confuse hilit19. + ;; This will be fixed, so don't bug me about it. + ;; + ;; * ALTHOUGH HILIT19 IS FASTER THAN FONT-LOCK-MODE... + ;; For various reasons, the speed of the package could still stand to be + ;; improved. If you care to do a little profiling and make things tighter... + ;; + ;; * hilit-toggle-highlight is flaky when auto-rehighlight is neither t nor nil. + ;; Does anyone actually USE this? I think I might just remove it. + ;; + ;; PROJECTS THAT YOU CAN TAKE OVER BECAUSE I DON'T MUCH CARE ABOUT THEM... + ;; + ;; * Moved hilit-wysiwyg-replace here from my version of man.el, this is not + ;; a bug. The bug is that I don't have a reverse operation yet...just a + ;; stub Wysiwyg-anything really belongs in a package of it's own. + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; Thanks to the following people for their input: + ;; ebert@enpc.enpc.fr (Rolf EBERT), ada, LaTeX & bibtex highlights + ;; Vivek Khera , gnus hooks + random advice & patches + ;; brian@athe.WUstl.EDU (Brian Dunford-Shore), prolog highlights + ;; John Ladwig , 1st pass nroff highlights + ;; campo@sunthpi3.difi.unipi.it (Massimo Campostrini), fortran highlights + ;; jayb@laplace.MATH.ColoState.EDU (Jay Bourland), 1st pass dired + ;; Yoshio Turner , modula 2 highlights + ;; Fritz Knabe , advice & patches + ;; Alon Albert , advice & patches + ;; dana@thumper.bellcore.com (Dana A. Chee), working on the multi-frame bug + ;; derway@ndc.com (Don Erway), for breaking it... + ;; + ;; With suggestions and minor regex patches from numerous others... + ;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; hilit19.el,v + ;; Revision 2.7 1993/07/30 02:43:01 stig + ;; added const to the list of modifiers for C/C++ types + ;; + ;; Revision 2.6 1993/07/30 00:30:54 stig + ;; now permit selection of arbitrary subexpressions for highlighting... + ;; fixed keyword patterns for C/C++ using this technique. + ;; + ;; Revision 2.5 1993/07/28 05:02:56 stig + ;; improvements to makefile regular expressions + ;; removed about 130 lines just by compacting the big defconst for + ;; hilit-face-translation-table into a mapcar and defining a separate table + ;; of default faces. + ;; + ;; Revision 2.4 1993/07/27 14:09:05 stig + ;; documented another "known problem" to "head off gripe mail at the pass." + ;; + ;; Revision 2.3 1993/07/27 02:15:49 stig + ;; (hilit-lookup-face-create) incorporated patch which improves it's behavior + ;; with more than one frame... Still can't have bold on the same face in two + ;; differrent fonts sizes at the same time... + ;; + ;; Revision 2.2 1993/07/27 02:02:59 stig + ;; vastly improved the makefile patterns + ;; added hook for mh-show-mode + ;; + ;; Revision 2.1 1993/07/24 17:46:21 stig + ;; Phasing out Info-select-hook... Version 19.18 will use Info-selection-hook. + ;; + ;; Revision 2.0 1993/07/24 13:50:10 stig + ;; better documentation and added the function hilit-submit-feedback. + ;; C-S-l (control shift l) repaints the buffer. Other bindings are optional. + ;; multi-line highlights no longer cause problems when + ;; hilit-auto-rehighlight is 'visible + ;; added hilit-predefined-face-list... + ;; changed name of hilit-mode-alist to hilit-patterns-alist + ;; added hilit-message-quietly to mail-setup-hook + ;; added hilit-parser-alist which can be used to apply different patterns to + ;; different parts of a buffer. This could be integrated in a far more + ;; elegant manner, but it presently serves the purpose of not applying + ;; message header patterns to message bodies in mail-mode and it's kin. + ;; hilit-set-mode-patterns now takes a list of modes and an optional parse-fn + ;; + + ;;;;;; AND THIS CAN BE APPLIED TO VM 5.33L_19 + ;; + ;; *** ../site/vm5.33L_19/vm-summary.el Fri Jun 4 22:17:11 1993 + ;; --- ./vm-summary.el Tue Jun 22 16:39:30 1993 + ;; *************** + ;; *** 152,158 **** + ;; (insert "->") + ;; (delete-char 2) + ;; (forward-char -2) + ;; ! (and w vm-auto-center-summary (vm-auto-center-summary)))) + ;; (and old-window (select-window old-window))))))) + ;; + ;; (defun vm-mark-for-display-update (message) + ;; --- 152,159 ---- + ;; (insert "->") + ;; (delete-char 2) + ;; (forward-char -2) + ;; ! (and w vm-auto-center-summary (vm-auto-center-summary)) + ;; ! (run-hooks 'vm-summary-pointer-hook))) + ;; (and old-window (select-window old-window))))))) + ;; + ;; (defun vm-mark-for-display-update (message) + ;; + ;;;;;; + + ;;; Code: + + ;; User Options: + + (defvar hilit-quietly nil + "* If non-nil, this inhibits progress indicators during highlighting") + + (defvar hilit-auto-highlight t + "* T if we should highlight all buffers as we find 'em, nil to disable + automatic highlighting by the find-file hook.") + + (defvar hilit-auto-highlight-maxout 57000 + "* auto-highlight is disabled in buffers larger than this") + + (defvar hilit-auto-rehighlight t + "* If this is non-nil, then hilit-redraw and hilit-recenter will also + rehighlight part or all of the current buffer. T will rehighlight the + whole buffer, a NUMBER will rehighlight that many lines before and after + the cursor, and the symbol 'visible' will rehighlight only the visible + portion of the current buffer. This variable is buffer-local.") + + (make-variable-buffer-local 'hilit-auto-rehighlight) + + (defvar hilit-auto-rehighlight-fallback '(20000 . 100) + "* Cons of the form (THRESHOLD . FALLBACK), where FALLBACK is assigned to + hilit-auto-rehighlight if the size of a newly opened buffer is larger than + THRESHOLD.") + + (defvar hilit-face-check t + "* T slows down highlighting but permits the user to change fonts without + losing bold and italic faces... T causes hilit-lookup-face-create to dig + through the frame parameters for the current window every time it's called. + If you never change fonts in emacs, set this to NIL.") + + ;; Variables which must be set before loading hilit19. + + (defvar hilit-inhibit-rebinding nil + "If non-nil, this inhibits replacement of recenter, yank, and yank-pop.") + + (defvar hilit-inhibit-hooks nil + "If non-nil, this inhibits installation of hooks for Info, gnus, & vm.") + + (defvar hilit-background-mode 'light + "'mono inhibits color, 'dark or 'light indicate the background brightness.") + + (defvar hilit-mode-enable-list nil + "If a list of modes to exclusively enable or specifically disable. + The sense of the list is negated if it begins with the symbol 'not'. + Set this variable before you load hilit19. + + Ex: (perl-mode jargon-mode c-mode) ; just perl, C, and jargon modes + (not text-mode) ; all modes except text mode") + + ;; Variables that are not generally modified directly + + (defvar hilit-parser-alist nil + "alist of major-mode values and parsers called by hilit-rehighlight-buffer. + + Parsers for a given mode are IGNORED for partial rehighlights...maybe you'd + like to make this more universal?") + + (defvar hilit-patterns-alist nil + "alist of major-mode values and default highlighting patterns + + A hilighting pattern is a list of the form (start end face), where + start is a regex, end is a regex (or nil if it's not needed) and face + is the name of an entry in hilit-face-translation-table, the name of a face, + or nil (which disables the pattern). + + See the hilit-lookup-face-create documentation for valid face names.") + + (defvar hilit-predefined-face-list (face-list) + "List of faces with which hilit-lookup-face-create will NOT tamper. + + If hilit19 is dumped into emacs at your site, you may have to set this in + your init file.") + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Use this to report bugs: + + (eval-when-compile (require 'reporter)) ; no compilation gripes + + (defun hilit-submit-feeback () + "Submit feedback on hilit19 to the author: Stig@netcom.com" + (interactive) + (require 'reporter) + (and (y-or-n-p "Do you really want to submit a report on hilit19? ") + (reporter-submit-bug-report + "Jonathan Stigelman " + "hilit19.el (Release 2.7)" + (and (y-or-n-p "Do you need to include a dump hilit variables? ") + (append + '( + hilit-quietly hilit-inhibit-hooks + hilit-background-mode hilit-mode-enable-list + hilit-auto-highlight hilit-auto-highlight-maxout + hilit-auto-rehighlight hilit-auto-rehighlight-fallback + hilit-face-check + ) + (and (y-or-n-p "Have you modified the standard patterns? ") + (yes-or-no-p "Are your patterns *REALLY* relevant? ") + '(hilit-parser-alist + hilit-patterns-alist + hilit-predefined-face-list + )))) + (function + (lambda () + (and (y-or-n-p "Is this a problem with font display? ") + (insert "\nFrame Configuration:\n====================\n" + (prin1-to-string (frame-configuration-to-register ?F)) + "\n" + )))) + nil + (concat + "This is (check all that apply, and delete what's irrelevant):\n" + " [ ] a _MASSIVE_THANK_YOU_ for writing hilit19.el\n" + " [ ] An invitation to attend the next Hackers Conference\n" + " [ ] my DONATION to your vacation fund (prototype digital cash)\n" + " [ ] You're a RIGHTEOUS HACKER, what are your rates?\n" + " [ ] I've used the force and read the source, but I'M CONFUSED\n" + " [ ] a PATCH (diff -cw oldversion newversion) to fix a problem\n" + " [ ] a REPRODUCABLE BUG that I do not believe to be an EMACS bug\n" + " - I *swear* that it's not already mentioned in the KNOWN BUGS\n" + " - Also, I have checked netcom.com:/pub/stig/src/hilit19.el.gz\n" + " for a newer release that fixes the problem.\n" + " [ ] ADVICE -- or an unfulfilled desire that I suspect you share\n" + "\n" + "Hey Stig, I *know* you're busy but...\n")))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; These faces are either a valid face name, or nil + ;; if you want to change them, you must do so AFTER hilit19 is loaded + + (defconst hilit-default-face-table + '( + ;; used for C/C++ and elisp and perl + (comment firebrick-italic moccasin italic) + (include purple Plum1 default-bold-italic) + (define ForestGreen-bold green bold) + (defun blue-bold cyan-bold default-bold-italic) + (decl RoyalBlue cyan bold) + (type nil yellow nil) + (keyword RoyalBlue cyan default-bold-italic) + (label red-bold orange-underlined underline) + (string grey40 orange underline) + + ;; some further faces for Ada + (struct black-bold white-bold bold) + (glob-struct magenta Plum1 default-bold-underline) + (named-param DarkGoldenrod Goldenrod underline) + + ;; and anotherone for LaTeX + (crossref DarkGoldenrod Goldenrod underline) + + ;; compilation buffers + (active-error default/pink-bold default/DeepPink-bold bold-underline) + (error red-bold yellow bold) + (warning blue-italic green italic) + + ;; Makefiles (some faces borrowed from C/C++ too) + (rule blue-bold-underline cyan-underline bold-underline) + + ;; VM, GNUS and Text mode + (msg-subject blue-bold yellow bold) + (msg-from purple-bold SeaGreen bold) + (msg-header firebrick-bold cyan italic) + (msg-separator black/tan-bold lightblue nil) + (msg-quote ForestGreen green italic) + + (summary-seen grey40 white nil) + (summary-killed grey50 white nil) + (summary-Xed OliveDrab2 green nil) + (summary-deleted firebrick white italic) + (summary-unread RoyalBlue yellow bold) + (summary-new blue-bold yellow-bold default-bold-italic) + (summary-current default/skyblue-bold green/LightGrey-bold reverse-default) + + (gnus-group-unsubscribed grey50 white nil) + (gnus-group-empty nil yellow nil) + (gnus-group-full ForestGreen green italic) + (gnus-group-overflowing firebrick orange default-bold-italic) + + ;; dired mode + (dired-directory blue-bold cyan bold) + (dired-link firebrick-italic green italic) + (dired-ignored ForestGreen moccasin nil) + (dired-deleted red-bold-italic orange default-bold-italic) + (dired-marked purple Plum1 nil) + + ;; Info-mode, and jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon* + (jargon-entry blue-bold cyan bold) + (jargon-xref purple-bold Plum1 italic) + (jargon-keyword firebrick-underline yellow underline) + ) + "alist of default faces (face . (light-default dark-default mono-default))") + + (defconst hilit-face-translation-table + (let ((index (or (cdr (assq hilit-background-mode + '((light . 1) (dark . 2)))) + 3))) + (mapcar (function (lambda (x) (cons (car x) (nth index x)))) + hilit-default-face-table)) + "alist that maps symbolic face-names to real face names") + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; To translate one face to another... + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defmacro hilit-translate (&rest args) + "(hilit-translate FROM TO FROM TO ...): translate each face FROM to the + value of its TO face. This is like setq for faces. + + The function hilit-lookup-face-create will repeatedly translate until no more + translations for the face exist in the translation table. + + See the documentation for hilit-lookup-face-create for names of valid faces." + (or (zerop (% (length args) 2)) + (error "wrong number of args")) + (let (cmdl from to) + (while args + (setq from (car args) to (nth 1 args) args (nthcdr 2 args) + cmdl (cons (list 'hilit-associate ''hilit-face-translation-table + (list 'quote from) to) + cmdl))) + (cons 'progn cmdl))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; This function actually translates and then creates the faces... + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defun hilit-lookup-face-create (face &optional force) + "Get a FACE, or create it if it doesn't exist. In order for it to + properly create the face, the followwing naming convention must be used: + [reverse-](fgcolor[/bgcolor])[-bold][-italic][-underline] + Example: (hilit-lookup-face-create 'comment-face) might create and return 'red + + Each color is either the name of an X color (see .../X11/lib/X11/rgb.txt), + a hexadecimal specification of the form \"hex-[0-9A-Fa-f]+\", or \"default\". + + An optional argument, FORCE, will cause the face to be recopied from the + default...which is probably of use only if you've changed fonts. + + See the documentation for hilit-translate and hilit-face-translation-table." + + ;; translate the face ... + (let ((trec t) visited) + (while trec + (cond ((memq face visited) (error "face translation loop: %S" visited)) + (t (setq visited (cons face visited) + trec (assq face hilit-face-translation-table)) + (and trec (setq face (cdr trec))))))) + + ;; make the face if we need to... + (let* ((fn (symbol-name face)) + (frame (selected-frame)) + (basefont (cdr (assq 'font (frame-parameters frame)))) + error fgcolor bgcolor) + (cond + ((or (null face) + (memq face hilit-predefined-face-list)) + ;; do nothing if the face is nil or if it's predefined. + ) + ((or force + (not (memq face (face-list))) + (and hilit-face-check + (not (string= (get face 'basefont) basefont)))) + (copy-face 'default 'scratch-face) + (if (string-match "^reverse-?" fn) + (progn (invert-face 'scratch-face) + (setq fn (substring fn (match-end 0))))) + + ;; parse foreground color + (if (string-match "^\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn) + (setq fgcolor (concat + (if (match-beginning 1) "#") + (substring fn (match-beginning 2) (match-end 2))) + fn (substring fn (match-end 0))) + (error "bad face name %S" face)) + + ;; parse background color + (if (string-match "^/\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn) + (setq bgcolor (concat + (and (match-beginning 1) "#") + (substring fn (match-beginning 2) (match-end 2))) + fn (substring fn (match-end 0)))) + + (and (string= "default" fgcolor) (setq fgcolor nil)) + (and (string= "default" bgcolor) (setq bgcolor nil)) + + ;; catch errors if we can't allocate the color(s) + (condition-case nil + (progn (set-face-foreground 'scratch-face fgcolor) + (set-face-background 'scratch-face bgcolor) + (copy-face 'scratch-face face) + (put face 'basefont basefont)) + (error (message "couldn't allocate color for '%s'" + (symbol-name face)) + (setq face 'default) + (setq error t))) + (or error + ;; don't bother w/ bold or italic if we didn't get the color + ;; we wanted, but ignore errors making the face bold or italic + ;; if the font isn't available, there's nothing to do about it... + (progn + (set-face-font face nil frame) + (set-face-underline-p face (string-match "underline" fn)) + (if (string-match ".*bold" fn) + (progn + ;; first, fix up this frame's face + (make-face-bold face frame 'noerr) + ;; now, fix up the face from the global list + (set-face-font face (face-font face frame) t))) + (if (string-match ".*italic" fn) + (progn + ;; first, fix up this frame's face + (make-face-italic face frame 'noerr) + ;; now, fix up the face from the global list + (set-face-font face (face-font face frame) t))) + )) + ))) + face) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Region Highlight/Unhighlight code (Both overlay and text-property versions) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defsubst hilit-region-set-face (start end face-name &optional prio prop) + "Highlight region from START to END using FACE and, optionally, PRIO. + The optional 5th arg, PROP is a property to set instead of 'hilit." + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'face face-name) + (overlay-put overlay (or prop 'hilit) t) + (and prio (overlay-put overlay 'priority prio)))) + + (defun hilit-unhighlight-region (start end &optional quietly) + "Unhighlights the region from START to END, optionally in a QUIET way" + (interactive "r") + (or quietly hilit-quietly (message "Unhighlighting")) + (while (< start end) + (mapcar (function (lambda (ovr) + (and (overlay-get ovr 'hilit) (delete-overlay ovr)))) + (overlays-at start)) + (setq start (next-overlay-change start))) + (or quietly hilit-quietly (message "Done unhighlighting"))) + + ;;;; These functions use text properties instead of overlays. Text properties + ;;;; are copied through kill and yank...which might be convenient, but is not + ;;;; terribly efficient as of 19.12, ERGO it's been disabled + ;; + ;;(defsubst hilit-region-set-face (start end face-name &optional prio prop) + ;; "Highlight region from START to END using FACE and, optionally, PRIO. + ;;The optional 5th arg, PROP is a property to set instead of 'hilit." + ;; (put-text-property start end 'face face-name) + ;; ) + ;; + ;;(defun hilit-unhighlight-region (start end &optional quietly) + ;; "Unhighlights the region from START to END, optionally in a QUIET way" + ;; (interactive "r") + ;; (let ((buffer-read-only nil) + ;; (bm (buffer-modified-p))) + ;; (remove-text-properties start end '(face)) + ;; (set-buffer-modified-p bm))) + ;;;; + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Pattern Application code and user functions + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defun hilit-highlight-region (start end &optional patterns quietly) + "Highlights the area of the buffer between START and END (the region when + interactive). Without the optional PATTERNS argument, the pattern for + major-mode is used. If PATTERNS is a symbol, then the patterns associated + with that symbol are used. QUIETLY suppresses progress messages if + non-nil." + (interactive "r") + (cond ((null patterns) + (setq patterns (cdr (assq major-mode hilit-patterns-alist)))) + ((symbolp patterns) + (setq patterns (cdr (assq patterns hilit-patterns-alist))))) + ;; txt prop: (setq patterns (reverse patterns)) + (let ((prio (length patterns)) + (case-fold-search nil) + ;; txt prop: (buffer-read-only nil) + ;; txt prop: (bm (buffer-modified-p)) + p pstart pend face mstart) + ;; txt prop: (unwind-protect + (save-excursion + (save-restriction + (narrow-to-region start end) + (while patterns + (setq p (car patterns)) + (setq pstart (car p) + pend (nth 1 p) + face (hilit-lookup-face-create (nth 2 p))) + (if (not face) ; skipped if nil + nil + (or quietly hilit-quietly + (message "highlighting %d: %s%s" prio pstart + (if pend (concat " ... " pend) ""))) + (goto-char (point-min)) + (condition-case nil + (cond + ((symbolp pstart) + ;; inner loop -- special function to find pattern + (let (region) + (while (setq region (funcall pstart pend)) + (hilit-region-set-face (car region) (cdr region) + face prio)))) + ((stringp pend) + ;; inner loop -- regex-start ... regex-end + (while (re-search-forward pstart nil t nil) + (goto-char (setq mstart (match-beginning 0))) + (if (re-search-forward pend nil t nil) + (hilit-region-set-face mstart (match-end 0) + face prio) + (forward-char 1)))) + (t + (or (numberp pend) (setq pend 0)) + ;; inner loop -- just one regex to match whole pattern + (while (re-search-forward pstart nil t nil) + (hilit-region-set-face (match-beginning pend) + (match-end pend) face prio)))) + (error (message "Unbalanced delimiters? Barfed on '%s'" + pstart) + (ding) (sit-for 4)))) + (setq prio (1- prio) + patterns (cdr patterns))) + )) + (or quietly hilit-quietly (message "")) ; "Done highlighting" + ;; txt prop: (set-buffer-modified-p bm)) ; unwind protection + )) + + (defun hilit-rehighlight-region (start end &optional quietly) + "Re-highlights the region, optionally in a QUIET way" + (interactive "r") + (setq start (apply 'min start (mapcar 'overlay-start (overlays-at start))) + end (apply 'max end (mapcar 'overlay-end (overlays-at end)))) + (hilit-unhighlight-region start end quietly) + (hilit-highlight-region start end nil quietly)) + + (defun hilit-rehighlight-buffer (&optional quietly) + "Re-highlights the buffer, optionally in a QUIET way" + (interactive "") + (let ((parse-fn (cdr (assq major-mode hilit-parser-alist)))) + (if parse-fn + (funcall parse-fn quietly) + (hilit-rehighlight-region (point-min) (point-max) quietly))) + nil) + + (defun hilit-rehighlight-buffer-quietly () + (hilit-rehighlight-buffer t)) + + (defun hilit-rehighlight-message (quietly) + "Highlight a buffer containing a news article or mail message." + (save-excursion + (goto-char (point-min)) + (re-search-forward "^$" nil 'noerr) + (hilit-unhighlight-region (point-min) (point-max) quietly) + (hilit-highlight-region (point-min) (point) 'msg-header quietly) + (hilit-highlight-region (point) (point-max) 'msg-body quietly))) + + (defalias 'hilit-highlight-buffer 'hilit-rehighlight-buffer) + + (defun hilit-toggle-highlight (arg) + "Locally toggle highlighting. With arg, forces highlighting off." + (interactive "P") + ;; FIXME -- this loses numeric information in hilit-auto-rehighlight + (setq hilit-auto-rehighlight + (and (not arg) (not hilit-auto-rehighlight))) + (if hilit-auto-rehighlight + (hilit-rehighlight-buffer) + (hilit-unhighlight-region (point-min) (point-max))) + (message "Rehighlighting is set to %s" hilit-auto-rehighlight)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; HOOKS + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (defun hilit-find-file-hook () + "Find-file hook for hilit package. See the variable hilit-auto-highlight." + (cond ((and hilit-auto-highlight + (assq major-mode hilit-patterns-alist)) + (if (> buffer-saved-size (car hilit-auto-rehighlight-fallback)) + (setq hilit-auto-rehighlight + (cdr hilit-auto-rehighlight-fallback))) + (if (> buffer-saved-size hilit-auto-highlight-maxout) nil + (hilit-rehighlight-buffer) + (set-buffer-modified-p nil))))) + + (defun hilit-repaint-command (arg) + "Rehighlights according to the value of hilit-auto-rehighlight, or the + prefix argument if that is specified. + \t\\[hilit-repaint-command]\t\trepaint according to hilit-auto-rehighlight + \t^U \\[hilit-repaint-command]\trepaint entire buffer + \t^U - \\[hilit-repaint-command]\trepaint visible portion of buffer + \t^U n \\[hilit-repaint-command]\trepaint n lines to either side of point" + (interactive "P") + (let (st en quietly) + (or arg (setq arg hilit-auto-rehighlight)) + (cond ((or (eq arg 'visible) (eq arg '-)) + (setq st (window-start) en (window-end) quietly t)) + ((numberp arg) + (setq st (save-excursion (forward-line (- arg)) (point)) + en (save-excursion (forward-line arg) (point)))) + (arg + (hilit-rehighlight-buffer))) + (if st + (hilit-rehighlight-region st en quietly)))) + + ;; (defun hilit-rehighlight-yank-region () + ;; "Rehighlights from the beginning of the line where the region starts to + ;; the end of the line where the region ends. This could flake out on + ;; multi-line highlights (like C comments and lisp strings.)" + ;; (if hilit-auto-rehighlight + ;; (hilit-rehighlight-region + ;; (save-excursion (goto-char (region-beginning)) + ;; (beginning-of-line) (point)) + ;; (save-excursion (goto-char (region-end)) + ;; (end-of-line) (point)) + ;; t))) + + (defun hilit-recenter (arg) + "Recenter, then rehighlight according to hilit-auto-rehighlight. If called + with an unspecified prefix argument (^U but no number), then a rehighlight of + the entire buffer is forced." + (interactive "P") + (recenter arg) + ;; force display update + (sit-for 0) + (hilit-repaint-command (consp arg))) + + ;; (defun hilit-redraw-display (arg) + ;; "Rehighlights according to the value of hilit-auto-rehighlight, a prefix + ;; arg forces a rehighlight of the whole buffer. Otherwise just like + ;; redraw-display." + ;; (interactive "P") + ;; (hilit-redraw-internal arg) + ;; (redraw-display)) + + (defun hilit-yank (arg) + "Yank with rehighlighting" + (interactive "*P") + (let ((transient-mark-mode nil)) + (yank arg) + (and hilit-auto-rehighlight + (hilit-rehighlight-region (region-beginning) (region-end) t)) + (setq this-command 'yank))) + + (defun hilit-yank-pop (arg) + "Yank-pop with rehighlighting" + (interactive "*p") + (let ((transient-mark-mode nil)) + (yank-pop arg) + (and hilit-auto-rehighlight + (hilit-rehighlight-region (region-beginning) (region-end) t)) + (setq this-command 'yank))) + + ;;; this line highlighting stuff is untested. play with it only if you feel + ;;; adventurous...don't ask me to fix it...though you're welcome to. -- Stig + ;; + ;; (defun hilit-rehighlight-line-quietly (&rest args) + ;; "Quietly rehighlight just this line. + ;; Useful as an after change hook in VM/gnus summary buffers and dired buffers. + ;; If only there were an after-change-function, that is..." + ;; (save-excursion + ;; (push-mark nil t) + ;; (hilit-rehighlight-yank-region) + ;; (and orig-achange-function (apply orig-achange-function args)))) + ;; + ;; (defun hilit-install-line-hooks () + ;; (make-variable-buffer-local 'after-change-function) + ;; (make-local-variable 'orig-achange-function) + ;; (setq orig-achange-function after-change-function) + ;; (setq after-change-function 'hilit-rehighlight-line-quietly)) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Wysiwyg Stuff... take it away and build a whole package around it! + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + ;; ; For the Jargon-impaired, WYSIWYG === What You See Is What You Get + ;; ; Sure, it sucks to type. Oh, well. + ;; (defun hilit-wysiwyg-replace () + ;; "Replace overstruck text with normal text that's been overlayed with the + ;; appropriate text attribute. Suitable for a find-file hook." + ;; (save-excursion + ;; (goto-char (point-min)) + ;; (let ((wysb (hilit-lookup-face-create 'wysiwyg-bold)) + ;; (wysu (hilit-lookup-face-create 'wysiwyg-underline)) + ;; (bmod (buffer-modified-p))) + ;; (while (re-search-forward "\\(.\b.\\)+" nil t) + ;; (let ((st (match-beginning 0)) (en (match-end 0))) + ;; (goto-char st) + ;; (if (looking-at "_") + ;; (hilit-region-set-face st en wysu 100 'wysiwyg) + ;; (hilit-region-set-face st en wysb 100 'wysiwyg)) + ;; (while (and (< (point) en) (looking-at ".\b")) + ;; (replace-match "") (forward-char)) + ;; )) + ;; (set-buffer-modified-p bmod)))) + ;; + ;; ; is this more appropriate as a write-file-hook or a write-contents-hook? + ;; (defun hilit-wysiwyg-write-repair () + ;; "Replace wysiwyg overlays with overstrike text." + ;; (message "*sigh* hilit-wysiwyg-write-repair not implemented yet") + ;; + ;; For efficiency, this hook should copy the current buffer to a scratch + ;; buffer and do it's overstriking there. Overlays are not copied, so it'll + ;; be necessary to hop back and forth. This is OK since you're not fiddling + ;; with--making or deleting--any overlays. THEN write the new buffer, + ;; delete it, and RETURN T. << important + ;; + ;; Just so you know...there is already an emacs function called + ;; underline-region that does underlining. I think that the thing to do is + ;; extend that to do overstriking as well. + ;; + ;; (while (< start end) + ;; (mapcar (function (lambda (ovr) + ;; (and (overlay-get ovr 'hilit) (delete-overlay ovr)))) + ;; (overlays-at start)) + ;; (setq start (next-overlay-change start))) + ;; nil) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Initialization. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (and (not hilit-inhibit-rebinding) + window-system + (progn + (substitute-key-definition 'yank 'hilit-yank + (current-global-map)) + (substitute-key-definition 'yank-pop 'hilit-yank-pop + (current-global-map)) + (substitute-key-definition 'recenter 'hilit-recenter + (current-global-map)))) + + (global-set-key [?\C-\S-l] 'hilit-repaint-command) + + (and window-system + (add-hook 'find-file-hooks 'hilit-find-file-hook t)) + + (eval-when-compile (require 'gnus)) ; no compilation gripes + + (and (not hilit-inhibit-hooks) + window-system + (condition-case c + (progn + + ;; BUFFER highlights... + (mapcar (function + (lambda (hook) + (add-hook hook 'hilit-rehighlight-buffer-quietly))) + '( + compilation-parse-hook + + Info-select-hook ; FIXME -- phase this out later + Info-selection-hook + + vm-summary-mode-hooks + vm-summary-pointer-hook + vm-preview-message-hook + vm-show-message-hook + + gnus-article-prepare-hook + gnus-summary-prepare-hook + gnus-group-prepare-hook + + rmail-show-message-hook + mail-setup-hook + mh-show-mode-hook + )) + + ;; rehilight only the visible part of the summary buffer for speed. + (add-hook 'gnus-mark-article-hook + (function + (lambda () + (or (memq gnus-current-article gnus-newsgroup-marked) + (gnus-summary-mark-as-read gnus-current-article)) + (gnus-summary-set-current-mark) + (save-excursion + (set-buffer gnus-summary-buffer) + (hilit-rehighlight-region (window-start) + (window-end) t) + )))) + ;; only need prepare article hook + ;; + ;; (add-hook 'gnus-select-article-hook + ;; '(lambda () (save-excursion + ;; (set-buffer gnus-article-buffer) + ;; (hilit-rehighlight-buffer)))) + ) + (error (message "Error loading highlight hooks: %s" c) + (ding) (sit-for 1)))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; Default patterns for various modes. + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + ;;; do I need this? I changed the defconst to a defvar because defconst is + ;;; inappropriate, but I don't know why I wanted hilit-patterns-alist to be + ;;; reset on every reload... + + (setq hilit-patterns-alist nil) + + (defun hilit-associate (alist key val) + "creates, or destructively replaces, the pair (key . val) in alist" + (let ((oldentry (assq key (eval alist)))) + (if oldentry + (setcdr oldentry val) + (set alist (cons (cons key val) (eval alist)))))) + + (defun hilit-set-mode-patterns (modelist patterns &optional parse-fn) + "Sets the default highlighting patterns for MODE to PATTERNS. + See the variable hilit-mode-enable-list." + (or (consp modelist) (setq modelist (list modelist))) + (let (ok (flip (eq (car hilit-mode-enable-list) 'not))) + (mapcar (function + (lambda (m) + (setq ok (or (null hilit-mode-enable-list) + (memq m hilit-mode-enable-list))) + (and flip (setq ok (not ok))) + (and ok + (progn + (and parse-fn + (hilit-associate 'hilit-parser-alist m parse-fn)) + (hilit-associate 'hilit-patterns-alist m patterns))))) + modelist))) + + (defun hilit-string-find (qchar) + "looks for a string and returns (start . end) or NIL. The argument QCHAR + is the character that would precede a character constant double quote. + Finds [^QCHAR]\" ... [^\\]\"" + (let (st en) + (while (and (search-forward "\"" nil t) + (eq qchar (char-after (1- (setq st (match-beginning 0))))))) + (while (and (search-forward "\"" nil t) + (eq ?\\ (char-after (- (setq en (point)) 2))))) + (and en (cons st en)))) + + (hilit-set-mode-patterns + '(c-mode c++-c-mode elec-c-mode) + '(("/\\*" "\\*/" comment) + ; ("\"" "[^\\]\"" string) + (hilit-string-find ?' string) + ;; declaration + ("^#[ \t]*\\(undef\\|define\\).*$" nil define) + ("^#.*$" nil include) + ;; function decls are expected to have types on the previous line + ("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) + ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl) + ;; datatype -- black magic regular expression + ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type) + ;; key words + ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>[^_]" 1 keyword) + )) + + (hilit-set-mode-patterns + 'c++-mode + '(("/\\*" "\\*/" comment) + ("//.*$" nil comment) + ("^/.*$" nil comment) + ; ("\"" "[^\\]\"" string) + (hilit-string-find ?' string) + ;; declaration + ("^#[ \t]*\\(undef\\|define\\).*$" nil define) + ("^#.*$" nil include) + ;; function decls are expected to have types on the previous line + ("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) + ("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun) + ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl) + ;; datatype -- black magic regular expression + ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type) + ;; key words + ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]" + 1 keyword))) + + (hilit-set-mode-patterns + 'perl-mode + '(("\\s #.*$" nil comment) + ("^#.*$" nil comment) + ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string) + ("^\\(__....?__\\|\\s *\\sw+:\\)" nil label) + ("^require.*$" nil include) + ("^package.*$" nil decl) + ("^\\s *sub\\s +\\(\\w\\|[_']\\)+" nil defun) + ("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword))) + + (hilit-set-mode-patterns + 'ada-mode + '(;; comments + ("--.*$" nil comment) + ;; main structure + ("[ \t\n]procedure[ \t]" "\\([ \t]\\(is\\|renames\\)\\|);\\)" glob-struct) + ("[ \t\n]task[ \t]" "[ \t]is" glob-struct) + ("[ \t\n]function[ \t]" "return[ \t]+[A-Za-z_0-9]+[ \t]*\\(is\\|;\\|renames\\)" glob-struct) + ("[ \t\n]package[ \t]" "[ \t]\\(is\\|renames\\)" glob-struct) + ;; if there is nothing before "private", it is part of the structure + ("^[ \t]*private[ \t\n]" nil glob-struct) + ;; if there is no indentation before the "end", then it is most + ;; probably the end of the package + ("^end.*$" ";" glob-struct) + ;; program structure -- "null", "delay" and "terminate" omitted + ("[ \n\t]\\(in\\|out\\|select\\|if\\|else\\|case\\|when\\|and\\|or\\|not\\|accept\\|loop\\|do\\|then\\|elsif\\|else\\|for\\|while\\|exit\\)[ \n\t;]" nil struct) + ;; block structure + ("[ \n\t]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n\t;]" nil struct) + ;; type declaration + ("^[ \t]*\\(type\\|subtype\\).*$" ";" decl) + ("[ \t]+is record.*$" "end record;" decl) + ;; "pragma", "with", and "use" are close to C cpp directives + ("^[ \t]*\\(with\\|pragma\\|use\\)" ";" include) + ;; nice for named parameters, but not so beautiful in case statements + ("[A-Za-z_0-9.]+[ \t]*=>" nil named-param) + ;; string constants probably not everybody likes this one + ("\"" ".*\"" string))) + + (hilit-set-mode-patterns + 'fortran-mode + '(("^[*Cc].*$" nil comment) + ("[ \t]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \t\n]" nil include) + ("\\(^[ \t]*[0-9]+\\|[ \t]continue[ \t\n]\\|format\\)" nil define) + ("[ \t]\\(do\\|do[ \t]*[0-9]+\\|go[ \t]*to[ \t]*[0-9]+\\|end[ \t]*do\\|if\\|else[ \t]*if\\|then\\|else\\|end[ \t]*if\\)[ \t\n(]" nil define) + ("[ \t]\\(parameter[\t\n ]*([^)]*)\\|data\\|save\\|common[ \t\n]*/[^/]*/\\)" + nil decl) + ("^ ." nil type) + ("implicit[ \t]*none" nil decl) + ("\\([ \t]\\|implicit[ \t]*\\)\\(dimension\\|integer\\|real\\|double[ \t]*precision\\|character\\|logical\\|complex\\|double[ \t]*complex\\)\\([*][0-9]*\\|[ \t\n]\\)" nil keyword) + ("'[^'\n]*'" nil string) + )) + + (hilit-set-mode-patterns + '(m2-mode modula-2-mode) + '(("(\\*" "\\*)" comment) + (hilit-string-find ?\\ string) + ("^[ \t]*PROCEDURE[ \t]+\\w+[^ \t(;]*" nil defun) + ("\\<\\(RECORD\\|ARRAY\\|OF\\|POINTER\\|TO\\|BEGIN\\|END\\|FOR\\|IF\\|THEN\\|ELSE\\|ELSIF\\|CASE\\|WHILE\\|DO\\|MODULE\\|FROM\\|RETURN\\|IMPORT\\|EXPORT\\|VAR\\|LOOP\\|UNTIL\\|\\DEFINITION\\|IMPLEMENTATION\\|AND\\|OR\\|NOT\\|CONST\\|TYPE\\|QUALIFIED\\)\\>" nil keyword) + )) + + (hilit-set-mode-patterns 'prolog-mode + '(("/\\*" "\\*/" comment) + ("%.*$" nil comment) + (":-" nil defun) + ("!" nil label) + ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string) + ("\\b\\(is\\|mod\\)\\b" nil keyword) + ("\\(->\\|-->\\|;\\|==\\|\\\\==\\|=<\\|>=\\|<\\|>\\|=\\|\\\\=\\|=:=\\|=\\\.\\\.\\|\\\\\\\+\\)" nil decl) + ("\\(\\\[\\||\\|\\\]\\)" nil include))) + + (hilit-set-mode-patterns + '( + LaTeX-mode japanese-LaTeX-mode SliTeX-mode + japanese-SliTeX-mode FoilTeX-mode latex-mode + ) + '( + ;; comments + ("[^\\]%.*$" nil comment) + + ;; the following two match \foo[xx]{xx} or \foo*{xx} or \foo{xx} + ("\\\\\\(sub\\)*\\(paragraph\\|section\\)\\(\*\\|\\[.*\\]\\)?{" "}" + keyword) + ("\\\\\\(chapter\\|part\\)\\(\*\\|\\[.*\\]\\)?{" "}" keyword) + ("\\\\footnote\\(mark\\|text\\)?{" "}" keyword) + ("\\\\[a-z]+box" nil keyword) + ("\\\\\\(v\\|h\\)space\\(\*\\)?{" "}" keyword) + + ;; (re-)define new commands/environments/counters + ("\\\\\\(re\\)?new\\(environment\\|command\\){" "}" defun) + ("\\\\new\\(length\\|theorem\\|counter\\){" "}" defun) + + ;; various declarations/definitions + ("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define) + ("\\\\\\(\\|title\\|author\\|date\\|thanks\\){" "}" define) + + ("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl) + ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl) + ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" nil + decl) + ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl) + ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" nil decl) + ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b" + nil decl) + ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl) + + ;; label-like things + ("\\\\item\\[" "\\]" label) + ("\\\\item\\b" nil label) + ("\\\\caption\\(\\[.*\\]\\)?{" "}" label) + + ;; things that bring in external files + ("\\\\\\(include\\|input\\|bibliography\\){" "}" include) + + ;; "wysiwyg" emphasis -- these don't work with nested expressions + ;; ("{\\\\\\(em\\|it\\|sl\\)" "}" italic) + ;; ("{\\\\bf" "}" bold) + + ("``" "''" string) + + ;; things that do some sort of cross-reference + ("\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){" "}" crossref) + )) + + (hilit-set-mode-patterns + 'bibtex-mode + '(;;(";.*$" nil comment) + ("%.*$" nil comment) + ("@[a-zA-Z]+" nil keyword) + ("{[ \t]*[-a-z:_A-Z0-9]+," nil label) ; is wrong sometimes + ("^[ \t]*[a-zA-Z]+[ \t]*=" nil define))) + + (hilit-set-mode-patterns + 'compilation-mode + '( + ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+: warning:.*$" nil warning) + ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+:.*$" nil error) + )) + + (hilit-set-mode-patterns + 'makefile-mode + '(("^#.*$" nil comment) + ("[^$]#.*$" nil comment) + ;; rules + ("^[^ \t\n]*%[^ \t\n]*[ \t]*::?[ \t]*[^ \t\n]*[ \t]*\\(#.*\\)?$" nil rule) + ("^[.][A-Za-z][A-Za-z]?\..*$" nil rule) + ;; variable definition + ("^[_A-Za-z0-9]+[ \t]*\+?=" nil define) + ("\\( \\|:=\\)[_A-Za-z0-9]+[ \t]*\\+=" nil define) + ;; variable references + ("\\$\\([^ \t\n{(]\\|[{(]@?[_A-Za-z0-9:.,%/=]+[)}]\\)" nil keyword) + ("^[A-Za-z0-9.,/_-]+[ \t]*:.*$" nil defun) + ("^include " nil include))) + + (let* ((header-patterns '(("^Subject:.*$" nil msg-subject) + ("^From:.*$" nil msg-from) + ("^--text follows this line--$" nil msg-separator) + ("^[A-Za-z][A-Za-z0-9-]+:" nil msg-header))) + (body-patterns '(("^\\(In article\\|[ \t]*\\w*[]<>}|]\\).*$" + nil msg-quote))) + (message-patterns (append header-patterns body-patterns))) + (hilit-set-mode-patterns 'msg-header header-patterns) + (hilit-set-mode-patterns 'msg-body body-patterns) + (hilit-set-mode-patterns '(vm-mode text-mode mail-mode rmail-mode + gnus-article-mode news-reply-mode mh-show-mode) + message-patterns + 'hilit-rehighlight-message)) + + (hilit-set-mode-patterns + 'gnus-group-mode + '(("^U.*$" nil gnus-group-unsubscribed) + ("^ +[01]?[0-9]:.*$" nil gnus-group-empty) + ("^ +[2-9][0-9]:.*$" nil gnus-group-full) + ("^ +[0-9][0-9][0-9]+:.*$" nil gnus-group-overflowing))) + + (hilit-set-mode-patterns + 'gnus-summary-mode + '(("^D +[0-9]+: \\[.*$" nil summary-seen) + ("^K +[0-9]+: \\[.*$" nil summary-killed) + ("^X +[0-9]+: \\[.*$" nil summary-Xed) + ("^- +[0-9]+: \\[.*$" nil summary-unread) + ("^. +[0-9]+:\\+\\[.*$" nil summary-current) + ("^ +[0-9]+: \\[.*$" nil summary-new) + )) + + (hilit-set-mode-patterns + 'vm-summary-mode + '(("^ .*$" nil summary-seen) + ("^->.*$" nil summary-current) + ("^ D.*$" nil summary-deleted) + ("^ U.*$" nil summary-unread) + ("^ N.*$" nil summary-new))) + + + (hilit-set-mode-patterns + '(emacs-lisp-mode lisp-mode) + '( + (";.*" nil comment) + ;;; ("^;.*$" nil comment) + ;;; ("\\s ;+[ ;].*$" nil comment) + (hilit-string-find ?\\ string) + ("^\\s *(def\\(un\\|macro\\|advice\\|subst\\)\\s " "\\()\\|nil\\)" defun) + ("^\\s *(defvar\\s +\\S +" nil decl) + ("^\\s *(defconst\\s +\\S +" nil define) + ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include) + )) + + + (hilit-set-mode-patterns + 'plain-tex-mode + '(("^%%.*$" nil comment) + ("{\\\\em\\([^}]+\\)}" nil comment) + ("\\(\\\\\\w+\\)" nil keyword) + ("{\\\\bf\\([^}]+\\)}" nil keyword) + ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun) + ("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun) + ; ("[^\\\\]\\$\\([^$]*\\)\\$" nil string) + ("\\$\\([^$]*\\)\\$" nil string) + )) + + ;; Reasonable extensions would include smarter parameter handling for such + ;; things as the .IX and .I macros, which alternate the handling of following + ;; arguments. + + (hilit-set-mode-patterns + 'nroff-mode + '(("^\\.[\\\][\\\"].*$" nil comment) + ("^\\.so .*$" nil include) + ("^\\.[ST]H.*$" nil defun) + ;; ("^[^\\.].*\"[^\\\"]*\\(\\\\\\(.\\)[^\\\"]*\\)*\"" nil string) + ("\"" "[^\\]\"" string) + ("^\\.[A-Za-z12\\\\].*$" nil define) + ("\\([\\\][^ ]*\\)" nil keyword) + ("^\\.[a-zA-Z].*$" nil keyword))) + + (hilit-set-mode-patterns + 'texinfo-mode + '(("^\\(@c\\|@comment\\)\\>.*$" nil comment) + ("@\\(emph\\|strong\\|b\\|i\\){[^}]+}" nil comment) + ; seems broken + ; ("\\$[^$]*\\$" nil string) + ("@\\(file\\|kbd\\|key\\){[^}]+}" nil string) + ("^\\*.*$" nil defun) + ("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun) + ("@end +[A-Za-z0-9]+[ \t]*$" nil defun) + ("@\\(samp\\|code\\|var\\){[^}]+}" nil defun) + ("@\\w+\\({[^}]+}\\)?" nil keyword) + )) + + (hilit-set-mode-patterns + 'dired-mode + (append + '(("^D.*$" nil dired-deleted) + ("^\\*.*$" nil dired-marked) + ("^ d.*$" nil dired-directory) + ("^ l.*$" nil dired-link) + ("^ -.*#.*#$" nil dired-ignored)) + (list (cons + (concat "^ .*\\(" + (mapconcat 'regexp-quote completion-ignored-extensions "\\|") + "\\)$") + '(nil dired-ignored))))) + + (hilit-set-mode-patterns + 'jargon-mode + '(("^:[^:]*:" nil jargon-entry) + ("{[^}]*}+" nil jargon-xref))) + + (hilit-set-mode-patterns + 'Info-mode + '(("^\\* [^:]+:+" nil jargon-entry) + ("\\*[Nn]ote\\b[^:]+:+" nil jargon-xref) + (" \\(Next\\|Prev\\|Up\\):" nil jargon-xref) + ("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$" + nil jargon-keyword))) ; lisp manual + + (provide 'hilit19) + + ;;; hilit19 ends here. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/inc-vers.el emacs-19.18/lisp/inc-vers.el *** emacs-19.17/lisp/inc-vers.el Mon Sep 21 06:45:48 1992 --- emacs-19.18/lisp/inc-vers.el Wed Jul 21 18:16:04 1993 *************** *** 42,45 **** --- 42,48 ---- + (if (and (file-accessible-directory-p "../lisp/") + (null (file-writable-p "../lisp/version.el"))) + (delete-file "../lisp/version.el")) (write-region (point-min) (point-max) "../lisp/version.el" nil 'nomsg) (erase-buffer) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/indent.el emacs-19.18/lisp/indent.el *** emacs-19.17/lisp/indent.el Mon Mar 22 09:41:47 1993 --- emacs-19.18/lisp/indent.el Fri Aug 6 18:15:18 1993 *************** *** 86,97 **** A value of nil means really run indent-according-to-mode on each line.") ! (defun indent-region (start end arg) "Indent each nonblank line in the region. ! With no argument, indent each line using indent-according-to-mode. ! \(If there is a fill prefix, make each line start with the fill prefix.) With argument COLUMN, indent each line to that column. Called from a program, takes three args: START, END and COLUMN." (interactive "r\nP") ! (if (null arg) (if fill-prefix (save-excursion --- 86,98 ---- A value of nil means really run indent-according-to-mode on each line.") ! (defun indent-region (start end column) "Indent each nonblank line in the region. ! With no argument, indent each line using `indent-according-to-mode', ! or use `indent-region-function' to do the whole region if that's non-nil. ! If there is a fill prefix, make each line start with the fill prefix. With argument COLUMN, indent each line to that column. Called from a program, takes three args: START, END and COLUMN." (interactive "r\nP") ! (if (null column) (if fill-prefix (save-excursion *************** *** 100,119 **** (goto-char start) (let ((regexp (regexp-quote fill-prefix))) ! (while (< (point) end) ! (or (looking-at regexp) ! (insert fill-prefix)) ! (forward-line 1)))) (if indent-region-function (funcall indent-region-function start end) (save-excursion ! (goto-char end) ! (setq end (point-marker)) ! (goto-char start) ! (or (bolp) (forward-line 1)) ! (while (< (point) end) ! (funcall indent-line-function) ! (forward-line 1)) ! (move-marker end nil)))) ! (setq arg (prefix-numeric-value arg)) (save-excursion (goto-char end) --- 101,122 ---- (goto-char start) (let ((regexp (regexp-quote fill-prefix))) ! (while (< (point) end) ! (or (looking-at regexp) ! (and (bolp) (eolp)) ! (insert fill-prefix)) ! (forward-line 1)))) (if indent-region-function (funcall indent-region-function start end) (save-excursion ! (goto-char end) ! (setq end (point-marker)) ! (goto-char start) ! (or (bolp) (forward-line 1)) ! (while (< (point) end) ! (or (and (bolp) (eolp)) ! (funcall indent-line-function)) ! (forward-line 1)) ! (move-marker end nil)))) ! (setq column (prefix-numeric-value column)) (save-excursion (goto-char end) *************** *** 124,128 **** (delete-region (point) (progn (skip-chars-forward " \t") (point))) (or (eolp) ! (indent-to arg 0)) (forward-line 1)) (move-marker end nil)))) --- 127,131 ---- (delete-region (point) (progn (skip-chars-forward " \t") (point))) (or (eolp) ! (indent-to column 0)) (forward-line 1)) (move-marker end nil)))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/info.el emacs-19.18/lisp/info.el *** emacs-19.17/lisp/info.el Sat Jun 19 17:47:06 1993 --- emacs-19.18/lisp/info.el Fri Aug 6 16:28:22 1993 *************** *** 1,5 **** ;;; info.el --- info package for Emacs. ! ;; Copyright (C) 1985, 1986, 1992 Free Software Foundation, Inc. ;; Maintainer: FSF --- 1,5 ---- ;;; info.el --- info package for Emacs. ! ;; Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. ;; Maintainer: FSF *************** *** 48,51 **** --- 48,54 ---- in paths.el.") + (defvar Info-fontify t + "*Non-nil enables highlighting and fonts in Info nodes.") + (defvar Info-directory-list (let ((path (getenv "INFOPATH"))) *************** *** 79,87 **** Marker points nowhere if file has no tag table.") (defvar Info-index-alternatives nil "List of possible matches for last Info-index command.") ! (defvar Info-suffix-list '( ("" . nil) ! (".info" . nil) (".Z" . "uncompress") (".Y" . "unyabba") --- 82,96 ---- Marker points nowhere if file has no tag table.") + (defvar Info-current-file-completions nil + "Cached completion list for current Info file.") + (defvar Info-index-alternatives nil "List of possible matches for last Info-index command.") ! (defvar Info-standalone nil ! "Non-nil if Emacs was started solely as an Info browser.") ! ! (defvar Info-suffix-list '( (".info" . nil) ! ("" . nil) (".Z" . "uncompress") (".Y" . "unyabba") *************** *** 132,135 **** --- 141,162 ---- (Info-directory)))) + ;;;###autoload + (defun info-standalone () + "Run Emacs as a standalone Info reader. + Usage: emacs -f info-standalone [filename] + In standalone mode, \\\\[Info-exit] exits Emacs itself." + (setq Info-standalone t) + (if (and command-line-args-left + (not (string-match "^-" (car command-line-args-left)))) + (condition-case err + (progn + (info (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left))) + (error (send-string-to-terminal + (format "%s\n" (if (eq (car-safe err) 'error) + (nth 1 err) err))) + (save-buffers-kill-emacs))) + (info))) + ;; Go to an info node specified as separate filename and nodename. ;; no-going-back is non-nil if recovering from an error in this function; *************** *** 191,194 **** --- 218,222 ---- (setq Info-current-file nil Info-current-subfile nil + Info-current-file-completions nil Info-index-alternatives nil buffer-file-name nil) *************** *** 476,480 **** (read (current-buffer)))))) (point-max))) ! (if Info-enable-active-nodes (eval active-expression))))) (defun Info-set-mode-line () --- 504,510 ---- (read (current-buffer)))))) (point-max))) ! (if Info-enable-active-nodes (eval active-expression)) ! (if Info-fontify (Info-fontify-node)) ! (run-hooks 'Info-selection-hook)))) (defun Info-set-mode-line () *************** *** 493,497 **** (defun Info-goto-node (nodename) "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME." ! (interactive "sGoto node: ") (let (filename) (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)" --- 523,527 ---- (defun Info-goto-node (nodename) "Go to info node named NAME. Give just NODENAME or (FILENAME)NODENAME." ! (interactive (list (Info-read-node-name "Goto node: "))) (let (filename) (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)" *************** *** 507,510 **** --- 537,576 ---- (Info-find-node (if (equal filename "") nil filename) (if (equal nodename "") "Top" nodename)))) + + (defun Info-read-node-name (prompt &optional default) + (let* ((completion-ignore-case t) + (nodename (completing-read prompt (Info-build-node-completions)))) + (if (equal nodename "") + (or default + (Info-read-node-name prompt)) + nodename))) + + (defun Info-build-node-completions () + (or Info-current-file-completions + (let ((compl nil)) + (save-excursion + (save-restriction + (if (marker-buffer Info-tag-table-marker) + (progn + (set-buffer (marker-buffer Info-tag-table-marker)) + (goto-char Info-tag-table-marker) + (while (re-search-forward "\nNode: \\(.*\\)\177" nil t) + (setq compl + (cons (list (buffer-substring (match-beginning 1) + (match-end 1))) + compl)))) + (widen) + (goto-char (point-min)) + (while (search-forward "\n\^_" nil t) + (forward-line 1) + (let ((beg (point))) + (forward-line 1) + (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]" + beg t) + (setq compl + (cons (list (buffer-substring (match-beginning 1) + (match-end 1))) + compl)))))))) + (setq Info-current-file-completions compl)))) (defun Info-restore-point (hl) *************** *** 879,884 **** "Exit Info by selecting some other buffer." (interactive) ! (switch-to-buffer (prog1 (other-buffer (current-buffer)) ! (bury-buffer (current-buffer))))) (defun Info-next-menu-item () --- 945,952 ---- "Exit Info by selecting some other buffer." (interactive) ! (if Info-standalone ! (save-buffers-kill-emacs) ! (switch-to-buffer (prog1 (other-buffer (current-buffer)) ! (bury-buffer (current-buffer)))))) (defun Info-next-menu-item () *************** *** 900,904 **** (Info-goto-node (Info-extract-menu-node-name)))) ! (defmacro no-error (&rest body) (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil))) --- 968,972 ---- (Info-goto-node (Info-extract-menu-node-name)))) ! (defmacro Info-no-error (&rest body) (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil))) *************** *** 906,911 **** "Go to the next node, popping up a level if there is none." (interactive) ! (cond ((no-error (Info-next-menu-item)) ) ! ((no-error (Info-up)) (forward-line 1)) (t (error "No more nodes")))) --- 974,982 ---- "Go to the next node, popping up a level if there is none." (interactive) ! (cond ((looking-at "\\*note[ \n]*\\([^:]*\\):") ! (Info-follow-reference ! (buffer-substring (match-beginning 1) (match-end 1)))) ! ((Info-no-error (Info-next-menu-item)) ) ! ((Info-no-error (Info-up)) (forward-line 1)) (t (error "No more nodes")))) *************** *** 913,918 **** "Go to the last node, popping up a level if there is none." (interactive) ! (cond ((no-error (Info-last-menu-item)) ) ! ((no-error (Info-up)) (forward-line -1)) (t (error "No previous nodes")))) --- 984,989 ---- "Go to the last node, popping up a level if there is none." (interactive) ! (cond ((Info-no-error (Info-last-menu-item)) ) ! ((Info-no-error (Info-up)) (forward-line -1)) (t (error "No previous nodes")))) *************** *** 933,936 **** --- 1004,1040 ---- ) + (defun Info-next-reference () + "Move cursor to the next cross-reference or menu item in the node." + (interactive) + (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:") + (old-pt (point))) + (or (eobp) (forward-char 1)) + (or (re-search-forward pat nil t) + (progn + (goto-char (point-min)) + (or (re-search-forward pat nil t) + (progn + (goto-char old-pt) + (error "No cross references in this node"))))) + (goto-char (match-beginning 0)) + (if (looking-at "\\* Menu:") + (Info-next-reference)))) + + (defun Info-prev-reference () + "Move cursor to the previous cross-reference or menu item in the node." + (interactive) + (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:") + (old-pt (point))) + (or (re-search-backward pat nil t) + (progn + (goto-char (point-max)) + (or (re-search-backward pat nil t) + (progn + (goto-char old-pt) + (error "No cross references in this node"))))) + (goto-char (match-beginning 0)) + (if (looking-at "\\* Menu:") + (Info-prev-reference)))) + (defun Info-index (topic) "Look up a string in the index for this file. *************** *** 1054,1058 **** (progn (setq unread-command-events (list ch)) nil) flag)) ! (scroll-up))))) (defun Info-get-token (pos start all &optional errorstring) --- 1158,1163 ---- (progn (setq unread-command-events (list ch)) nil) flag)) ! (scroll-up))) ! (bury-buffer "*Help*"))) (defun Info-get-token (pos start all &optional errorstring) *************** *** 1126,1129 **** --- 1231,1236 ---- (define-key Info-mode-map " " 'Info-scroll-up) (define-key Info-mode-map "\C-m" 'Info-next-preorder) + (define-key Info-mode-map "\t" 'Info-next-reference) + (define-key Info-mode-map "\e\t" 'Info-prev-reference) (define-key Info-mode-map "1" 'Info-nth-menu-item) (define-key Info-mode-map "2" 'Info-nth-menu-item) *************** *** 1199,1202 **** --- 1306,1310 ---- \\[Info-goto-node] Move to node specified by name. You may include a filename as well, as (FILENAME)NODENAME. + \\[universal-argument] \\[info] Move to new Info file with completion. \\[Info-search] Search through this Info file for specified regexp, and select the node in which the next occurrence is found. *************** *** 1203,1207 **** \\[Info-next-preorder] Next-preorder; that is, try to go to the next menu item, and if that fails try to move up, and if that fails, tell user ! he/she is done reading." (kill-all-local-variables) (setq major-mode 'Info-mode) --- 1311,1317 ---- \\[Info-next-preorder] Next-preorder; that is, try to go to the next menu item, and if that fails try to move up, and if that fails, tell user ! he/she is done reading. ! \\[Info-next-reference] Move cursor to next cross-reference or menu item. ! \\[Info-prev-reference] Move cursor to previous cross-reference or menu item." (kill-all-local-variables) (setq major-mode 'Info-mode) *************** *** 1218,1221 **** --- 1328,1345 ---- (make-local-variable 'Info-history) (make-local-variable 'Info-index-alternatives) + (if (fboundp 'make-face) + (progn + (make-face 'info-node) + (make-face 'info-menu-5) + (make-face 'info-xref) + (or (face-differs-from-default-p 'info-node) + (if (face-differs-from-default-p 'bold-italic) + (copy-face 'bold-italic 'info-node) + (copy-face 'bold 'info-node))) + (or (face-differs-from-default-p 'info-menu-5) + (set-face-underline-p 'info-menu-5 t)) + (or (face-differs-from-default-p 'info-xref) + (copy-face 'bold 'info-xref))) + (setq Info-fontify nil)) (Info-set-mode-line) (run-hooks 'Info-mode-hook)) *************** *** 1296,1300 **** ;;;###autoload (defun Info-goto-emacs-command-node (command) ! "Go to the Info node in the Emacs manual for command COMMAND." (interactive "CFind documentation for command: ") (or (commandp command) --- 1420,1425 ---- ;;;###autoload (defun Info-goto-emacs-command-node (command) ! "Go to the Info node in the Emacs manual for command COMMAND. ! The command is found by looking up in Emacs manual's Command Index." (interactive "CFind documentation for command: ") (or (commandp command) *************** *** 1325,1329 **** (defun Info-goto-emacs-key-command-node (key) "Go to the Info node in the Emacs manual the command bound to KEY, a string. ! Interactively, if the binding is execute-extended-command, a command is read." (interactive "kFind documentation for key:") (let ((command (key-binding key))) --- 1450,1455 ---- (defun Info-goto-emacs-key-command-node (key) "Go to the Info node in the Emacs manual the command bound to KEY, a string. ! Interactively, if the binding is execute-extended-command, a command is read. ! The command is found by looking up in Emacs manual's Command Index." (interactive "kFind documentation for key:") (let ((command (key-binding key))) *************** *** 1336,1339 **** --- 1462,1499 ---- (t (Info-goto-emacs-command-node command))))) + + (defun Info-fontify-node () + (save-excursion + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (if (looking-at "^File: [^,: \t]+,?[ \t]+") + (progn + (goto-char (match-end 0)) + (while + (looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?") + (goto-char (match-end 0)) + (put-text-property (match-beginning 1) (match-end 1) + 'face 'info-xref)))) + (goto-char (point-min)) + (while (re-search-forward "\\*Note[ \n\t]*\\([^:]*\\):" nil t) + (if (= (char-after (1- (match-beginning 0))) ?\") ; hack + nil + (put-text-property (match-beginning 1) (match-end 1) + 'face 'info-xref))) + (goto-char (point-min)) + (if (and (search-forward "\n* Menu:" nil t) + (not (string-match "\\" Info-current-node)) + ;; Don't take time to annotate huge menus + (< (- (point-max) (point)) 10000)) + (let ((n 0)) + (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t) + (setq n (1+ n)) + (if (memq n '(5 9)) ; visual aids to help with 1-9 keys + (put-text-property (match-beginning 0) + (1+ (match-beginning 0)) + 'face 'info-menu-5)) + (put-text-property (match-beginning 1) (match-end 1) + 'face 'info-node)))) + (set-buffer-modified-p nil)))) (provide 'info) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/isearch.el emacs-19.18/lisp/isearch.el *** emacs-19.17/lisp/isearch.el Wed Jul 14 23:46:06 1993 --- emacs-19.18/lisp/isearch.el Sat Jul 31 14:39:14 1993 *************** *** 5,9 **** ;; Author: Daniel LaLiberte ! ;; |$Date: 1993/07/15 03:46:02 $|$Revision: 1.46 $ ;; This file is not yet part of GNU Emacs, but it is based almost --- 5,9 ---- ;; Author: Daniel LaLiberte ! ;; |$Date: 1993/07/31 18:39:09 $|$Revision: 1.47 $ ;; This file is not yet part of GNU Emacs, but it is based almost *************** *** 585,588 **** --- 585,593 ---- (set-window-configuration isearch-window-configuration)) + (if isearch-small-window + (goto-char found-point) + ;; Exiting the save-window-excursion clobbers window-start; restore it. + (set-window-start (selected-window) found-start t))) + ;; If there was movement, mark the starting position. ;; Maybe should test difference between and set mark iff > threshold. *************** *** 595,602 **** ;; (message "") why is this needed? ) - (if isearch-small-window - (goto-char found-point) - ;; Exiting the save-window-excursion clobbers window-start; restore it. - (set-window-start (selected-window) found-start t))) (setq isearch-mode nil) --- 600,603 ---- diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/ispell.el emacs-19.18/lisp/ispell.el *** emacs-19.17/lisp/ispell.el Thu Jul 15 02:55:06 1993 --- emacs-19.18/lisp/ispell.el Sat Jul 24 01:33:09 1993 *************** *** 420,453 **** (ispell-find-word-end) ;now find correct end (setq end (point-marker)) ! (if (>= start end) ! (error "No word %s" message)) ! (while (< start end) ! (goto-char start) ! (ispell-find-word-end) ;find end of current word ;could be before 'end' if ;user typed replacement ;that is more than one word ! (set-marker wend (point)) ! (setq rescan nil) ! (setq word (buffer-substring start wend)) ! (cond ((ispell-still-bad word) ;;; This just causes confusion. -- rms. ;;; (goto-char start) ;;; (sit-for 0) ! (message (format "Ispell checking %s" word)) ! (ispell-cmd word) ! (let ((message (ispell-next-message))) ! (cond ((eq message t) ! (message "%s: ok" word)) ! ((or (null message) ! (consp message)) ! (setq rescan ! (ispell-command-loop word start wend message))) ! (t ! (error "unknown ispell response %s" message)))))) ! (cond ((null rescan) ! (goto-char wend) ! (ispell-next-word) ! (set-marker start (point))))) ;;clear the choices buffer; otherwise it's hard for the user to tell ;;when we get back to the command loop --- 420,453 ---- (ispell-find-word-end) ;now find correct end (setq end (point-marker)) ! ;; Do nothing if we don't find a word. ! (if (< start end) ! (while (< start end) ! (goto-char start) ! (ispell-find-word-end) ;find end of current word ;could be before 'end' if ;user typed replacement ;that is more than one word ! (set-marker wend (point)) ! (setq rescan nil) ! (setq word (buffer-substring start wend)) ! (cond ((ispell-still-bad word) ;;; This just causes confusion. -- rms. ;;; (goto-char start) ;;; (sit-for 0) ! (message (format "Ispell checking %s" word)) ! (ispell-cmd word) ! (let ((message (ispell-next-message))) ! (cond ((eq message t) ! (message "%s: ok" word)) ! ((or (null message) ! (consp message)) ! (setq rescan ! (ispell-command-loop word start wend message))) ! (t ! (error "unknown ispell response %s" message)))))) ! (cond ((null rescan) ! (goto-char wend) ! (ispell-next-word) ! (set-marker start (point)))))) ;;clear the choices buffer; otherwise it's hard for the user to tell ;;when we get back to the command loop diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/life.el emacs-19.18/lisp/life.el *** emacs-19.17/lisp/life.el Wed Jun 9 07:24:06 1993 --- emacs-19.18/lisp/life.el Sun Aug 1 16:50:07 1993 *************** *** 183,187 **** (defun life-insert-random-pattern () (insert-rectangle ! (elt life-patterns (% (abs (random)) (length life-patterns)))) (insert ?\n)) --- 183,187 ---- (defun life-insert-random-pattern () (insert-rectangle ! (elt life-patterns (random (length life-patterns)))) (insert ?\n)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/lisp-mnt.el emacs-19.18/lisp/lisp-mnt.el *** emacs-19.17/lisp/lisp-mnt.el Tue Apr 13 23:34:43 1993 --- emacs-19.18/lisp/lisp-mnt.el Mon Jul 26 14:40:05 1993 *************** *** 6,10 **** ;; Maintainer: Eric S. Raymond ;; Created: 14 Jul 1992 ! ;; Version: $Id: lisp-mnt.el,v 1.3 1993/04/14 03:34:42 eric Exp $ ;; Keywords: docs ;; Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! --- 6,10 ---- ;; Maintainer: Eric S. Raymond ;; Created: 14 Jul 1992 ! ;; Version: $Id: lisp-mnt.el,v 1.4 1993/07/26 18:40:03 rms Exp $ ;; Keywords: docs ;; Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out! *************** *** 315,319 **** (defun lm-commentary (&optional file) ! ;; Return the commentary region of a file, as a string." (save-excursion (if file --- 315,319 ---- (defun lm-commentary (&optional file) ! ;; Return the commentary region of a file, as a string. (save-excursion (if file diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/loaddefs.el emacs-19.18/lisp/loaddefs.el *** emacs-19.17/lisp/loaddefs.el Sun Jul 18 04:05:33 1993 --- emacs-19.18/lisp/loaddefs.el Wed Aug 4 21:37:42 1993 *************** *** 374,378 **** (define-key ctl-x-map "ry" 'yank-rectangle) (define-key ctl-x-map "ro" 'open-rectangle) ! (define-key ctl-x-map "rt" 'fill-rectangle) (define-key ctl-x-map "rw" 'window-configuration-to-register) (define-key ctl-x-map "rf" 'frame-configuration-to-register) --- 374,378 ---- (define-key ctl-x-map "ry" 'yank-rectangle) (define-key ctl-x-map "ro" 'open-rectangle) ! (define-key ctl-x-map "rt" 'string-rectangle) (define-key ctl-x-map "rw" 'window-configuration-to-register) (define-key ctl-x-map "rf" 'frame-configuration-to-register) *************** *** 430,434 **** ;;; (point-min) (point-max)) ! ;;;### (autoloads (change-log-mode add-change-log-entry-other-window add-change-log-entry find-change-log) "add-log" "add-log.el" (11318 13833)) ;;; Generated autoloads from add-log.el --- 430,434 ---- ;;; (point-min) (point-max)) ! ;;;### (autoloads (change-log-mode add-change-log-entry-other-window add-change-log-entry find-change-log) "add-log" "add-log.el" (11337 52470)) ;;; Generated autoloads from add-log.el *************** *** 436,439 **** --- 436,444 ---- *Name of a change log file for \\[add-change-log-entry].") + (defvar add-log-current-defun-function nil "\ + *If non-nil, function to guess name of current function from surrounding text. + \\[add-change-log-entry] calls this function (if nil, `add-log-current-defun' + instead) with no arguments. It returns a string or nil if it cannot guess.") + (autoload (quote find-change-log) "add-log" "\ Find a change log file for \\[add-change-log-entry] and return the name. *************** *** 455,461 **** (autoload (quote add-change-log-entry-other-window) "add-log" "\ Find change log file in other window and add an entry for today. ! First arg (interactive prefix) non-nil means prompt for user name and site. ! Second arg is file name of change log. ! Interactively, with a prefix argument, the file name is prompted for." t nil) (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) --- 460,465 ---- (autoload (quote add-change-log-entry-other-window) "add-log" "\ Find change log file in other window and add an entry for today. ! Optional arg (interactive prefix) non-nil means prompt for user name and site. ! Second arg is file name of change log. If nil, uses `change-log-default-name'." t nil) (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window) *************** *** 585,589 **** ;;;*** ! ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (11336 60199)) ;;; Generated autoloads from ange-ftp.el --- 589,593 ---- ;;;*** ! ;;;### (autoloads (ange-ftp-hook-function) "ange-ftp" "ange-ftp.el" (11339 39555)) ;;; Generated autoloads from ange-ftp.el *************** *** 590,595 **** (autoload (quote ange-ftp-hook-function) "ange-ftp" nil nil nil) ! (or (assoc "^/[^/:]*\\([^/:]:\\|\\'\\)" file-name-handler-alist) (setq file-name-handler-alist (cons (quote ("^/[^/:]*\\([^/:]:\\|\\'\\)" . ange-ftp-hook-function)) file-name-handler-alist))) ;;;*** --- 594,601 ---- (autoload (quote ange-ftp-hook-function) "ange-ftp" nil nil nil) ! (or (assoc "^/[^/:]*[^/:]:" file-name-handler-alist) (setq file-name-handler-alist (cons (quote ("^/[^/:]*[^/:]:" . ange-ftp-hook-function)) file-name-handler-alist))) + (or (assoc "^/[^/:]*\\'" file-name-handler-alist) (setq file-name-handler-alist (cons (quote ("^/[^/:]*\\'" . ange-ftp-completion-hook-function)) file-name-handler-alist))) + ;;;*** *************** *** 1595,1599 **** ;;;*** ! ;;;### (autoloads (next-error grep compile) "compile" "compile.el" (11332 51733)) ;;; Generated autoloads from compile.el --- 1601,1605 ---- ;;;*** ! ;;;### (autoloads (next-error compilation-minor-mode grep compile) "compile" "compile.el" (11358 55857)) ;;; Generated autoloads from compile.el *************** *** 1644,1647 **** --- 1650,1658 ---- easily repeat a grep command." t nil) + (autoload (quote compilation-minor-mode) "compile" "\ + Toggle compilation minor mode. + With arg, turn compilation mode on if and only if arg is positive. + See `compilation-mode'." t nil) + (autoload (quote next-error) "compile" "\ Visit next compilation error message and corresponding source code. *************** *** 1669,1672 **** --- 1680,1704 ---- ;;;*** + ;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie) "cookie1" "cookie1.el" (11337 43735)) + ;;; Generated autoloads from cookie1.el + + (autoload (quote cookie) "cookie1" "\ + Return a random phrase from PHRASE-FILE. When the phrase file + is read in, display STARTMSG at beginning of load, ENDMSG at end." nil nil) + + (autoload (quote cookie-insert) "cookie1" "\ + Insert random phrases from PHRASE-FILE; COUNT of them. When the phrase file + is read in, display STARTMSG at beginning of load, ENDMSG at end." nil nil) + + (autoload (quote cookie-snarf) "cookie1" "\ + Reads in the PHRASE-FILE, returns it as a vector of strings. Emit + STARTMSG and ENDMSG before and after. Caches the result; second and + subsequent calls on the same file won't go to disk." nil nil) + + (autoload (quote shuffle-vector) "cookie1" "\ + Randomly permute the elements of VECTOR (all permutations equally likely)" nil nil) + + ;;;*** + ;;;### (autoloads (c++-mode) "cplus-md" "cplus-md.el" (11296 5913)) ;;; Generated autoloads from cplus-md.el *************** *** 3745,3748 **** --- 3777,3832 ---- ;;;*** + ;;;### (autoloads (perl-mode) "perl-mode" "perl-mode.el" (11360 25587)) + ;;; Generated autoloads from perl-mode.el + + (autoload (quote perl-mode) "perl-mode" "\ + Major mode for editing Perl code. + Expression and list commands understand all Perl brackets. + Tab indents for Perl code. + Comments are delimited with # ... \\n. + Paragraphs are separated by blank lines only. + Delete converts tabs to spaces as it moves back. + \\{perl-mode-map} + Variables controlling indentation style: + perl-tab-always-indent + Non-nil means TAB in Perl mode should always indent the current line, + regardless of where in the line point is when the TAB command is used. + perl-tab-to-comment + Non-nil means that for lines which don't need indenting, TAB will + either delete an empty comment, indent an existing comment, move + to end-of-line, or if at end-of-line already, create a new comment. + perl-nochange + Lines starting with this regular expression will not be auto-indented. + perl-indent-level + Indentation of Perl statements within surrounding block. + The surrounding block's indentation is the indentation + of the line on which the open-brace appears. + perl-continued-statement-offset + Extra indentation given to a substatement, such as the + then-clause of an if or body of a while. + perl-continued-brace-offset + Extra indentation given to a brace that starts a substatement. + This is in addition to perl-continued-statement-offset. + perl-brace-offset + Extra indentation for line if it starts with an open brace. + perl-brace-imaginary-offset + An open brace following other text is treated as if it were + this far to the right of the start of its line. + perl-label-offset + Extra indentation for line that is a label. + + Various indentation styles: K&R BSD BLK GNU LW + perl-indent-level 5 8 0 2 4 + perl-continued-statement-offset 5 8 4 2 4 + perl-continued-brace-offset 0 0 0 0 -4 + perl-brace-offset -5 -8 0 0 0 + perl-brace-imaginary-offset 0 0 4 0 0 + perl-label-offset -5 -8 -2 -2 -2 + + Turning on Perl mode calls the value of the variable perl-mode-hook with no + args, if that value is non-nil." t nil) + + ;;;*** + ;;;### (autoloads (picture-mode) "picture" "picture.el" (11292 51488)) ;;; Generated autoloads from picture.el *************** *** 4163,4167 **** ;;;*** ! ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (11334 11290)) ;;; Generated autoloads from sendmail.el --- 4247,4251 ---- ;;;*** ! ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mode) "sendmail" "sendmail.el" (11352 5490)) ;;; Generated autoloads from sendmail.el *************** *** 4248,4257 **** (autoload (quote mail-other-frame) "sendmail" "\ Like `mail' command, but display mail buffer in another frame." t nil) ! ! (define-key ctl-x-map "m" (quote mail)) ! ! (define-key ctl-x-4-map "m" (quote mail-other-window)) ! ! (define-key ctl-x-5-map "m" (quote mail-other-frame)) ;;;*** --- 4332,4338 ---- (autoload (quote mail-other-frame) "sendmail" "\ Like `mail' command, but display mail buffer in another frame." t nil) ! (define-key ctl-x-map "m" 'mail) ! (define-key ctl-x-4-map "m" 'mail-other-window) ! (define-key ctl-x-5-map "m" 'mail-other-frame) ;;;*** *************** *** 4284,4289 **** ;;; Generated autoloads from shell.el ! (defvar shell-prompt-pattern "^[^#$%> ! ]*[#$%>] *" "\ Regexp to match prompts in the inferior shell. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. --- 4365,4369 ---- ;;; Generated autoloads from shell.el ! (defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *" "\ Regexp to match prompts in the inferior shell. Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/lpr.el emacs-19.18/lisp/lpr.el *** emacs-19.17/lisp/lpr.el Fri Mar 26 20:34:13 1993 --- emacs-19.18/lisp/lpr.el Tue Aug 3 23:39:55 1993 *************** *** 81,84 **** --- 81,87 ---- (print-region-new-buffer start end) (setq tab-width width) + (save-excursion + (goto-char end) + (setq end (point-marker))) (untabify (point-min) (point-max)))) (if page-headers *************** *** 95,98 **** --- 98,103 ---- (list "-J" name "-T" name)) switches))) + (if (markerp end) + (set-marker end nil)) (message "Spooling...done")))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/lucid.el emacs-19.18/lisp/lucid.el *** emacs-19.17/lisp/lucid.el Tue Jun 1 14:23:43 1993 --- emacs-19.18/lisp/lucid.el Mon Aug 2 03:23:19 1993 *************** *** 54,59 **** (defun remove-hook (hook-var function) (if (boundp 'hook-var) ! (set hook-var (delq function (symbol-value hook-var))))) (defun remprop (symbol prop) --- 54,67 ---- (defun remove-hook (hook-var function) + "Remove a function from a hook, if it is present. + First argument HOOK-VAR (a symbol) is the name of a hook, second + argument FUNCTION is the function to remove (compared with `eq')." (if (boundp 'hook-var) ! (let ((old (symbol-value hook-var))) ! ;; If the hook value is a single function, turn it into a list. ! (if (or (not (listp old)) (eq (car old) 'lambda)) ! (set hook-var (list old))) ! ;; Now delete FUNCTION. ! (set hook-var (delq function (symbol-value hook-var)))))) (defun remprop (symbol prop) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/macros.el emacs-19.18/lisp/macros.el *** emacs-19.17/lisp/macros.el Wed Jun 9 07:24:20 1993 --- emacs-19.18/lisp/macros.el Wed Jul 28 23:26:42 1993 *************** *** 42,45 **** --- 42,46 ---- (and (fboundp symbol) (not (stringp (symbol-function symbol))) + (not (vectorp (symbol-function symbol))) (error "Function %s is already defined and not a keyboard macro." symbol)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/mailabbrev.el emacs-19.18/lisp/mailabbrev.el *** emacs-19.17/lisp/mailabbrev.el Thu Jul 8 17:13:30 1993 --- emacs-19.18/lisp/mailabbrev.el Tue Jul 27 18:51:26 1993 *************** *** 121,126 **** ;;; Noah Friedman for suggestions and bug reports. ! ;;; To use this file, add mail-abbrevs-setup as a hook ! ;;; to the hook list `mail-setup-hook'. ;;; Code: --- 121,125 ---- ;;; Noah Friedman for suggestions and bug reports. ! ;;; To use this package, do (add-hook 'mail-setup-hook 'mail-abbrevs-setup). ;;; Code: diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/man.el emacs-19.18/lisp/man.el *** emacs-19.17/lisp/man.el Tue Jul 6 18:07:05 1993 --- emacs-19.18/lisp/man.el Tue Aug 3 14:51:58 1993 *************** *** 126,129 **** --- 126,131 ---- (defvar Man-section-translations-alist '(("3C++" . "3") + ("3X" . "3") ; Xlib man pages + ("3X11" . "3") ("1-UCB" . "")) "*Association list of bogus sections to real section numbers. *************** *** 148,157 **** "-e '/^\\n$/D'" )) ! ("awk '" ! ("BEGIN { blankline=0; anonblank=0; }" ! "/^$/ { if (anonblank==0) next; }" ! "{ anonblank=1; }" ! "/^$/ { blankline++; next; }" ! "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }" "'" )) --- 150,159 ---- "-e '/^\\n$/D'" )) ! ("awk '\n" ! ("BEGIN { blankline=0; anonblank=0; }\n" ! "/^$/ { if (anonblank==0) next; }\n" ! "{ anonblank=1; }\n" ! "/^$/ { blankline++; next; }\n" ! "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n" "'" )) *************** *** 186,190 **** "*Regular expression describing a manpage section within parentheses.") ! (defvar Man-heading-regexp "^[A-Z]" "*Regular expression describing a manpage heading entry.") --- 188,192 ---- "*Regular expression describing a manpage section within parentheses.") ! (defvar Man-heading-regexp "^ ?[A-Z]" "*Regular expression describing a manpage heading entry.") *************** *** 193,201 **** This regexp should not start with a `^' character.") ! (defvar Man-first-heading-regexp "^NAME$\\|^No manual entry for .*$" "*Regular expression describing first heading on a manpage. This regular expression should start with a `^' character.") ! (defvar Man-reference-regexp "[-a-zA-Z0-9_.]+\\(([0-9][a-zA-Z+]*)\\)?" "*Regular expression describing a reference in the SEE ALSO section.") --- 195,204 ---- This regexp should not start with a `^' character.") ! (defvar Man-first-heading-regexp "^ ?NAME$\\|^ ?No manual entry for .*$" "*Regular expression describing first heading on a manpage. This regular expression should start with a `^' character.") ! (defvar Man-reference-regexp ! "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*\\(([0-9][a-zA-Z+]*)\\)?" "*Regular expression describing a reference in the SEE ALSO section.") *************** *** 387,391 **** --- 390,398 ---- ;; top level command and background process sentinel + ;;; This alias makes completion more predictable if ignoring case. ;;;###autoload + (defalias 'man 'manual-entry) + + ;;;###autoload (defun manual-entry (arg) "Get a Un*x manual page and put it in a buffer. *************** *** 429,433 **** (message "Invoking man %s in background..." man-args) (setq buffer (generate-new-buffer bufname)) ! (let ((process-environment process-environment)) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") --- 436,440 ---- (message "Invoking man %s in background..." man-args) (setq buffer (generate-new-buffer bufname)) ! (let ((process-environment (copy-sequence process-environment))) ;; Prevent any attempt to use display terminal fanciness. (setenv "TERM" "dumb") *************** *** 461,472 **** (defun Man-set-fonts () (goto-char (point-min)) ! (while (re-search-forward "\\(.\b.\\)+" nil t) (let ((st (match-beginning 0)) (en (match-end 0))) (goto-char st) (if window-system ! (put-text-property st en 'face (if (looking-at "_") 'underline 'bold))) (while (and (< (point) en) (looking-at ".\b")) ! (replace-match "") (forward-char 1))))) (defun Man-bgproc-sentinel (process msg) --- 468,479 ---- (defun Man-set-fonts () (goto-char (point-min)) ! (while (re-search-forward "\\(.\b\\)+" nil t) (let ((st (match-beginning 0)) (en (match-end 0))) (goto-char st) (if window-system ! (put-text-property st (if (= en (point-max)) en (1+ en)) 'face (if (looking-at "_") 'underline 'bold))) (while (and (< (point) en) (looking-at ".\b")) ! (replace-match ""))))) (defun Man-bgproc-sentinel (process msg) *************** *** 594,600 **** (while (and (not (eobp)) (/= (point) runningpoint)) (setq runningpoint (point)) ! (let* ((bow (point)) ! (eow (re-search-forward Man-reference-regexp end t)) ! (word (buffer-substring bow (match-end 0))) (len (1- (length word)))) (if (not eow) nil --- 601,606 ---- (while (and (not (eobp)) (/= (point) runningpoint)) (setq runningpoint (point)) ! (let* ((eow (re-search-forward Man-reference-regexp end t)) ! (word (buffer-substring (match-beginning 0) (match-end 0))) (len (1- (length word)))) (if (not eow) nil *************** *** 656,660 **** (let ((curpos (point))) (goto-char (point-min)) ! (if (re-search-forward (concat "^" section) (point-max) t) (progn (beginning-of-line) t) (goto-char curpos) --- 662,666 ---- (let ((curpos (point))) (goto-char (point-min)) ! (if (re-search-forward (concat "^\\s-?" section) (point-max) t) (progn (beginning-of-line) t) (goto-char curpos) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/map-ynp.el emacs-19.18/lisp/map-ynp.el *** emacs-19.17/lisp/map-ynp.el Mon Jul 5 00:49:28 1993 --- emacs-19.18/lisp/map-ynp.el Thu Jul 22 03:16:49 1993 *************** *** 90,94 **** (actions 0) prompt char elt tail def delayed-switch-frame ! (next (if (or (symbolp list) (subrp list) (byte-code-function-p list) --- 90,94 ---- (actions 0) prompt char elt tail def delayed-switch-frame ! (next (if (or (and list (symbolp list)) (subrp list) (byte-code-function-p list) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/menu-bar.el emacs-19.18/lisp/menu-bar.el *** emacs-19.17/lisp/menu-bar.el Fri Jul 16 21:41:42 1993 --- emacs-19.18/lisp/menu-bar.el Fri Aug 6 17:04:02 1993 *************** *** 108,112 **** (and (buffer-file-name) (not (verify-visited-file-modtime (current-buffer)))))) ! (put 'delete-frame 'menu-enable '(cdr (visible-frame-list))) (put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) --- 108,120 ---- (and (buffer-file-name) (not (verify-visited-file-modtime (current-buffer)))))) ! ;; Permit deleting frame if it would leave a visible or iconified frame. ! (put 'delete-frame 'menu-enable ! '(let ((frames (frame-list)) ! (count 0)) ! (while frames ! (if (cdr (assq 'visibility (frame-parameters (car frames)))) ! (setq count (1+ count))) ! (setq frames (cdr frames))) ! (> count 1))) (put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p)) *************** *** 174,216 **** (setcdr (nthcdr buffers-menu-max-size buffers) nil))) (setq menu ! (list "Buffer Menu" ! (cons "Select Buffer" ! (let ((tail buffers) ! (maxbuf 0) ! (maxlen 0) ! head) ! (while tail ! (or (eq ?\ (aref (buffer-name (car tail)) 0)) ! (setq maxbuf ! (max maxbuf ! (length (buffer-name (car tail)))))) ! (setq tail (cdr tail))) ! (setq tail buffers) ! (while tail ! (let ((elt (car tail))) ! (if (not (string-match "^ " ! (buffer-name elt))) ! (setq head (cons ! (cons ! (format ! (format "%%%ds %%s%%s %%s" ! maxbuf) ! (buffer-name elt) ! (if (buffer-modified-p elt) "*" " ") ! (save-excursion ! (set-buffer elt) ! (if buffer-read-only "%" " ")) ! (or (buffer-file-name elt) "")) ! elt) ! head))) ! (and head (> (length (car (car head))) maxlen) ! (setq maxlen (length (car (car head)))))) ! (setq tail (cdr tail))) ! (nconc (reverse head) ! (list (cons (concat (make-string (max 0 (- (/ maxlen 2) 8)) ?\ ) ! "List All Buffers") ! 'list-buffers))))))) - (let ((buf (x-popup-menu (if (listp event) event (cons '(0 0) (selected-frame))) --- 182,239 ---- (setcdr (nthcdr buffers-menu-max-size buffers) nil))) (setq menu ! (cons "Select Buffer" ! (let ((tail buffers) ! (maxbuf 0) ! (maxlen 0) ! head) ! (while tail ! (or (eq ?\ (aref (buffer-name (car tail)) 0)) ! (setq maxbuf ! (max maxbuf ! (length (buffer-name (car tail)))))) ! (setq tail (cdr tail))) ! (setq tail buffers) ! (while tail ! (let ((elt (car tail))) ! (if (not (string-match "^ " ! (buffer-name elt))) ! (setq head (cons ! (cons ! (format ! (format "%%%ds %%s%%s %%s" ! maxbuf) ! (buffer-name elt) ! (if (buffer-modified-p elt) ! "*" " ") ! (save-excursion ! (set-buffer elt) ! (if buffer-read-only "%" " ")) ! (or (buffer-file-name elt) "")) ! elt) ! head))) ! (and head (> (length (car (car head))) maxlen) ! (setq maxlen (length (car (car head)))))) ! (setq tail (cdr tail))) ! (nconc (nreverse head) ! (list (cons ! (concat (make-string (max (- (/ maxlen ! 2) ! 8) ! 0) ?\ ) ! "List All Buffers") ! 'list-buffers)))))) ! (setq menu (list menu)) ! ! (if (cdr (frame-list)) ! (setq menu ! (cons (cons "Select Frame" ! (mapcar (lambda (frame) ! (cons (cdr (assq 'name ! (frame-parameters frame))) ! frame)) ! (frame-list))) ! menu))) ! (setq menu (cons "Buffer and Frame Menu" menu)) (let ((buf (x-popup-menu (if (listp event) event (cons '(0 0) (selected-frame))) *************** *** 217,239 **** menu)) (window (and (listp event) (posn-window (event-start event))))) ! (if (eq buf 'list-buffers) ! (list-buffers) ! (if buf ! (if complex-buffers-menu-p ! (let ((action (x-popup-menu (if (listp event) event ! (cons '(0 0) (selected-frame))) ! '("Buffer Action" ! ("" ! ("Save Buffer" . save-buffer) ! ("Kill Buffer" . kill-buffer) ! ("Select Buffer" . switch-to-buffer)))))) ! (if (eq action 'save-buffer) ! (save-excursion ! (set-buffer buf) ! (save-buffer)) ! (funcall action buf))) ! (and (windowp window) ! (select-window window)) ! (switch-to-buffer buf))))))) ;; this version is too slow --- 240,267 ---- menu)) (window (and (listp event) (posn-window (event-start event))))) ! (cond ((framep buf) ! (make-frame-visible buf) ! (raise-frame buf) ! (select-frame buf)) ! ((eq buf 'list-buffers) ! (list-buffers)) ! (buf ! (if complex-buffers-menu-p ! (let ((action (x-popup-menu ! (if (listp event) event ! (cons '(0 0) (selected-frame))) ! '("Buffer Action" ! ("" ! ("Save Buffer" . save-buffer) ! ("Kill Buffer" . kill-buffer) ! ("Select Buffer" . switch-to-buffer)))))) ! (if (eq action 'save-buffer) ! (save-excursion ! (set-buffer buf) ! (save-buffer)) ! (funcall action buf))) ! (and (windowp window) ! (select-window window)) ! (switch-to-buffer buf))))))) ;; this version is too slow *************** *** 254,259 **** ;;; (or (buffer-file-name) "")))))) - (defvar menu-bar-mode nil) - (defun menu-bar-mode (flag) "Toggle display of a menu bar on each frame. --- 282,285 ---- *************** *** 262,285 **** With a numeric argument, if the argument is negative, turn off menu bars; otherwise, turn on menu bars." ! (interactive "P") ! (setq menu-bar-mode (if (null flag) (not menu-bar-mode) ! (or (not (numberp flag)) (>= flag 0)))) ! (let ((parameter (assq 'menu-bar-lines default-frame-alist))) ! (if (consp parameter) ! (setcdr parameter (if menu-bar-mode 1 0)) ! (setq default-frame-alist ! (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) ! default-frame-alist)))) ! (let ((frames (frame-list))) ! (while frames ! ;; Turn menu bar on or off in existing frames. ! ;; (Except for minibuffer-only frames.) ! (or (eq 'only (cdr (assq 'minibuffer (frame-parameters (car frames))))) ! (modify-frame-parameters ! (car frames) ! (list (if menu-bar-mode ! '(menu-bar-lines . 1) ! '(menu-bar-lines . 0))))) ! (setq frames (cdr frames))))) ;; Make frames created from now on have a menu bar. --- 288,318 ---- With a numeric argument, if the argument is negative, turn off menu bars; otherwise, turn on menu bars." ! (interactive "P") ! (if flag (setq flag (prefix-numeric-value flag))) ! ! ;; Obtain the current setting by looking at default-frame-alist. ! (let ((menu-bar-mode ! (not (zerop (let ((assq (assq 'menu-bar-lines default-frame-alist))) ! (if assq (cdr assq) 0)))))) ! ! ;; Tweedle it according to the argument. ! (setq menu-bar-mode (if (null flag) (not menu-bar-mode) ! (or (not (numberp flag)) (>= flag 0)))) ! ! ;; Apply it to default-frame-alist. ! (let ((parameter (assq 'menu-bar-lines default-frame-alist))) ! (if (consp parameter) ! (setcdr parameter (if menu-bar-mode 1 0)) ! (setq default-frame-alist ! (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0)) ! default-frame-alist)))) ! ! ;; Apply it to existing frames. ! (let ((frames (frame-list))) ! (while frames ! (modify-frame-parameters (car frames) ! (list (cons 'menu-bar-lines ! (if menu-bar-mode 1 0)))) ! (setq frames (cdr frames)))))) ;; Make frames created from now on have a menu bar. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/metamail.el emacs-19.18/lisp/metamail.el *** emacs-19.17/lisp/metamail.el Mon Jun 21 03:03:20 1993 --- emacs-19.18/lisp/metamail.el Mon Jul 19 23:02:12 1993 *************** *** 1,7 **** ! ;;; Metamail interface for GNU Emacs ;; Copyright (C) 1993 Masanobu UMEDA ;; Author: Masanobu UMEDA ! ;; Version: $Header: metamail.el,v 1.3 93/06/21 15:37:28 umerin Exp $ ;; Keywords: mail, news, mime, multimedia --- 1,8 ---- ! ;;; metamail.el --- Metamail interface for GNU Emacs ! ;; Copyright (C) 1993 Masanobu UMEDA ;; Author: Masanobu UMEDA ! ;; Version: $Header: metamail.el,v 1.5 93/07/08 21:56:49 umerin Exp $ ;; Keywords: mail, news, mime, multimedia *************** *** 27,31 **** ;; metamail|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| ;; Metamail interface for GNU Emacs| ! ;; $Date: 93/06/21 15:37:28 $|$Revision: 1.3 $|~/misc/metamail.el.Z| ;; Note: Metamail does not have all options which is compatible with --- 28,32 ---- ;; metamail|Masanobu UMEDA|umerin@mse.kyutech.ac.jp| ;; Metamail interface for GNU Emacs| ! ;; $Date: 93/07/08 21:56:49 $|$Revision: 1.5 $|~/misc/metamail.el.Z| ;; Note: Metamail does not have all options which is compatible with *************** *** 43,63 **** "*Metamail program name.") ! (defvar metamail-environment "KEYHEADS='*';export KEYHEADS;" ! "*Environment variables for Metamail. ! It must be an emtpy string or a string terminated with ';'.") (defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z") ! "*Switches for Metamail program. -z is required to remove zap file.") ! (defun metamail-buffer (&optional buffer) ! "Process current buffer through 'metamail'. ! Optional argument BUFFER specifies a buffer to be filled (nil means current)." (interactive) ! (metamail-region (point-min) (point-max) buffer)) ! (defun metamail-region (beg end &optional buffer) "Process current region through 'metamail'. ! Optional argument BUFFER specifies a buffer to be filled (nil means current)." (interactive "r") (let ((curbuf (current-buffer)) --- 44,70 ---- "*Metamail program name.") ! (defvar metamail-environment '("KEYHEADS=*") ! "*Environment variables passed to `metamail'. ! It must ba a list of strings that have the format ENVVARNAME=VALUE.") (defvar metamail-switches '("-m" "emacs" "-x" "-d" "-z") ! "*Switches for `metamail' program. -z is required to remove zap file.") ! (defun metamail-buffer (&optional buffer nodisplay) ! "Process current buffer through `metamail'. ! Optional 1st argument BUFFER specifies a buffer to be filled (nil ! means current). ! Optional 2nd argument NODISPLAY non-nil means buffer is not ! redisplayed as output is inserted." (interactive) ! (metamail-region (point-min) (point-max) buffer nodisplay)) ! (defun metamail-region (beg end &optional buffer nodisplay) "Process current region through 'metamail'. ! Optional 1st argument BUFFER specifies a buffer to be filled (nil ! means current). ! Optional 2nd argument NODISPLAY non-nil means buffer is not ! redisplayed as output is inserted." (interactive "r") (let ((curbuf (current-buffer)) *************** *** 75,96 **** (delete-region beg end) (delete-region (point-min) (point-max))) ! ;; We have to pass the environment variable KEYHEADS to /bin/sh ! ;; to display all header fields. Metamail should have an ! ;; optional argument to pass such information directly. ! (apply (function call-process) ! "/bin/sh" ! nil ! t ;Output to current buffer ! t ;Force redisplay ! (list "-c" ! ;; Construct environment and the command. ! (concat ! metamail-environment ! metamail-program-name ! " " ! (mapconcat (function identity) metamail-switches " ") ! " " ! metafile ! ))) ))) --- 82,100 ---- (delete-region beg end) (delete-region (point-min) (point-max))) ! ;; We have to pass the environment variable KEYHEADS to display ! ;; all header fields. Metamail should have an optional argument ! ;; to pass such information directly. ! (let ((process-environment ! (append metamail-environment process-environment))) ! (apply (function call-process) ! metamail-program-name ! nil ! t ;Output to current buffer ! (not nodisplay) ;Force redisplay ! (append metamail-switches (list metafile)))) ! ;; `metamail' may not delete the temporary file! ! (condition-case error ! (delete-file metafile) ! (error nil)) ))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/mh-e.el emacs-19.18/lisp/mh-e.el *** emacs-19.17/lisp/mh-e.el Fri Jul 16 20:18:08 1993 --- emacs-19.18/lisp/mh-e.el Sun Aug 8 20:09:03 1993 *************** *** 49,53 **** ;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu ;;; Modified by Stephen Gildea 1988. gildea@bbn.com ! (defconst mh-e-RCS-id "$Header: /home/fsf/rms/e19/lisp/RCS/mh-e.el,v 1.14 1993/07/17 00:18:04 rms Exp $") ;;; Code: --- 49,53 ---- ;;; Rewritten for GNU Emacs, James Larus 1985. larus@ginger.berkeley.edu ;;; Modified by Stephen Gildea 1988. gildea@bbn.com ! (defconst mh-e-RCS-id "$Header: /home/fsf/rms/e19/lisp/RCS/mh-e.el,v 1.16 1993/08/09 00:08:55 rms Exp $") ;;; Code: diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/mlconvert.el emacs-19.18/lisp/mlconvert.el *** emacs-19.17/lisp/mlconvert.el Wed Jun 9 07:26:23 1993 --- emacs-19.18/lisp/mlconvert.el Mon Jul 19 18:07:59 1993 *************** *** 111,127 **** (replace-match "set-buffer-modified-p")))) ! (ml-expansion 'while '(lambda () ! (let ((end (progn (forward-sexp 2) (point-marker))) ! (start (progn (forward-sexp -1) (point)))) ! (let ((cond (buffer-substring start end))) ! (cond ((equal cond "1") ! (delete-region (point) end) ! (insert "t")) ! (t ! (insert "(not (zerop ") ! (goto-char end) ! (insert "))"))) ! (set-marker end nil) ! (goto-char start))))) (ml-expansion 'arg "ml-arg") --- 111,127 ---- (replace-match "set-buffer-modified-p")))) ! ;;(ml-expansion 'while '(lambda () ! ;; (let ((end (progn (forward-sexp 2) (point-marker))) ! ;; (start (progn (forward-sexp -1) (point)))) ! ;; (let ((cond (buffer-substring start end))) ! ;; (cond ((equal cond "1") ! ;; (delete-region (point) end) ! ;; (insert "t")) ! ;; (t ! ;; (insert "(not (zerop ") ! ;; (goto-char end) ! ;; (insert "))"))) ! ;; (set-marker end nil) ! ;; (goto-char start))))) (ml-expansion 'arg "ml-arg") diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/mouse.el emacs-19.18/lisp/mouse.el *** emacs-19.17/lisp/mouse.el Tue Jul 13 17:31:54 1993 --- emacs-19.18/lisp/mouse.el Sun Aug 8 15:15:52 1993 *************** *** 97,100 **** --- 97,103 ---- (interactive "e") (let ((posn (event-start click))) + (and (window-minibuffer-p (posn-window posn)) + (not (minibuffer-window-active-p (posn-window posn))) + (error "Minibuffer window is not active")) (select-window (posn-window posn)) (if (numberp (posn-point posn)) *************** *** 169,178 **** ;; Don't count the mode line. (1- (nth 3 bounds))))) ! (select-window start-window) ! (goto-char start-point) (move-overlay mouse-drag-overlay start-point start-point (window-buffer start-window)) ! (setq mark-active nil) (let (event end end-point) (track-mouse --- 172,180 ---- ;; Don't count the mode line. (1- (nth 3 bounds))))) ! (mouse-set-point start-event) (move-overlay mouse-drag-overlay start-point start-point (window-buffer start-window)) ! (deactivate-mark) (let (event end end-point) (track-mouse *************** *** 220,227 **** (eq (posn-window (event-end event)) start-window) (numberp (posn-point (event-end event)))) ! (goto-char (posn-point (event-end event)))) ! (if (= (point) start-point) ! (setq mark-active nil) ! (set-mark start-point)) (delete-overlay mouse-drag-overlay)))) --- 222,230 ---- (eq (posn-window (event-end event)) start-window) (numberp (posn-point (event-end event)))) ! (progn ! (mouse-set-point event) ! (if (= (point) start-point) ! (deactivate-mark) ! (set-mark start-point)))) (delete-overlay mouse-drag-overlay)))) *************** *** 348,357 **** ;; mouse-save-then-kill, delete the text from the buffer. (progn (let ((buffer-undo-list t)) (delete-region (point) (mark))) - ;; Make the undo list by hand so it is shared. (if (not (eq buffer-undo-list t)) ! (setq buffer-undo-list ! (cons (cons (car kill-ring) (point)) buffer-undo-list)))) ;; Otherwise, save this region. (mouse-set-mark-fast click) --- 351,371 ---- ;; mouse-save-then-kill, delete the text from the buffer. (progn + ;; Delete just one char, so in case buffer is being modified + ;; for the first time, the undo list records that fact. + (delete-region (point) + (+ (point) (if (> (mark) (point)) 1 -1))) + ;; Now delete the rest of the specified region, + ;; but don't record it. (let ((buffer-undo-list t)) (delete-region (point) (mark))) (if (not (eq buffer-undo-list t)) ! (let ((tail buffer-undo-list)) ! ;; Search back in buffer-undo-list for the string ! ;; that came from the first delete-region. ! (while (and tail (not (stringp (car (car tail))))) ! (setq tail (cdr tail))) ! ;; Replace it with an entry for the entire deleted text. ! (and tail ! (setcar tail (cons (car kill-ring) (point))))))) ;; Otherwise, save this region. (mouse-set-mark-fast click) *************** *** 457,461 **** (if (not (eq buffer-undo-list t)) (setq buffer-undo-list ! (cons (cons (car kill-ring) start) buffer-undo-list)))) ;; Otherwise, save this region. --- 471,475 ---- (if (not (eq buffer-undo-list t)) (setq buffer-undo-list ! (cons (cons (car kill-ring) (marker-position start)) buffer-undo-list)))) ;; Otherwise, save this region. *************** *** 844,847 **** --- 858,862 ---- (defun mouse-choose-completion (event) + "Click on an alternative in the `*Completions*' buffer to choose it." (interactive "e") (let (choice) *************** *** 862,883 **** (forward-char 1)) (insert choice) ! (delete-region (point) (point-max))))) ;; Font selection. (defvar x-fixed-font-alist '("Font menu" ("Misc" ("fixed" "fixed") - ("6x10" "6x10") - ("6x12" "6x12") - ("6x13" "6x13") - ("7x13" "7x13") - ("7x14" "7x14") - ("8x13" "8x13") - ("8x13 bold" "8x13bold") - ("8x16" "8x16") - ("9x15" "9x15") - ("9x15 bold" "9x15bold") ("10x20" "10x20") ("11x18" "11x18") --- 877,916 ---- (forward-char 1)) (insert choice) ! (delete-region (point) (point-max)) ! (minibuffer-complete-and-exit)))) ;; Font selection. + (defun font-menu-add-default () + (let* ((default (cdr (assq 'font (frame-parameters (selected-frame))))) + (font-alist x-fixed-font-alist) + (elt (assoc "Misc" font-alist))) + (if (assoc "Default" elt) + (delete (assoc "Default" elt) elt)) + (setcdr elt + (cons (cons "Default" + (cdr (assq 'font (frame-parameters (selected-frame))))) + (cdr elt))))) + (defvar x-fixed-font-alist '("Font menu" ("Misc" + ("6x10" "-misc-fixed-medium-r-semicondensed--10-110-75-75-c-60-*-1") + ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1") + ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1") + ("lucida 13" + "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1") + ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1") + ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1") + ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1") + ("") + ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1") + ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1") + ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1") + ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1") + ("") + ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1") + ("") ("fixed" "fixed") ("10x20" "10x20") ("11x18" "11x18") *************** *** 924,929 **** (x-popup-menu last-nonmenu-event x-fixed-font-alist)) (if font ! (modify-frame-parameters (selected-frame) ! (list (cons 'font font))))) ;;; Bindings for mouse commands. --- 957,969 ---- (x-popup-menu last-nonmenu-event x-fixed-font-alist)) (if font ! (progn (modify-frame-parameters (selected-frame) ! (list (cons 'font font))) ! ;; Update some standard faces too. ! (set-face-font 'bold nil (selected-frame)) ! (make-face-bold 'bold (selected-frame) t) ! (set-face-font 'italic nil (selected-frame)) ! (make-face-italic 'italic (selected-frame) t) ! (set-face-font 'bold-italic nil (selected-frame)) ! (make-face-bold-italic 'bold-italic (selected-frame) t)))) ;;; Bindings for mouse commands. *************** *** 1000,1006 **** (define-key help-admin-map "n" ! '("view Emacs news" . view-emacs-news)) (define-key help-admin-map "l" ! '("View the GNU Emacs license" . describe-copying)) (define-key help-admin-map "d" '("Describe distribution" . describe-distribution)) --- 1040,1046 ---- (define-key help-admin-map "n" ! '("View Emacs news" . view-emacs-news)) (define-key help-admin-map "l" ! '("View Emacs copying conditions" . describe-copying)) (define-key help-admin-map "d" '("Describe distribution" . describe-distribution)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/mpuz.el emacs-19.18/lisp/mpuz.el *** emacs-19.17/lisp/mpuz.el Wed Jun 9 07:26:27 1993 --- emacs-19.18/lisp/mpuz.el Sun Aug 1 16:50:07 1993 *************** *** 34,42 **** (random t) ; randomize - (defun mpuz-random (n) - "Return a random integer between 0 and N - 1 inclusive." - (setq n (% (random) n)) - (if (< n 0) (- n) n)) - (defvar mpuz-silent nil "*Set this to T if you don't want dings on inputs.") --- 34,37 ---- *************** *** 143,147 **** elem) (while letters ! (setq elem (nth (mpuz-random index) letters) letters (delq elem letters) index (1- index)) --- 138,142 ---- elem) (while letters ! (setq elem (nth (random index) letters) letters (delq elem letters) index (1- index)) *************** *** 154,158 **** ;;------------------------------------------------------ (defvar mpuz-board (make-vector 10 nil) ! "The board associates ot any digit the list of squares where it appears.") (defun mpuz-put-digit-on-board (number square) --- 149,153 ---- ;;------------------------------------------------------ (defvar mpuz-board (make-vector 10 nil) ! "The board associates to any digit the list of squares where it appears.") (defun mpuz-put-digit-on-board (number square) *************** *** 186,191 **** ;; Choose random values, discarding uninteresting cases. (while (progn ! (setq A (mpuz-random 1000) ! B (mpuz-random 100) C (* A (% B 10)) D (* A (/ B 10)) --- 181,186 ---- ;; Choose random values, discarding uninteresting cases. (while (progn ! (setq A (random 1000) ! B (random 100) C (* A (% B 10)) D (* A (/ B 10)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/outline.el emacs-19.18/lisp/outline.el *** emacs-19.17/lisp/outline.el Sun Jul 4 17:42:00 1993 --- emacs-19.18/lisp/outline.el Tue Jul 20 13:56:22 1993 *************** *** 62,72 **** (define-key outline-mode-map [menu-bar hide hide-subtree] ! '("Hide Subtree" . outline-hide-subtree)) (define-key outline-mode-map [menu-bar hide hide-entry] ! '("Hide Entry" . outline-hide-entry)) (define-key outline-mode-map [menu-bar hide hide-body] ! '("Hide Body" . outline-hide-body)) (define-key outline-mode-map [menu-bar hide hide-leaves] ! '("Hide Leaves" . outline-hide-leaves)) (define-key outline-mode-map [menu-bar show] --- 62,72 ---- (define-key outline-mode-map [menu-bar hide hide-subtree] ! '("Hide Subtree" . hide-subtree)) (define-key outline-mode-map [menu-bar hide hide-entry] ! '("Hide Entry" . hide-entry)) (define-key outline-mode-map [menu-bar hide hide-body] ! '("Hide Body" . hide-body)) (define-key outline-mode-map [menu-bar hide hide-leaves] ! '("Hide Leaves" . hide-leaves)) (define-key outline-mode-map [menu-bar show] *************** *** 74,86 **** (define-key outline-mode-map [menu-bar show show-subtree] ! '("Show Subtree" . outline-show-subtree)) (define-key outline-mode-map [menu-bar show show-children] ! '("Show Children" . outline-show-children)) (define-key outline-mode-map [menu-bar show show-branches] ! '("Show Branches" . outline-show-branches)) (define-key outline-mode-map [menu-bar show show-entry] ! '("Show Entry" . outline-show-entry)) (define-key outline-mode-map [menu-bar show show-all] ! '("Show All" . outline-show-all)) (define-key outline-mode-map [menu-bar headings] --- 74,86 ---- (define-key outline-mode-map [menu-bar show show-subtree] ! '("Show Subtree" . show-subtree)) (define-key outline-mode-map [menu-bar show show-children] ! '("Show Children" . show-children)) (define-key outline-mode-map [menu-bar show show-branches] ! '("Show Branches" . show-branches)) (define-key outline-mode-map [menu-bar show show-entry] ! '("Show Entry" . show-entry)) (define-key outline-mode-map [menu-bar show show-all] ! '("Show All" . show-all)) (define-key outline-mode-map [menu-bar headings] diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/paren.el emacs-19.18/lisp/paren.el *** emacs-19.17/lisp/paren.el Fri Jul 16 14:35:23 1993 --- emacs-19.18/lisp/paren.el Tue Aug 3 13:44:41 1993 *************** *** 37,40 **** --- 37,43 ---- (defvar show-paren-mismatch-face nil) + (defvar show-paren-face 'region + "*Name of face to use for showing the matching paren.") + ;; Find the place to show, if there is one, ;; and show it until input arrives. *************** *** 42,46 **** (if window-system (let (pos dir mismatch (oldpos (point)) ! (face 'region)) (cond ((eq (char-syntax (following-char)) ?\() (setq dir 1)) --- 45,49 ---- (if window-system (let (pos dir mismatch (oldpos (point)) ! (face show-paren-face)) (cond ((eq (char-syntax (following-char)) ?\() (setq dir 1)) *************** *** 82,86 **** (setq show-paren-mismatch-face (make-face 'paren-mismatch)) ! (set-face-background 'paren-mismatch 'purple)))) (if show-paren-mismatch-face (setq face show-paren-mismatch-face) --- 85,90 ---- (setq show-paren-mismatch-face (make-face 'paren-mismatch)) ! (set-face-background 'paren-mismatch ! "purple")))) (if show-paren-mismatch-face (setq face show-paren-mismatch-face) *************** *** 93,97 **** (progn (if show-paren-overlay-1 ! (move-overlay show-paren-overlay-1 (+ (point) dir) (point)) (setq show-paren-overlay-1 (make-overlay (- pos dir) pos))) --- 97,103 ---- (progn (if show-paren-overlay-1 ! (move-overlay show-paren-overlay-1 ! (+ (point) dir) (point) ! (current-buffer)) (setq show-paren-overlay-1 (make-overlay (- pos dir) pos))) *************** *** 103,107 **** ;; Turn on highlighting for the matching paren. (if show-paren-overlay ! (move-overlay show-paren-overlay (- pos dir) pos) (setq show-paren-overlay (make-overlay (- pos dir) pos))) --- 109,114 ---- ;; Turn on highlighting for the matching paren. (if show-paren-overlay ! (move-overlay show-paren-overlay (- pos dir) pos ! (current-buffer)) (setq show-paren-overlay (make-overlay (- pos dir) pos))) *************** *** 119,123 **** (setq blink-paren-function nil) (add-hook 'post-command-hook 'show-paren-command-hook))) ! (provide 'paren) --- 126,137 ---- (setq blink-paren-function nil) (add-hook 'post-command-hook 'show-paren-command-hook))) ! ;;; This is in case paren.el is preloaded. ! (add-hook 'window-setup-hook ! (function (lambda () ! (if window-system ! (progn ! (setq blink-paren-function nil) ! (add-hook 'post-command-hook ! 'show-paren-command-hook)))))) (provide 'paren) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/paths.el emacs-19.18/lisp/paths.el *** emacs-19.17/lisp/paths.el Sat May 29 12:05:51 1993 --- emacs-19.18/lisp/paths.el Wed Aug 4 19:19:28 1993 *************** *** 109,117 **** (defconst sendmail-program ! (if (file-exists-p "/usr/lib/sendmail") ! "/usr/lib/sendmail" ! (if (file-exists-p "/usr/ucblib/sendmail") ! "/usr/ucblib/sendmail" ! "fakemail")) ;In ../etc, to interface to /bin/mail. "Program used to send messages.") --- 109,117 ---- (defconst sendmail-program ! (cond ! ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail") ! ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail") ! ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail") ! (t "fakemail")) ;In ../etc, to interface to /bin/mail. "Program used to send messages.") diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/perl-mode.el emacs-19.18/lisp/perl-mode.el *** emacs-19.17/lisp/perl-mode.el Wed Jun 9 07:26:47 1993 --- emacs-19.18/lisp/perl-mode.el Wed Aug 4 21:35:47 1993 *************** *** 173,176 **** --- 173,177 ---- "*Lines starting with this regular expression will not be auto-indented.") + ;;;###autoload (defun perl-mode () "Major mode for editing Perl code. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/replace.el emacs-19.18/lisp/replace.el *** emacs-19.17/lisp/replace.el Mon Jul 5 00:39:50 1993 --- emacs-19.18/lisp/replace.el Mon Aug 2 21:07:50 1993 *************** *** 251,254 **** --- 251,256 ---- (t 1))))) (pos (nth occur-number occur-pos-list))) + (or pos + (error "No occurrence on this line")) (pop-to-buffer occur-buffer) (goto-char (marker-position pos)))) *************** *** 277,281 **** (input (read-from-minibuffer ! (format "List lines matching regexp (default `%s'): " default) nil nil nil 'regexp-history))) --- 279,285 ---- (input (read-from-minibuffer ! (if default ! (format "List lines matching regexp (default `%s'): " default) ! "List lines matching regexp: ") nil nil nil 'regexp-history))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/reposition.el emacs-19.18/lisp/reposition.el *** emacs-19.17/lisp/reposition.el Thu Mar 25 00:07:18 1993 --- emacs-19.18/lisp/reposition.el Tue Jul 20 01:48:56 1993 *************** *** 71,75 **** ;; the beginning of the preceding comment (save-excursion ! (forward-char 1) (end-of-defun -1) ;; Skip whitespace, newlines, and form feeds. (re-search-forward "[^\\s \n\014]") --- 71,76 ---- ;; the beginning of the preceding comment (save-excursion ! (if (not (eobp)) (forward-char 1)) ! (end-of-defun -1) ;; Skip whitespace, newlines, and form feeds. (re-search-forward "[^\\s \n\014]") diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/rmail.el emacs-19.18/lisp/rmail.el *** emacs-19.17/lisp/rmail.el Fri Jul 16 00:16:34 1993 --- emacs-19.18/lisp/rmail.el Wed Aug 4 17:37:02 1993 *************** *** 127,131 **** (defvar rmail-last-file nil) (defvar rmail-last-regexp nil) ! (defvar rmail-last-rmail-file nil) ;;; Regexp matching the delimiter of messages in UNIX mail format --- 127,131 ---- (defvar rmail-last-file nil) (defvar rmail-last-regexp nil) ! (defvar rmail-last-rmail-file (expand-file-name "~/XMAIL")) ;;; Regexp matching the delimiter of messages in UNIX mail format *************** *** 202,207 **** (or rmail-last-file (setq rmail-last-file (expand-file-name "~/xmail"))) - (or rmail-last-rmail-file - (setq rmail-last-rmail-file (expand-file-name "~/XMAIL"))) (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name))) (existed (get-file-buffer file-name))) --- 202,205 ---- *************** *** 285,289 **** (let ((buffer-read-only nil)) (message "Converting to Babyl format...") ! (narrow-to-region (point) (point-max)) (rmail-convert-to-babyl-format) (message "Converting to Babyl format...done"))))) --- 283,288 ---- (let ((buffer-read-only nil)) (message "Converting to Babyl format...") ! ;;; If file needs conversion, convert it all. ! ;;; (narrow-to-region (point) (point-max)) (rmail-convert-to-babyl-format) (message "Converting to Babyl format...done"))))) *************** *** 967,971 **** (if has-from "" ! "From: \\1\n"))))))))) ;;;; *** Rmail Message Formatting and Header Manipulation *** --- 966,971 ---- (if has-from "" ! "From: \\1\n")) ! t))))))) ;;;; *** Rmail Message Formatting and Header Manipulation *** *************** *** 981,986 **** (insert ?1) (forward-line 1) ! (if (looking-at "Summary-line: ") ! (forward-line 1)) (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n") (delete-region (point) --- 981,987 ---- (insert ?1) (forward-line 1) ! (let ((case-fold-search t)) ! (if (looking-at "Summary-line: ") ! (forward-line 1))) (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n") (delete-region (point) *************** *** 1021,1026 **** (insert ?0) (forward-line 1) ! (if (looking-at "Summary-Line:") ! (forward-line 1)) (insert "*** EOOH ***\n") (forward-char -1) --- 1022,1028 ---- (insert ?0) (forward-line 1) ! (let ((case-fold-search t)) ! (if (looking-at "Summary-Line:") ! (forward-line 1))) (insert "*** EOOH ***\n") (forward-char -1) *************** *** 1655,1659 **** (defun rmail-start-mail (&rest args) (if rmail-mail-new-frame ! (progn (apply 'mail-other-frame args) (modify-frame-parameters (selected-frame) --- 1657,1661 ---- (defun rmail-start-mail (&rest args) (if rmail-mail-new-frame ! (prog1 (apply 'mail-other-frame args) (modify-frame-parameters (selected-frame) *************** *** 1814,1818 **** ;; so that the Rmail buffer remains visible ;; and sending the mail will get back to it. ! (if (funcall (if (one-window-p t) (function mail) (function rmail-start-mail)) --- 1816,1820 ---- ;; so that the Rmail buffer remains visible ;; and sending the mail will get back to it. ! (if (funcall (if (and (not rmail-mail-new-frame) (one-window-p t)) (function mail) (function rmail-start-mail)) *************** *** 1825,1832 **** (current-buffer) rmail-current-message))) ! (save-excursion ! (goto-char (point-max)) ! (forward-line 1) ! (insert-buffer forward-buffer))))))) (defun rmail-resend (address &optional from comment mail-alias-file) --- 1827,1834 ---- (current-buffer) rmail-current-message))) ! (save-excursion ! (goto-char (point-max)) ! (forward-line 1) ! (insert-buffer forward-buffer))))))) (defun rmail-resend (address &optional from comment mail-alias-file) *************** *** 1855,1858 **** --- 1857,1869 ---- (insert-buffer-substring mailbuf) (goto-char (point-min)) + ;; Delete any Sender field, since that's not specifyable. + (if (re-search-forward "^Sender:" nil t) + (let (beg) + (beginning-of-line) + (setq beg (point)) + (forward-line 1) + (while (looking-at "[ \t]") + (forward-line 1)) + (delete-region beg (point)))) ;;>> Insert resent-from: (insert "Resent-From: " from "\n") diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/rmailedit.el emacs-19.18/lisp/rmailedit.el *** emacs-19.17/lisp/rmailedit.el Mon Sep 21 06:42:53 1992 --- emacs-19.18/lisp/rmailedit.el Tue Jul 20 01:18:23 1993 *************** *** 29,33 **** (if rmail-edit-map nil ! (setq rmail-edit-map (nconc (make-sparse-keymap) (cdr text-mode-map))) (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit) (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit)) --- 29,34 ---- (if rmail-edit-map nil ! ;; Make a keymap that inherits text-mode-map. ! (setq rmail-edit-map (nconc (make-sparse-keymap) text-mode-map)) (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit) (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit)) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/rmailout.el emacs-19.18/lisp/rmailout.el *** emacs-19.17/lisp/rmailout.el Sat Jul 10 01:09:15 1993 --- emacs-19.18/lisp/rmailout.el Sat Jul 24 22:19:09 1993 *************** *** 60,69 **** ;; If not suggestions, use same file as last time. (or answer rmail-last-rmail-file)))) ! (list (read-file-name ! (concat "Output message to Rmail file: (default " ! (file-name-nondirectory default-file) ! ") ") ! (file-name-directory rmail-last-rmail-file) ! default-file) (prefix-numeric-value current-prefix-arg)))) (or count (setq count 1)) --- 60,70 ---- ;; If not suggestions, use same file as last time. (or answer rmail-last-rmail-file)))) ! (list (setq rmail-last-rmail-file ! (read-file-name ! (concat "Output message to Rmail file: (default " ! (file-name-nondirectory default-file) ! ") ") ! (file-name-directory default-file) ! default-file)) (prefix-numeric-value current-prefix-arg)))) (or count (setq count 1)) *************** *** 73,77 **** (if (and (file-readable-p file-name) (not (rmail-file-p file-name))) (rmail-output file-name count) - (setq rmail-last-rmail-file file-name) (rmail-maybe-set-message-counters) (setq file-name (abbreviate-file-name file-name)) --- 74,77 ---- *************** *** 149,167 **** ;;; There are functions elsewhere in Emacs that use this function; check ;;; them out before you change the calling method. ! (defun rmail-output (file-name &optional count) "Append this message to Unix mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. ! When called from lisp code, N may be omitted." (interactive ! (list (read-file-name ! (concat "Output message to Unix mail file" ! (if rmail-last-file ! (concat " (default " ! (file-name-nondirectory rmail-last-file) ! "): " ) ! ": ")) ! (and rmail-last-file (file-name-directory rmail-last-file)) ! rmail-last-file) (prefix-numeric-value current-prefix-arg))) (or count (setq count 1)) --- 149,171 ---- ;;; There are functions elsewhere in Emacs that use this function; check ;;; them out before you change the calling method. ! (defun rmail-output (file-name &optional count noattribute) "Append this message to Unix mail file named FILE-NAME. A prefix argument N says to output N consecutive messages starting with the current one. Deleted messages are skipped and don't count. ! When called from lisp code, N may be omitted. ! ! The optional third argument NOATTRIBUTE, if non-nil, says not ! to set the `filed' attribute, and not to display a message." (interactive ! (list (setq rmail-last-file ! (read-file-name ! (concat "Output message to Unix mail file" ! (if rmail-last-file ! (concat " (default " ! (file-name-nondirectory rmail-last-file) ! "): " ) ! ": ")) ! (and rmail-last-file (file-name-directory rmail-last-file)) ! rmail-last-file)) (prefix-numeric-value current-prefix-arg))) (or count (setq count 1)) *************** *** 172,176 **** (if (and (file-readable-p file-name) (rmail-file-p file-name)) (rmail-output-to-rmail-file file-name count) - (setq rmail-last-file file-name) (while (> count 0) (let ((rmailbuf (current-buffer)) --- 176,179 ---- *************** *** 195,202 **** (forward-char -5) (insert ?>)) ! (append-to-file (point-min) (point-max) file-name)) (kill-buffer tembuf)) ! (if (equal major-mode 'rmail-mode) ! (rmail-set-attribute "filed" t)) (setq count (1- count)) (if rmail-delete-after-output --- 198,207 ---- (forward-char -5) (insert ?>)) ! (write-region (point-min) (point-max) file-name t ! (if noattribute 'nomsg))) (kill-buffer tembuf)) ! (or noattribute ! (if (equal major-mode 'rmail-mode) ! (rmail-set-attribute "filed" t))) (setq count (1- count)) (if rmail-delete-after-output Only in emacs-19.17/lisp: sc-alist.el diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/sc.el emacs-19.18/lisp/sc.el *** emacs-19.17/lisp/sc.el Thu Jun 17 19:40:53 1993 --- emacs-19.18/lisp/sc.el Wed Jul 28 14:21:09 1993 *************** *** 120,124 **** ;; (setq sc-load-hook 'my-supercite-hook) ! (require 'sc-alist) --- 120,124 ---- ;; (setq sc-load-hook 'my-supercite-hook) ! (require 'assoc) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/scroll-bar.el emacs-19.18/lisp/scroll-bar.el *** emacs-19.17/lisp/scroll-bar.el Fri Jul 2 16:32:16 1993 --- emacs-19.18/lisp/scroll-bar.el Fri Aug 6 16:59:30 1993 *************** *** 57,60 **** --- 57,61 ---- turn off scroll bars; otherwise, turn on scroll bars." (interactive "P") + (if flag (setq flag (prefix-numeric-value flag))) ;; Obtain the current setting by looking at default-frame-alist. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/sendmail.el emacs-19.18/lisp/sendmail.el *** emacs-19.17/lisp/sendmail.el Fri Jul 16 00:18:34 1993 --- emacs-19.18/lisp/sendmail.el Mon Aug 2 03:10:22 1993 *************** *** 80,84 **** "*Number of spaces to insert at the beginning of each cited line. Used by `mail-yank-original' via `mail-yank-cite'.") ! (defvar mail-yank-hooks '(mail-indent-citation) "Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). --- 80,84 ---- "*Number of spaces to insert at the beginning of each cited line. Used by `mail-yank-original' via `mail-yank-cite'.") ! (defvar mail-yank-hooks nil "Obsolete hook for modifying a citation just inserted in the mail buffer. Each hook function can find the citation between (point) and (mark t). *************** *** 299,303 **** (let ((newbuf (other-buffer (current-buffer)))) (bury-buffer (current-buffer)) ! (if (and (cdr (assq 'dedicated (frame-parameters))) (not (null (delq (selected-frame) (visible-frame-list))))) (delete-frame (selected-frame)) --- 299,304 ---- (let ((newbuf (other-buffer (current-buffer)))) (bury-buffer (current-buffer)) ! (if (and (fboundp 'frame-parameters) ! (cdr (assq 'dedicated (frame-parameters))) (not (null (delq (selected-frame) (visible-frame-list))))) (delete-frame (selected-frame)) *************** *** 678,682 **** (if mail-citation-hook (run-hooks 'mail-citation-hook) ! (run-hooks 'mail-yank-hooks)))) ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command --- 679,685 ---- (if mail-citation-hook (run-hooks 'mail-citation-hook) ! (if mail-yank-hooks ! (run-hooks 'mail-yank-hooks) ! (mail-indent-citation))))) ;; This is like exchange-point-and-mark, but doesn't activate the mark. ;; It is cleaner to avoid activation, even though the command *************** *** 831,844 **** (mail noerase to subject in-reply-to cc replybuffer sendactions)) ! ! ;;;###autoload ! (define-key ctl-x-map "m" 'mail) ! ! ;;;###autoload ! (define-key ctl-x-4-map "m" 'mail-other-window) ! ! ;;;###autoload ! (define-key ctl-x-5-map "m" 'mail-other-frame) ! ;;; Do not add anything but external entries on this page. --- 834,842 ---- (mail noerase to subject in-reply-to cc replybuffer sendactions)) ! ;;; Do not execute these when sendmail.el is loaded, ! ;;; only in loaddefs.el. ! ;;;###autoload (define-key ctl-x-map "m" 'mail) ! ;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window) ! ;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame) ;;; Do not add anything but external entries on this page. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/server.el emacs-19.18/lisp/server.el *** emacs-19.17/lisp/server.el Thu Jul 15 00:01:05 1993 --- emacs-19.18/lisp/server.el Mon Aug 9 01:52:55 1993 *************** *** 197,224 **** "Finds FILES and returns the list CLIENT with the buffers nconc'd. FILES is an alist whose elements are (FILENAME LINENUMBER)." ! (let (client-record) ! (while files ! (save-excursion ! ;; If there is an existing buffer modified or the file is modified, ! ;; revert it. ! ;; If there is an existing buffer with deleted file, offer to write it. ! (let* ((filen (car (car files))) ! (obuf (get-file-buffer filen))) ! (if (and obuf (set-buffer obuf)) ! (if (file-exists-p filen) ! (if (or (not (verify-visited-file-modtime obuf)) ! (buffer-modified-p obuf)) ! (revert-buffer t nil)) ! (if (y-or-n-p ! (concat "File no longer exists: " ! filen ! ", write buffer to file? ")) ! (write-file filen))) ! (set-buffer (find-file-noselect filen)) ! (run-hooks 'server-visit-hook))) ! (goto-line (nth 1 (car files))) ! (setq server-buffer-clients (cons (car client) server-buffer-clients)) ! (setq client-record (cons (current-buffer) client-record))) ! (setq files (cdr files))) (nconc client client-record))) --- 197,228 ---- "Finds FILES and returns the list CLIENT with the buffers nconc'd. FILES is an alist whose elements are (FILENAME LINENUMBER)." ! (let (client-record (obuf (current-buffer))) ! ;; Restore the current buffer afterward, but not using save-excursion, ! ;; because we don't want to save point in this buffer ! ;; if it happens to be one of those specified by the server. ! (unwind-protect ! (while files ! ;; If there is an existing buffer modified or the file is modified, ! ;; revert it. ! ;; If there is an existing buffer with deleted file, offer to write it. ! (let* ((filen (car (car files))) ! (obuf (get-file-buffer filen))) ! (if (and obuf (set-buffer obuf)) ! (if (file-exists-p filen) ! (if (or (not (verify-visited-file-modtime obuf)) ! (buffer-modified-p obuf)) ! (revert-buffer t nil)) ! (if (y-or-n-p ! (concat "File no longer exists: " ! filen ! ", write buffer to file? ")) ! (write-file filen))) ! (set-buffer (find-file-noselect filen)) ! (run-hooks 'server-visit-hook))) ! (goto-line (nth 1 (car files))) ! (setq server-buffer-clients (cons (car client) server-buffer-clients)) ! (setq client-record (cons (current-buffer) client-record)) ! (setq files (cdr files))) ! (set-buffer obuf)) (nconc client client-record))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/simple.el emacs-19.18/lisp/simple.el *** emacs-19.17/lisp/simple.el Thu Jul 15 01:46:45 1993 --- emacs-19.18/lisp/simple.el Sun Aug 8 03:36:33 1993 *************** *** 376,380 **** (put 'eval-expression 'disabled t) ! ;; We define this, rather than making eval interactive, ;; for the sake of completion of names like eval-region, eval-current-buffer. (defun eval-expression (expression) --- 376,382 ---- (put 'eval-expression 'disabled t) ! (defvar read-expression-history nil) ! ! ;; We define this, rather than making `eval' interactive, ;; for the sake of completion of names like eval-region, eval-current-buffer. (defun eval-expression (expression) *************** *** 382,386 **** Value is also consed on to front of the variable `values'." (interactive (list (read-from-minibuffer "Eval: " ! nil read-expression-map t))) (setq values (cons (eval expression) values)) (prin1 (car values) t)) --- 384,389 ---- Value is also consed on to front of the variable `values'." (interactive (list (read-from-minibuffer "Eval: " ! nil read-expression-map t ! 'read-expression-history))) (setq values (cons (eval expression) values)) (prin1 (car values) t)) *************** *** 628,633 **** (setq pending-undo-list (primitive-undo count pending-undo-list))) ! (defvar last-shell-command "") ! (defvar last-shell-command-on-region "") (defun shell-command (command &optional flag) --- 631,636 ---- (setq pending-undo-list (primitive-undo count pending-undo-list))) ! (defvar shell-command-history nil ! "History list for some commands that read shell commands.") (defun shell-command (command &optional flag) *************** *** 638,642 **** means insert output in current buffer after point (leave mark after it). This cannot be done asynchronously." ! (interactive (list (read-string "Shell command: " last-shell-command) current-prefix-arg)) (if flag --- 641,646 ---- means insert output in current buffer after point (leave mark after it). This cannot be done asynchronously." ! (interactive (list (read-from-minibuffer "Shell command: " ! nil nil nil 'shell-command-history) current-prefix-arg)) (if flag *************** *** 733,738 **** deleted." (interactive (list (region-beginning) (region-end) ! (read-string "Shell command on region: " ! last-shell-command-on-region) current-prefix-arg (prefix-numeric-value current-prefix-arg))) --- 737,742 ---- deleted." (interactive (list (region-beginning) (region-end) ! (read-from-minibuffer "Shell command on region: " ! nil nil nil 'shell-command-history) current-prefix-arg (prefix-numeric-value current-prefix-arg))) *************** *** 1096,1102 **** ;; as C-g would as a command. (and quit-flag mark-active ! (progn ! (message "foo") ;XXX what is this here for? --roland ! (deactivate-mark)))) (let* ((killed-text (current-kill 0)) (message-len (min (length killed-text) 40))) --- 1100,1104 ---- ;; as C-g would as a command. (and quit-flag mark-active ! (deactivate-mark))) (let* ((killed-text (current-kill 0)) (message-len (min (length killed-text) 40))) *************** *** 1263,1266 **** --- 1265,1269 ---- (defsubst deactivate-mark () "Deactivate the mark by setting `mark-active' to nil. + \(That makes a difference only in Transient Mark mode.) Also runs the hook `deactivate-mark-hook'." (setq mark-active nil) *************** *** 1284,1290 **** (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." ! (setq mark-active t) ! (run-hooks 'activate-mark-hook) ! (set-marker (mark-marker) pos (current-buffer))) (defvar mark-ring nil --- 1287,1297 ---- (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." ! (if pos ! (progn ! (setq mark-active t) ! (run-hooks 'activate-mark-hook) ! (set-marker (mark-marker) pos (current-buffer))) ! (deactivate-mark) ! (set-marker (mark-marker) pos (current-buffer)))) (defvar mark-ring nil *************** *** 1903,1916 **** (goto-char fill-point) (not (bolp))) ! ;; If point is at the fill-point, do not `save-excursion'. ! ;; Otherwise, if a comment prefix or fill-prefix is inserted, ! ;; point will end up before it rather than after it. ! (if (save-excursion ! (skip-chars-backward " \t") ! (= (point) fill-point)) ! (indent-new-comment-line) ! (save-excursion ! (goto-char fill-point) ! (indent-new-comment-line))) ;; No place to break => stop trying. (setq give-up t))))))) --- 1910,1929 ---- (goto-char fill-point) (not (bolp))) ! (let ((prev-column (current-column))) ! ;; If point is at the fill-point, do not `save-excursion'. ! ;; Otherwise, if a comment prefix or fill-prefix is inserted, ! ;; point will end up before it rather than after it. ! (if (save-excursion ! (skip-chars-backward " \t") ! (= (point) fill-point)) ! (indent-new-comment-line) ! (save-excursion ! (goto-char fill-point) ! (indent-new-comment-line))) ! ;; If making the new line didn't reduce the hpos of ! ;; the end of the line, then give up now; ! ;; trying again will not help. ! (if (>= (current-column) prev-column) ! (setq give-up t))) ;; No place to break => stop trying. (setq give-up t))))))) *************** *** 2198,2224 **** ;; Define the major mode for lists of completions. ! (defvar completion-mode-map nil) ! (or completion-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'mouse-choose-completion) ! (setq completion-mode-map map))) ;; Completion mode is suitable only for specially formatted data. ! (put 'completion-mode 'mode-class 'special) ! (defun completion-mode () "Major mode for buffers showing lists of possible completions. ! Type \\\\[mouse-choose-completion] to select a completion with the mouse." (interactive) (kill-all-local-variables) ! (use-local-map completion-mode-map) ! (setq mode-name "Completion") ! (setq major-mode 'completion-mode) ! (run-hooks 'completion-mode-hook)) (defun completion-setup-function () (save-excursion ! (completion-mode) (goto-char (point-min)) (if window-system --- 2211,2237 ---- ;; Define the major mode for lists of completions. ! (defvar completion-list-mode-map nil) ! (or completion-list-mode-map (let ((map (make-sparse-keymap))) (define-key map [mouse-2] 'mouse-choose-completion) ! (setq completion-list-mode-map map))) ;; Completion mode is suitable only for specially formatted data. ! (put 'completion-list-mode 'mode-class 'special) ! (defun completion-list-mode () "Major mode for buffers showing lists of possible completions. ! Type \\\\[mouse-choose-completion] to select a completion with the mouse." (interactive) (kill-all-local-variables) ! (use-local-map completion-list-mode-map) ! (setq mode-name "Completion List") ! (setq major-mode 'completion-list-mode) ! (run-hooks 'completion-list-mode-hook)) (defun completion-setup-function () (save-excursion ! (completion-list-mode) (goto-char (point-min)) (if window-system diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/sort.el emacs-19.18/lisp/sort.el *** emacs-19.17/lisp/sort.el Wed Jun 9 07:27:37 1993 --- emacs-19.18/lisp/sort.el Fri Jul 23 13:52:58 1993 *************** *** 254,258 **** (sort-fields-1 field beg end (function (lambda () ! (sort-skip-fields (1- field)) (string-to-number (buffer-substring --- 254,258 ---- (sort-fields-1 field beg end (function (lambda () ! (sort-skip-fields field) (string-to-number (buffer-substring *************** *** 276,280 **** (sort-fields-1 field beg end (function (lambda () ! (sort-skip-fields (1- field)) (string-to-number (buffer-substring --- 276,280 ---- (sort-fields-1 field beg end (function (lambda () ! (sort-skip-fields field) (string-to-number (buffer-substring *************** *** 296,300 **** (sort-fields-1 field beg end (function (lambda () ! (sort-skip-fields (1- field)) nil)) (function (lambda () (skip-chars-forward "^ \t\n"))))) --- 296,300 ---- (sort-fields-1 field beg end (function (lambda () ! (sort-skip-fields field) nil)) (function (lambda () (skip-chars-forward "^ \t\n"))))) *************** *** 314,332 **** (set-syntax-table tbl)))) (defun sort-skip-fields (n) ! (let ((bol (point)) ! (eol (save-excursion (end-of-line 1) (point)))) ! (if (> n 0) (forward-word n) ! (end-of-line) ! (forward-word (1+ n))) ! (if (or (and (>= (point) eol) (> n 0)) ! ;; this is marginally wrong; if the first line of the sort ! ;; at bob has the wrong number of fields the error won't be ! ;; reported until the next short line. ! (and (< (point) bol) (< n 0))) (error "Line has too few fields: %s" ! (buffer-substring bol eol))) ! (skip-chars-forward " \t"))) ! ;;;###autoload --- 314,349 ---- (set-syntax-table tbl)))) + ;; Position at the beginning of field N on the current line, + ;; assuming point is initially at the beginning of the line. (defun sort-skip-fields (n) ! (if (> n 0) ! ;; Skip across N - 1 fields. ! (let ((i (1- n))) ! (while (> i 0) ! (skip-chars-forward " \t") ! (skip-chars-forward "^ \t\n") ! (setq i (1- i))) ! (skip-chars-forward " \t") ! (if (eolp) ! (error "Line has too few fields: %s" ! (buffer-substring ! (save-excursion (beginning-of-line) (point)) ! (save-excursion (end-of-line) (point)))))) ! (end-of-line) ! ;; Skip back across - N - 1 fields. ! (let ((i (1- (- n)))) ! (while (> i 0) ! (skip-chars-backward " \t") ! (skip-chars-backward "^ \t\n") ! (setq i (1- i))) ! (skip-chars-backward " \t")) ! (if (bolp) (error "Line has too few fields: %s" ! (buffer-substring ! (save-excursion (beginning-of-line) (point)) ! (save-excursion (end-of-line) (point))))) ! ;; Position at the front of the field ! ;; even if moving backwards. ! (skip-chars-backward "^ \t\n"))) ;;;###autoload diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/startup.el emacs-19.18/lisp/startup.el *** emacs-19.17/lisp/startup.el Sat May 29 18:28:10 1993 --- emacs-19.18/lisp/startup.el Mon Jul 26 16:01:50 1993 *************** *** 144,152 **** --- 144,159 ---- (unwind-protect (command-line) + ;; Do this again, in case .emacs defined more abbreviations. + (setq default-directory (abbreviate-file-name default-directory)) (run-hooks 'emacs-startup-hook) (and term-setup-hook (run-hooks 'term-setup-hook)) + ;; Modify the initial frame based on what .emacs puts into + ;; ...-frame-alist. (if (fboundp 'frame-notice-user-settings) (frame-notice-user-settings)) + ;; Now we know the user's default font, so add it to the menu. + (if (fboundp 'font-menu-add-default) + (font-menu-add-default)) (and window-setup-hook (run-hooks 'window-setup-hook))))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/subr.el emacs-19.18/lisp/subr.el *** emacs-19.17/lisp/subr.el Mon Jul 12 23:59:40 1993 --- emacs-19.18/lisp/subr.el Sun Aug 8 15:12:54 1993 *************** *** 84,87 **** --- 84,100 ---- (not (eq walk-windows-current walk-windows-start)))))) + (defun minibuffer-window-active-p (window) + "Return t if WINDOW (a minibuffer window) is now active." + ;; nil nil means include WINDOW's frame + ;; and other frames using WINDOW as minibuffer, + ;; and include minibuffer if active. + (let ((prev (previous-window window nil nil))) + ;; If PREV equals WINDOW, WINDOW must be on a minibuffer-only frame + ;; and it's not currently being used. So return nil. + (and (not (eq window prev)) + (let ((should-be-same (next-window prev nil nil))) + ;; If next-window doesn't reverse previous-window, + ;; WINDOW must be outside the cycle specified by nil nil. + (eq should-be-same window))))) ;;;; Keymap support. *************** *** 192,196 **** (or (keymapp keymap) (signal 'wrong-type-argument (list 'keymapp keymap))) ! (if (> (length key) 0) (error "multi-event key specified in `define-key-after'")) (let ((tail keymap) done inserted --- 205,209 ---- (or (keymapp keymap) (signal 'wrong-type-argument (list 'keymapp keymap))) ! (if (> (length key) 1) (error "multi-event key specified in `define-key-after'")) (let ((tail keymap) done inserted *************** *** 228,232 **** (progn (let* ((i (length keyboard-translate-table)) ! (table (make-string (- 256 i) 0))) (while (< i 256) (aset table i i) --- 241,246 ---- (progn (let* ((i (length keyboard-translate-table)) ! (table (concat keyboard-translate-table ! (make-string (- 256 i) 0)))) (while (< i 256) (aset table i i) *************** *** 296,300 **** "Returns a list of symbols representing the modifier keys in event EVENT. The elements of the list may include `meta', `control', ! `shift', `hyper', `super', `alt', `click', `drag', and `down'." (let ((type event)) (if (listp type) --- 310,315 ---- "Returns a list of symbols representing the modifier keys in event EVENT. The elements of the list may include `meta', `control', ! `shift', `hyper', `super', `alt', `click', `double', `triple', `drag', ! and `down'." (let ((type event)) (if (listp type) *************** *** 352,355 **** --- 367,375 ---- (nth (if (consp (nth 2 event)) 2 1) event)) + (defsubst event-click-count (event) + "Return the multi-click count of EVENT, a click or drag event. + The return value is a positive integer." + (if (integerp (nth 2 event)) (nth 2 event) 1)) + (defsubst posn-window (position) "Return the window in POSITION. *************** *** 460,469 **** (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 set to nil." (or (boundp hook) (set hook nil)) (or (if (consp function) ;; Clever way to tell whether a given lambda-expression --- 480,497 ---- (defun add-hook (hook function &optional append) ! "Add to the value of HOOK the function FUNCTION. ! FUNCTION is not added if already present. ! FUNCTION is added (if necessary) at the beginning of the hook list ! unless the optional argument APPEND is non-nil, in which case ! FUNCTION is added at the end. ! ! HOOK should be a symbol, and FUNCTION may be any valid function. If ! HOOK is void, it is first set to nil. If HOOK's value is a single ! function, it is changed to a list of functions." (or (boundp hook) (set hook nil)) + ;; If the hook value is a single function, turn it into a list. + (let ((old (symbol-value hook))) + (if (or (not (listp old)) (eq (car old) 'lambda)) + (set hook (list old)))) (or (if (consp function) ;; Clever way to tell whether a given lambda-expression diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/tar-mode.el emacs-19.18/lisp/tar-mode.el *** emacs-19.17/lisp/tar-mode.el Sat Jul 17 15:09:57 1993 --- emacs-19.18/lisp/tar-mode.el Sat Jul 31 18:32:52 1993 *************** *** 1,5 **** ;;; tar-mode.el --- simple editing of tar files from GNU emacs ! ;;; Copyright (C) 1990, 1991 Free Software Foundation, Inc. ;; Author: Jamie Zawinski --- 1,5 ---- ;;; tar-mode.el --- simple editing of tar files from GNU emacs ! ;;; Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc. ;; Author: Jamie Zawinski *************** *** 37,49 **** ;;; string of tar-mode for more info. - ;;; To autoload, add this to your .emacs file: - ;;; - ;;; (setq auto-mode-alist (cons '("\\.tar$" . tar-mode) auto-mode-alist)) - ;;; (autoload 'tar-mode "tar-mode") - ;;; - ;;; But beware: for certain tar files - those whose very first file has - ;;; a -*- property line - autoloading won't work. See the function - ;;; "tar-normal-mode" to understand why. - ;;; This code now understands the extra fields that GNU tar adds to tar files. --- 37,40 ---- *************** *** 116,119 **** --- 107,115 ---- (defvar tar-superior-descriptor nil) (defvar tar-subfile-mode nil) + + (put 'tar-parse-info 'permanent-local t) + (put 'tar-header-offset 'permanent-local t) + (put 'tar-superior-buffer 'permanent-local t) + (put 'tar-superior-descriptor 'permanent-local t) ;;; First, duplicate some Common Lisp functions; I used to just (require 'cl) *************** *** 208,213 **** (defun tokenize-tar-header-block (string) ! "Returns a 'tar-header' structure (a list of name, mode, uid, gid, size, ! write-date, checksum, link-type, and link-name)." (cond ((< (length string) 512) nil) (;(some 'plusp string) ; <-- oops, massive cycle hog! --- 204,210 ---- (defun tokenize-tar-header-block (string) ! "Return a `tar-header' structure. ! This is a list of name, mode, uid, gid, size, ! write-date, checksum, link-type, and link-name." (cond ((< (length string) 512) nil) (;(some 'plusp string) ; <-- oops, massive cycle hog! *************** *** 252,256 **** (defun tar-parse-octal-integer (string &optional start end) - "deletes all your files, and then reboots." (if (null start) (setq start 0)) (if (null end) (setq end (length string))) --- 249,252 ---- *************** *** 275,279 **** (defun checksum-tar-header-block (string) ! "Computes and returns a tar-acceptable checksum for this block." (let* ((chk-field-start tar-chk-offset) (chk-field-end (+ chk-field-start 8)) --- 271,275 ---- (defun checksum-tar-header-block (string) ! "Compute and return a tar-acceptable checksum for this block." (let* ((chk-field-start tar-chk-offset) (chk-field-end (+ chk-field-start 8)) *************** *** 323,327 **** (defun summarize-tar-header-block (tar-hblock &optional mod-p) ! "Returns a line similar to the output of 'tar -vtf'." (let ((name (tar-header-name tar-hblock)) (mode (tar-header-mode tar-hblock)) --- 319,323 ---- (defun summarize-tar-header-block (tar-hblock &optional mod-p) ! "Returns a line similar to the output of `tar -vtf'." (let ((name (tar-header-name tar-hblock)) (mode (tar-header-mode tar-hblock)) *************** *** 378,383 **** (defun tar-summarize-buffer () ! "Parse the contents of the tar file in the current buffer, and place a ! dired-like listing on the front; then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." (message "parsing tar file...") --- 374,380 ---- (defun tar-summarize-buffer () ! "Parse the contents of the tar file in the current buffer. ! Place a dired-like listing on the front; ! then narrow to it, so that only that listing is visible (and the real data of the buffer is hidden)." (message "parsing tar file...") *************** *** 434,439 **** (set-buffer-modified-p nil))) (message "parsing tar file...done.")) ! ! (defvar tar-mode-map nil "*Local keymap for tar-mode listings.") --- 431,435 ---- (set-buffer-modified-p nil))) (message "parsing tar file...done.")) ! (defvar tar-mode-map nil "*Local keymap for tar-mode listings.") *************** *** 466,470 **** --- 462,509 ---- (define-key tar-mode-map "O" 'tar-chown-entry) ) + + ;; Make menu bar items. + ;; Get rid of the Edit menu bar item to save space. + (define-key tar-mode-map [menu-bar edit] 'undefined) + + (define-key tar-mode-map [menu-bar immediate] + (cons "Immediate" (make-sparse-keymap "Immediate"))) + + (define-key tar-mode-map [menu-bar immediate view] + '("View This File" . tar-view)) + (define-key tar-mode-map [menu-bar immediate display] + '("Display in Other Window" . tar-display-file)) + (define-key tar-mode-map [menu-bar immediate find-file-other-window] + '("Find in Other Window" . tar-extract-other-window)) + (define-key tar-mode-map [menu-bar immediate find-file] + '("Find This File" . tar-extract)) + + (define-key tar-mode-map [menu-bar mark] + (cons "Mark" (make-sparse-keymap "Mark"))) + + (define-key tar-mode-map [menu-bar mark unmark-all] + '("Unmark All" . tar-clear-modification-flags)) + (define-key tar-mode-map [menu-bar mark deletion] + '("Flag" . tar-flag-deleted)) + (define-key tar-mode-map [menu-bar mark unmark] + '("Unflag" . tar-unflag)) + + (define-key tar-mode-map [menu-bar operate] + (cons "Operate" (make-sparse-keymap "Operate"))) + + (define-key tar-mode-map [menu-bar operate chown] + '("Change Owner..." . tar-chown-entry)) + (define-key tar-mode-map [menu-bar operate chgrp] + '("Change Group..." . tar-chgrp-entry)) + (define-key tar-mode-map [menu-bar operate chmod] + '("Change Mode..." . tar-chmod-entry)) + (define-key tar-mode-map [menu-bar operate rename] + '("Rename to..." . tar-rename-entry)) + (define-key tar-mode-map [menu-bar operate copy] + '("Copy to..." . tar-copy)) + (define-key tar-mode-map [menu-bar operate expunge] + '("Expunge marked files" . tar-expunge)) + ;; tar mode is suitable only for specially formatted data. (put 'tar-mode 'mode-class 'special) *************** *** 476,491 **** You can move around using the usual cursor motion commands. Letters no longer insert themselves. ! Type 'e' to pull a file out of the tar file and into its own buffer. ! Type 'c' to copy an entry from the tar file into another file on disk. ! If you edit a sub-file of this archive (as with the 'e' command) and ! save it with Control-X Control-S, the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it. ! See also: variables tar-update-datestamp and tar-anal-blocksize. \\{tar-mode-map}" ;; this is not interactive because you shouldn't be turning this ;; mode on and off. You can corrupt things that way. (make-local-variable 'tar-header-offset) (make-local-variable 'tar-parse-info) --- 515,533 ---- You can move around using the usual cursor motion commands. Letters no longer insert themselves. ! Type `e' to pull a file out of the tar file and into its own buffer. ! Type `c' to copy an entry from the tar file into another file on disk. ! If you edit a sub-file of this archive (as with the `e' command) and ! save it with Control-x Control-s, the contents of that buffer will be saved back into the tar-file buffer; in this way you can edit a file inside of a tar archive without extracting it and re-archiving it. ! See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. \\{tar-mode-map}" ;; this is not interactive because you shouldn't be turning this ;; mode on and off. You can corrupt things that way. + ;; rms: with permanent locals, it should now be possible to make this work + ;; interactively in some reasonable fashion. + (kill-all-local-variables) (make-local-variable 'tar-header-offset) (make-local-variable 'tar-parse-info) *************** *** 494,497 **** --- 536,541 ---- (make-local-variable 'revert-buffer-function) (setq revert-buffer-function 'tar-mode-revert) + (make-local-variable 'enable-local-variables) + (setq enable-local-variables nil) (setq major-mode 'tar-mode) (setq mode-name "Tar") *************** *** 506,512 **** (defun tar-subfile-mode (p) "Minor mode for editing an element of a tar-file. ! This mode redefines ^X^S to save the current buffer back into its associated tar-file buffer. You must save that buffer to actually save your changes to disk." --- 550,558 ---- + ;; This should be converted to use a minor mode keymap. + (defun tar-subfile-mode (p) "Minor mode for editing an element of a tar-file. ! This mode redefines C-x C-s to save the current buffer back into its associated tar-file buffer. You must save that buffer to actually save your changes to disk." *************** *** 513,517 **** (interactive "P") (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) ! (error "This buffer is not an element of a tar file.")) (or (assq 'tar-subfile-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist --- 559,563 ---- (interactive "P") (or (and (boundp 'tar-superior-buffer) tar-superior-buffer) ! (error "This buffer is not an element of a tar file")) (or (assq 'tar-subfile-mode minor-mode-alist) (setq minor-mode-alist (append minor-mode-alist *************** *** 524,533 **** (> (prefix-numeric-value p) 0))) (cond (tar-subfile-mode ! ;; copy the local keymap so that we don't accidentally ! ;; alter a keymap like 'lisp-mode-map' which is shared ! ;; by all buffers in that mode. ! (let ((m (current-local-map))) ! (if m (use-local-map (copy-keymap m)))) ! (local-set-key "\^X\^S" 'tar-subfile-save-buffer) ;; turn off auto-save. (auto-save-mode nil) --- 570,575 ---- (> (prefix-numeric-value p) 0))) (cond (tar-subfile-mode ! (make-local-variable 'local-write-file-hooks) ! (setq local-write-file-hooks '(tar-subfile-save-buffer)) ;; turn off auto-save. (auto-save-mode nil) *************** *** 534,544 **** (setq buffer-auto-save-file-name nil) (run-hooks 'tar-subfile-mode-hook)) ! (t (local-set-key "\^X\^S" 'save-buffer))) ! ) (defun tar-mode-revert (&optional no-autosave no-confirm) - "Revert this buffer and turn on tar mode again, to re-compute the - directory listing." (setq tar-header-offset nil) (let ((revert-buffer-function nil)) --- 576,585 ---- (setq buffer-auto-save-file-name nil) (run-hooks 'tar-subfile-mode-hook)) ! (t ! (kill-local-variable 'local-write-file-hooks)))) + ;; 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)) *************** *** 558,562 **** (defun tar-current-descriptor (&optional noerror) ! "Returns the tar-descriptor of the current line, or signals an error." ;; I wish lines had plists, like in ZMACS... (or (nth (count-lines (point-min) --- 599,603 ---- (defun tar-current-descriptor (&optional noerror) ! "Return the tar-descriptor of the current line, or signals an error." ;; I wish lines had plists, like in ZMACS... (or (nth (count-lines (point-min) *************** *** 569,573 **** (defun tar-extract (&optional other-window-p) ! "*In tar-mode, extract this entry of the tar file into its own buffer." (interactive) (let* ((view-p (eq other-window-p 'view)) --- 610,614 ---- (defun tar-extract (&optional other-window-p) ! "*In Tar mode, extract this entry of the tar file into its own buffer." (interactive) (let* ((view-p (eq other-window-p 'view)) *************** *** 627,642 **** (and just-created (setq view-exit-action 'kill-buffer))) ! (if other-window-p ! (switch-to-buffer-other-window buffer) ! (switch-to-buffer buffer)))))) (defun tar-extract-other-window () ! "*In tar-mode, extract this entry of the tar file into its own buffer." (interactive) (tar-extract t)) (defun tar-view () ! "*In tar-mode, view the tar file entry on this line." (interactive) (tar-extract 'view)) --- 668,690 ---- (and just-created (setq view-exit-action 'kill-buffer))) ! (if (eq other-window-p 'display) ! (display-buffer buffer) ! (if other-window-p ! (switch-to-buffer-other-window buffer) ! (switch-to-buffer buffer))))))) (defun tar-extract-other-window () ! "*In Tar mode, find this entry of the tar file in another window." (interactive) (tar-extract t)) + (defun tar-display-other-window () + "*In Tar mode, display this entry of the tar file in another window." + (interactive) + (tar-extract 'display)) + (defun tar-view () ! "*In Tar mode, view the tar file entry on this line." (interactive) (tar-extract 'view)) *************** *** 644,649 **** (defun tar-read-file-name (&optional prompt) ! "Calls read-file-name, with the default being the file of the current ! tar-file descriptor." (or prompt (setq prompt "Copy to: ")) (let* ((default-file (expand-file-name --- 692,696 ---- (defun tar-read-file-name (&optional prompt) ! "Read a file name with this line's entry as the default." (or prompt (setq prompt "Copy to: ")) (let* ((default-file (expand-file-name *************** *** 665,669 **** (defun tar-copy (&optional to-file) ! "*In tar-mode, extract this entry of the tar file into a file on disk. If TO-FILE is not supplied, it is prompted for, defaulting to the name of the current tar-entry." --- 712,716 ---- (defun tar-copy (&optional to-file) ! "*In Tar mode, extract this entry of the tar file into a file on disk. If TO-FILE is not supplied, it is prompted for, defaulting to the name of the current tar-entry." *************** *** 697,701 **** (defun tar-flag-deleted (p &optional unflag) ! "*In tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." (interactive "p") --- 744,748 ---- (defun tar-flag-deleted (p &optional unflag) ! "*In Tar mode, mark this sub-file to be deleted from the tar file. With a prefix argument, mark that many files." (interactive "p") *************** *** 710,714 **** (defun tar-unflag (p) ! "*In tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files forward." (interactive "p") --- 757,761 ---- (defun tar-unflag (p) ! "*In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files forward." (interactive "p") *************** *** 716,720 **** (defun tar-unflag-backwards (p) ! "*In tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files backward." (interactive "p") --- 763,767 ---- (defun tar-unflag-backwards (p) ! "*In Tar mode, un-mark this sub-file if it is marked to be deleted. With a prefix argument, un-mark that many files backward." (interactive "p") *************** *** 767,771 **** (defun tar-expunge (&optional noconfirm) ! "*In tar-mode, delete all the archived files flagged for deletion. This does not modify the disk image; you must save the tar file itself for this to be permanent." --- 814,818 ---- (defun tar-expunge (&optional noconfirm) ! "*In Tar mode, delete all the archived files flagged for deletion. This does not modify the disk image; you must save the tar file itself for this to be permanent." *************** *** 791,795 **** (defun tar-clear-modification-flags () ! "remove the stars at the beginning of each line." (save-excursion (goto-char 0) --- 838,842 ---- (defun tar-clear-modification-flags () ! "Remove the stars at the beginning of each line." (save-excursion (goto-char 0) *************** *** 933,938 **** (defun tar-subfile-save-buffer () ! "In tar subfile mode, write this buffer back into its parent tar-file buffer. ! This doesn't write anything to disk - you must save the parent tar-file buffer to make your changes permanent." (interactive) --- 980,985 ---- (defun tar-subfile-save-buffer () ! "In tar subfile mode, save this buffer into its parent tar-file buffer. ! This doesn't write anything to disk; you must save the parent tar-file buffer to make your changes permanent." (interactive) *************** *** 1024,1028 **** (message "saved into tar-buffer \"%s\" - remember to save that buffer!" (buffer-name tar-superior-buffer)) ! ))) --- 1071,1076 ---- (message "saved into tar-buffer \"%s\" - remember to save that buffer!" (buffer-name tar-superior-buffer)) ! ;; Prevent ordinary saving from happening. ! t))) *************** *** 1058,1062 **** "Used as a write-file-hook to write tar-files out correctly." ;; ! ;; If the current buffer is in tar-mode and has its header-offset set, ;; only write out the part of the file after the header-offset. ;; --- 1106,1110 ---- "Used as a write-file-hook to write tar-files out correctly." ;; ! ;; If the current buffer is in Tar mode and has its header-offset set, ;; only write out the part of the file after the header-offset. ;; diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/telnet.el emacs-19.18/lisp/telnet.el *** emacs-19.17/lisp/telnet.el Mon Jun 7 21:29:01 1993 --- emacs-19.18/lisp/telnet.el Tue Aug 3 00:08:57 1993 *************** *** 172,176 **** ;;;###autoload ! (defun telnet (arg) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-telnet*. --- 172,176 ---- ;;;###autoload ! (defun telnet (host) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-telnet*. *************** *** 177,190 **** Normally input is edited in Emacs and sent a line at a time." (interactive "sOpen telnet connection to host: ") ! (let ((name (concat arg "-telnet" ))) ! (switch-to-buffer (make-comint name "telnet")) ! (set-process-filter (get-process name) 'telnet-initial-filter) ! ;; Don't send the `open' cmd till telnet is ready for it. ! (accept-process-output (get-process name)) ! (erase-buffer) ! (send-string name (concat "open " arg "\n")) ! (telnet-mode) ! (setq comint-input-sender 'telnet-simple-send) ! (setq telnet-count telnet-initial-count))) (defun telnet-mode () --- 177,193 ---- Normally input is edited in Emacs and sent a line at a time." (interactive "sOpen telnet connection to host: ") ! (let* ((name (concat host "-telnet" )) ! (buffer (get-buffer (concat "*" name "*")))) ! (if (and buffer (get-buffer-process buffer)) ! (switch-to-buffer (concat "*" name "*")) ! (switch-to-buffer (make-comint name "telnet")) ! (set-process-filter (get-process name) 'telnet-initial-filter) ! ;; Don't send the `open' cmd till telnet is ready for it. ! (accept-process-output (get-process name)) ! (erase-buffer) ! (send-string name (concat "open " host "\n")) ! (telnet-mode) ! (setq comint-input-sender 'telnet-simple-send) ! (setq telnet-count telnet-initial-count)))) (defun telnet-mode () *************** *** 206,210 **** ;;;###autoload ! (defun rsh (arg) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-rsh*. --- 209,213 ---- ;;;###autoload ! (defun rsh (host) "Open a network login connection to host named HOST (a string). Communication with HOST is recorded in a buffer *HOST-rsh*. *************** *** 212,216 **** (interactive "sOpen rsh connection to host: ") (require 'shell) ! (let ((name (concat arg "-rsh" ))) (switch-to-buffer (make-comint name "rsh")) (set-process-filter (get-process name) 'telnet-initial-filter) --- 215,219 ---- (interactive "sOpen rsh connection to host: ") (require 'shell) ! (let ((name (concat host "-rsh" ))) (switch-to-buffer (make-comint name "rsh")) (set-process-filter (get-process name) 'telnet-initial-filter) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/term/lk201.el emacs-19.18/lisp/term/lk201.el *** emacs-19.17/lisp/term/lk201.el Sat May 29 23:34:09 1993 --- emacs-19.18/lisp/term/lk201.el Wed Jul 21 17:44:24 1993 *************** *** 35,42 **** ;; (define-key function-key-map "\eOC" [right]) ;; (define-key function-key-map "\eOD" [left]) ! ;; (define-key function-key-map "\eOP" [kp-f1]) ! ;; (define-key function-key-map "\eOQ" [kp-f2]) ! ;; (define-key function-key-map "\eOR" [kp-f3]) ! ;; (define-key function-key-map "\eOS" [kp-f4]) (define-key function-key-map "\eOM" [kp-enter]) --- 35,45 ---- ;; (define-key function-key-map "\eOC" [right]) ;; (define-key function-key-map "\eOD" [left]) ! ! ;; Termcap or terminfo should set these, but doesn't properly. ! ;; Termcap sets these to k1-k4, which get mapped to f1-f4 in term.c ! (define-key function-key-map "\eOP" [kp-f1]) ! (define-key function-key-map "\eOQ" [kp-f2]) ! (define-key function-key-map "\eOR" [kp-f3]) ! (define-key function-key-map "\eOS" [kp-f4]) (define-key function-key-map "\eOM" [kp-enter]) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/term/x-win.el emacs-19.18/lisp/term/x-win.el *** emacs-19.17/lisp/term/x-win.el Sun Jul 18 02:01:21 1993 --- emacs-19.18/lisp/term/x-win.el Tue Jul 27 18:01:14 1993 *************** *** 101,105 **** ("-itype" . x-handle-switch) ("-i" . x-handle-switch) ! ("-iconic" . x-handle-switch) ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) --- 101,105 ---- ("-itype" . x-handle-switch) ("-i" . x-handle-switch) ! ("-iconic" . x-handle-iconic) ("-xrm" . x-handle-xrm-switch) ("-cr" . x-handle-switch) *************** *** 126,130 **** ("-itype" icon-type t) ("-i" icon-type t) - ("-iconic" visibility icon) ("-vb" vertical-scroll-bars t) ("-hb" horizontal-scroll-bars t) --- 126,129 ---- *************** *** 146,149 **** --- 145,153 ---- x-invocation-args (cdr x-invocation-args)))))) + ;; Make -iconic apply only to the initial frame! + (defun x-handle-iconic (switch) + (setq initial-frame-alist + (cons '(visibility . icon) initial-frame-alist))) + ;; Handler for switches of the form "-switch n" (defun x-handle-numeric-switch (switch) *************** *** 456,460 **** ;;;; Function keys ! (substitute-key-definition 'suspend-emacs 'iconify-frame global-map) ;; Map certain keypad keys into ASCII characters --- 460,474 ---- ;;;; Function keys ! (defun iconify-or-deiconify-frame () ! "Iconify the selected frame, or deiconify if it's currently an icon." ! (interactive) ! (if (eq (cdr (assq 'visibility (frame-parameters))) t) ! (iconify-frame) ! (let ((foo (selected-frame))) ! (make-frame-invisible foo) ! (make-frame-visible foo)))) ! ! (substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame ! global-map) ;; Map certain keypad keys into ASCII characters *************** *** 492,503 **** (defvar x-last-selected-text nil) ! ;;; Make TEXT, a string, the primary and clipboard X selections. ! ;;; If you are running xclipboard, this means you can effectively ! ;;; have a window on a copy of the kill-ring. ;;; Also, set the value of X cut buffer 0, for backward compatibility ;;; with older X applications. (defun x-select-text (text &optional push) ! (x-set-cut-buffer text push) ! (x-set-selection 'CLIPBOARD text) (x-set-selection 'PRIMARY text) (setq x-last-selected-text text)) --- 506,525 ---- (defvar x-last-selected-text nil) ! ;;; It is said that overlarge strings are slow to put into the cut buffer. ! ;;; Note this value is overridden below. ! (defvar x-cut-buffer-max 20000 ! "Max number of characters to put in the cut buffer.") ! ! ;;; Make TEXT, a string, the primary X selection. ;;; Also, set the value of X cut buffer 0, for backward compatibility ;;; with older X applications. + ;;; gildea@lcs.mit.edu says it's not desirable to put kills + ;;; in the clipboard. (defun x-select-text (text &optional push) ! ;; Don't send the cut buffer too much text. ! ;; It becomes slow, and if really big it causes errors. ! (if (< (length text) x-cut-buffer-max) ! (x-set-cut-buffer text push) ! (x-set-cut-buffer "" push)) (x-set-selection 'PRIMARY text) (setq x-last-selected-text text)) *************** *** 509,517 **** (let (text) ! ;; Consult the cut buffer, then the selection. Treat empty strings ;; as if they were unset. ! (setq text (x-get-cut-buffer 0)) (if (string= text "") (setq text nil)) ! (or text (setq text (x-get-selection 'PRIMARY))) (if (string= text "") (setq text nil)) --- 531,539 ---- (let (text) ! ;; Consult the selection, then the cut buffer. Treat empty strings ;; as if they were unset. ! (setq text (x-get-selection 'PRIMARY)) (if (string= text "") (setq text nil)) ! (or text (setq text (x-get-cut-buffer 0))) (if (string= text "") (setq text nil)) *************** *** 548,551 **** --- 570,576 ---- (setq frame-creation-function 'x-create-frame-with-faces) + (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) + x-cut-buffer-max)) + ;; Apply a geometry resource to the initial frame. Put it at the end ;; of the alist, so that anything specified on the command line takes *************** *** 567,571 **** (let ((res-selection-timeout (x-get-resource "selectionTimeout" "SelectionTimeout"))) ! (setq x-selection-timeout 5000) (if res-selection-timeout (setq x-selection-timeout (string-to-number res-selection-timeout)))) --- 592,596 ---- (let ((res-selection-timeout (x-get-resource "selectionTimeout" "SelectionTimeout"))) ! (setq x-selection-timeout 20000) (if res-selection-timeout (setq x-selection-timeout (string-to-number res-selection-timeout)))) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/tex-mode.el emacs-19.18/lisp/tex-mode.el *** emacs-19.17/lisp/tex-mode.el Wed Jun 9 07:28:20 1993 --- emacs-19.18/lisp/tex-mode.el Sat Jul 31 03:32:40 1993 *************** *** 507,527 **** (defun validate-tex-buffer () "Check current buffer for paragraphs containing mismatched $s. ! As each such paragraph is found, a mark is pushed at its beginning, ! and the location is displayed for a few seconds." (interactive) ! (let ((opoint (point))) ! (goto-char (point-max)) ! ;; Does not use save-excursion ! ;; because we do not want to save the mark. ! (unwind-protect (while (and (not (input-pending-p)) (not (bobp))) (let ((end (point))) (search-backward "\n\n" nil 'move) (or (tex-validate-region (point) end) ! (progn ! (push-mark (point)) ! (message "Mismatch found in paragraph starting here") ! (sit-for 4))))) ! (goto-char opoint)))) (defun tex-validate-region (start end) --- 507,563 ---- (defun validate-tex-buffer () "Check current buffer for paragraphs containing mismatched $s. ! Their positions are recorded in the buffer `*Occur*'. ! To find a particular invalidity from `*Occur*', ! switch to to that buffer and type C-c C-c on the line ! for the invalidity you want to see." (interactive) ! (let ((buffer (current-buffer)) ! (prevpos (point-min)) ! (linenum nil)) ! (with-output-to-temp-buffer "*Occur*" ! (princ "Mismatches:\n") ! (save-excursion ! (set-buffer standard-output) ! (occur-mode) ! (setq occur-buffer buffer) ! (setq occur-nlines 0) ! (setq occur-pos-list nil)) ! (save-excursion ! (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) ! (setq start (point)) ! ;; Keep track of line number as we scan, ! ;; in a cumulative fashion. ! (if linenum ! (setq linenum (- linenum (count-lines prevpos (point)))) ! (setq linenum (1+ (count-lines 1 start)))) ! (setq prevpos (point)) ! ;; Mention this mismatch in *Occur*. ! ;; Since we scan from end of buffer to beginning, ! ;; add each mismatch at the beginning of *Occur* ! ;; and at the beginning of occur-pos-list. ! (save-excursion ! (setq tem (point-marker)) ! (set-buffer standard-output) ! (goto-char (point-min)) ! ;; Skip "Mismatches:" header line. ! (forward-line 1) ! (setq occur-pos-list (cons tem occur-pos-list)) ! (insert-buffer-substring buffer start end) ! (forward-char (- start end)) ! (insert (format "%3d: " linenum)))))))) ! (save-excursion ! (set-buffer standard-output) ! (if (null occur-pos-list) ! (insert "None!\n")) ! (if (interactive-p) ! (message "%d mismatches found" (length occur-pos-list))))))) (defun tex-validate-region (start end) diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/texinfmt.el emacs-19.18/lisp/texinfmt.el *** emacs-19.17/lisp/texinfmt.el --- emacs-19.18/lisp/texinfmt.el Sun Aug 1 08:22:53 1993 *************** *** 0 **** --- 1,3010 ---- + ;;;; texinfmt.el + ;;; Copyright (C) 1985, 1986, 1988, + ;;; 1990, 1991, 1992, 1993 Free Software Foundation, Inc. + + ;; Maintainer: Robert J. Chassell + + ;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Code: + + ;;; Emacs lisp functions to convert Texinfo files to Info files. + + (defvar texinfmt-version "2.30 of 18 May 1993") + + ;;; Variable definitions + + (require 'texinfo) ; So `texinfo-footnote-style' is defined. + (require 'texnfo-upd) ; So `texinfo-section-types-regexp' is defined. + + (defvar texinfo-format-syntax-table nil) + + (defvar texinfo-vindex) + (defvar texinfo-findex) + (defvar texinfo-cindex) + (defvar texinfo-pindex) + (defvar texinfo-tindex) + (defvar texinfo-kindex) + (defvar texinfo-last-node) + (defvar texinfo-node-names) + (defvar texinfo-enclosure-list) + + + ;;; Syntax table + + (if texinfo-format-syntax-table + nil + (setq texinfo-format-syntax-table (make-syntax-table)) + (modify-syntax-entry ?\" " " texinfo-format-syntax-table) + (modify-syntax-entry ?\\ " " texinfo-format-syntax-table) + (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table) + (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table) + (modify-syntax-entry ?\[ "." texinfo-format-syntax-table) + (modify-syntax-entry ?\] "." texinfo-format-syntax-table) + (modify-syntax-entry ?\( "." texinfo-format-syntax-table) + (modify-syntax-entry ?\) "." texinfo-format-syntax-table) + (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table) + (modify-syntax-entry ?} "){" texinfo-format-syntax-table) + (modify-syntax-entry ?\' "." texinfo-format-syntax-table)) + + + ;;; Top level buffer and region formatting functions + + (defun texinfo-format-buffer (&optional notagify) + "Process the current buffer as texinfo code, into an Info file. + The Info file output is generated in a buffer visiting the Info file + names specified in the @setfilename command. + + Non-nil argument (prefix, if interactive) means don't make tag table + and don't split the file if large. You can use Info-tagify and + Info-split to do these manually." + (interactive "P") + (let ((lastmessage "Formatting Info file...")) + (message lastmessage) + (texinfo-format-buffer-1) + (if notagify + nil + (if (> (buffer-size) 30000) + (progn + (message (setq lastmessage "Making tags table for Info file...")) + (Info-tagify))) + (if (> (buffer-size) 100000) + (progn + (message (setq lastmessage "Splitting Info file...")) + (Info-split)))) + (message (concat lastmessage + (if (interactive-p) "done. Now save it." "done."))))) + + (defvar texinfo-region-buffer-name "*Info Region*" + "*Name of the temporary buffer used by \\[texinfo-format-region].") + + (defun texinfo-format-region (region-beginning region-end) + "Convert the current region of the Texinfo file to Info format. + This lets you see what that part of the file will look like in Info. + The command is bound to \\[texinfo-format-region]. The text that is + converted to Info is stored in a temporary buffer." + (interactive "r") + (message "Converting region to Info format...") + (let (texinfo-command-start + texinfo-command-end + texinfo-command-name + texinfo-vindex + texinfo-findex + texinfo-cindex + texinfo-pindex + texinfo-tindex + texinfo-kindex + texinfo-stack + (texinfo-format-filename "") + texinfo-example-start + texinfo-last-node-pos + texinfo-last-node + texinfo-node-names + (texinfo-footnote-number 0) + last-input-buffer + (fill-column-for-info fill-column) + (input-buffer (current-buffer)) + (input-directory default-directory) + (header-text "") + (header-beginning 1) + (header-end 1)) + + ;;; Copy lines between beginning and end of header lines, + ;;; if any, or else copy the `@setfilename' line, if any. + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((search-end (save-excursion (forward-line 100) (point)))) + (if (or + ;; Either copy header text. + (and + (prog1 + (search-forward texinfo-start-of-header search-end t) + (forward-line 1) + ;; Mark beginning of header. + (setq header-beginning (point))) + (prog1 + (search-forward texinfo-end-of-header nil t) + (beginning-of-line) + ;; Mark end of header + (setq header-end (point)))) + ;; Or copy @filename line. + (prog2 + (goto-char (point-min)) + (search-forward "@setfilename" search-end t) + (beginning-of-line) + (setq header-beginning (point)) + (forward-line 1) + (setq header-end (point)))) + + ;; Copy header + (setq header-text + (buffer-substring + (min header-beginning region-beginning) + header-end)))))) + + ;;; Find a buffer to use. + (switch-to-buffer (get-buffer-create texinfo-region-buffer-name)) + (erase-buffer) + ;; Insert the header into the buffer. + (insert header-text) + ;; Insert the region into the buffer. + (insert-buffer-substring + input-buffer + (max region-beginning header-end) + region-end) + ;; Make sure region ends in a newline. + (or (= (preceding-char) ?\n) + (insert "\n")) + + (goto-char (point-min)) + (texinfo-mode) + (message "Converting region to Info format...") + (setq fill-column fill-column-for-info) + ;; Install a syntax table useful for scanning command operands. + (set-syntax-table texinfo-format-syntax-table) + + ;; Insert @include files so `texinfo-raise-lower-sections' can + ;; work on them without losing track of multiple + ;; @raise/@lowersections commands. + (while (re-search-forward "^@include" nil t) + (setq texinfo-command-end (point)) + (let ((filename (concat input-directory + (texinfo-parse-line-arg)))) + (beginning-of-line) + (delete-region (point) (save-excursion (forward-line 1) (point))) + (message "Reading included file: %s" filename) + (save-excursion + (save-restriction + (narrow-to-region + (point) + (+ (point) (car (cdr (insert-file-contents filename))))) + (goto-char (point-min)) + ;; Remove `@setfilename' line from included file, if any, + ;; so @setfilename command not duplicated. + (if (re-search-forward + "^@setfilename" (save-excursion (forward-line 100) (point)) t) + (progn + (beginning-of-line) + (delete-region + (point) (save-excursion (forward-line 1) (point))))))))) + + ;; Raise or lower level of each section, if necessary. + (goto-char (point-min)) + (texinfo-raise-lower-sections) + ;; Append @refill to appropriate paragraphs for filling. + (goto-char (point-min)) + (texinfo-append-refill) + ;; If the region includes the effective end of the data, + ;; discard everything after that. + (goto-char (point-max)) + (if (re-search-backward "^@bye" nil t) + (delete-region (point) (point-max))) + ;; Make sure buffer ends in a newline. + (or (= (preceding-char) ?\n) + (insert "\n")) + ;; Don't use a previous value of texinfo-enclosure-list. + (setq texinfo-enclosure-list nil) + + (goto-char (point-min)) + (if (looking-at "\\\\input[ \t]+texinfo") + (delete-region (point) (save-excursion (forward-line 1) (point)))) + + ;; Insert Info region title text. + (goto-char (point-min)) + (if (search-forward + "@setfilename" (save-excursion (forward-line 100) (point)) t) + (progn + (setq texinfo-command-end (point)) + (beginning-of-line) + (setq texinfo-command-start (point)) + (let ((arg (texinfo-parse-arg-discard))) + (insert " " + texinfo-region-buffer-name + " buffer for: `") + (insert (file-name-nondirectory (expand-file-name arg))) + (insert "', -*-Text-*-\n"))) + ;; Else no `@setfilename' line + (insert " " + texinfo-region-buffer-name + " buffer -*-Text-*-\n")) + (insert "produced by `texinfo-format-region'\n" + "from a region in: " + (if (buffer-file-name input-buffer) + (concat "`" + (file-name-sans-versions + (file-name-nondirectory + (buffer-file-name input-buffer))) + "'") + (concat "buffer `" (buffer-name input-buffer) "'")) + "\nusing `texinfmt.el' version " + texinfmt-version + ".\n\n") + + ;; Now convert for real. + (goto-char (point-min)) + (texinfo-format-scan) + (goto-char (point-min)) + + (message "Done."))) + + + ;;; Primary internal formatting function for the whole buffer. + + (defun texinfo-format-buffer-1 () + (let (texinfo-format-filename + texinfo-example-start + texinfo-command-start + texinfo-command-end + texinfo-command-name + texinfo-last-node + texinfo-last-node-pos + texinfo-vindex + texinfo-findex + texinfo-cindex + texinfo-pindex + texinfo-tindex + texinfo-kindex + texinfo-stack + texinfo-node-names + (texinfo-footnote-number 0) + last-input-buffer + outfile + (fill-column-for-info fill-column) + (input-buffer (current-buffer)) + (input-directory default-directory)) + (setq texinfo-enclosure-list nil) + (save-excursion + (goto-char (point-min)) + (or (search-forward "@setfilename" nil t) + (error "Texinfo file needs an `@setfilename FILENAME' line.")) + (setq texinfo-command-end (point)) + (setq outfile (texinfo-parse-line-arg))) + (find-file outfile) + (texinfo-mode) + (setq fill-column fill-column-for-info) + (set-syntax-table texinfo-format-syntax-table) + (erase-buffer) + (insert-buffer-substring input-buffer) + (message "Converting %s to Info format..." (buffer-name input-buffer)) + + ;; Insert @include files so `texinfo-raise-lower-sections' can + ;; work on them without losing track of multiple + ;; @raise/@lowersections commands. + (goto-char (point-min)) + (while (re-search-forward "^@include" nil t) + (setq texinfo-command-end (point)) + (let ((filename (concat input-directory + (texinfo-parse-line-arg)))) + (beginning-of-line) + (delete-region (point) (save-excursion (forward-line 1) (point))) + (message "Reading included file: %s" filename) + (save-excursion + (save-restriction + (narrow-to-region + (point) + (+ (point) (car (cdr (insert-file-contents filename))))) + (goto-char (point-min)) + ;; Remove `@setfilename' line from included file, if any, + ;; so @setfilename command not duplicated. + (if (re-search-forward + "^@setfilename" + (save-excursion (forward-line 100) (point)) t) + (progn + (beginning-of-line) + (delete-region + (point) (save-excursion (forward-line 1) (point))))))))) + ;; Raise or lower level of each section, if necessary. + (goto-char (point-min)) + (texinfo-raise-lower-sections) + ;; Append @refill to appropriate paragraphs + (goto-char (point-min)) + (texinfo-append-refill) + (goto-char (point-min)) + (search-forward "@setfilename") + (beginning-of-line) + (delete-region (point-min) (point)) + ;; Remove @bye at end of file, if it is there. + (goto-char (point-max)) + (if (search-backward "@bye" nil t) + (delete-region (point) (point-max))) + ;; Make sure buffer ends in a newline. + (or (= (preceding-char) ?\n) + (insert "\n")) + ;; Scan the whole buffer, converting to Info format. + (texinfo-format-scan) + ;; Return data for indices. + (goto-char (point-min)) + (list outfile + texinfo-vindex texinfo-findex texinfo-cindex + texinfo-pindex texinfo-tindex texinfo-kindex))) + + + ;;; Perform non-@-command file conversions: quotes and hyphens + + (defun texinfo-format-convert (min max) + ;; Convert left and right quotes to typewriter font quotes. + (goto-char min) + (while (search-forward "``" max t) + (replace-match "\"")) + (goto-char min) + (while (search-forward "''" max t) + (replace-match "\"")) + ;; Convert three hyphens in a row to two. + (goto-char min) + (while (re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" max t) + (delete-region (1+ (match-beginning 2)) (+ 2 (match-beginning + 2))))) + + + ;;; Handle paragraph filling + + (defvar texinfo-no-refill-regexp + "^@\\(example\\|smallexample\\|lisp\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|menu\\|titlepage\\|iftex\\|tex\\)" + "Regexp specifying environments in which paragraphs are not filled.") + + (defvar texinfo-part-of-para-regexp + "^@\\(b{\\|bullet{\\|cite{\\|code{\\|emph{\\|equiv{\\|error{\\|expansion{\\|file{\\|i{\\|inforef{\\|kbd{\\|key{\\|lisp{\\|minus{\\|point{\\|print{\\|pxref{\\|r{\\|ref{\\|result{\\|samp{\\|sc{\\|t{\\|TeX{\\|today{\\|var{\\|w{\\|xref{\\)" + "Regexp specifying @-commands found within paragraphs.") + + (defun texinfo-append-refill () + "Append @refill at end of each paragraph that should be filled. + Do not append @refill to paragraphs within @example and similar environments. + Do not append @refill to paragraphs containing @w{TEXT} or @*." + + ;; It is necessary to append @refill before other processing because + ;; the other processing removes information that tells Texinfo + ;; whether the text should or should not be filled. + + (while (< (point) (point-max)) + (let ((refill-blank-lines "^[ \t\n]*$") + (case-fold-search nil)) ; Don't confuse @TeX and @tex.... + (beginning-of-line) + ;; 1. Skip over blank lines; + ;; skip over lines beginning with @-commands, + ;; but do not skip over lines + ;; that are no-refill environments such as @example or + ;; that begin with within-paragraph @-commands such as @code. + (while (and (looking-at (concat "^@\\|^\\\\\\|" refill-blank-lines)) + (not (looking-at + (concat + "\\(" + texinfo-no-refill-regexp + "\\|" + texinfo-part-of-para-regexp + "\\)"))) + (< (point) (point-max))) + (forward-line 1)) + ;; 2. Skip over @example and similar no-refill environments. + (if (looking-at texinfo-no-refill-regexp) + (let ((environment + (buffer-substring (match-beginning 1) (match-end 1)))) + (progn (re-search-forward (concat "^@end " environment) nil t) + (forward-line 1))) + ;; 3. Do not refill a paragraph containing @w or @* + (if (or + (>= (point) (point-max)) + (re-search-forward + "@w{\\|@\\*" (save-excursion (forward-paragraph) (point)) t)) + ;; Go to end of paragraph and do nothing. + (forward-paragraph) + ;; 4. Else go to end of paragraph and insert @refill + (forward-paragraph) + (forward-line -1) + (end-of-line) + (delete-region + (point) + (save-excursion (skip-chars-backward " \t") (point))) + ;; `looking-at-backward' not available in v. 18.57 + ;; (if (not (looking-at-backward "@refill\\|@bye")) ;) + (if (not (re-search-backward + "@refill\\|@bye" + (save-excursion (beginning-of-line) (point)) + t)) + (insert "@refill")) + (forward-line 1)))))) + + + ;;; Handle `@raisesections' and `@lowersections' commands + + ;; These commands change the hierarchical level of chapter structuring + ;; commands. + ;; + ;; @raisesections changes @subsection to @section, + ;; @section to @chapter, + ;; etc. + ;; + ;; @lowersections changes @chapter to @section + ;; @subsection to @subsubsection, + ;; etc. + ;; + ;; An @raisesections/@lowersections command changes only those + ;; structuring commands that follow the @raisesections/@lowersections + ;; command. + ;; + ;; Repeated @raisesections/@lowersections continue to raise or lower + ;; the heading level. + ;; + ;; An @lowersections command cancels an @raisesections command, and + ;; vice versa. + ;; + ;; You cannot raise or lower "beyond" chapters or subsubsections, but + ;; trying to do so does not elicit an error---you just get more + ;; headings that mean the same thing as you keep raising or lowering + ;; (for example, after a single @raisesections, both @chapter and + ;; @section produce chapter headings). + + (defun texinfo-raise-lower-sections () + "Raise or lower the hierarchical level of chapters, sections, etc. + + This function acts according to `@raisesections' and `@lowersections' + commands in the Texinfo file. + + For example, an `@lowersections' command is useful if you wish to + include what is written as an outer or standalone Texinfo file in + another Texinfo file as an inner, included file. The `@lowersections' + command changes chapters to sections, sections to subsections and so + on. + + @raisesections changes @subsection to @section, + @section to @chapter, + @heading to @chapheading, + etc. + + @lowersections changes @chapter to @section, + @subsection to @subsubsection, + @heading to @subheading, + etc. + + An `@raisesections' or `@lowersections' command changes only those + structuring commands that follow the `@raisesections' or + `@lowersections' command. + + An `@lowersections' command cancels an `@raisesections' command, and + vice versa. + + Repeated use of the commands continue to raise or lower the hierarchical + level a step at a time. + + An attempt to raise above `chapters' reproduces chapter commands; an + attempt to lower below subsubsections reproduces subsubsection + commands." + + ;; `texinfo-section-types-regexp' is defined in `texnfo-upd.el'; + ;; it is a regexp matching chapter, section, other headings + ;; (but not the top node). + + (let (type (level 0)) + (while + (re-search-forward + (concat + "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\(" + texinfo-section-types-regexp + "\\)\\)") + nil t) + (beginning-of-line) + (save-excursion (setq type (read (current-buffer)))) + (cond + + ;; 1. Increment level + ((eq type '@raisesections) + (setq level (1+ level)) + (delete-region + (point) (save-excursion (forward-line 1) (point)))) + + ;; 2. Decrement level + ((eq type '@lowersections) + (setq level (1- level)) + (delete-region + (point) (save-excursion (forward-line 1) (point)))) + + ;; Now handle structuring commands + ((cond + + ;; 3. Raise level when positive + ((> level 0) + (let ((count level) + (new-level type)) + (while (> count 0) + (setq new-level + (cdr (assq new-level texinfo-raisesections-alist))) + (setq count (1- count))) + (kill-word 1) + (insert (symbol-name new-level)))) + + ;; 4. Do nothing except move point when level is zero + ((= level 0) (forward-line 1)) + + ;; 5. Lower level when positive + ((< level 0) + (let ((count level) + (new-level type)) + (while (< count 0) + (setq new-level + (cdr (assq new-level texinfo-lowersections-alist))) + (setq count (1+ count))) + (kill-word 1) + (insert (symbol-name new-level)))))))))) + + (defvar texinfo-raisesections-alist + '((@chapter . @chapter) ; Cannot go higher + (@unnumbered . @unnumbered) + + (@majorheading . @majorheading) + (@chapheading . @chapheading) + (@appendix . @appendix) + + (@section . @chapter) + (@unnumberedsec . @unnumbered) + (@heading . @chapheading) + (@appendixsec . @appendix) + + (@subsection . @section) + (@unnumberedsubsec . @unnumberedsec) + (@subheading . @heading) + (@appendixsubsec . @appendixsec) + + (@subsubsection . @subsection) + (@unnumberedsubsubsec . @unnumberedsubsec) + (@subsubheading . @subheading) + (@appendixsubsubsec . @appendixsubsec)) + "*An alist of next higher levels for chapters, sections. etc. + For example, section to chapter, subsection to section. + Used by `texinfo-raise-lower-sections'. + The keys specify types of section; the values correspond to the next + higher types.") + + (defvar texinfo-lowersections-alist + '((@chapter . @section) + (@unnumbered . @unnumberedsec) + (@majorheading . @heading) + (@chapheading . @heading) + (@appendix . @appendixsec) + + (@section . @subsection) + (@unnumberedsec . @unnumberedsubsec) + (@heading . @subheading) + (@appendixsec . @appendixsubsec) + + (@subsection . @subsubsection) + (@unnumberedsubsec . @unnumberedsubsubsec) + (@subheading . @subsubheading) + (@appendixsubsec . @appendixsubsubsec) + + (@subsubsection . @subsubsection) ; Cannot go lower. + (@unnumberedsubsubsec . @unnumberedsubsubsec) + (@subsubheading . @subsubheading) + (@appendixsubsubsec . @appendixsubsubsec)) + "*An alist of next lower levels for chapters, sections. etc. + For example, chapter to section, section to subsection. + Used by `texinfo-raise-lower-sections'. + The keys specify types of section; the values correspond to the next + lower types.") + + + ;;; Perform those texinfo-to-info conversions that apply to the whole input + ;;; uniformly. + + (defun texinfo-format-scan () + (texinfo-format-convert (point-min) (point-max)) + ;; Scan for @-commands. + (goto-char (point-min)) + (while (search-forward "@" nil t) + (if (looking-at "[@{}'` *]") + ;; Handle a few special @-followed-by-one-char commands. + (if (= (following-char) ?*) + (progn + ;; remove command + (delete-region (1- (point)) (1+ (point))) + ;; insert return if not at end of line; + ;; else line is already broken. + (if (not (= (following-char) ?\n)) + (insert ?\n))) + ;; The other characters are simply quoted. Delete the @. + (delete-char -1) + (forward-char 1)) + ;; @ is followed by a command-word; find the end of the word. + (setq texinfo-command-start (1- (point))) + (if (= (char-syntax (following-char)) ?w) + (forward-word 1) + (forward-char 1)) + (setq texinfo-command-end (point)) + ;; Call the handler for this command. + (setq texinfo-command-name + (intern (buffer-substring + (1+ texinfo-command-start) texinfo-command-end))) + (let ((enclosure-type + (assoc + (symbol-name texinfo-command-name) + texinfo-enclosure-list))) + (if enclosure-type + (progn + (insert + (car (car (cdr enclosure-type))) + (texinfo-parse-arg-discard) + (car (cdr (car (cdr enclosure-type))))) + (goto-char texinfo-command-start)) + (let ((cmd (get texinfo-command-name 'texinfo-format))) + (if cmd (funcall cmd) (texinfo-unsupported))))))) + + (cond (texinfo-stack + (goto-char (nth 2 (car texinfo-stack))) + (error "Unterminated @%s" (car (car texinfo-stack)))))) + + (put 'begin 'texinfo-format 'texinfo-format-begin) + (defun texinfo-format-begin () + (texinfo-format-begin-end 'texinfo-format)) + + (put 'end 'texinfo-format 'texinfo-format-end) + (defun texinfo-format-end () + (texinfo-format-begin-end 'texinfo-end)) + + (defun texinfo-format-begin-end (prop) + (setq texinfo-command-name (intern (texinfo-parse-line-arg))) + (setq cmd (get texinfo-command-name prop)) + (if cmd (funcall cmd) + (texinfo-unsupported))) + + ;;; Parsing functions + + (defun texinfo-parse-line-arg () + (goto-char texinfo-command-end) + (let ((start (point))) + (cond ((looking-at " ") + (skip-chars-forward " ") + (setq start (point)) + (end-of-line) + (skip-chars-backward " ") + (delete-region (point) (progn (end-of-line) (point))) + (setq texinfo-command-end (1+ (point)))) + ((looking-at "{") + (setq start (1+ (point))) + (forward-list 1) + (setq texinfo-command-end (point)) + (forward-char -1)) + (t + (error "Invalid texinfo command arg format"))) + (prog1 (buffer-substring start (point)) + (if (eolp) (forward-char 1))))) + + (defun texinfo-parse-expanded-arg () + (goto-char texinfo-command-end) + (let ((start (point)) + marker) + (cond ((looking-at " ") + (skip-chars-forward " ") + (setq start (point)) + (end-of-line) + (setq texinfo-command-end (1+ (point)))) + ((looking-at "{") + (setq start (1+ (point))) + (forward-list 1) + (setq texinfo-command-end (point)) + (forward-char -1)) + (t + (error "Invalid texinfo command arg format"))) + (setq marker (move-marker (make-marker) texinfo-command-end)) + (texinfo-format-expand-region start (point)) + (setq texinfo-command-end (marker-position marker)) + (move-marker marker nil) + (prog1 (buffer-substring start (point)) + (if (eolp) (forward-char 1))))) + + (defun texinfo-format-expand-region (start end) + (save-restriction + (narrow-to-region start end) + (let (texinfo-command-start + texinfo-command-end + texinfo-command-name + texinfo-stack) + (texinfo-format-scan)) + (goto-char (point-max)))) + + (defun texinfo-parse-arg-discard () + (prog1 (texinfo-parse-line-arg) + (texinfo-discard-command))) + + (defun texinfo-discard-command () + (delete-region texinfo-command-start texinfo-command-end)) + + (defun texinfo-optional-braces-discard () + "Discard braces following command, if any." + (goto-char texinfo-command-end) + (let ((start (point))) + (cond ((looking-at "[ \t]*\n")) ; do nothing + ((looking-at "{") ; remove braces, if any + (forward-list 1) + (setq texinfo-command-end (point))) + (t + (error + "Invalid `texinfo-optional-braces-discard' format \(need braces?\)"))) + (delete-region texinfo-command-start texinfo-command-end))) + + (defun texinfo-format-parse-line-args () + (let ((start (1- (point))) + next beg end + args) + (skip-chars-forward " ") + (while (not (eolp)) + (setq beg (point)) + (re-search-forward "[\n,]") + (setq next (point)) + (if (bolp) (setq next (1- next))) + (forward-char -1) + (skip-chars-backward " ") + (setq end (point)) + (setq args (cons (if (> end beg) (buffer-substring beg end)) + args)) + (goto-char next) + (skip-chars-forward " ")) + (if (eolp) (forward-char 1)) + (setq texinfo-command-end (point)) + (nreverse args))) + + (defun texinfo-format-parse-args () + (let ((start (1- (point))) + next beg end + args) + (search-forward "{") + (save-excursion + (texinfo-format-expand-region + (point) + (save-excursion (up-list 1) (1- (point))))) + ;; The following does not handle cross references of the form: + ;; `@xref{bullet, , @code{@@bullet}@{@}}.' because the + ;; re-search-forward finds the first right brace after the second + ;; comma. + (while (/= (preceding-char) ?\}) + (skip-chars-forward " \t\n") + (setq beg (point)) + (re-search-forward "[},]") + (setq next (point)) + (forward-char -1) + (skip-chars-backward " \t\n") + (setq end (point)) + (cond ((< beg end) + (goto-char beg) + (while (search-forward "\n" end t) + (replace-match " ")))) + (setq args (cons (if (> end beg) (buffer-substring beg end)) + args)) + (goto-char next)) + (if (eolp) (forward-char 1)) + (setq texinfo-command-end (point)) + (nreverse args))) + + (defun texinfo-format-parse-defun-args () + (goto-char texinfo-command-end) + (let ((start (point))) + (end-of-line) + (setq texinfo-command-end (1+ (point))) + (let ((marker (move-marker (make-marker) texinfo-command-end))) + (texinfo-format-expand-region start (point)) + (setq texinfo-command-end (marker-position marker)) + (move-marker marker nil)) + (goto-char start) + (let ((args '()) + beg end) + (skip-chars-forward " ") + (while (not (eolp)) + (cond ((looking-at "{") + (setq beg (1+ (point))) + (forward-list 1) + (setq end (1- (point)))) + (t + (setq beg (point)) + (re-search-forward "[\n ]") + (forward-char -1) + (setq end (point)))) + (setq args (cons (buffer-substring beg end) args)) + (skip-chars-forward " ")) + (forward-char 1) + (nreverse args)))) + + (defun texinfo-discard-line () + (goto-char texinfo-command-end) + (skip-chars-forward " \t") + (or (eolp) + (error "Extraneous text at end of command line.")) + (goto-char texinfo-command-start) + (or (bolp) + (error "Extraneous text at beginning of command line.")) + (delete-region (point) (progn (forward-line 1) (point)))) + + (defun texinfo-discard-line-with-args () + (goto-char texinfo-command-start) + (delete-region (point) (progn (forward-line 1) (point)))) + + + ;;; @setfilename + + ;; Only `texinfo-format-buffer' handles @setfilename with this + ;; definition; `texinfo-format-region' handles @setfilename, if any, + ;; specially. + (put 'setfilename 'texinfo-format 'texinfo-format-setfilename) + (defun texinfo-format-setfilename () + (let ((arg (texinfo-parse-arg-discard))) + (message "Formatting Info file: %s" arg) + (setq texinfo-format-filename + (file-name-nondirectory (expand-file-name arg))) + (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" + (if (buffer-file-name input-buffer) + (concat " `" + (file-name-sans-versions + (file-name-nondirectory + (buffer-file-name input-buffer))) + "'") + (concat "buffer `" (buffer-name input-buffer) "'")) + "\nusing `texinfmt.el' version " + texinfmt-version + ".\n\n"))) + + ;;; @node, @menu + + (put 'node 'texinfo-format 'texinfo-format-node) + (put 'nwnode 'texinfo-format 'texinfo-format-node) + (defun texinfo-format-node () + (let* ((args (texinfo-format-parse-line-args)) + (name (nth 0 args)) + (next (nth 1 args)) + (prev (nth 2 args)) + (up (nth 3 args))) + (texinfo-discard-command) + (setq texinfo-last-node name) + (let ((tem (downcase name))) + (if (assoc tem texinfo-node-names) + (error "Duplicate node name: %s" name) + (setq texinfo-node-names (cons (list tem) texinfo-node-names)))) + (setq texinfo-footnote-number 0) + (or (bolp) + (insert ?\n)) + (insert "\^_\nFile: " texinfo-format-filename + ", Node: " name) + (if next + (insert ", Next: " next)) + (if prev + (insert ", Prev: " prev)) + (if up + (insert ", Up: " up)) + (insert ?\n) + (setq texinfo-last-node-pos (point)))) + + (put 'menu 'texinfo-format 'texinfo-format-menu) + (defun texinfo-format-menu () + (texinfo-discard-line) + (insert "* Menu:\n\n")) + + (put 'menu 'texinfo-end 'texinfo-discard-command) + + + ;;; Cross references + + ; @xref {NODE, FNAME, NAME, FILE, DOCUMENT} + ; -> *Note FNAME: (FILE)NODE + ; If FILE is missing, + ; *Note FNAME: NODE + ; If FNAME is empty and NAME is present + ; *Note NAME: Node + ; If both NAME and FNAME are missing + ; *Note NODE:: + ; texinfo ignores the DOCUMENT argument. + ; -> See section [NAME, else NODE], page + ; If FILE is specified, (FILE)NODE is used for xrefs. + ; If fifth argument DOCUMENT is specified, produces + ; See section [NAME, else NODE], page + ; of DOCUMENT + + ; @ref a reference that does not put `See' or `see' in + ; the hardcopy and is the same as @xref in Info + (put 'ref 'texinfo-format 'texinfo-format-xref) + + (put 'xref 'texinfo-format 'texinfo-format-xref) + (defun texinfo-format-xref () + (let ((args (texinfo-format-parse-args))) + (texinfo-discard-command) + (insert "*Note ") + (let ((fname (or (nth 1 args) (nth 2 args)))) + (if (null (or fname (nth 3 args))) + (insert (car args) "::") + (insert (or fname (car args)) ": ") + (if (nth 3 args) + (insert "(" (nth 3 args) ")")) + (insert (car args)))))) + + (put 'pxref 'texinfo-format 'texinfo-format-pxref) + (defun texinfo-format-pxref () + (texinfo-format-xref) + (or (save-excursion + (forward-char -2) + (looking-at "::")) + (insert "."))) + + ;@inforef{NODE, FNAME, FILE} + ;Like @xref{NODE, FNAME,,FILE} in texinfo. + ;In Tex, generates "See Info file FILE, node NODE" + (put 'inforef 'texinfo-format 'texinfo-format-inforef) + (defun texinfo-format-inforef () + (let ((args (texinfo-format-parse-args))) + (texinfo-discard-command) + (if (nth 1 args) + (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args)) + (insert "*Note " "(" (nth 2 args) ")" (car args) "::")))) + + + ;;; Section headings + + (put 'majorheading 'texinfo-format 'texinfo-format-chapter) + (put 'chapheading 'texinfo-format 'texinfo-format-chapter) + (put 'ichapter 'texinfo-format 'texinfo-format-chapter) + (put 'chapter 'texinfo-format 'texinfo-format-chapter) + (put 'iappendix 'texinfo-format 'texinfo-format-chapter) + (put 'appendix 'texinfo-format 'texinfo-format-chapter) + (put 'iunnumbered 'texinfo-format 'texinfo-format-chapter) + (put 'top 'texinfo-format 'texinfo-format-chapter) + (put 'unnumbered 'texinfo-format 'texinfo-format-chapter) + (defun texinfo-format-chapter () + (texinfo-format-chapter-1 ?*)) + + (put 'heading 'texinfo-format 'texinfo-format-section) + (put 'isection 'texinfo-format 'texinfo-format-section) + (put 'section 'texinfo-format 'texinfo-format-section) + (put 'iappendixsection 'texinfo-format 'texinfo-format-section) + (put 'appendixsection 'texinfo-format 'texinfo-format-section) + (put 'iappendixsec 'texinfo-format 'texinfo-format-section) + (put 'appendixsec 'texinfo-format 'texinfo-format-section) + (put 'iunnumberedsec 'texinfo-format 'texinfo-format-section) + (put 'unnumberedsec 'texinfo-format 'texinfo-format-section) + (defun texinfo-format-section () + (texinfo-format-chapter-1 ?=)) + + (put 'subheading 'texinfo-format 'texinfo-format-subsection) + (put 'isubsection 'texinfo-format 'texinfo-format-subsection) + (put 'subsection 'texinfo-format 'texinfo-format-subsection) + (put 'iappendixsubsec 'texinfo-format 'texinfo-format-subsection) + (put 'appendixsubsec 'texinfo-format 'texinfo-format-subsection) + (put 'iunnumberedsubsec 'texinfo-format 'texinfo-format-subsection) + (put 'unnumberedsubsec 'texinfo-format 'texinfo-format-subsection) + (defun texinfo-format-subsection () + (texinfo-format-chapter-1 ?-)) + + (put 'subsubheading 'texinfo-format 'texinfo-format-subsubsection) + (put 'isubsubsection 'texinfo-format 'texinfo-format-subsubsection) + (put 'subsubsection 'texinfo-format 'texinfo-format-subsubsection) + (put 'iappendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection) + (put 'appendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection) + (put 'iunnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection) + (put 'unnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection) + (defun texinfo-format-subsubsection () + (texinfo-format-chapter-1 ?.)) + + (defun texinfo-format-chapter-1 (belowchar) + (let ((arg (texinfo-parse-arg-discard))) + (message "Formatting: %s ... " arg) ; So we can see where we are. + (insert ?\n arg ?\n "@SectionPAD " belowchar ?\n) + (forward-line -2))) + + (put 'SectionPAD 'texinfo-format 'texinfo-format-sectionpad) + (defun texinfo-format-sectionpad () + (let ((str (texinfo-parse-arg-discard))) + (forward-char -1) + (let ((column (current-column))) + (forward-char 1) + (while (> column 0) + (insert str) + (setq column (1- column)))) + (insert ?\n))) + + + ;;; Space controling commands: @. and @: + (put '\. 'texinfo-format 'texinfo-format-\.) + (defun texinfo-format-\. () + (texinfo-discard-command) + (insert ".")) + + (put '\: 'texinfo-format 'texinfo-format-\:) + (defun texinfo-format-\: () + (texinfo-discard-command)) + + + ;;; @center, @sp, and @br + + (put 'center 'texinfo-format 'texinfo-format-center) + (defun texinfo-format-center () + (let ((arg (texinfo-parse-expanded-arg))) + (texinfo-discard-command) + (insert arg) + (insert ?\n) + (save-restriction + (goto-char (1- (point))) + (let ((indent-tabs-mode nil)) + (center-line))))) + + (put 'sp 'texinfo-format 'texinfo-format-sp) + (defun texinfo-format-sp () + (let* ((arg (texinfo-parse-arg-discard)) + (num (read arg))) + (insert-char ?\n num))) + + (put 'br 'texinfo-format 'texinfo-format-paragraph-break) + (defun texinfo-format-paragraph-break () + "Force a paragraph break. + If used within a line, follow `@br' with braces." + (texinfo-optional-braces-discard) + ;; insert one return if at end of line; + ;; else insert two returns, to generate a blank line. + (if (= (following-char) ?\n) + (insert ?\n) + (insert-char ?\n 2))) + + + ;;; @footnote and @footnotestyle + + ; In Texinfo, footnotes are created with the `@footnote' command. + ; This command is followed immediately by a left brace, then by the text of + ; the footnote, and then by a terminating right brace. The + ; template for a footnote is: + ; + ; @footnote{TEXT} + ; + ; Info has two footnote styles: + ; + ; * In the End of node style, all the footnotes for a single node + ; are placed at the end of that node. The footnotes are + ; separated from the rest of the node by a line of dashes with + ; the word `Footnotes' within it. + ; + ; * In the Separate node style, all the footnotes for a single node + ; are placed in an automatically constructed node of their own. + + ; Footnote style is specified by the @footnotestyle command, either + ; @footnotestyle separate + ; or + ; @footnotestyle end + ; + ; The default is separate + + (defvar texinfo-footnote-style "separate" + "Footnote style, either separate or end.") + + (put 'footnotestyle 'texinfo-format 'texinfo-footnotestyle) + (defun texinfo-footnotestyle () + "Specify whether footnotes are at end of node or in separate nodes. + Argument is either end or separate." + (setq texinfo-footnote-style (texinfo-parse-arg-discard))) + + (defvar texinfo-footnote-number) + + (put 'footnote 'texinfo-format 'texinfo-format-footnote) + (defun texinfo-format-footnote () + "Format a footnote in either end of node or separate node style. + The texinfo-footnote-style variable controls which style is used." + (setq texinfo-footnote-number (1+ texinfo-footnote-number)) + (cond ((string= texinfo-footnote-style "end") + (texinfo-format-end-node)) + ((string= texinfo-footnote-style "separate") + (texinfo-format-separate-node)))) + + (defun texinfo-format-separate-node () + "Format footnote in Separate node style, with notes in own node. + The node is constructed automatically." + (let* (start + (arg (texinfo-parse-line-arg)) + (node-name-beginning + (save-excursion + (re-search-backward + "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ \t]+Node:") + (match-end 0))) + (node-name + (save-excursion + (buffer-substring + (progn (goto-char node-name-beginning) ; skip over node command + (skip-chars-forward " \t") ; and over spaces + (point)) + (if (search-forward + "," + (save-excursion (end-of-line) (point)) t) ; bound search + (1- (point)) + (end-of-line) (point)))))) + (texinfo-discard-command) ; remove or insert whitespace, as needed + (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) + (point)) + (insert (format " (%d) (*Note %s-Footnotes::)" + texinfo-footnote-number node-name)) + (fill-paragraph nil) + (save-excursion + (if (re-search-forward "^@node" nil 'move) + (forward-line -1)) + + ;; two cases: for the first footnote, we must insert a node header; + ;; for the second and subsequent footnotes, we need only insert + ;; the text of the footnote. + + (if (save-excursion + (re-search-backward + (concat node-name "-Footnotes, Up: ") + node-name-beginning + t)) + (progn ; already at least one footnote + (setq start (point)) + (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) + (fill-region start (point))) + ;; else not yet a footnote + (insert "\n\^_\nFile: " texinfo-format-filename + " Node: " node-name "-Footnotes, Up: " node-name "\n") + (setq start (point)) + (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) + (fill-region start (point)))))) + + (defun texinfo-format-end-node () + "Format footnote in the End of node style, with notes at end of node." + (let (start + (arg (texinfo-parse-line-arg))) + (texinfo-discard-command) ; remove or insert whitespace, as needed + (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) + (point)) + (insert (format " (%d) " texinfo-footnote-number)) + (fill-paragraph nil) + (save-excursion + (if (search-forward "\n--------- Footnotes ---------\n" nil t) + (progn ; already have footnote, put new one before end of node + (if (re-search-forward "^@node" nil 'move) + (forward-line -1)) + (setq start (point)) + (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)) + (fill-region start (point))) + ;; else no prior footnote + (if (re-search-forward "^@node" nil 'move) + (forward-line -1)) + (insert "\n--------- Footnotes ---------\n") + (setq start (point)) + (insert (format "\n(%d) %s\n" texinfo-footnote-number arg)))))) + + + ;;; @itemize, @enumerate, and similar commands + + ;; @itemize pushes (itemize "COMMANDS" STARTPOS) on texinfo-stack. + ;; @enumerate pushes (enumerate 0 STARTPOS). + ;; @item dispatches to the texinfo-item prop of the first elt of the list. + ;; For itemize, this puts in and rescans the COMMANDS. + ;; For enumerate, this increments the number and puts it in. + ;; In either case, it puts a Backspace at the front of the line + ;; which marks it not to be indented later. + ;; All other lines get indented by 5 when the @end is reached. + + (defvar texinfo-stack-depth 0 + "Count of number of unpopped texinfo-push-stack calls. + Used by @refill indenting command to avoid indenting within lists, etc.") + + (defun texinfo-push-stack (check arg) + (setq texinfo-stack-depth (1+ texinfo-stack-depth)) + (setq texinfo-stack + (cons (list check arg texinfo-command-start) + texinfo-stack))) + + (defun texinfo-pop-stack (check) + (setq texinfo-stack-depth (1- texinfo-stack-depth)) + (if (null texinfo-stack) + (error "Unmatched @end %s" check)) + (if (not (eq (car (car texinfo-stack)) check)) + (error "@end %s matches @%s" + check (car (car texinfo-stack)))) + (prog1 (cdr (car texinfo-stack)) + (setq texinfo-stack (cdr texinfo-stack)))) + + (put 'itemize 'texinfo-format 'texinfo-itemize) + (defun texinfo-itemize () + (texinfo-push-stack + 'itemize + (progn (skip-chars-forward " \t") + (if (eolp) + "@bullet" + (texinfo-parse-line-arg)))) + (texinfo-discard-line-with-args) + (setq fill-column (- fill-column 5))) + + (put 'itemize 'texinfo-end 'texinfo-end-itemize) + (defun texinfo-end-itemize () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack 'itemize))) + (texinfo-do-itemize (nth 1 stacktop)))) + + (put 'enumerate 'texinfo-format 'texinfo-enumerate) + (defun texinfo-enumerate () + (texinfo-push-stack + 'enumerate + (progn (skip-chars-forward " \t") + (if (eolp) + 1 + (read (current-buffer))))) + (if (and (symbolp (car (cdr (car texinfo-stack)))) + (> 1 (length (symbol-name (car (cdr (car texinfo-stack))))))) + (error + "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." )) + (texinfo-discard-line-with-args) + (setq fill-column (- fill-column 5))) + + (put 'enumerate 'texinfo-end 'texinfo-end-enumerate) + (defun texinfo-end-enumerate () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack 'enumerate))) + (texinfo-do-itemize (nth 1 stacktop)))) + + ;; @alphaenumerate never became a standard part of Texinfo + (put 'alphaenumerate 'texinfo-format 'texinfo-alphaenumerate) + (defun texinfo-alphaenumerate () + (texinfo-push-stack 'alphaenumerate (1- ?a)) + (setq fill-column (- fill-column 5)) + (texinfo-discard-line)) + + (put 'alphaenumerate 'texinfo-end 'texinfo-end-alphaenumerate) + (defun texinfo-end-alphaenumerate () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack 'alphaenumerate))) + (texinfo-do-itemize (nth 1 stacktop)))) + + ;; @capsenumerate never became a standard part of Texinfo + (put 'capsenumerate 'texinfo-format 'texinfo-capsenumerate) + (defun texinfo-capsenumerate () + (texinfo-push-stack 'capsenumerate (1- ?A)) + (setq fill-column (- fill-column 5)) + (texinfo-discard-line)) + + (put 'capsenumerate 'texinfo-end 'texinfo-end-capsenumerate) + (defun texinfo-end-capsenumerate () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack 'capsenumerate))) + (texinfo-do-itemize (nth 1 stacktop)))) + + ;; At the @end, indent all the lines within the construct + ;; except those marked with backspace. FROM says where + ;; construct started. + (defun texinfo-do-itemize (from) + (save-excursion + (while (progn (forward-line -1) + (>= (point) from)) + (if (= (following-char) ?\b) + (save-excursion + (delete-char 1) + (end-of-line) + (delete-char 6)) + (if (not (looking-at "[ \t]*$")) + (save-excursion (insert " "))))))) + + (put 'item 'texinfo-format 'texinfo-item) + (put 'itemx 'texinfo-format 'texinfo-item) + (defun texinfo-item () + (funcall (get (car (car texinfo-stack)) 'texinfo-item))) + + (put 'itemize 'texinfo-item 'texinfo-itemize-item) + (defun texinfo-itemize-item () + ;; (texinfo-discard-line) ; Did not handle text on same line as @item. + (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point))) + (if (looking-at "[ \t]*[^ \t\n]+") + ;; Text on same line as @item command. + (insert "\b " (nth 1 (car texinfo-stack)) " \n") + ;; Else text on next line. + (insert "\b " (nth 1 (car texinfo-stack)) " ")) + (forward-line -1)) + + (put 'enumerate 'texinfo-item 'texinfo-enumerate-item) + (defun texinfo-enumerate-item () + (texinfo-discard-line) + (let (enumerating-symbol) + (cond ((integerp (car (cdr (car texinfo-stack)))) + (setq enumerating-symbol (car (cdr (car texinfo-stack)))) + (insert ?\b (format "%3d. " enumerating-symbol) ?\n) + (setcar (cdr (car texinfo-stack)) (1+ enumerating-symbol))) + ((symbolp (car (cdr (car texinfo-stack)))) + (setq enumerating-symbol + (symbol-name (car (cdr (car texinfo-stack))))) + (if (or (equal ?\[ (string-to-char enumerating-symbol)) + (equal ?\{ (string-to-char enumerating-symbol))) + (error + "Too many items in enumerated list; alphabet ends at Z.")) + (insert ?\b (format "%3s. " enumerating-symbol) ?\n) + (setcar (cdr (car texinfo-stack)) + (make-symbol + (char-to-string + (1+ + (string-to-char enumerating-symbol)))))) + (t + (error + "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." ))) + (forward-line -1))) + + (put 'alphaenumerate 'texinfo-item 'texinfo-alphaenumerate-item) + (defun texinfo-alphaenumerate-item () + (texinfo-discard-line) + (let ((next (1+ (car (cdr (car texinfo-stack)))))) + (if (> next ?z) + (error "More than 26 items in @alphaenumerate; get a bigger alphabet.")) + (setcar (cdr (car texinfo-stack)) next) + (insert "\b " next ". \n")) + (forward-line -1)) + + (put 'capsenumerate 'texinfo-item 'texinfo-capsenumerate-item) + (defun texinfo-capsenumerate-item () + (texinfo-discard-line) + (let ((next (1+ (car (cdr (car texinfo-stack)))))) + (if (> next ?Z) + (error "More than 26 items in @capsenumerate; get a bigger alphabet.")) + (setcar (cdr (car texinfo-stack)) next) + (insert "\b " next ". \n")) + (forward-line -1)) + + + ;;; @table + + ; The `@table' command produces two-column tables. + + (put 'table 'texinfo-format 'texinfo-table) + (defun texinfo-table () + (texinfo-push-stack + 'table + (progn (skip-chars-forward " \t") + (if (eolp) + "@asis" + (texinfo-parse-line-arg)))) + (texinfo-discard-line-with-args) + (setq fill-column (- fill-column 5))) + + (put 'table 'texinfo-item 'texinfo-table-item) + (defun texinfo-table-item () + (let ((arg (texinfo-parse-arg-discard)) + (itemfont (car (cdr (car texinfo-stack))))) + (insert ?\b itemfont ?\{ arg "}\n \n")) + (forward-line -2)) + + (put 'table 'texinfo-end 'texinfo-end-table) + (defun texinfo-end-table () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack 'table))) + (texinfo-do-itemize (nth 1 stacktop)))) + + ;; @description appears to be an undocumented variant on @table that + ;; does not require an arg. It fails in texinfo.tex 2.58 and is not + ;; part of makeinfo.c The command appears to be a relic of the past. + (put 'description 'texinfo-end 'texinfo-end-table) + (put 'description 'texinfo-format 'texinfo-description) + (defun texinfo-description () + (texinfo-push-stack 'table "@asis") + (setq fill-column (- fill-column 5)) + (texinfo-discard-line)) + + + ;;; @ftable, @vtable + + ; The `@ftable' and `@vtable' commands are like the `@table' command + ; but they also insert each entry in the first column of the table + ; into the function or variable index. + + ;; Handle the @ftable and @vtable commands: + + (put 'ftable 'texinfo-format 'texinfo-ftable) + (put 'vtable 'texinfo-format 'texinfo-vtable) + + (defun texinfo-ftable () (texinfo-indextable 'ftable)) + (defun texinfo-vtable () (texinfo-indextable 'vtable)) + + (defun texinfo-indextable (table-type) + (texinfo-push-stack table-type (texinfo-parse-arg-discard)) + (setq fill-column (- fill-column 5))) + + ;; Handle the @item commands within ftable and vtable: + + (put 'ftable 'texinfo-item 'texinfo-ftable-item) + (put 'vtable 'texinfo-item 'texinfo-vtable-item) + + (defun texinfo-ftable-item () (texinfo-indextable-item 'texinfo-findex)) + (defun texinfo-vtable-item () (texinfo-indextable-item 'texinfo-vindex)) + + (defun texinfo-indextable-item (index-type) + (let ((item (texinfo-parse-arg-discard)) + (itemfont (car (cdr (car texinfo-stack)))) + (indexvar index-type)) + (insert ?\b itemfont ?\{ item "}\n \n") + (set indexvar + (cons + (list item texinfo-last-node) + (symbol-value indexvar))) + (forward-line -2))) + + ;; Handle @end ftable, @end vtable + + (put 'ftable 'texinfo-end 'texinfo-end-ftable) + (put 'vtable 'texinfo-end 'texinfo-end-vtable) + + (defun texinfo-end-ftable () (texinfo-end-indextable 'ftable)) + (defun texinfo-end-vtable () (texinfo-end-indextable 'vtable)) + + (defun texinfo-end-indextable (table-type) + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack table-type))) + (texinfo-do-itemize (nth 1 stacktop)))) + + + ;;; @ifinfo, @iftex, @tex + + (put 'ifinfo 'texinfo-format 'texinfo-discard-line) + (put 'ifinfo 'texinfo-end 'texinfo-discard-command) + + (put 'iftex 'texinfo-format 'texinfo-format-iftex) + (defun texinfo-format-iftex () + (delete-region texinfo-command-start + (progn (re-search-forward "@end iftex[ \t]*\n") + (point)))) + + (put 'tex 'texinfo-format 'texinfo-format-tex) + (defun texinfo-format-tex () + (delete-region texinfo-command-start + (progn (re-search-forward "@end tex[ \t]*\n") + (point)))) + + + ;;; @titlepage + + (put 'titlepage 'texinfo-format 'texinfo-format-titlepage) + (defun texinfo-format-titlepage () + (delete-region texinfo-command-start + (progn (re-search-forward "@end titlepage[ \t]*\n") + (point)))) + + (put 'endtitlepage 'texinfo-format 'texinfo-discard-line) + + ; @titlespec an alternative titling command; ignored by Info + + (put 'titlespec 'texinfo-format 'texinfo-format-titlespec) + (defun texinfo-format-titlespec () + (delete-region texinfo-command-start + (progn (re-search-forward "@end titlespec[ \t]*\n") + (point)))) + + (put 'endtitlespec 'texinfo-format 'texinfo-discard-line) + + + ;;; @today + + (put 'today 'texinfo-format 'texinfo-format-today) + + ; Produces Day Month Year style of output. eg `1 Jan 1900' + ; The `@today{}' command requires a pair of braces, like `@dots{}'. + (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)))) + + + ;;; @ignore + + (put 'ignore 'texinfo-format 'texinfo-format-ignore) + (defun texinfo-format-ignore () + (delete-region texinfo-command-start + (progn (re-search-forward "@end ignore[ \t]*\n") + (point)))) + + (put 'endignore 'texinfo-format 'texinfo-discard-line) + + + ;;; Define the Info enclosure command: @definfoenclose + + ; A `@definfoenclose' command may be used to define a highlighting + ; command for Info, but not for TeX. A command defined using + ; `@definfoenclose' marks text by enclosing it in strings that precede + ; and follow the text. + ; + ; Presumably, if you define a command with `@definfoenclose` for Info, + ; you will also define the same command in the TeX definitions file, + ; `texinfo.tex' in a manner appropriate for typesetting. + ; + ; Write a `@definfoenclose' command on a line and follow it with three + ; arguments separated by commas (commas are used as separators in an + ; `@node' line in the same way). The first argument to + ; `@definfoenclose' is the @-command name \(without the `@'\); the + ; second argument is the Info start delimiter string; and the third + ; argument is the Info end delimiter string. The latter two arguments + ; enclose the highlighted text in the Info file. A delimiter string + ; may contain spaces. Neither the start nor end delimiter is + ; required. However, if you do not provide a start delimiter, you + ; must follow the command name with two commas in a row; otherwise, + ; the Info formatting commands will misinterpret the end delimiter + ; string as a start delimiter string. + ; + ; An enclosure command defined this way takes one argument in braces. + ; + ; For example, you can write: + ; + ; @ifinfo + ; @definfoenclose phoo, //, \\ + ; @end ifinfo + ; + ; near the beginning of a Texinfo file at the beginning of the lines + ; to define `@phoo' as an Info formatting command that inserts `//' + ; before and `\\' after the argument to `@phoo'. You can then write + ; `@phoo{bar}' wherever you want `//bar\\' highlighted in Info. + ; + ; Also, for TeX formatting, you could write + ; + ; @iftex + ; @global@let@phoo=@i + ; @end iftex + ; + ; to define `@phoo' as a command that causes TeX to typeset + ; the argument to `@phoo' in italics. + ; + ; Note that each definition applies to its own formatter: one for TeX, + ; the other for texinfo-format-buffer or texinfo-format-region. + ; + ; Here is another example: write + ; + ; @definfoenclose headword, , : + ; + ; near the beginning of the file, to define `@headword' as an Info + ; formatting command that inserts nothing before and a colon after the + ; argument to `@headword'. + + (put 'definfoenclose 'texinfo-format 'texinfo-define-info-enclosure) + (defun texinfo-define-info-enclosure () + (let* ((args (texinfo-format-parse-line-args)) + (command-name (nth 0 args)) + (beginning-delimiter (or (nth 1 args) "")) + (end-delimiter (or (nth 2 args) ""))) + (texinfo-discard-command) + (setq texinfo-enclosure-list + (cons + (list command-name + (list + beginning-delimiter + end-delimiter)) + texinfo-enclosure-list)))) + + + ;;; @var, @code and the like + + (put 'var 'texinfo-format 'texinfo-format-var) + ; @sc a small caps font for TeX; formatted as `var' in Info + (put 'sc 'texinfo-format 'texinfo-format-var) + (defun texinfo-format-var () + (insert (upcase (texinfo-parse-arg-discard))) + (goto-char texinfo-command-start)) + + ; various noops + + (put 'b 'texinfo-format 'texinfo-format-noop) + (put 'i 'texinfo-format 'texinfo-format-noop) + (put 'r 'texinfo-format 'texinfo-format-noop) + (put 't 'texinfo-format 'texinfo-format-noop) + (put 'w 'texinfo-format 'texinfo-format-noop) + (put 'asis 'texinfo-format 'texinfo-format-noop) + (put 'dmn 'texinfo-format 'texinfo-format-noop) + (put 'key 'texinfo-format 'texinfo-format-noop) + (put 'math 'texinfo-format 'texinfo-format-noop) + (put 'titlefont 'texinfo-format 'texinfo-format-noop) + (defun texinfo-format-noop () + (insert (texinfo-parse-arg-discard)) + (goto-char texinfo-command-start)) + + (put 'cite 'texinfo-format 'texinfo-format-code) + (put 'code 'texinfo-format 'texinfo-format-code) + (put 'file 'texinfo-format 'texinfo-format-code) + (put 'kbd 'texinfo-format 'texinfo-format-code) + (put 'samp 'texinfo-format 'texinfo-format-code) + (defun texinfo-format-code () + (insert "`" (texinfo-parse-arg-discard) "'") + (goto-char texinfo-command-start)) + + (put 'emph 'texinfo-format 'texinfo-format-emph) + (put 'strong 'texinfo-format 'texinfo-format-emph) + (defun texinfo-format-emph () + (insert "*" (texinfo-parse-arg-discard) "*") + (goto-char texinfo-command-start)) + + (put 'dfn 'texinfo-format 'texinfo-format-defn) + (put 'defn 'texinfo-format 'texinfo-format-defn) + (defun texinfo-format-defn () + (insert "\"" (texinfo-parse-arg-discard) "\"") + (goto-char texinfo-command-start)) + + (put 'bullet 'texinfo-format 'texinfo-format-bullet) + (defun texinfo-format-bullet () + "Insert an asterisk. + If used within a line, follow `@bullet' with braces." + (texinfo-optional-braces-discard) + (insert "*")) + + + ;;; @example, @lisp, @quotation, @display, @smalllisp, @smallexample + + (put 'display 'texinfo-format 'texinfo-format-example) + (put 'example 'texinfo-format 'texinfo-format-example) + (put 'lisp 'texinfo-format 'texinfo-format-example) + (put 'quotation 'texinfo-format 'texinfo-format-example) + (put 'smallexample 'texinfo-format 'texinfo-format-example) + (put 'smalllisp 'texinfo-format 'texinfo-format-example) + (defun texinfo-format-example () + (texinfo-push-stack 'example nil) + (setq fill-column (- fill-column 5)) + (texinfo-discard-line)) + + (put 'example 'texinfo-end 'texinfo-end-example) + (put 'display 'texinfo-end 'texinfo-end-example) + (put 'lisp 'texinfo-end 'texinfo-end-example) + (put 'quotation 'texinfo-end 'texinfo-end-example) + (put 'smallexample 'texinfo-end 'texinfo-end-example) + (put 'smalllisp 'texinfo-end 'texinfo-end-example) + (defun texinfo-end-example () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((stacktop + (texinfo-pop-stack 'example))) + (texinfo-do-itemize (nth 1 stacktop)))) + + (put 'exdent 'texinfo-format 'texinfo-format-exdent) + (defun texinfo-format-exdent () + (texinfo-discard-command) + (delete-region (point) + (progn + (skip-chars-forward " ") + (point))) + (insert ?\b) + ;; Cancel out the deletion that texinfo-do-itemize + ;; is going to do at the end of this line. + (save-excursion + (end-of-line) + (insert "\n "))) + + + ;;; @cartouche + + ; The @cartouche command is a noop in Info; in a printed manual, + ; it makes a box with rounded corners. + + (put 'cartouche 'texinfo-format 'texinfo-discard-line) + (put 'cartouche 'texinfo-end 'texinfo-discard-command) + + + ;;; @flushleft and @format + + ; The @flushleft command left justifies every line but leaves the + ; right end ragged. As far as Info is concerned, @flushleft is a + ; `do-nothing' command + + ; The @format command is similar to @example except that it does not + ; indent; this means that in Info, @format is similar to @flushleft. + + (put 'format 'texinfo-format 'texinfo-format-flushleft) + (put 'flushleft 'texinfo-format 'texinfo-format-flushleft) + (defun texinfo-format-flushleft () + (texinfo-discard-line)) + + (put 'format 'texinfo-end 'texinfo-end-flushleft) + (put 'flushleft 'texinfo-end 'texinfo-end-flushleft) + (defun texinfo-end-flushleft () + (texinfo-discard-command)) + + + ;;; @flushright + + ; The @flushright command right justifies every line but leaves the + ; left end ragged. Spaces and tabs at the right ends of lines are + ; removed so that visible text lines up on the right side. + + (put 'flushright 'texinfo-format 'texinfo-format-flushright) + (defun texinfo-format-flushright () + (texinfo-push-stack 'flushright nil) + (texinfo-discard-line)) + + (put 'flushright 'texinfo-end 'texinfo-end-flushright) + (defun texinfo-end-flushright () + (texinfo-discard-command) + + (let ((stacktop + (texinfo-pop-stack 'flushright))) + + (texinfo-do-flushright (nth 1 stacktop)))) + + (defun texinfo-do-flushright (from) + (save-excursion + (while (progn (forward-line -1) + (>= (point) from)) + + (beginning-of-line) + (insert + (make-string + (- fill-column + (save-excursion + (end-of-line) + (skip-chars-backward " \t") + (delete-region (point) (progn (end-of-line) (point))) + (current-column))) + ? ))))) + + + ;;; @ctrl, @TeX, @copyright, @minus, @dots + + (put 'ctrl 'texinfo-format 'texinfo-format-ctrl) + (defun texinfo-format-ctrl () + (let ((str (texinfo-parse-arg-discard))) + (insert (logand 31 (aref str 0))))) + + (put 'TeX 'texinfo-format 'texinfo-format-TeX) + (defun texinfo-format-TeX () + (texinfo-parse-arg-discard) + (insert "TeX")) + + (put 'copyright 'texinfo-format 'texinfo-format-copyright) + (defun texinfo-format-copyright () + (texinfo-parse-arg-discard) + (insert "(C)")) + + (put 'minus 'texinfo-format 'texinfo-format-minus) + (defun texinfo-format-minus () + "Insert a minus sign. + If used within a line, follow `@minus' with braces." + (texinfo-optional-braces-discard) + (insert "-")) + + (put 'dots 'texinfo-format 'texinfo-format-dots) + (defun texinfo-format-dots () + (texinfo-parse-arg-discard) + (insert "...")) + + + ;;; Refilling and indenting: @refill, @paragraphindent, @noindent + + ;;; Indent only those paragraphs that are refilled as a result of an + ;;; @refill command. + + ; * If the value is `asis', do not change the existing indentation at + ; the starts of paragraphs. + + ; * If the value zero, delete any existing indentation. + + ; * If the value is greater than zero, indent each paragraph by that + ; number of spaces. + + ;;; But do not refill paragraphs with an @refill command that are + ;;; preceded by @noindent or are part of a table, list, or deffn. + + (defvar texinfo-paragraph-indent "asis" + "Number of spaces for @refill to indent a paragraph; else to leave as is.") + + (put 'paragraphindent 'texinfo-format 'texinfo-paragraphindent) + + (defun texinfo-paragraphindent () + "Specify the number of spaces for @refill to indent a paragraph. + Default is to leave the number of spaces as is." + (let ((arg (texinfo-parse-arg-discard))) + (if (string= "asis" arg) + (setq texinfo-paragraph-indent "asis") + (setq texinfo-paragraph-indent (string-to-int arg))))) + + (put 'refill 'texinfo-format 'texinfo-format-refill) + (defun texinfo-format-refill () + "Refill paragraph. Also, indent first line as set by @paragraphindent. + Default is to leave paragraph indentation as is." + (texinfo-discard-command) + (forward-paragraph -1) + (if (looking-at "[ \t\n]*$") (forward-line 1)) + ;; Do not indent if an entry in a list, table, or deffn, + ;; or if paragraph is preceded by @noindent. + ;; Otherwise, indent + (cond + ;; delete a @noindent line and do not indent paragraph + ((save-excursion (forward-line -1) + (looking-at "^@noindent")) + (forward-line -1) + (delete-region (point) (progn (forward-line 1) (point)))) + ;; do nothing if "asis" + ((equal texinfo-paragraph-indent "asis")) + ;; do no indenting in list, etc. + ((> texinfo-stack-depth 0)) + ;; otherwise delete existing whitespace and indent + (t + (delete-region (point) (progn (skip-chars-forward " \t") (point))) + (insert (make-string texinfo-paragraph-indent ? )))) + (forward-paragraph 1) + (forward-line -1) + (end-of-line) + ;; Do not fill a section title line with asterisks, hyphens, etc. that + ;; are used to underline it. This could occur if the line following + ;; the underlining is not an index entry and has text within it. + (let* ((previous-paragraph-separate paragraph-separate) + (paragraph-separate (concat paragraph-separate "\\|^[=*---.]+")) + (previous-paragraph-start paragraph-start) + (paragraph-start (concat paragraph-start "\\|^[=*---.]+"))) + (unwind-protect + (fill-paragraph nil) + (setq paragraph-separate previous-paragraph-separate) + (setq paragraph-start previous-paragraph-start)))) + + (put 'noindent 'texinfo-format 'texinfo-noindent) + (defun texinfo-noindent () + (save-excursion + (forward-paragraph 1) + (if (search-backward "@refill" + (save-excursion (forward-line -1) (point)) t) + () ; leave @noindent command so @refill command knows not to indent + ;; else + (texinfo-discard-line)))) + + + ;;; Index generation + + (put 'vindex 'texinfo-format 'texinfo-format-vindex) + (defun texinfo-format-vindex () + (texinfo-index 'texinfo-vindex)) + + (put 'cindex 'texinfo-format 'texinfo-format-cindex) + (defun texinfo-format-cindex () + (texinfo-index 'texinfo-cindex)) + + (put 'findex 'texinfo-format 'texinfo-format-findex) + (defun texinfo-format-findex () + (texinfo-index 'texinfo-findex)) + + (put 'pindex 'texinfo-format 'texinfo-format-pindex) + (defun texinfo-format-pindex () + (texinfo-index 'texinfo-pindex)) + + (put 'tindex 'texinfo-format 'texinfo-format-tindex) + (defun texinfo-format-tindex () + (texinfo-index 'texinfo-tindex)) + + (put 'kindex 'texinfo-format 'texinfo-format-kindex) + (defun texinfo-format-kindex () + (texinfo-index 'texinfo-kindex)) + + (defun texinfo-index (indexvar) + (let ((arg (texinfo-parse-expanded-arg))) + (texinfo-discard-command) + (set indexvar + (cons (list arg + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value indexvar))))) + + (defconst texinfo-indexvar-alist + '(("cp" . texinfo-cindex) + ("fn" . texinfo-findex) + ("vr" . texinfo-vindex) + ("tp" . texinfo-tindex) + ("pg" . texinfo-pindex) + ("ky" . texinfo-kindex))) + + + ;;; @defindex @defcodeindex + (put 'defindex 'texinfo-format 'texinfo-format-defindex) + (put 'defcodeindex 'texinfo-format 'texinfo-format-defindex) + + (defun texinfo-format-defindex () + (let* ((index-name (texinfo-parse-arg-discard)) ; eg: `aa' + (indexing-command (intern (concat index-name "index"))) + (index-formatting-command ; eg: `texinfo-format-aaindex' + (intern (concat "texinfo-format-" index-name "index"))) + (index-alist-name ; eg: `texinfo-aaindex' + (intern (concat "texinfo-" index-name "index")))) + + (set index-alist-name nil) + + (put indexing-command ; eg, aaindex + 'texinfo-format + index-formatting-command) ; eg, texinfo-format-aaindex + + ;; eg: "aa" . texinfo-aaindex + (or (assoc index-name texinfo-indexvar-alist) + (setq texinfo-indexvar-alist + (cons + (cons index-name + index-alist-name) + texinfo-indexvar-alist))) + + (fset index-formatting-command + (list 'lambda 'nil + (list 'texinfo-index + (list 'quote index-alist-name)))))) + + + ;;; @synindex @syncodeindex + + (put 'synindex 'texinfo-format 'texinfo-format-synindex) + (put 'syncodeindex 'texinfo-format 'texinfo-format-synindex) + + (defun texinfo-format-synindex () + (let* ((args (texinfo-parse-arg-discard)) + (second (cdr (read-from-string args))) + (joiner (symbol-name (car (read-from-string args)))) + (joined (symbol-name (car (read-from-string args second))))) + + (if (assoc joiner texinfo-short-index-cmds-alist) + (put + (cdr (assoc joiner texinfo-short-index-cmds-alist)) + 'texinfo-format + (or (cdr (assoc joined texinfo-short-index-format-cmds-alist)) + (intern (concat "texinfo-format-" joined "index")))) + (put + (intern (concat joiner "index")) + 'texinfo-format + (or (cdr(assoc joined texinfo-short-index-format-cmds-alist)) + (intern (concat "texinfo-format-" joined "index"))))))) + + (defconst texinfo-short-index-cmds-alist + '(("cp" . cindex) + ("fn" . findex) + ("vr" . vindex) + ("tp" . tindex) + ("pg" . pindex) + ("ky" . kindex))) + + (defconst texinfo-short-index-format-cmds-alist + '(("cp" . texinfo-format-cindex) + ("fn" . texinfo-format-findex) + ("vr" . texinfo-format-vindex) + ("tp" . texinfo-format-tindex) + ("pg" . texinfo-format-pindex) + ("ky" . texinfo-format-kindex))) + + + ;;; Sort and index (for VMS) + + ;; Sort an index which is in the current buffer between START and END. + ;; Used on VMS, where the `sort' utility is not available. + (defun texinfo-sort-region (start end) + (require 'sort) + (save-restriction + (narrow-to-region start end) + (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun))) + + ;; Subroutine for sorting an index. + ;; At start of a line, return a string to sort the line under. + (defun texinfo-sort-startkeyfun () + (let ((line + (buffer-substring (point) (save-excursion (end-of-line) (point))))) + ;; Canonicalize whitespace and eliminate funny chars. + (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line) + (setq line (concat (substring line 0 (match-beginning 0)) + " " + (substring line (match-end 0) (length line))))) + line)) + + + ;;; @printindex + + (put 'printindex 'texinfo-format 'texinfo-format-printindex) + + (defun texinfo-format-printindex () + (let ((indexelts (symbol-value + (cdr (assoc (texinfo-parse-arg-discard) + texinfo-indexvar-alist)))) + opoint) + (insert "\n* Menu:\n\n") + (setq opoint (point)) + (texinfo-print-index nil indexelts) + + (if (eq system-type 'vax-vms) + (texinfo-sort-region opoint (point)) + (shell-command-on-region opoint (point) "sort -fd" 1)))) + + (defun texinfo-print-index (file indexelts) + (while indexelts + (if (stringp (car (car indexelts))) + (progn + (insert "* " (car (car indexelts)) ": " ) + (indent-to 32) + (insert + (if file (concat "(" file ")") "") + (nth 1 (car indexelts)) ".") + (indent-to 54) + (insert + (if (nth 2 (car indexelts)) + (format " %d." (nth 2 (car indexelts))) + "") + "\n")) + ;; index entries from @include'd file + (texinfo-print-index (nth 1 (car indexelts)) + (nth 2 (car indexelts)))) + (setq indexelts (cdr indexelts)))) + + + ;;; Glyphs: @equiv, @error, etc + + ;; @equiv to show that two expressions are equivalent + ;; @error to show an error message + ;; @expansion to show what a macro expands to + ;; @point to show the location of point in an example + ;; @print to show what an evaluated expression prints + ;; @result to indicate the value returned by an expression + + (put 'equiv 'texinfo-format 'texinfo-format-equiv) + (defun texinfo-format-equiv () + (texinfo-parse-arg-discard) + (insert "==")) + + (put 'error 'texinfo-format 'texinfo-format-error) + (defun texinfo-format-error () + (texinfo-parse-arg-discard) + (insert "error-->")) + + (put 'expansion 'texinfo-format 'texinfo-format-expansion) + (defun texinfo-format-expansion () + (texinfo-parse-arg-discard) + (insert "==>")) + + (put 'point 'texinfo-format 'texinfo-format-point) + (defun texinfo-format-point () + (texinfo-parse-arg-discard) + (insert "-!-")) + + (put 'print 'texinfo-format 'texinfo-format-print) + (defun texinfo-format-print () + (texinfo-parse-arg-discard) + (insert "-|")) + + (put 'result 'texinfo-format 'texinfo-format-result) + (defun texinfo-format-result () + (texinfo-parse-arg-discard) + (insert "=>")) + + + ;;; Definition formatting: @deffn, @defun, etc + + ;; What definition formatting produces: + ;; + ;; @deffn category name args... + ;; In Info, `Category: name ARGS' + ;; In index: name: node. line#. + ;; + ;; @defvr category name + ;; In Info, `Category: name' + ;; In index: name: node. line#. + ;; + ;; @deftp category name attributes... + ;; `category name attributes...' Note: @deftp args in lower case. + ;; In index: name: node. line#. + ;; + ;; Specialized function-like or variable-like entity: + ;; + ;; @defun, @defmac, @defspec, @defvar, @defopt + ;; + ;; @defun name args In Info, `Function: name ARGS' + ;; @defmac name args In Info, `Macro: name ARGS' + ;; @defvar name In Info, `Variable: name' + ;; etc. + ;; In index: name: node. line#. + ;; + ;; Generalized typed-function-like or typed-variable-like entity: + ;; @deftypefn category data-type name args... + ;; In Info, `Category: data-type name args...' + ;; @deftypevr category data-type name + ;; In Info, `Category: data-type name' + ;; In index: name: node. line#. + ;; + ;; Specialized typed-function-like or typed-variable-like entity: + ;; @deftypefun data-type name args... + ;; In Info, `Function: data-type name ARGS' + ;; In index: name: node. line#. + ;; + ;; @deftypevar data-type name + ;; In Info, `Variable: data-type name' + ;; In index: name: node. line#. but include args after name!? + ;; + ;; Generalized object oriented entity: + ;; @defop category class name args... + ;; In Info, `Category on class: name ARG' + ;; In index: name on class: node. line#. + ;; + ;; @defcv category class name + ;; In Info, `Category of class: name' + ;; In index: name of class: node. line#. + ;; + ;; Specialized object oriented entity: + ;; @defmethod class name args... + ;; In Info, `Method on class: name ARGS' + ;; In index: name on class: node. line#. + ;; + ;; @defivar class name + ;; In Info, `Instance variable of class: name' + ;; In index: name of class: node. line#. + + + ;;; The definition formatting functions + + (defun texinfo-format-defun () + (texinfo-push-stack 'defun nil) + (setq fill-column (- fill-column 5)) + (texinfo-format-defun-1 t)) + + (defun texinfo-end-defun () + (setq fill-column (+ fill-column 5)) + (texinfo-discard-command) + (let ((start (nth 1 (texinfo-pop-stack 'defun)))) + (texinfo-do-itemize start) + ;; Delete extra newline inserted after header. + (save-excursion + (goto-char start) + (delete-char -1)))) + + (defun texinfo-format-defunx () + (texinfo-format-defun-1 nil)) + + (defun texinfo-format-defun-1 (first-p) + (let ((parse-args (texinfo-format-parse-defun-args)) + (command-type (get texinfo-command-name 'texinfo-defun-type))) + (texinfo-discard-command) + ;; Delete extra newline inserted after previous header line. + (if (not first-p) + (delete-char -1)) + (funcall + (get texinfo-command-name 'texinfo-deffn-formatting-property) parse-args) + ;; Insert extra newline so that paragraph filling does not mess + ;; with header line. + (insert "\n\n") + (rplaca (cdr (cdr (car texinfo-stack))) (point)) + (funcall + (get texinfo-command-name 'texinfo-defun-indexing-property) parse-args))) + + ;;; Formatting the first line of a definition + + ;; @deffn, @defvr, @deftp + (put 'deffn 'texinfo-deffn-formatting-property 'texinfo-format-deffn) + (put 'deffnx 'texinfo-deffn-formatting-property 'texinfo-format-deffn) + (put 'defvr 'texinfo-deffn-formatting-property 'texinfo-format-deffn) + (put 'defvrx 'texinfo-deffn-formatting-property 'texinfo-format-deffn) + (put 'deftp 'texinfo-deffn-formatting-property 'texinfo-format-deffn) + (put 'deftpx 'texinfo-deffn-formatting-property 'texinfo-format-deffn) + (defun texinfo-format-deffn (parsed-args) + ;; Generalized function-like, variable-like, or generic data-type entity: + ;; @deffn category name args... + ;; In Info, `Category: name ARGS' + ;; @deftp category name attributes... + ;; `category name attributes...' Note: @deftp args in lower case. + (let ((category (car parsed-args)) + (name (car (cdr parsed-args))) + (args (cdr (cdr parsed-args)))) + (insert " -- " category ": " name) + (while args + (insert " " + (if (or (= ?& (aref (car args) 0)) + (eq (eval (car command-type)) 'deftp-type)) + (car args) + (upcase (car args)))) + (setq args (cdr args))))) + + ;; @defun, @defmac, @defspec, @defvar, @defopt: Specialized, simple + (put 'defun 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defunx 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defmac 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defmacx 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defspec 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defspecx 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defvar 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defvarx 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defopt 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (put 'defoptx 'texinfo-deffn-formatting-property + 'texinfo-format-specialized-defun) + (defun texinfo-format-specialized-defun (parsed-args) + ;; Specialized function-like or variable-like entity: + ;; @defun name args In Info, `Function: Name ARGS' + ;; @defmac name args In Info, `Macro: Name ARGS' + ;; @defvar name In Info, `Variable: Name' + ;; Use cdr of command-type to determine category: + (let ((category (car (cdr command-type))) + (name (car parsed-args)) + (args (cdr parsed-args))) + (insert " -- " category ": " name) + (while args + (insert " " + (if (= ?& (aref (car args) 0)) + (car args) + (upcase (car args)))) + (setq args (cdr args))))) + + ;; @deftypefn, @deftypevr: Generalized typed + (put 'deftypefn 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) + (put 'deftypefnx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) + (put 'deftypevr 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) + (put 'deftypevrx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn) + (defun texinfo-format-deftypefn (parsed-args) + ;; Generalized typed-function-like or typed-variable-like entity: + ;; @deftypefn category data-type name args... + ;; In Info, `Category: data-type name args...' + ;; @deftypevr category data-type name + ;; In Info, `Category: data-type name' + ;; Note: args in lower case, unless modified in command line. + (let ((category (car parsed-args)) + (data-type (car (cdr parsed-args))) + (name (car (cdr (cdr parsed-args)))) + (args (cdr (cdr (cdr parsed-args))))) + (insert " -- " category ": " data-type " " name) + (while args + (insert " " (car args)) + (setq args (cdr args))))) + + ;; @deftypefun, @deftypevar: Specialized typed + (put 'deftypefun 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun) + (put 'deftypefunx 'texinfo-deffn-formatting-property + 'texinfo-format-deftypefun) + (put 'deftypevar 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun) + (put 'deftypevarx 'texinfo-deffn-formatting-property + 'texinfo-format-deftypefun) + (defun texinfo-format-deftypefun (parsed-args) + ;; Specialized typed-function-like or typed-variable-like entity: + ;; @deftypefun data-type name args... + ;; In Info, `Function: data-type name ARGS' + ;; @deftypevar data-type name + ;; In Info, `Variable: data-type name' + ;; Note: args in lower case, unless modified in command line. + ;; Use cdr of command-type to determine category: + (let ((category (car (cdr command-type))) + (data-type (car parsed-args)) + (name (car (cdr parsed-args))) + (args (cdr (cdr parsed-args)))) + (insert " -- " category ": " data-type " " name) + (while args + (insert " " (car args)) + (setq args (cdr args))))) + + ;; @defop: Generalized object-oriented + (put 'defop 'texinfo-deffn-formatting-property 'texinfo-format-defop) + (put 'defopx 'texinfo-deffn-formatting-property 'texinfo-format-defop) + (defun texinfo-format-defop (parsed-args) + ;; Generalized object oriented entity: + ;; @defop category class name args... + ;; In Info, `Category on class: name ARG' + ;; Note: args in upper case; use of `on' + (let ((category (car parsed-args)) + (class (car (cdr parsed-args))) + (name (car (cdr (cdr parsed-args)))) + (args (cdr (cdr (cdr parsed-args))))) + (insert " -- " category " on " class ": " name) + (while args + (insert " " (upcase (car args))) + (setq args (cdr args))))) + + ;; @defcv: Generalized object-oriented + (put 'defcv 'texinfo-deffn-formatting-property 'texinfo-format-defcv) + (put 'defcvx 'texinfo-deffn-formatting-property 'texinfo-format-defcv) + (defun texinfo-format-defcv (parsed-args) + ;; Generalized object oriented entity: + ;; @defcv category class name + ;; In Info, `Category of class: name' + ;; Note: args in upper case; use of `of' + (let ((category (car parsed-args)) + (class (car (cdr parsed-args))) + (name (car (cdr (cdr parsed-args)))) + (args (cdr (cdr (cdr parsed-args))))) + (insert " -- " category " of " class ": " name) + (while args + (insert " " (upcase (car args))) + (setq args (cdr args))))) + + ;; @defmethod: Specialized object-oriented + (put 'defmethod 'texinfo-deffn-formatting-property 'texinfo-format-defmethod) + (put 'defmethodx 'texinfo-deffn-formatting-property 'texinfo-format-defmethod) + (defun texinfo-format-defmethod (parsed-args) + ;; Specialized object oriented entity: + ;; @defmethod class name args... + ;; In Info, `Method on class: name ARGS' + ;; Note: args in upper case; use of `on' + ;; Use cdr of command-type to determine category: + (let ((category (car (cdr command-type))) + (class (car parsed-args)) + (name (car (cdr parsed-args))) + (args (cdr (cdr parsed-args)))) + (insert " -- " category " on " class ": " name) + (while args + (insert " " (upcase (car args))) + (setq args (cdr args))))) + + ;; @defivar: Specialized object-oriented + (put 'defivar 'texinfo-deffn-formatting-property 'texinfo-format-defivar) + (put 'defivarx 'texinfo-deffn-formatting-property 'texinfo-format-defivar) + (defun texinfo-format-defivar (parsed-args) + ;; Specialized object oriented entity: + ;; @defivar class name + ;; In Info, `Instance variable of class: name' + ;; Note: args in upper case; use of `of' + ;; Use cdr of command-type to determine category: + (let ((category (car (cdr command-type))) + (class (car parsed-args)) + (name (car (cdr parsed-args))) + (args (cdr (cdr parsed-args)))) + (insert " -- " category " of " class ": " name) + (while args + (insert " " (upcase (car args))) + (setq args (cdr args))))) + + + ;;; Indexing for definitions + + ;; An index entry has three parts: the `entry proper', the node name, and the + ;; line number. Depending on the which command is used, the entry is + ;; formatted differently: + ;; + ;; @defun, + ;; @defmac, + ;; @defspec, + ;; @defvar, + ;; @defopt all use their 1st argument as the entry-proper + ;; + ;; @deffn, + ;; @defvr, + ;; @deftp + ;; @deftypefun + ;; @deftypevar all use their 2nd argument as the entry-proper + ;; + ;; @deftypefn, + ;; @deftypevr both use their 3rd argument as the entry-proper + ;; + ;; @defmethod uses its 2nd and 1st arguments as an entry-proper + ;; formatted: NAME on CLASS + + ;; @defop uses its 3rd and 2nd arguments as an entry-proper + ;; formatted: NAME on CLASS + ;; + ;; @defivar uses its 2nd and 1st arguments as an entry-proper + ;; formatted: NAME of CLASS + ;; + ;; @defcv uses its 3rd and 2nd argument as an entry-proper + ;; formatted: NAME of CLASS + + (put 'defun 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defunx 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defmac 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defmacx 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defspec 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defspecx 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defvar 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defvarx 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defopt 'texinfo-defun-indexing-property 'texinfo-index-defun) + (put 'defoptx 'texinfo-defun-indexing-property 'texinfo-index-defun) + (defun texinfo-index-defun (parsed-args) + ;; use 1st parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (car parsed-args) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + (put 'deffn 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deffnx 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'defvr 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'defvrx 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deftp 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deftpx 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deftypefun 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deftypefunx 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deftypevar 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (put 'deftypevarx 'texinfo-defun-indexing-property 'texinfo-index-deffn) + (defun texinfo-index-deffn (parsed-args) + ;; use 2nd parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (car (cdr parsed-args)) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + (put 'deftypefn 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) + (put 'deftypefnx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) + (put 'deftypevr 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) + (put 'deftypevrx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn) + (defun texinfo-index-deftypefn (parsed-args) + ;; use 3rd parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (car (cdr (cdr parsed-args))) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + (put 'defmethod 'texinfo-defun-indexing-property 'texinfo-index-defmethod) + (put 'defmethodx 'texinfo-defun-indexing-property 'texinfo-index-defmethod) + (defun texinfo-index-defmethod (parsed-args) + ;; use 2nd on 1st parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (format "%s on %s" + (car (cdr parsed-args)) + (car parsed-args)) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + (put 'defop 'texinfo-defun-indexing-property 'texinfo-index-defop) + (put 'defopx 'texinfo-defun-indexing-property 'texinfo-index-defop) + (defun texinfo-index-defop (parsed-args) + ;; use 3rd on 2nd parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (format "%s on %s" + (car (cdr (cdr parsed-args))) + (car (cdr parsed-args))) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + (put 'defivar 'texinfo-defun-indexing-property 'texinfo-index-defivar) + (put 'defivarx 'texinfo-defun-indexing-property 'texinfo-index-defivar) + (defun texinfo-index-defivar (parsed-args) + ;; use 2nd of 1st parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (format "%s of %s" + (car (cdr parsed-args)) + (car parsed-args)) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + (put 'defcv 'texinfo-defun-indexing-property 'texinfo-index-defcv) + (put 'defcvx 'texinfo-defun-indexing-property 'texinfo-index-defcv) + (defun texinfo-index-defcv (parsed-args) + ;; use 3rd of 2nd parsed-arg as entry-proper + ;; `index-list' will be texinfo-findex or the like + (let ((index-list (get texinfo-command-name 'texinfo-defun-index))) + (set index-list + (cons + ;; Three elements: entry-proper, node-name, line-number + (list + (format "%s of %s" + (car (cdr (cdr parsed-args))) + (car (cdr parsed-args))) + texinfo-last-node + ;; Region formatting may not provide last node position. + (if texinfo-last-node-pos + (1+ (count-lines texinfo-last-node-pos (point))) + 1)) + (symbol-value index-list))))) + + + ;;; Properties for definitions + + ;; Each definition command has six properties: + ;; + ;; 1. texinfo-deffn-formatting-property to format definition line + ;; 2. texinfo-defun-indexing-property to create index entry + ;; 3. texinfo-format formatting command + ;; 4. texinfo-end end formatting command + ;; 5. texinfo-defun-type type of deffn to format + ;; 6. texinfo-defun-index type of index to use + ;; + ;; The `x' forms of each definition command are used for the second + ;; and subsequent header lines. + + ;; The texinfo-deffn-formatting-property and texinfo-defun-indexing-property + ;; are listed just before the appropriate formatting and indexing commands. + + (put 'deffn 'texinfo-format 'texinfo-format-defun) + (put 'deffnx 'texinfo-format 'texinfo-format-defunx) + (put 'deffn 'texinfo-end 'texinfo-end-defun) + (put 'deffn 'texinfo-defun-type '('deffn-type nil)) + (put 'deffnx 'texinfo-defun-type '('deffn-type nil)) + (put 'deffn 'texinfo-defun-index 'texinfo-findex) + (put 'deffnx 'texinfo-defun-index 'texinfo-findex) + + (put 'defun 'texinfo-format 'texinfo-format-defun) + (put 'defunx 'texinfo-format 'texinfo-format-defunx) + (put 'defun 'texinfo-end 'texinfo-end-defun) + (put 'defun 'texinfo-defun-type '('defun-type "Function")) + (put 'defunx 'texinfo-defun-type '('defun-type "Function")) + (put 'defun 'texinfo-defun-index 'texinfo-findex) + (put 'defunx 'texinfo-defun-index 'texinfo-findex) + + (put 'defmac 'texinfo-format 'texinfo-format-defun) + (put 'defmacx 'texinfo-format 'texinfo-format-defunx) + (put 'defmac 'texinfo-end 'texinfo-end-defun) + (put 'defmac 'texinfo-defun-type '('defun-type "Macro")) + (put 'defmacx 'texinfo-defun-type '('defun-type "Macro")) + (put 'defmac 'texinfo-defun-index 'texinfo-findex) + (put 'defmacx 'texinfo-defun-index 'texinfo-findex) + + (put 'defspec 'texinfo-format 'texinfo-format-defun) + (put 'defspecx 'texinfo-format 'texinfo-format-defunx) + (put 'defspec 'texinfo-end 'texinfo-end-defun) + (put 'defspec 'texinfo-defun-type '('defun-type "Special form")) + (put 'defspecx 'texinfo-defun-type '('defun-type "Special form")) + (put 'defspec 'texinfo-defun-index 'texinfo-findex) + (put 'defspecx 'texinfo-defun-index 'texinfo-findex) + + (put 'defvr 'texinfo-format 'texinfo-format-defun) + (put 'defvrx 'texinfo-format 'texinfo-format-defunx) + (put 'defvr 'texinfo-end 'texinfo-end-defun) + (put 'defvr 'texinfo-defun-type '('deffn-type nil)) + (put 'defvrx 'texinfo-defun-type '('deffn-type nil)) + (put 'defvr 'texinfo-defun-index 'texinfo-vindex) + (put 'defvrx 'texinfo-defun-index 'texinfo-vindex) + + (put 'defvar 'texinfo-format 'texinfo-format-defun) + (put 'defvarx 'texinfo-format 'texinfo-format-defunx) + (put 'defvar 'texinfo-end 'texinfo-end-defun) + (put 'defvar 'texinfo-defun-type '('defun-type "Variable")) + (put 'defvarx 'texinfo-defun-type '('defun-type "Variable")) + (put 'defvar 'texinfo-defun-index 'texinfo-vindex) + (put 'defvarx 'texinfo-defun-index 'texinfo-vindex) + + (put 'defconst 'texinfo-format 'texinfo-format-defun) + (put 'defconstx 'texinfo-format 'texinfo-format-defunx) + (put 'defconst 'texinfo-end 'texinfo-end-defun) + (put 'defconst 'texinfo-defun-type '('defun-type "Constant")) + (put 'defconstx 'texinfo-defun-type '('defun-type "Constant")) + (put 'defconst 'texinfo-defun-index 'texinfo-vindex) + (put 'defconstx 'texinfo-defun-index 'texinfo-vindex) + + (put 'defcmd 'texinfo-format 'texinfo-format-defun) + (put 'defcmdx 'texinfo-format 'texinfo-format-defunx) + (put 'defcmd 'texinfo-end 'texinfo-end-defun) + (put 'defcmd 'texinfo-defun-type '('defun-type "Command")) + (put 'defcmdx 'texinfo-defun-type '('defun-type "Command")) + (put 'defcmd 'texinfo-defun-index 'texinfo-findex) + (put 'defcmdx 'texinfo-defun-index 'texinfo-findex) + + (put 'defopt 'texinfo-format 'texinfo-format-defun) + (put 'defoptx 'texinfo-format 'texinfo-format-defunx) + (put 'defopt 'texinfo-end 'texinfo-end-defun) + (put 'defopt 'texinfo-defun-type '('defun-type "User Option")) + (put 'defoptx 'texinfo-defun-type '('defun-type "User Option")) + (put 'defopt 'texinfo-defun-index 'texinfo-vindex) + (put 'defoptx 'texinfo-defun-index 'texinfo-vindex) + + (put 'deftp 'texinfo-format 'texinfo-format-defun) + (put 'deftpx 'texinfo-format 'texinfo-format-defunx) + (put 'deftp 'texinfo-end 'texinfo-end-defun) + (put 'deftp 'texinfo-defun-type '('deftp-type nil)) + (put 'deftpx 'texinfo-defun-type '('deftp-type nil)) + (put 'deftp 'texinfo-defun-index 'texinfo-tindex) + (put 'deftpx 'texinfo-defun-index 'texinfo-tindex) + + ;;; Object-oriented stuff is a little hairier. + + (put 'defop 'texinfo-format 'texinfo-format-defun) + (put 'defopx 'texinfo-format 'texinfo-format-defunx) + (put 'defop 'texinfo-end 'texinfo-end-defun) + (put 'defop 'texinfo-defun-type '('defop-type nil)) + (put 'defopx 'texinfo-defun-type '('defop-type nil)) + (put 'defop 'texinfo-defun-index 'texinfo-findex) + (put 'defopx 'texinfo-defun-index 'texinfo-findex) + + (put 'defmethod 'texinfo-format 'texinfo-format-defun) + (put 'defmethodx 'texinfo-format 'texinfo-format-defunx) + (put 'defmethod 'texinfo-end 'texinfo-end-defun) + (put 'defmethod 'texinfo-defun-type '('defmethod-type "Method")) + (put 'defmethodx 'texinfo-defun-type '('defmethod-type "Method")) + (put 'defmethod 'texinfo-defun-index 'texinfo-findex) + (put 'defmethodx 'texinfo-defun-index 'texinfo-findex) + + (put 'defcv 'texinfo-format 'texinfo-format-defun) + (put 'defcvx 'texinfo-format 'texinfo-format-defunx) + (put 'defcv 'texinfo-end 'texinfo-end-defun) + (put 'defcv 'texinfo-defun-type '('defop-type nil)) + (put 'defcvx 'texinfo-defun-type '('defop-type nil)) + (put 'defcv 'texinfo-defun-index 'texinfo-vindex) + (put 'defcvx 'texinfo-defun-index 'texinfo-vindex) + + (put 'defivar 'texinfo-format 'texinfo-format-defun) + (put 'defivarx 'texinfo-format 'texinfo-format-defunx) + (put 'defivar 'texinfo-end 'texinfo-end-defun) + (put 'defivar 'texinfo-defun-type '('defmethod-type "Instance variable")) + (put 'defivarx 'texinfo-defun-type '('defmethod-type "Instance variable")) + (put 'defivar 'texinfo-defun-index 'texinfo-vindex) + (put 'defivarx 'texinfo-defun-index 'texinfo-vindex) + + ;;; Typed functions and variables + + (put 'deftypefn 'texinfo-format 'texinfo-format-defun) + (put 'deftypefnx 'texinfo-format 'texinfo-format-defunx) + (put 'deftypefn 'texinfo-end 'texinfo-end-defun) + (put 'deftypefn 'texinfo-defun-type '('deftypefn-type nil)) + (put 'deftypefnx 'texinfo-defun-type '('deftypefn-type nil)) + (put 'deftypefn 'texinfo-defun-index 'texinfo-findex) + (put 'deftypefnx 'texinfo-defun-index 'texinfo-findex) + + (put 'deftypefun 'texinfo-format 'texinfo-format-defun) + (put 'deftypefunx 'texinfo-format 'texinfo-format-defunx) + (put 'deftypefun 'texinfo-end 'texinfo-end-defun) + (put 'deftypefun 'texinfo-defun-type '('deftypefun-type "Function")) + (put 'deftypefunx 'texinfo-defun-type '('deftypefun-type "Function")) + (put 'deftypefun 'texinfo-defun-index 'texinfo-findex) + (put 'deftypefunx 'texinfo-defun-index 'texinfo-findex) + + (put 'deftypevr 'texinfo-format 'texinfo-format-defun) + (put 'deftypevrx 'texinfo-format 'texinfo-format-defunx) + (put 'deftypevr 'texinfo-end 'texinfo-end-defun) + (put 'deftypevr 'texinfo-defun-type '('deftypefn-type nil)) + (put 'deftypevrx 'texinfo-defun-type '('deftypefn-type nil)) + (put 'deftypevr 'texinfo-defun-index 'texinfo-vindex) + (put 'deftypevrx 'texinfo-defun-index 'texinfo-vindex) + + (put 'deftypevar 'texinfo-format 'texinfo-format-defun) + (put 'deftypevarx 'texinfo-format 'texinfo-format-defunx) + (put 'deftypevar 'texinfo-end 'texinfo-end-defun) + (put 'deftypevar 'texinfo-defun-type '('deftypevar-type "Variable")) + (put 'deftypevarx 'texinfo-defun-type '('deftypevar-type "Variable")) + (put 'deftypevar 'texinfo-defun-index 'texinfo-vindex) + (put 'deftypevarx 'texinfo-defun-index 'texinfo-vindex) + + + ;;; @set, @clear, @ifset, @ifclear + + ;; If a flag is set with @set FLAG, then text between @ifset and @end + ;; ifset is formatted normally, but if the flag is is cleared with + ;; @clear FLAG, then the text is not formatted; it is ignored. + + ;; If a flag is cleared with @clear FLAG, then text between @ifclear + ;; and @end ifclear is formatted normally, but if the flag is is set with + ;; @set FLAG, then the text is not formatted; it is ignored. @ifclear + ;; is the opposite of @ifset. + + ;; If a flag is set to a string with @set FLAG, + ;; replace @value{FLAG} with the string. + ;; If a flag with a value is cleared, + ;; @value{FLAG} is invalid, + ;; as if there had never been any @set FLAG previously. + + (put 'clear 'texinfo-format 'texinfo-clear) + (defun texinfo-clear () + "Clear the value of the flag." + (let* ((arg (texinfo-parse-arg-discard)) + (flag (car (read-from-string arg))) + (value (substring arg (cdr (read-from-string arg))))) + (put flag 'texinfo-whether-setp 'flag-cleared) + (put flag 'texinfo-set-value ""))) + + (put 'set 'texinfo-format 'texinfo-set) + (defun texinfo-set () + "Set the value of the flag, optionally to a string. + The command `@set foo This is a string.' + sets flag foo to the value: `This is a string.' + The command `@value{foo}' expands to the value." + (let* ((arg (texinfo-parse-arg-discard)) + (flag (car (read-from-string arg))) + (value (substring arg (cdr (read-from-string arg))))) + (put flag 'texinfo-whether-setp 'flag-set) + (put flag 'texinfo-set-value value))) + + (put 'value 'texinfo-format 'texinfo-value) + (defun texinfo-value () + "Insert the string to which the flag is set. + The command `@set foo This is a string.' + sets flag foo to the value: `This is a string.' + The command `@value{foo}' expands to the value." + (let ((arg (texinfo-parse-arg-discard))) + (cond ((and + (eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + 'flag-set) + (get (car (read-from-string arg)) 'texinfo-set-value)) + (insert (get (car (read-from-string arg)) 'texinfo-set-value))) + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + 'flag-cleared) + (insert (format "{No value for \"%s\"}" arg))) + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil) + (insert (format "{No value for \"%s\"}" arg)))))) + + (put 'ifset 'texinfo-end 'texinfo-discard-command) + (put 'ifset 'texinfo-format 'texinfo-if-set) + (defun texinfo-if-set () + "If set, continue formatting; else do not format region up to @end ifset" + (let ((arg (texinfo-parse-arg-discard))) + (cond + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + 'flag-set) + ;; Format the text (i.e., do not remove it); do nothing here. + ()) + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + 'flag-cleared) + ;; Clear region (i.e., cause the text to be ignored). + (delete-region texinfo-command-start + (progn (re-search-forward "@end ifset[ \t]*\n") + (point)))) + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + nil) + (error "@ifset flag `%s' is not defined by @set or @clear." arg))))) + + (put 'ifclear 'texinfo-end 'texinfo-discard-command) + (put 'ifclear 'texinfo-format 'texinfo-if-clear) + (defun texinfo-if-clear () + "If clear, continue formatting; if set, do not format up to @end ifset" + (let ((arg (texinfo-parse-arg-discard))) + (cond + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + 'flag-set) + ;; Clear region (i.e., cause the text to be ignored). + (delete-region texinfo-command-start + (progn (re-search-forward "@end ifclear[ \t]*\n") + (point)))) + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + 'flag-cleared) + ;; Format the text (i.e., do not remove it); do nothing here. + ()) + ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) + nil) + (error "@ifclear flag `%s' is not defined by @clear or @set." arg))))) + + + ;;; Process included files: `@include' command + + ;; Updated 19 October 1990 + ;; In the original version, include files were ignored by Info but + ;; incorporated in to the printed manual. To make references to the + ;; included file, the Texinfo source file has to refer to the included + ;; files using the `(filename)nodename' format for refering to other + ;; Info files. Also, the included files had to be formatted on their + ;; own. It was just like they were another file. + + ;; Currently, include files are inserted into the buffer that is + ;; formatted for Info. If large, the resulting info file is split and + ;; tagified. For current include files to work, the master menu must + ;; refer to all the nodes, and the highest level nodes in the include + ;; files must have the correct next, prev, and up pointers. + + ;; The included file may have an @setfilename and even an @settitle, + ;; but not an `\input texinfo' line. + + ;; Updated 24 March 1993 + ;; In order for @raisesections and @lowersections to work, included + ;; files must be inserted into the buffer holding the outer file + ;; before other Info formatting takes place. So @include is no longer + ;; is treated like other @-commands. + (put 'include 'texinfo-format 'texinfo-format-noop) + + ; Original definition: + ; (defun texinfo-format-include () + ; (let ((filename (texinfo-parse-arg-discard)) + ; (default-directory input-directory) + ; subindex) + ; (setq subindex + ; (save-excursion + ; (progn (find-file + ; (cond ((file-readable-p (concat filename ".texinfo")) + ; (concat filename ".texinfo")) + ; ((file-readable-p (concat filename ".texi")) + ; (concat filename ".texi")) + ; ((file-readable-p (concat filename ".tex")) + ; (concat filename ".tex")) + ; ((file-readable-p filename) + ; filename) + ; (t (error "@include'd file %s not found" + ; filename)))) + ; (texinfo-format-buffer-1)))) + ; (texinfo-subindex 'texinfo-vindex (car subindex) (nth 1 subindex)) + ; (texinfo-subindex 'texinfo-findex (car subindex) (nth 2 subindex)) + ; (texinfo-subindex 'texinfo-cindex (car subindex) (nth 3 subindex)) + ; (texinfo-subindex 'texinfo-pindex (car subindex) (nth 4 subindex)) + ; (texinfo-subindex 'texinfo-tindex (car subindex) (nth 5 subindex)) + ; (texinfo-subindex 'texinfo-kindex (car subindex) (nth 6 subindex)))) + ; + ;(defun texinfo-subindex (indexvar file content) + ; (set indexvar (cons (list 'recurse file content) + ; (symbol-value indexvar)))) + + ; Second definition: + ; (put 'include 'texinfo-format 'texinfo-format-include) + ; (defun texinfo-format-include () + ; (let ((filename (concat input-directory + ; (texinfo-parse-arg-discard))) + ; (default-directory input-directory)) + ; (message "Reading: %s" filename) + ; (save-excursion + ; (save-restriction + ; (narrow-to-region + ; (point) + ; (+ (point) (car (cdr (insert-file-contents filename))))) + ; (goto-char (point-min)) + ; (texinfo-append-refill) + ; (texinfo-format-convert (point-min) (point-max)))) + ; (setq last-input-buffer input-buffer) ; to bypass setfilename + ; )) + + + ;;; Numerous commands do nothing in Texinfo + + ;; These commands are defined in texinfo.tex for printed output. + + (put 'bye 'texinfo-format 'texinfo-discard-line) + (put 'c 'texinfo-format 'texinfo-discard-line-with-args) + (put 'comment 'texinfo-format 'texinfo-discard-line-with-args) + (put 'contents 'texinfo-format 'texinfo-discard-line-with-args) + (put 'finalout 'texinfo-format 'texinfo-discard-line) + (put 'group 'texinfo-end 'texinfo-discard-line-with-args) + (put 'group 'texinfo-format 'texinfo-discard-line-with-args) + (put 'headings 'texinfo-format 'texinfo-discard-line-with-args) + (put 'hsize 'texinfo-format 'texinfo-discard-line-with-args) + (put 'itemindent 'texinfo-format 'texinfo-discard-line-with-args) + (put 'lispnarrowing 'texinfo-format 'texinfo-discard-line-with-args) + (put 'need 'texinfo-format 'texinfo-discard-line-with-args) + (put 'nopara 'texinfo-format 'texinfo-discard-line-with-args) + (put 'page 'texinfo-format 'texinfo-discard-line-with-args) + (put 'parindent 'texinfo-format 'texinfo-discard-line-with-args) + (put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args) + (put 'setq 'texinfo-format 'texinfo-discard-line-with-args) + (put 'settitle 'texinfo-format 'texinfo-discard-line-with-args) + (put 'setx 'texinfo-format 'texinfo-discard-line-with-args) + (put 'shortcontents 'texinfo-format 'texinfo-discard-line-with-args) + (put 'smallbook 'texinfo-format 'texinfo-discard-line) + (put 'summarycontents 'texinfo-format 'texinfo-discard-line-with-args) + + + ;;; Some commands cannot be handled + + (defun texinfo-unsupported () + (error "%s is not handled by texinfo" + (buffer-substring texinfo-command-start texinfo-command-end))) + + ;;; Batch formatting + + (defun batch-texinfo-format () + "Runs texinfo-format-buffer on the files remaining on the command line. + Must be used only with -batch, and kills emacs on completion. + Each file will be processed even if an error occurred previously. + For example, invoke + \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"." + (if (not noninteractive) + (error "batch-texinfo-format may only be used -batch.")) + (let ((version-control t) + (auto-save-default nil) + (find-file-run-dired nil) + (kept-old-versions 259259) + (kept-new-versions 259259)) + (let ((error 0) + file + (files ())) + (while command-line-args-left + (setq file (expand-file-name (car command-line-args-left))) + (cond ((not (file-exists-p file)) + (message ">> %s does not exist!" file) + (setq error 1 + command-line-args-left (cdr command-line-args-left))) + ((file-directory-p file) + (setq command-line-args-left + (nconc (directory-files file) + (cdr command-line-args-left)))) + (t + (setq files (cons file files) + command-line-args-left (cdr command-line-args-left))))) + (while files + (setq file (car files) + files (cdr files)) + (condition-case err + (progn + (if buffer-file-name (kill-buffer (current-buffer))) + (find-file file) + (buffer-flush-undo (current-buffer)) + (set-buffer-modified-p nil) + (texinfo-mode) + (message "texinfo formatting %s..." file) + (texinfo-format-buffer nil) + (if (buffer-modified-p) + (progn (message "Saving modified %s" (buffer-file-name)) + (save-buffer)))) + (error + (message ">> Error: %s" (prin1-to-string err)) + (message ">> point at") + (let ((s (buffer-substring (point) + (min (+ (point) 100) + (point-max)))) + (tem 0)) + (while (setq tem (string-match "\n+" s tem)) + (setq s (concat (substring s 0 (match-beginning 0)) + "\n>> " + (substring s (match-end 0))) + tem (1+ tem))) + (message ">> %s" s)) + (setq error 1)))) + (kill-emacs error)))) + + + ;;; Place `provide' at end of file. + (provide 'texinfmt) + + ;;; texinfmt.el ends here. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/time-stamp.el emacs-19.18/lisp/time-stamp.el *** emacs-19.17/lisp/time-stamp.el Mon Jun 21 01:06:06 1993 --- emacs-19.18/lisp/time-stamp.el Wed Jul 28 19:50:39 1993 *************** *** 26,30 **** ;;; time-stamp.el for a sample. The template looks like one of the following: ;;; Time-stamp: <> ! ;;; Time-stamp: "" ;;; The time stamp is written between the brackets or quotes, resulting in ;;; Time-stamp: <93/06/18 10:26:51 gildea> --- 26,30 ---- ;;; time-stamp.el for a sample. The template looks like one of the following: ;;; Time-stamp: <> ! ;;; Time-stamp: " " ;;; The time stamp is written between the brackets or quotes, resulting in ;;; Time-stamp: <93/06/18 10:26:51 gildea> *************** *** 83,86 **** --- 83,87 ---- then writes the time stamp specified by time-stamp-format between them.") + ;;;###autoload (defun time-stamp () "Update the time stamp string in the buffer. diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/tpu-doc.el emacs-19.18/lisp/tpu-doc.el *** emacs-19.17/lisp/tpu-doc.el --- emacs-19.18/lisp/tpu-doc.el Mon Aug 9 02:17:33 1993 *************** *** 0 **** --- 1,467 ---- + ;;; tpu-doc.el --- Documentation for TPU-edt + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Rob Riepel + ;; Maintainer: Rob Riepel + ;; Keywords: tpu-edt + + ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + ;;; Revision: $Id: tpu-doc.el,v 1.3 1993/08/09 06:17:30 rms Exp $ + (defconst tpu-doc-revision "$Revision: 1.3 $" + "TPU-edt documentation revision number.") + + + ;; This is documentation for the TPU-edt editor for GNU emacs. Major + ;; sections of this document are separated with lines that begin with + ;; ";; %% ", where is what is discussed in that section. + + + ;; %% Contents + + ;; % Introduction + ;; % Terminal Support + ;; % X-windows Support + ;; % Differences Between TPU-edt and the Real Thing + ;; % Starting TPU-edt + ;; % TPU-edt Default Editing Keypad, Control and Gold Key Bindings + ;; % Optional TPU-edt Extensions + ;; % Customizing TPU-edt using the Emacs Initialization File + ;; % Compiling TPU-edt + ;; % Regular expressions in TPU-edt + ;; % Etcetera + + + ;; %% Introduction + + ;; TPU-edt is based on tpu.el by Jeff Kowalski. TPU-edt endeavors + ;; to be even more like TPU's EDT emulation than the original tpu.el. + ;; Considerable effort has been expended to that end. Still, emacs + ;; is emacs and there are differences between TPU-edt and the real + ;; thing. Please read the "Differences Between TPU-edt and the Real + ;; Thing" and "Starting TPU-edt" sections before running TPU-edt. + + + ;; %% Terminal Support + + ;; TPU-edt, like it's VMS cousin, works on VT-series terminals with + ;; DEC style keyboards. VT terminal emulators, including xterm with + ;; the appropriate key translations, work just fine too. + + + ;; %% X-windows Support + + ;; Starting with version 19 of emacs, TPU-edt works with X-windows. + ;; This is accomplished through a TPU-edt X keymap. The emacs lisp + ;; program tpu-mapper.el creates this map and stores it in a file. + ;; Tpu-mapper will be run automatically the first time you invoke + ;; the X-windows version of emacs, or you can run it by hand. See + ;; the commentary in tpu-mapper.el for details. + + + ;; %% Differences Between TPU-edt and the Real Thing (not Coke (r)) + + ;; Emacs (version 18.58) doesn't support text highlighting, so selected + ;; regions are not shown in inverse video. Emacs uses the concept of + ;; "the mark". The mark is set at one end of a selected region; the + ;; cursor is at the other. The letter "M" appears in the mode line + ;; when the mark is set. The native emacs command ^X^X (Control-X + ;; twice) exchanges the cursor with the mark; this provides a handy + ;; way to find the location of the mark. + + ;; In TPU the cursor can be either bound or free. Bound means the + ;; cursor cannot wander outside the text of the file being edited. + ;; Free means the arrow keys can move the cursor past the ends of + ;; lines. Free is the default mode in TPU; bound is the only mode + ;; in EDT. Bound is the only mode in the base version of TPU-edt; + ;; optional extensions add an approximation of free mode. + + ;; Like TPU, emacs uses multiple buffers. Some buffers are used to + ;; hold files you are editing; other "internal" buffers are used for + ;; emacs' own purposes (like showing you help). Here are some commands + ;; for dealing with buffers. + + ;; Gold-B moves to next buffer, including internal buffers + ;; Gold-N moves to next buffer containing a file + ;; Gold-M brings up a buffer menu (like TPU "show buffers") + + ;; Emacs is very fond of throwing up new windows. Dealing with all + ;; these windows can be a little confusing at first, so here are a few + ;; commands to that may help: + + ;; Gold-Next_Scr moves to the next window on the screen + ;; Gold-Prev_Scr moves to the previous window on the screen + ;; Gold-TAB also moves to the next window on the screen + + ;; Control-x 1 deletes all but the current window + ;; Control-x 0 deletes the current window + + ;; Note that the buffers associated with deleted windows still exist! + + ;; Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or + ;; Do. Most of the commands available are emacs commands. Some TPU + ;; commands are available, they are: replace, exit, quit, include, and + ;; Get (unfortunately, "get" is an internal emacs function, so we are + ;; stuck with "Get" - to make life easier, Get is available as Gold-g). + + ;; Support for recall of commands, file names, and search strings was + ;; added to emacs in version 19. For version 18 of emacs, optional + ;; extensions are available to add this recall capability (see "Optional + ;; TPU-edt Extensions" below). The history of strings recalled in both + ;; versions of emacs differs slightly from TPU/edt, but it is still very + ;; convenient. + + ;; Help is available! The traditional help keys (Help and PF2) display + ;; a three page help file showing the default keypad layout, control key + ;; functions, and Gold key functions. Pressing any key inside of help + ;; splits the screen and prints a description of the function of the + ;; pressed key. Gold-PF2 invokes the native emacs help, with it's + ;; zillions of options. Gold-Help shows all the current key bindings. + + ;; Thanks to emacs, TPU-edt has some extensions that may make your life + ;; easier, or at least more interesting. For example, Gold-r toggles + ;; TPU-edt rectangular mode. In rectangular mode, Remove and Insert work + ;; on rectangles. Likewise, Gold-* toggles TPU-edt regular expression + ;; mode. In regular expression mode Find, Find Next, and the line-mode + ;; replace command work with regular expressions. [A regular expression + ;; is a pattern that denotes a set of strings; like VMS wildcards.] + + ;; Emacs also gives TPU-edt the undo and occur functions. Undo does + ;; what it says; it undoes the last change. Multiple undos in a row + ;; undo multiple changes. For your convenience, undo is available on + ;; Gold-u. Occur shows all the lines containing a specific string in + ;; another window. Moving to that window, and typing ^C^C (Control-C + ;; twice) on a particular line moves you back to the original window + ;; at that line. Occur is on Gold-o. + + ;; Finally, as you edit, remember that all the power of emacs is at + ;; your disposal. It really is a fantastic tool. You may even want to + ;; take some time and read the emacs tutorial; perhaps not to learn the + ;; native emacs key bindings, but to get a feel for all the things + ;; emacs can do for you. The emacs tutorial is available from the + ;; emacs help function: "Gold-PF2 t" + + + ;; %% Starting TPU-edt + + ;; In order to use TPU-edt, the TPU-edt editor definitions, contained + ;; in tpu-edt.el, need to be loaded when emacs is run. This can be + ;; done in a couple of ways. The first is by explicitly requesting + ;; loading of the TPU-edt emacs definition file on the command line: + + ;; prompt> emacs -l /path/to/definitions/tpu-edt.el + + ;; If TPU-edt is installed on your system, that is, if tpu-edt.el is in + ;; a directory like /usr/local/emacs/lisp, along with dozens of other + ;; .el files, you should be able to use the command: + + ;; prompt> emacs -l tpu-edt + + ;; If you like TPU-edt and want to use it all the time, you can load + ;; the TPU-edt definitions using the emacs initialization file, .emacs. + ;; Simply create a .emacs file in your home directory containing the + ;; line: + + ;; (load "/path/to/definitions/tpu-edt") + + ;; or, if (as above) TPU-edt is installed on your system: + + ;; (load "tpu-edt") + + ;; Once TPU-edt has been loaded, you will be using an editor with the + ;; interface shown in the next section (A section that is suitable for + ;; cutting out of this document and pasting next to your terminal!). + + + ;; %% TPU-edt Default Editing Keypad, Control and Gold Key Bindings + ;; + ;; _______________________ _______________________________ + ;; | HELP | Do | | | | | | + ;; |KeyDefs| | | | | | | + ;; |_______|_______________| |_______|_______|_______|_______| + ;; _______________________ _______________________________ + ;; | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | + ;; | | |Sto Tex| | key |E-Help | Find |Undel L| + ;; |_______|_______|_______| |_______|_______|_______|_______| + ;; |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | + ;; | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| + ;; |_______|_______|_______| |_______|_______|_______|_______| + ;; |Move up| |Forward|Reverse|Remove | Del C | + ;; | Top | |Bottom | Top |Insert |Undel C| + ;; _______|_______|_______ |_______|_______|_______|_______| + ;; |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | + ;; |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | + ;; |_______|_______|_______| |_______|_______|_______| | + ;; | Line |Select | Subs | + ;; | Open Line | Reset | | + ;; |_______________|_______|_______| + ;; Control Characters + ;; + ;; ^A toggle insert and overwrite ^L insert page break + ;; ^B recall ^R remember, re-center + ;; ^E end of line ^U delete to beginning of line + ;; ^G cancel current operation ^V quote + ;; ^H beginning of line ^W refresh + ;; ^J delete previous word ^Z exit + ;; ^K learn ^X^X exchange point and mark + ;; + ;; + ;; Gold- Functions + ;; ----------------------------------------------------------------- + ;; W Write - save current buffer + ;; K Kill buffer - abandon edits and delete buffer + ;; + ;; E Exit - save current buffer and ask about others + ;; X eXit - save all modified buffers and exit + ;; Q Quit - exit without saving anything + ;; + ;; G Get - load a file into a new edit buffer + ;; I Include - include a file in this buffer + ;; + ;; B next Buffer - display the next buffer (all buffers) + ;; N Next file buffer - display next buffer containing a file + ;; M buffer Menu - display a list of all buffers + ;; + ;; U Undo - undo the last edit + ;; C Recall - edit and possibly repeat previous commands + ;; + ;; O Occur - show following lines containing REGEXP + ;; S Search and substitute - line mode REPLACE command + ;; + ;; ? Spell check - check spelling in a region or entire buffer + ;; + ;; R Toggle Rectangular mode for remove and insert + ;; * Toggle regular expression mode for search and substitute + ;; + ;; V Show TPU-edt version + ;; ----------------------------------------------------------------- + + + ;; %% Optional TPU-edt Extensions + + ;; Several optional packages have been included in this distribution + ;; of TPU-edt. The following is a brief description of each package. + ;; See the {package}.el file for more detailed information and usage + ;; instructions. + + ;; tpu-extras - TPU/edt scroll margins and free cursor mode. + ;; tpu-recall - String, file name, and command history. + ;; vt-control - VTxxx terminal width and keypad controls. + + ;; Packages are normally loaded from the emacs initialization file + ;; (discussed below). If a package is not installed in the emacs + ;; lisp directory, it can be loaded by specifying the complete path + ;; to the package file. However, it is preferable to modify the + ;; emacs load-path variable to include the directory where packages + ;; are stored. This way, packages can be loaded by name, just as if + ;; they were installed. The first part of the sample .emacs file + ;; below shows how to make such a modification. + + + ;; %% Customizing TPU-edt using the Emacs Initialization File + + ;; .emacs - a sample emacs initialization file + + ;; This is a sample emacs initialization file. It shows how to invoke + ;; TPU-edt, and how to customize it. + + ;; The load-path is where emacs looks for files to fulfill load requests. + ;; If TPU-edt is not installed in a standard emacs directory, the load-path + ;; should be updated to include the directory where the TPU-edt files are + ;; stored. Modify and un-comment the following section if TPU-ed is not + ;; installed on your system - be sure to leave the double quotes! + + ;; (setq load-path + ;; (append (list (expand-file-name "/path/to/tpu-edt/files")) + ;; load-path)) + + ;; Load TPU-edt + (load "tpu-edt") + + ;; Load the optional goodies - scroll margins, free cursor mode, command + ;; and string recall. But don't complain if the file aren't available. + (load "tpu-extras" t) + (load "tpu-recall" t) + + ;; Uncomment this line to set scroll margins 10% (top) and 15% (bottom). + ;(tpu-set-scroll-margins "10%" "15%") + + ;; Load the vtxxx terminal control functions, but don't complain if + ;; if the file is not found. + (load "vt-control" t) + + ;; TPU-edt treats words like EDT; here's how to add word separators. + ;; Note that backslash (\) and double quote (") are quoted with '\'. + (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$") + + ;; Emacs is happy to save files without a final newline; other Unix programs + ;; hate that! This line will make sure that files end with newlines. + (setq require-final-newline t) + + ;; Emacs uses Control-s and Control-q. Problems can occur when using emacs + ;; on terminals that use these codes for flow control (Xon/Xoff flow control). + ;; These lines disable emacs' use of these characters. + (global-unset-key "\C-s") + (global-unset-key "\C-q") + + ;; top, bottom, bol, eol seem like a waste of Gold-arrow functions. The + ;; following section re-maps up and down arrow keys to top and bottom of + ;; screen, and left and right arrow keys to pan left and right (pan-left, + ;; right moves the screen 16 characters left or right - try it, you'll + ;; like it!). + + ;; Re-map the Gold-arrow functions + (define-key GOLD-CSI-map "A" 'tpu-beginning-of-window) ; up-arrow + (define-key GOLD-CSI-map "B" 'tpu-end-of-window) ; down-arrow + (define-key GOLD-CSI-map "C" 'tpu-pan-right) ; right-arrow + (define-key GOLD-CSI-map "D" 'tpu-pan-left) ; left-arrow + (define-key GOLD-SS3-map "A" 'tpu-beginning-of-window) ; up-arrow + (define-key GOLD-SS3-map "B" 'tpu-end-of-window) ; down-arrow + (define-key GOLD-SS3-map "C" 'tpu-pan-right) ; right-arrow + (define-key GOLD-SS3-map "D" 'tpu-pan-left) ; left-arrow + + ;; Re-map the Gold-arrow functions for X-windows TPU-edt (emacs version 19) + (cond + ((and tpu-emacs19-p window-system) + (define-key GOLD-map [up] 'tpu-beginning-of-window) ; up-arrow + (define-key GOLD-map [down] 'tpu-end-of-window) ; down-arrow + (define-key GOLD-map [right] 'tpu-pan-right) ; right-arrow + (define-key GOLD-map [left] 'tpu-pan-left))) ; left-arrow + + ;; The emacs universal-argument function is very useful for native emacs + ;; commands. This line maps universal-argument to Gold-PF1 + (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1 + + ;; Make KP7 move by paragraphs, instead of pages. + (define-key SS3-map "w" 'tpu-paragraph) ; KP7 + + ;; TPU-edt assumes you have the ispell spelling checker; + ;; Un-comment this line if you don't. + ;(setq tpu-have-spell nil) + + ;; Display the TPU-edt version. + (tpu-version) + + ;; End of .emacs - a sample emacs initialization file + + ;; After initialization with the .emacs file shown above, the editing + ;; keys have been re-mapped to look like this: + + ;; _______________________ _______________________________ + ;; | HELP | Do | | | | | | + ;; |KeyDefs| | | | | | | + ;; |_______|_______________| |_______|_______|_______|_______| + ;; _______________________ _______________________________ + ;; | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | + ;; | | |Sto Tex| | U Arg |E-Help | Find |Undel L| + ;; |_______|_______|_______| |_______|_______|_______|_______| + ;; |Select |Pre Scr|Nex Scr| |Paragra| Sect |Append | Del W | + ;; | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| + ;; |_______|_______|_______| |_______|_______|_______|_______| + ;; |Move up| |Forward|Reverse|Remove | Del C | + ;; |Tscreen| |Bottom | Top |Insert |Undel C| + ;; _______|_______|_______ |_______|_______|_______|_______| + ;; |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | + ;; |PanLeft|Bscreen|PanRigh| |ChngCas|Del EOL|SpecIns| Enter | + ;; |_______|_______|_______| |_______|_______|_______| | + ;; | Line |Select | Subs | + ;; | Open Line | Reset | | + ;; |_______________|_______|_______| + + ;; Astute emacs hackers will realize that on systems where TPU-edt is + ;; installed, this documentation file can be loaded to produce the above + ;; editing keypad layout. In fact, to get all the changes in the sample + ;; initialization file, you only need a one line initialization file: + + ;; (load "tpu-doc") + + ;; wow! + + + ;; %% Compiling TPU-edt + + ;; It is not necessary to compile (byte-compile in emacs parlance) + ;; TPU-edt to use it. However, byte-compiled code loads and runs + ;; faster, and takes up less memory when loaded. To byte compile + ;; TPU-edt, use the following command. + + ;; emacs -batch -f batch-byte-compile tpu-edt.el + + ;; This will produce a file named tpu-edt.elc. This new file can be + ;; used in place of the original tpu-edt.el file. In commands where + ;; the file type is not specified, emacs always attempts to use the + ;; byte-compiled version before resorting to the source. + + + ;; %% Regular expressions in TPU-edt + + ;; Gold-* toggles TPU-edt regular expression mode. In regular expression + ;; mode, find, find next, replace, and substitute accept emacs regular + ;; expressions. A complete list of emacs regular expressions can be + ;; found using the emacs "info" command (it's somewhat like the VMS help + ;; command). Try the following sequence of commands: + + ;; DO info + ;; m regex + + ;; Type "q" to quit out of info mode. + + ;; There is a problem in regular expression mode when searching for + ;; empty strings, like beginning-of-line (^) and end-of-line ($). + ;; When searching for these strings, find-next may find the current + ;; string, instead of the next one. This can cause global replace and + ;; substitute commands to loop forever in the same location. For this + ;; reason, commands like + + ;; replace "^" "> " " to beginning of line> + ;; replace "$" "00711" + + ;; may not work properly. + + ;; Commands like those above are very useful for adding text to the + ;; beginning or end of lines. They might work on a line-by-line basis, + ;; but go into an infinite loop if the "all" response is specified. If + ;; the goal is to add a string to the beginning or end of a particular + ;; set of lines TPU-edt provides functions to do this. + + ;; Gold-^ Add a string at BOL in region or buffer + ;; Gold-$ Add a string at EOL in region or buffer + + ;; There is also a TPU-edt interface to the native emacs string + ;; replacement commands. Gold-/ invokes this command. It accepts + ;; regular expressions if TPU-edt is in regular expression mode. Given + ;; a repeat count, it will perform the replacement without prompting + ;; for confirmation. + + ;; This command replaces empty strings correctly, however, it has its + ;; drawbacks. As a native emacs command, it has a different interface + ;; than the emulated TPU commands. Also, it works only in the forward + ;; direction, regardless of the current TPU-edt direction. + + + ;; %% Etcetera + + ;; That's TPU-edt in a nutshell... + + ;; Please send any bug reports, feature requests, or cookies to the + ;; author, Rob Riepel, at the address shown by the tpu-version command + ;; (Gold-V). + + ;; Share and enjoy... Rob Riepel 7/93 + + ;;; tpu-doc.el ends here diff -rc2P --exclude-from=exceptions emacs-19.17/lisp/tpu-edt.el emacs-19.18/lisp/tpu-edt.el *** emacs-19.17/lisp/tpu-edt.el --- emacs-19.18/lisp/tpu-edt.el Wed Aug 4 04:22:07 1993 *************** *** 0 **** --- 1,2124 ---- + ;;; tpu-edt.el --- Emacs emulating TPU emulating EDT + ;; Copyright (C) 1993 Free Software Foundation, Inc. + + ;; Author: Rob Riepel + ;; Maintainer: Rob Riepel + ;; Version: 3.0 + ;; Keywords: tpu edt tpu-edt + + ;; 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, 675 Mass Ave, Cambridge, MA 02139, USA. + + + ;;; + ;;; Revision Information + ;;; + (defconst tpu-revision "$Revision: 1.2 $" + "Revision number of TPU-edt.") + (defconst tpu-revision-date "$Date: 1993/08/04 08:18:22 $" + "Date current revision of TPU-edt was created.") + + + ;;; + ;;; User Configurable Variables + ;;; + (defconst tpu-have-ispell t + "*If non-nil (default), TPU-edt uses ispell for spell checking.") + + (defconst tpu-kill-buffers-silently nil + "*If non-nil, TPU-edt kills modified buffers without asking.") + + (defvar tpu-percent-scroll 75 + "*Percentage of the screen to scroll for next/previous screen commands.") + + (defvar tpu-pan-columns 16 + "*Number of columns the tpu-pan functions scroll left or right.") + + + ;;; + ;;; Emacs version identifiers - currently referenced by + ;;; + ;;; o tpu-mark o tpu-set-mark + ;;; o tpu-string-prompt o tpu-regexp-prompt + ;;; o tpu-edt-on o tpu-load-xkeys + ;;; o tpu-update-mode-line o mode line section + ;;; + (defconst tpu-emacs19-p (not (string-lessp emacs-version "19")) + "Non-NIL if we are running Lucid or GNU Emacs version 19.") + + (defconst tpu-gnu-emacs18-p (not tpu-emacs19-p) + "Non-NIL if we are running GNU Emacs version 18.") + + (defconst tpu-lucid-emacs19-p + (and tpu-emacs19-p (string-match "Lucid" emacs-version)) + "Non-NIL if we are running Lucid Emacs version 19.") + + (defconst tpu-gnu-emacs19-p (and tpu-emacs19-p (not tpu-lucid-emacs19-p)) + "Non-NIL if we are running GNU Emacs version 19.") + + + ;;; + ;;; Global Keymaps + ;;; + (defvar CSI-map (make-sparse-keymap) + "Maps the CSI function keys on the VT100 keyboard. + CSI is DEC's name for the sequence [.") + + (defvar SS3-map (make-sparse-keymap) + "Maps the SS3 function keys on the VT100 keyboard. + SS3 is DEC's name for the sequence O.") + + (defvar GOLD-map (make-keymap) + "Maps the function keys on the VT100 keyboard preceeded by PF1. + GOLD is the ASCII 7-bit escape sequence OP.") + + (defvar GOLD-CSI-map (make-sparse-keymap) + "Maps the function keys on the VT100 keyboard preceeded by GOLD-CSI.") + + (defvar GOLD-SS3-map (make-sparse-keymap) + "Maps the function keys on the VT100 keyboard preceeded by GOLD-SS3.") + + (defvar tpu-original-global-map (copy-keymap global-map) + "Original global keymap.") + + (and tpu-lucid-emacs19-p + (defvar minibuffer-local-ns-map (make-sparse-keymap) + "Hack to give Lucid emacs the same maps as GNU emacs.")) + + + ;;; + ;;; Global Variables + ;;; + (defvar tpu-edt-mode nil + "If non-nil, TPU-edt mode is active.") + + (defvar tpu-last-replaced-text "" + "Last text deleted by a TPU-edt replace command.") + (defvar tpu-last-deleted-region "" + "Last text deleted by a TPU-edt remove command.") + (defvar tpu-last-deleted-lines "" + "Last text deleted by a TPU-edt line-delete command.") + (defvar tpu-last-deleted-words "" + "Last text deleted by a TPU-edt word-delete command.") + (defvar tpu-last-deleted-char "" + "Last character deleted by a TPU-edt character-delete command.") + + (defvar tpu-search-last-string "" + "Last text searched for by the TPU-edt search commands.") + + (defvar tpu-regexp-p nil + "If non-nil, TPU-edt uses regexp search and replace routines.") + (defvar tpu-rectangular-p nil + "If non-nil, TPU-edt removes and inserts rectangles.") + (defvar tpu-advance t + "True when TPU-edt is operating in the forward direction.") + (defvar tpu-reverse nil + "True when TPU-edt is operating in the backward direction.") + (defvar tpu-control-keys t + "If non-nil, control keys are set to perform TPU functions.") + + (defvar tpu-rectangle-string nil + "Mode line string to identify rectangular mode.") + (defvar tpu-direction-string nil + "Mode line string to identify current direction.") + + (defvar tpu-add-at-bol-hist nil + "History variable for tpu-edt-add-at-bol function.") + (defvar tpu-add-at-eol-hist nil + "History variable for tpu-edt-add-at-eol function.") + (defvar tpu-regexp-prompt-hist nil + "History variable for search and replace functions.") + + + ;;; + ;;; Buffer Local Variables + ;;; + (defvar tpu-newline-and-indent-p nil + "If non-nil, Return produces a newline and indents.") + (make-variable-buffer-local 'tpu-newline-and-indent-p) + + (defvar tpu-newline-and-indent-string nil + "Mode line string to identify AutoIndent mode.") + (make-variable-buffer-local 'tpu-newline-and-indent-string) + + (defvar tpu-saved-delete-func nil + "Saved value of the delete key.") + (make-variable-buffer-local 'tpu-saved-delete-func) + + (defvar tpu-buffer-local-map nil + "TPU-edt buffer local key map.") + (make-variable-buffer-local 'tpu-buffer-local-map) + + + ;;; + ;;; Mode Line - Modify the mode line to show the following + ;;; + ;;; o If the mark is set. + ;;; o Direction of motion. + ;;; o Active rectangle mode. + ;;; + (defvar tpu-original-mode-line mode-line-format) + (defvar tpu-original-mm-alist minor-mode-alist) + + (defvar tpu-mark-flag " ") + (make-variable-buffer-local 'tpu-mark-flag) + + (defun tpu-set-mode-line (for-tpu) + "Set the mode for TPU-edt, or reset it to default Emacs." + (cond ((not for-tpu) + (setq mode-line-format tpu-original-mode-line) + (setq minor-mode-alist tpu-original-mm-alist)) + (t + (setq-default mode-line-format + (list (purecopy "") + 'mode-line-modified + 'mode-line-buffer-identification + (purecopy " ") + 'global-mode-string + (purecopy " ") + 'tpu-mark-flag + (purecopy " %[(") + 'mode-name 'minor-mode-alist "%n" 'mode-line-process + (purecopy ")%]----") + (purecopy '(-3 . "%p")) + (purecopy "-%-"))) + (or (assq 'tpu-newline-and-indent-p minor-mode-alist) + (setq minor-mode-alist + (cons '(tpu-newline-and-indent-p + tpu-newline-and-indent-string) + minor-mode-alist))) + (or (assq 'tpu-rectangular-p minor-mode-alist) + (setq minor-mode-alist + (cons '(tpu-rectangular-p tpu-rectangle-string) + minor-mode-alist))) + (or (assq 'tpu-direction-string minor-mode-alist) + (setq minor-mode-alist + (cons '(tpu-direction-string tpu-direction-string) + minor-mode-alist)))))) + + (defun tpu-update-mode-line nil + "Make sure mode-line in the current buffer reflects all changes." + (setq tpu-mark-flag (if (tpu-mark) "M" " ")) + (cond (tpu-emacs19-p (force-mode-line-update)) + (t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0)))) + + (cond (tpu-gnu-emacs19-p + (add-hook 'activate-mark-hook 'tpu-update-mode-line) + (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)) + (tpu-lucid-emacs19-p + (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line) + (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))) + + + ;;; + ;;; Match Markers - + ;;; + ;;; Set in: Search + ;;; + ;;; Used in: Replace, Substitute, Store-Text, Cut/Remove, + ;;; Append, and Change-Case + ;;; + (defvar tpu-match-beginning-mark (make-marker)) + (defvar tpu-match-end-mark (make-marker)) + + (defun tpu-set-match nil + "Set markers at match beginning and end." + ;; Add one to beginning mark so it stays with the first character of + ;; the string even if characters are added just before the string. + (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0)))) + (setq tpu-match-end-mark (copy-marker (match-end 0)))) + + (defun tpu-unset-match nil + "Unset match beginning and end markers." + (set-marker tpu-match-beginning-mark nil) + (set-marker tpu-match-end-mark nil)) + + (defun tpu-match-beginning nil + "Returns the location of the last match beginning." + (1- (marker-position tpu-match-beginning-mark))) + + (defun tpu-match-end nil + "Returns the location of the last match end." + (marker-position tpu-match-end-mark)) + + (defun tpu-check-match nil + "Returns t if point is between tpu-match markers. + Otherwise sets the tpu-match markers to nil and returns nil." + ;; make sure 1- marker is in this buffer + ;; 2- point is at or after beginning marker + ;; 3- point is before ending marker, or in the case of + ;; zero length regions (like bol, or eol) that the + ;; beginning, end, and point are equal. + (cond ((and + (equal (marker-buffer tpu-match-beginning-mark) (current-buffer)) + (>= (point) (1- (marker-position tpu-match-beginning-mark))) + (or + (< (point) (marker-position tpu-match-end-mark)) + (and (= (1- (marker-position tpu-match-beginning-mark)) + (marker-position tpu-match-end-mark)) + (= (marker-position tpu-match-end-mark) (point))))) t) + (t + (tpu-unset-match) nil))) + + (defun tpu-show-match-markers nil + "Show the values of the match markers." + (interactive) + (if (markerp tpu-match-beginning-mark) + (let ((beg (marker-position tpu-match-beginning-mark))) + (message "(%s, %s) in %s -- current %s in %s" + (if beg (1- beg) nil) + (marker-position tpu-match-end-mark) + (marker-buffer tpu-match-end-mark) + (point) (current-buffer))))) + + + ;;; + ;;; Utilities + ;;; + (defun tpu-caar (thingy) (car (car thingy))) + (defun tpu-cadr (thingy) (car (cdr thingy))) + + (defun tpu-mark nil + "TPU-edt version of the mark function. + Return the appropriate value of the mark for the current + version of emacs." + (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions))) + (tpu-gnu-emacs19-p (and mark-active (mark (not transient-mark-mode)))) + (t (mark)))) + + (defun tpu-set-mark (pos) + "TPU-edt verion of the set-mark function. + Sets the mark at POS and activates the region acording to the + current version of emacs." + (set-mark pos) + (and tpu-lucid-emacs19-p pos (zmacs-activate-region))) + + (defun tpu-string-prompt (prompt history-symbol) + "Read a string with PROMPT." + (if tpu-emacs19-p + (read-from-minibuffer prompt nil nil nil history-symbol) + (read-string prompt))) + + (defun tpu-y-or-n-p (prompt &optional not-yes) + "Prompt for a y or n answer with positive default. + Optional second argument NOT-YES changes default to negative. + Like emacs y-or-n-p, also accepts space as y and DEL as n." + (message (format "%s[%s]" prompt (if not-yes "n" "y"))) + (let ((doit t)) + (while doit + (setq doit nil) + (let ((ans (read-char))) + (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ )) + (setq tpu-last-answer t)) + ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) + (setq tpu-last-answer nil)) + ((= ans ?\r) (setq tpu-last-answer (not not-yes))) + (t + (setq doit t) (beep) + (message (format "Please answer y or n. %s[%s]" + prompt (if not-yes "n" "y")))))))) + tpu-last-answer) + + (defun tpu-local-set-key (key func) + "Replace a key in the TPU-edt local key map. + Create the key map if necessary." + (cond ((not (keymapp tpu-buffer-local-map)) + (setq tpu-buffer-local-map (if (current-local-map) + (copy-keymap (current-local-map)) + (make-sparse-keymap))) + (use-local-map tpu-buffer-local-map))) + (local-set-key key func)) + + (defun tpu-current-line nil + "Return the vertical position of point in the selected window. + Top line is 0. Counts each text line only once, even if it wraps." + (+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1)) + + + ;;; + ;;; Breadcrumbs + ;;; + (defvar tpu-breadcrumb-plist nil + "The set of user-defined markers (breadcrumbs), as a plist.") + + (defun tpu-drop-breadcrumb (num) + "Drops a breadcrumb that can be returned to later with goto-breadcrumb." + (interactive "p") + (put tpu-breadcrumb-plist num (list (current-buffer) (point))) + (message "Mark %d set." num)) + + (defun tpu-goto-breadcrumb (num) + "Returns to a breadcrumb set with drop-breadcrumb." + (interactive "p") + (cond ((get tpu-breadcrumb-plist num) + (switch-to-buffer (car (get tpu-breadcrumb-plist num))) + (goto-char (tpu-cadr (get tpu-breadcrumb-plist num))) + (message "mark %d found." num)) + (t + (message "mark %d not found." num)))) + + + ;;; + ;;; Miscellaneous + ;;; + (defun tpu-change-case (num) + "Change the case of the character under the cursor or region. + Accepts a prefix argument of the number of characters to invert." + (interactive "p") + (cond ((tpu-mark) + (let ((beg (region-beginning)) (end (region-end))) + (while (> end beg) + (funcall (if (= (downcase (char-after beg)) (char-after beg)) + 'upcase-region 'downcase-region) + beg (1+ beg)) + (setq beg (1+ beg))) + (tpu-unselect t))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (while (> end beg) + (funcall (if (= (downcase (char-after beg)) (char-after beg)) + 'upcase-region 'downcase-region) + beg (1+ beg)) + (setq beg (1+ beg))) + (tpu-unset-match))) + (t + (while (> num 0) + (funcall (if (= (downcase (following-char)) (following-char)) + 'upcase-region 'downcase-region) + (point) (1+ (point))) + (forward-char (if tpu-reverse -1 1)) + (setq num (1- num)))))) + + (defun tpu-fill (num) + "Fill paragraph or marked region. + With argument, fill and justify." + (interactive "P") + (cond ((tpu-mark) + (fill-region (point) (tpu-mark) num) + (tpu-unselect t)) + (t + (fill-paragraph num)))) + + (defun tpu-version nil + "Print the TPU-edt version number." + (interactive) + (message (concat "TPU-edt revision " + (substring tpu-revision 11 -2) + " by Rob Riepel (riepel@networking.stanford.edu) " + (substring tpu-revision-date 12 -11) "/" + (substring tpu-revision-date 9 11)))) + + (defun tpu-reset-screen-size (height width) + "Sets the screen size." + (interactive "nnew screen height: \nnnew screen width: ") + (set-screen-height height) + (set-screen-width width)) + + (defun tpu-toggle-newline-and-indent nil + "Toggle between 'newline and indent' and 'simple newline'." + (interactive) + (cond (tpu-newline-and-indent-p + (setq tpu-newline-and-indent-string "") + (setq tpu-newline-and-indent-p nil) + (tpu-local-set-key "\C-m" 'newline)) + (t + (setq tpu-newline-and-indent-string " AutoIndent") + (setq tpu-newline-and-indent-p t) + (tpu-local-set-key "\C-m" 'newline-and-indent))) + (tpu-update-mode-line) + (and (interactive-p) + (message "Carriage return inserts a newline%s" + (if tpu-newline-and-indent-p " and indents." ".")))) + + (defun tpu-spell-check nil + "Checks the spelling of the region, or of the entire buffer if no + region is selected." + (interactive) + (cond (tpu-have-ispell + (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer))) + (t + (if (tpu-mark) (spell-region (tpu-mark) (point)) (spell-buffer)))) + (if (tpu-mark) (tpu-unselect t))) + + (defun tpu-toggle-overwrite-mode nil + "Switches in and out of overwrite mode" + (interactive) + (cond (overwrite-mode + (tpu-local-set-key "\177" tpu-saved-delete-func) + (overwrite-mode 0)) + (t + (setq tpu-saved-delete-func (local-key-binding "\177")) + (tpu-local-set-key "\177" 'picture-backward-clear-column) + (overwrite-mode 1)))) + + (defun tpu-special-insert (num) + "Insert a character or control code according to + its ASCII decimal value." + (interactive "P") + (if overwrite-mode (delete-char 1)) + (insert (if num num 0))) + + + ;;; + ;;; TPU line-mode commands + ;;; + (defun tpu-include (file) + "TPU-like include file" + (interactive "fInclude file: ") + (save-excursion + (insert-file file) + (message ""))) + + (defun tpu-get (file) + "TPU-like get file" + (interactive "FFile to get: ") + (find-file file)) + + (defun tpu-what-line nil + "Tells what line the point is on, + and the total number of lines in the buffer." + (interactive) + (if (eobp) + (message "You are at the End of Buffer. The last line is %d." + (count-lines 1 (point-max))) + (message "Line %d of %d" + (count-lines 1 (1+ (point))) + (count-lines 1 (point-max))))) + + (defun tpu-exit nil + "Exit the way TPU does, save current buffer and ask about others." + (interactive) + (if (not (eq (recursion-depth) 0)) + (exit-recursive-edit) + (progn (save-buffer) (save-buffers-kill-emacs)))) + + (defun tpu-quit nil + "Quit the way TPU does, ask to make sure changes should be abandoned." + (interactive) + (let ((list (buffer-list)) + (working t)) + (while (and list working) + (let ((buffer (car list))) + (if (and (buffer-file-name buffer) (buffer-modified-p buffer)) + (if (tpu-y-or-n-p + "Modifications will not be saved, continue quitting? ") + (kill-emacs t) (setq working nil))) + (setq list (cdr list)))) + (if working (kill-emacs t)))) + + + ;;; + ;;; Command and Function Aliases + ;;; + ;;;###autoload + (fset 'tpu-edt-mode 'tpu-edt-on) + (fset 'TPU-EDT-MODE 'tpu-edt-on) + + ;;;###autoload + (fset 'tpu-edt 'tpu-edt-on) + (fset 'TPU-EDT 'tpu-edt-on) + + (fset 'exit 'tpu-exit) + (fset 'EXIT 'tpu-exit) + + (fset 'Get 'tpu-get) + (fset 'GET 'tpu-get) + + (fset 'include 'tpu-include) + (fset 'INCLUDE 'tpu-include) + + (fset 'quit 'tpu-quit) + (fset 'QUIT 'tpu-quit) + + (fset 'spell 'tpu-spell-check) + (fset 'SPELL 'tpu-spell-check) + + (fset 'what\ line 'tpu-what-line) + (fset 'WHAT\ LINE 'tpu-what-line) + + (fset 'replace 'tpu-lm-replace) + (fset 'REPLACE 'tpu-lm-replace) + + (fset 'help 'tpu-help) + (fset 'HELP 'tpu-help) + + ;; Around emacs version 18.57, function line-move was renamed to + ;; next-line-internal. If we're running under an older emacs, + ;; make next-line-internal equivalent to line-move. + + (if (not (fboundp 'next-line-internal)) (fset 'next-line-internal 'line-move)) + + + ;;; + ;;; Help + ;;; + (defconst tpu-help-keypad-map "\f + _______________________ _______________________________ + | HELP | Do | | | | | | + |KeyDefs| | | | | | | + |_______|_______________| |_______|_______|_______|_______| + _______________________ _______________________________ + | Find |Insert |Remove | | Gold | HELP |FndNxt | Del L | + | | |Sto Tex| | key |E-Help | Find |Undel L| + |_______|_______|_______| |_______|_______|_______|_______| + |Select |Pre Scr|Nex Scr| | Page | Sect |Append | Del W | + | Reset |Pre Win|Nex Win| | Do | Fill |Replace|Undel W| + |_______|_______|_______| |_______|_______|_______|_______| + |Move up| |Forward|Reverse|Remove | Del C | + | Top | |Bottom | Top |Insert |Undel C| + _______|_______|_______ |_______|_______|_______|_______| + |Mov Lef|Mov Dow|Mov Rig| | Word | EOL | Char | | + |StaOfLi|Bottom |EndOfLi| |ChngCas|Del EOL|SpecIns| Enter | + |_______|_______|_______| |_______|_______|_______| | + | Line |Select | Subs | + | Open Line | Reset | | + |_______________|_______|_______| + ") + + (defconst tpu-help-text " + \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f + + Control Characters + + ^A toggle insert and overwrite + ^B recall + ^E end of line + + ^G Cancel current operation + ^H beginning of line + ^J delete previous word + + ^K learn + ^L insert page break + ^R remember (during learn), re-center + + ^U delete to beginning of line + ^V quote + ^W refresh + + ^Z exit + ^X^X exchange point and mark - useful for checking region boundaries + + \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f + Gold- Functions + + B Next Buffer - display the next buffer (all buffers) + C Recall - edit and possibly repeat previous commands + E Exit - save current buffer and ask about others + + G Get - load a file into a new edit buffer + I Include - include a file in this buffer + K Kill Buffer - abandon edits and delete buffer + + M Buffer Menu - display a list of all buffers + N Next File Buffer - display next buffer containing a file + O Occur - show following lines containing REGEXP + + Q Quit - exit without saving anything + R Toggle rectangular mode for remove and insert + S Search and substitute - line mode REPLACE command + + U Undo - undo the last edit + W Write - save current buffer + X Exit - save all modified buffers and exit + + \n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f + + *** No more help, use P to view previous screen") + + (defvar tpu-help-enter (format "%s" "\eOM")) ; tpu-help enter key symbol + (defvar tpu-help-return (format "%s" "\r")) ; tpu-help enter key symbol + + (defun tpu-help nil + "Display TPU-edt help." + (interactive) + ;; Save current window configuration + (save-window-excursion + ;; Create and fill help buffer if necessary + (if (not (get-buffer "*TPU-edt Help*")) + (progn (generate-new-buffer "*TPU-edt Help*") + (switch-to-buffer "*TPU-edt Help*") + (insert tpu-help-keypad-map) + (insert tpu-help-text) + (setq buffer-read-only t))) + + ;; Display the help buffer + (switch-to-buffer "*TPU-edt Help*") + (delete-other-windows) + (tpu-move-to-beginning) + (forward-line 1) + (tpu-line-to-top-of-window) + + ;; Prompt for keys to describe, based on screen state (split/not split) + (let ((key nil) (split nil)) + (while (not (equal tpu-help-return (format "%s" key))) + (if split + (setq key + (read-key-sequence + "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): ")) + (setq key + (read-key-sequence + "Press the key you want help on (RET to exit, N next screen, P prev screen): "))) + + ;; Process the read key + ;; + ;; ENTER - Display just the help window + ;; N or n - Next help or describe-key screen + ;; P or p - Previous help or describe-key screen + ;; RETURN - Exit from TPU-help + ;; default - describe the key + ;; + (cond ((equal tpu-help-enter (format "%s" key)) + (setq split nil) + (delete-other-windows)) + ((or (equal "N" key) (equal "n" key)) + (cond (split + (condition-case nil + (scroll-other-window 8) + (error nil))) + (t + (forward-page) + (forward-line 1) + (tpu-line-to-top-of-window)))) + ((or (equal "P" key) (equal "p" key)) + (cond (split + (condition-case nil + (scroll-other-window -8) + (error nil))) + (t + (backward-page 2) + (forward-line 1) + (tpu-line-to-top-of-window)))) + ((not (equal tpu-help-return (format "%s" key))) + (setq split t) + (describe-key key) + ;; If the key is undefined, leave the + ;; message in the mini-buffer for 3 seconds + (if (not (key-binding key)) (sit-for 3)))))))) + + + ;;; + ;;; Auto-insert + ;;; + (defun tpu-insert-escape nil + "Inserts an escape character, and so becomes the escape-key alias." + (interactive) + (insert "\e")) + + (defun tpu-insert-formfeed nil + "Inserts a formfeed character." + (interactive) + (insert "\C-L")) + + + ;;; + ;;; Define key + ;;; + (defun tpu-end-define-macro-key (key) + "Ends the current macro definition" + (interactive "kPress the key you want to use to do what was just learned: ") + (end-kbd-macro nil) + (global-set-key key last-kbd-macro) + (global-set-key "\C-r" tpu-saved-control-r)) + + (defun tpu-define-macro-key nil + "Bind a set of keystrokes to a single key, or key combination." + (interactive) + (setq tpu-saved-control-r (global-key-binding "\C-r")) + (global-set-key "\C-r" 'tpu-end-define-macro-key) + (start-kbd-macro nil)) + + + ;;; + ;;; Buffers and Windows + ;;; + (defun tpu-kill-buffer nil + "Kills the current buffer. If tpu-kill-buffers-silently is non-nil, + kills modified buffers without asking." + (interactive) + (if tpu-kill-buffers-silently (set-buffer-modified-p nil)) + (kill-buffer (current-buffer))) + + (defun tpu-save-all-buffers-kill-emacs nil + "Save all buffers and exit emacs." + (interactive) + (setq trim-versions-without-asking t) + (save-buffers-kill-emacs t)) + + (defun tpu-write-current-buffers nil + "Save all modified buffers without exiting." + (interactive) + (save-some-buffers t)) + + (defun tpu-next-buffer nil + "Go to next buffer in ring." + (interactive) + (switch-to-buffer (car (reverse (buffer-list))))) + + (defun tpu-next-file-buffer nil + "Go to next buffer in ring that is visiting a file." + (interactive) + (setq starting-buffer (buffer-name)) + (switch-to-buffer (car (reverse (buffer-list)))) + (while (and (not (equal (buffer-name) starting-buffer)) + (not (buffer-file-name))) + (switch-to-buffer (car (reverse (buffer-list))))) + (if (equal (buffer-name) starting-buffer) (error "No other buffers."))) + + (defun tpu-next-window nil + "Move to the next window." + (interactive) + (if (one-window-p) (message "There is only one window on screen.") + (other-window 1))) + + (defun tpu-previous-window nil + "Move to the previous window." + (interactive) + (if (one-window-p) (message "There is only one window on screen.") + (select-window (previous-window)))) + + + ;;; + ;;; Search + ;;; + (defun tpu-toggle-regexp nil + "Switches in and out of regular expression search and replace mode." + (interactive) + (setq tpu-regexp-p (not tpu-regexp-p)) + (tpu-set-search) + (and (interactive-p) + (message "Regular expression search and substitute %sabled." + (if tpu-regexp-p "en" "dis")))) + + (defun tpu-regexp-prompt (prompt) + "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set." + (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt))) + (if tpu-emacs19-p + (read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist) + (read-string re-prompt)))) + + (defun tpu-search nil + "Search for a string or regular expression. + The search is performed in the current direction." + (interactive) + (tpu-set-search) + (tpu-search-internal "")) + + (defun tpu-search-forward nil + "Search for a string or regular expression. + The search is begins in the forward direction." + (interactive) + (setq searching-forward t) + (tpu-set-search t) + (tpu-search-internal "")) + + (defun tpu-search-reverse nil + "Search for a string or regular expression. + The search is begins in the reverse direction." + (interactive) + (setq searching-forward nil) + (tpu-set-search t) + (tpu-search-internal "")) + + (defun tpu-search-again nil + "Search for the same string or regular expression as last time. + The search is performed in the current direction." + (interactive) + (tpu-search-internal tpu-search-last-string)) + + ;; tpu-set-search defines the search functions used by the TPU-edt internal + ;; search function. It should be called whenever the direction changes, or + ;; the regular expression mode is turned on or off. It can also be called + ;; to ensure that the next search will be in the current direction. It is + ;; called from: + + ;; tpu-advance tpu-backup + ;; tpu-toggle-regexp tpu-toggle-search-direction (t) + ;; tpu-search tpu-lm-replace + ;; tpu-search-forward (t) tpu-search-reverse (t) + + (defun tpu-set-search (&optional arg) + "Set the search functions and set the search direction to the current + direction. If an argument is specified, don't set the search direction." + (if (not arg) (setq searching-forward (if tpu-advance t nil))) + (cond (searching-forward + (cond (tpu-regexp-p + (fset 'tpu-emacs-search 're-search-forward) + (fset 'tpu-emacs-rev-search 're-search-backward)) + (t + (fset 'tpu-emacs-search 'search-forward) + (fset 'tpu-emacs-rev-search 'search-backward)))) + (t + (cond (tpu-regexp-p + (fset 'tpu-emacs-search 're-search-backward) + (fset 'tpu-emacs-rev-search 're-search-forward)) + (t + (fset 'tpu-emacs-search 'search-backward) + (fset 'tpu-emacs-rev-search 'search-forward)))))) + + (defun tpu-search-internal (pat &optional quiet) + "Search for a string or regular expression." + (setq tpu-search-last-string + (if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: "))) + + (tpu-unset-match) + (tpu-adjust-search) + + (cond ((tpu-emacs-search tpu-search-last-string nil t) + (tpu-set-match) (goto-char (tpu-match-beginning))) + + (t + (tpu-adjust-search t) + (let ((found nil) (pos nil)) + (save-excursion + (let ((searching-forward (not searching-forward))) + (tpu-adjust-search) + (setq found (tpu-emacs-rev-search tpu-search-last-string nil t)) + (setq pos (match-beginning 0)))) + + (cond (found + (cond ((tpu-y-or-n-p + (format "Found in %s direction. Go there? " + (if searching-forward "reverse" "forward"))) + (goto-char pos) (tpu-set-match) + (tpu-toggle-search-direction)))) + + (t + (if (not quiet) + (message + "%sSearch failed: \"%s\"" + (if tpu-regexp-p "RE " "") tpu-search-last-string)))))))) + + (fset 'tpu-search-internal-core (symbol-function 'tpu-search-internal)) + + (defun tpu-adjust-search (&optional arg) + "For forward searches, move forward a character before searching, + and backward a character after a failed search. Arg means end of search." + (if searching-forward + (cond (arg (if (not (bobp)) (forward-char -1))) + (t (if (not (eobp)) (forward-char 1)))))) + + (defun tpu-toggle-search-direction nil + "Toggle the TPU-edt search direction. + Used for reversing a search in progress." + (interactive) + (setq searching-forward (not searching-forward)) + (tpu-set-search t) + (and (interactive-p) + (message "Searching %sward." + (if searching-forward "for" "back")))) + + + ;;; + ;;; Select / Unselect + ;;; + (defun tpu-select (&optional quiet) + "Sets the mark to define one end of a region." + (interactive "P") + (cond ((tpu-mark) + (tpu-unselect quiet)) + (t + (tpu-set-mark (point)) + (tpu-update-mode-line) + (if (not quiet) (message "Move the text cursor to select text."))))) + + (defun tpu-unselect (&optional quiet) + "Removes the mark to unselect the current region." + (interactive "P") + (setq mark-ring nil) + (tpu-set-mark nil) + (tpu-update-mode-line) + (if (not quiet) (message "Selection canceled."))) + + + ;;; + ;;; Delete / Cut + ;;; + (defun tpu-toggle-rectangle nil + "Toggle rectangular mode for remove and insert." + (interactive) + (setq tpu-rectangular-p (not tpu-rectangular-p)) + (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" "")) + (tpu-update-mode-line) + (and (interactive-p) + (message "Rectangular cut and paste %sabled." + (if tpu-rectangular-p "en" "dis")))) + + (defun tpu-arrange-rectangle nil + "Adjust point and mark to mark upper left and lower right + corners of a rectangle." + (let ((mc (current-column)) + (pc (progn (exchange-point-and-mark) (current-column)))) + + (cond ((> (point) (tpu-mark)) ; point on lower line + (cond ((> pc mc) ; point @ lower-right + (exchange-point-and-mark)) ; point -> upper-left + + (t ; point @ lower-left + (move-to-column-force mc) ; point -> lower-right + (exchange-point-and-mark) ; point -> upper-right + (move-to-column-force pc)))) ; point -> upper-left + + (t ; point on upper line + (cond ((> pc mc) ; point @ upper-right + (move-to-column-force mc) ; point -> upper-left + (exchange-point-and-mark) ; point -> lower-left + (move-to-column-force pc) ; point -> lower-right + (exchange-point-and-mark))))))) ; point -> upper-left + + (defun tpu-cut-text nil + "Delete the selected region. + The text is saved for the tpu-paste command." + (interactive) + (cond ((tpu-mark) + (cond (tpu-rectangular-p + (tpu-arrange-rectangle) + (picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode)) + (tpu-unselect t)) + (t + (setq tpu-last-deleted-region + (buffer-substring (tpu-mark) (point))) + (delete-region (tpu-mark) (point)) + (tpu-unselect t)))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (setq tpu-last-deleted-region (buffer-substring beg end)) + (delete-region beg end) + (tpu-unset-match))) + (t + (error "No selection active.")))) + + (defun tpu-store-text nil + "Copy the selected region to the cut buffer without deleting it. + The text is saved for the tpu-paste command." + (interactive) + (cond ((tpu-mark) + (cond (tpu-rectangular-p + (save-excursion + (tpu-arrange-rectangle) + (setq picture-killed-rectangle + (extract-rectangle (point) (tpu-mark)))) + (tpu-unselect t)) + (t + (setq tpu-last-deleted-region + (buffer-substring (tpu-mark) (point))) + (tpu-unselect t)))) + ((tpu-check-match) + (setq tpu-last-deleted-region + (buffer-substring (tpu-match-beginning) (tpu-match-end))) + (tpu-unset-match)) + (t + (error "No selection active.")))) + + (defun tpu-cut (arg) + "Copy selected region to the cut buffer. In the absence of an + argument, delete the selected region too." + (interactive "P") + (if arg (tpu-store-text) (tpu-cut-text))) + + (defun tpu-append-region (arg) + "Append selected region to the tpu-cut buffer. In the absence of an + argument, delete the selected region too." + (interactive "P") + (cond ((tpu-mark) + (let ((beg (region-beginning)) (end (region-end))) + (setq tpu-last-deleted-region + (concat tpu-last-deleted-region + (buffer-substring beg end))) + (if (not arg) (delete-region beg end)) + (tpu-unselect t))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (setq tpu-last-deleted-region + (concat tpu-last-deleted-region + (buffer-substring beg end))) + (if (not arg) (delete-region beg end)) + (tpu-unset-match))) + (t + (error "No selection active.")))) + + (defun tpu-delete-current-line (num) + "Delete one or specified number of lines after point. + This includes the newline character at the end of each line. + They are saved for the TPU-edt undelete-lines command." + (interactive "p") + (let ((beg (point))) + (forward-line num) + (if (not (eq (preceding-char) ?\n)) + (insert "\n")) + (setq tpu-last-deleted-lines + (buffer-substring beg (point))) + (delete-region beg (point)))) + + (defun tpu-delete-to-eol (num) + "Delete text up to end of line. + With argument, delete up to to Nth line-end past point. + They are saved for the TPU-edt undelete-lines command." + (interactive "p") + (let ((beg (point))) + (forward-char 1) + (end-of-line num) + (setq tpu-last-deleted-lines + (buffer-substring beg (point))) + (delete-region beg (point)))) + + (defun tpu-delete-to-bol (num) + "Delete text back to beginning of line. + With argument, delete up to to Nth line-end past point. + They are saved for the TPU-edt undelete-lines command." + (interactive "p") + (let ((beg (point))) + (tpu-next-beginning-of-line num) + (setq tpu-last-deleted-lines + (buffer-substring (point) beg)) + (delete-region (point) beg))) + + (defun tpu-delete-current-word (num) + "Delete one or specified number of words after point. + They are saved for the TPU-edt undelete-words command." + (interactive "p") + (let ((beg (point))) + (tpu-forward-to-word num) + (setq tpu-last-deleted-words + (buffer-substring beg (point))) + (delete-region beg (point)))) + + (defun tpu-delete-previous-word (num) + "Delete one or specified number of words before point. + They are saved for the TPU-edt undelete-words command." + (interactive "p") + (let ((beg (point))) + (tpu-backward-to-word num) + (setq tpu-last-deleted-words + (buffer-substring (point) beg)) + (delete-region beg (point)))) + + (defun tpu-delete-current-char (num) + "Delete one or specified number of characters after point. The last + character deleted is saved for the TPU-edt undelete-char command." + (interactive "p") + (while (and (> num 0) (not (eobp))) + (setq tpu-last-deleted-char (char-after (point))) + (cond (overwrite-mode + (picture-clear-column 1) + (forward-char 1)) + (t + (delete-char 1))) + (setq num (1- num)))) + + + ;;; + ;;; Undelete / Paste + ;;; + (defun tpu-paste (num) + "Insert the last region or rectangle of killed text. + With argument reinserts the text that many times." + (interactive "p") + (while (> num 0) + (cond (tpu-rectangular-p + (let ((beg (point))) + (save-excursion + (picture-yank-rectangle (not overwrite-mode)) + (message "")) + (goto-char beg))) + (t + (insert tpu-last-deleted-region))) + (setq num (1- num)))) + + (defun tpu-undelete-lines (num) + "Insert lines deleted by last TPU-edt line-deletion command. + With argument reinserts lines that many times." + (interactive "p") + (let ((beg (point))) + (while (> num 0) + (insert tpu-last-deleted-lines) + (setq num (1- num))) + (goto-char beg))) + + (defun tpu-undelete-words (num) + "Insert words deleted by last TPU-edt word-deletion command. + With argument reinserts words that many times." + (interactive "p") + (let ((beg (point))) + (while (> num 0) + (insert tpu-last-deleted-words) + (setq num (1- num))) + (goto-char beg))) + + (defun tpu-undelete-char (num) + "Insert character deleted by last TPU-edt character-deletion command. + With argument reinserts the character that many times." + (interactive "p") + (while (> num 0) + (if overwrite-mode (prog1 (forward-char -1) (delete-char 1))) + (insert tpu-last-deleted-char) + (forward-char -1) + (setq num (1- num)))) + + + ;;; + ;;; Replace and Substitute + ;;; + (defun tpu-replace nil + "Replace the selected region with the contents of the cut buffer." + (interactive) + (cond ((tpu-mark) + (let ((beg (region-beginning)) (end (region-end))) + (setq tpu-last-replaced-text (buffer-substring beg end)) + (delete-region beg end) + (insert tpu-last-deleted-region) + (tpu-unselect t))) + ((tpu-check-match) + (let ((beg (tpu-match-beginning)) (end (tpu-match-end))) + (setq tpu-last-replaced-text (buffer-substring beg end)) + (replace-match tpu-last-deleted-region + (not case-replace) (not tpu-regexp-p)) + (tpu-unset-match))) + (t + (error "No selection active.")))) + + (defun tpu-substitute (num) + "Replace the selected region with the contents of the cut buffer, and + repeat most recent search. A numeric argument serves as a repeat count. + A negative argument means replace all occurrences of the search string." + (interactive "p") + (cond ((or (tpu-mark) (tpu-check-match)) + (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match))) + (let ((beg (point))) + (tpu-replace) + (if searching-forward (forward-char -1) (goto-char beg)) + (if (= num 1) (tpu-search-internal tpu-search-last-string) + (tpu-search-internal-core tpu-search-last-string))) + (setq num (1- num)))) + (t + (error "No selection active.")))) + + (defun tpu-lm-replace (from to) + "Interactively search for OLD-string and substitute NEW-string." + (interactive (list (tpu-regexp-prompt "Old String: ") + (tpu-regexp-prompt "New String: "))) + + (let ((doit t) (strings 0)) + + ;; Can't replace null strings + (if (string= "" from) (error "No string to replace.")) + + ;; Find the first occurrence + (tpu-set-search) + (tpu-search-internal from t) + + ;; Loop on replace question - yes, no, all, last, or quit. + (while doit + (if (not (tpu-check-match)) (setq doit nil) + (progn (message "Replace? Type Yes, No, All, Last, or Quit: ") + (let ((ans (read-char))) + + (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ )) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal from t)) + + ((or (= ans ?n) (= ans ?N) (= ans ?\C-?)) + (tpu-search-internal from t)) + + ((or (= ans ?a) (= ans ?A)) + (save-excursion + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal-core from t) + (while (tpu-check-match) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if searching-forward (forward-char -1) (goto-char beg))) + (tpu-search-internal-core from t))) + (setq doit nil)) + + ((or (= ans ?l) (= ans ?L)) + (let ((beg (point))) + (replace-match to (not case-replace) (not tpu-regexp-p)) + (setq strings (1+ strings)) + (if searching-forward (forward-char -1) (goto-char beg))) + (setq doit nil)) + + ((or (= ans ?q) (= ans ?Q)) + (setq doit nil))))))) + + (message "Replaced %s occurrence%s." strings + (if (not (= 1 strings)) "s" "")))) + + (defun tpu-emacs-replace (&optional dont-ask) + "A TPU-edt interface to the emacs replace functions. If TPU-edt is + currently in regular expression mode, the emacs regular expression + replace functions are used. If an argument is supplied, replacements + a